feat: add vsm hub metadata

2026-05-19 02:16:39 +02:00
parent 75ad691dd6
commit 5d5e810886
11 changed files with 161 additions and 6 deletions
--- a/Web/Controller/Api/V2/HubRegistry.hs
+++ b/Web/Controller/Api/V2/HubRegistry.hs
@@ -61,6 +61,9 @@ hubDetailJson hub mManifest mSnapshot =
        , "slug"       .= hub.slug
        , "domain"     .= hub.domain
        , "hubKind"    .= hub.hubKind
+        , "hubFamily"  .= hub.hubFamily
+        , "vsmFunction" .= hub.vsmFunction
+        , "vsmSystem" .= hub.vsmSystem
        , "gaafStatus" .= gaafIndicator
        , "manifest"   .= fmap manifestSummary mManifest
        , "healthScore" .= fmap (.healthScore) mSnapshot
--- a/Web/Controller/Api/V2/Hubs.hs
+++ b/Web/Controller/Api/V2/Hubs.hs
@@ -45,6 +45,9 @@ createHub = do
        name   = paramOrNothing @Text "name"
        domain = paramOrNothing @Text "domain"
        kind   = fromMaybe "domain" (nonEmptyText =<< paramOrNothing @Text "hubKind")
+        hubFamily = nonEmptyText =<< paramOrNothing @Text "hubFamily"
+        vsmFunction = nonEmptyText =<< paramOrNothing @Text "vsmFunction"
+        vsmSystem = nonEmptyText =<< paramOrNothing @Text "vsmSystem"

    let missing = missingRequiredFields
            [ ("slug", slug)
@@ -65,6 +68,14 @@ createHub = do
            , "valid" .= validCreateHubKinds
            ]

+    unless (validVsmMetadata hubFamily vsmFunction vsmSystem) do
+        respondWithStatus 422 $ object
+            [ "error" .= ("Invalid VSM hub metadata" :: Text)
+            , "code"  .= ("invalid_vsm_metadata" :: Text)
+            , "hint"  .= ("Use no VSM fields, or set hubFamily=vsm with vsmFunction and vsmSystem." :: Text)
+            , "validVsmSystems" .= validVsmSystems
+            ]
+
    let Just slugText   = slug
        Just nameText   = name
        Just domainText = domain
@@ -84,6 +95,9 @@ createHub = do
        |> set #name nameText
        |> set #domain domainText
        |> set #hubKind kind
+        |> set #hubFamily hubFamily
+        |> set #vsmFunction vsmFunction
+        |> set #vsmSystem vsmSystem
        |> createRecord
    respondWithStatus 201 (hubToJson hub)

@@ -94,6 +108,9 @@ hubToJson hub = object
    , "name"      .= hub.name
    , "domain"    .= hub.domain
    , "hubKind"   .= hub.hubKind
+    , "hubFamily" .= hub.hubFamily
+    , "vsmFunction" .= hub.vsmFunction
+    , "vsmSystem" .= hub.vsmSystem
    , "createdAt" .= hub.createdAt
    ]

@@ -103,6 +120,18 @@ validCreateHubKinds = ["domain", "shared"]
 validCreateHubKind :: Text -> Bool
 validCreateHubKind kind = kind `elem` validCreateHubKinds

+validVsmSystems :: [Text]
+validVsmSystems = ["1", "2", "3", "3*", "4", "5", "environment"]
+
+validVsmSystem :: Text -> Bool
+validVsmSystem systemName = systemName `elem` validVsmSystems
+
+validVsmMetadata :: Maybe Text -> Maybe Text -> Maybe Text -> Bool
+validVsmMetadata Nothing Nothing Nothing = True
+validVsmMetadata (Just "vsm") (Just functionName) (Just systemName) =
+    functionName /= "" && validVsmSystem systemName
+validVsmMetadata _ _ _ = False
+
 missingRequiredFields :: [(Text, Maybe Text)] -> [Text]
 missingRequiredFields fields =
    [ name | (name, value) <- fields, maybe True (== "") value ]
--- a/Web/Controller/Api/V2/OpenApi.hs
+++ b/Web/Controller/Api/V2/OpenApi.hs
@@ -92,6 +92,7 @@ buildOpenApiSpec = do
                        ]
                    ]
                , "Hub" .= hubSchema
+                , "CreateHubRequest" .= createHubRequestSchema
                , "HubCapabilityManifest" .= manifestSchema
                , "ApiConsumer" .= apiConsumerSchema
                , "ApiKey" .= apiKeySchema
@@ -320,10 +321,28 @@ hubSchema = object
        , "name"      .= strProp
        , "domain"    .= strProp
        , "hubKind"   .= object ["type" .= ("string" :: Text), "enum" .= ["domain" :: Text, "shared"]]
+        , "hubFamily" .= object ["type" .= ("string" :: Text), "enum" .= ["vsm" :: Text]]
+        , "vsmFunction" .= strProp
+        , "vsmSystem" .= object ["type" .= ("string" :: Text), "enum" .= ["1" :: Text, "2", "3", "3*", "4", "5", "environment"]]
        , "createdAt" .= object ["type" .= ("string" :: Text), "format" .= ("date-time" :: Text)]
        ]
    ]

+createHubRequestSchema :: Value
+createHubRequestSchema = object
+    [ "type" .= ("object" :: Text)
+    , "required" .= (["slug", "name", "domain"] :: [Text])
+    , "properties" .= object
+        [ "slug" .= strProp
+        , "name" .= strProp
+        , "domain" .= strProp
+        , "hubKind" .= object ["type" .= ("string" :: Text), "enum" .= ["domain" :: Text, "shared"]]
+        , "hubFamily" .= object ["type" .= ("string" :: Text), "enum" .= ["vsm" :: Text]]
+        , "vsmFunction" .= strProp
+        , "vsmSystem" .= object ["type" .= ("string" :: Text), "enum" .= ["1" :: Text, "2", "3", "3*", "4", "5", "environment"]]
+        ]
+    ]
+
 widgetSchema :: Value
 widgetSchema = object
    [ "type" .= ("object" :: Text)
--- a/Web/Controller/Api/V2/Sdk.hs
+++ b/Web/Controller/Api/V2/Sdk.hs
@@ -94,7 +94,7 @@ tsSdkClientClass = T.unlines
    , "    });"
    , "  }"
    , ""
-    , "  async createHub(body: { slug: string; name: string; domain: string; hubKind?: 'domain' | 'shared' }) {"
+    , "  async createHub(body: { slug: string; name: string; domain: string; hubKind?: 'domain' | 'shared'; hubFamily?: 'vsm'; vsmFunction?: string; vsmSystem?: '1' | '2' | '3' | '3*' | '4' | '5' | 'environment' }) {"
    , "    return this.fetch('/hubs', 'POST', body).then(r => r.json());"
    , "  }"
    , ""
@@ -177,8 +177,12 @@ pyClientClass = T.unlines
    , "        with urllib.request.urlopen(req) as resp:"
    , "            return json.loads(resp.read())"
    , ""
-    , "    def create_hub(self, slug: str, name: str, domain: str, hub_kind: str = 'domain') -> dict:"
-    , "        return self._request('/hubs', 'POST', {'slug': slug, 'name': name, 'domain': domain, 'hubKind': hub_kind})"
+    , "    def create_hub(self, slug: str, name: str, domain: str, hub_kind: str = 'domain', hub_family: Optional[str] = None, vsm_function: Optional[str] = None, vsm_system: Optional[str] = None) -> dict:"
+    , "        body: dict = {'slug': slug, 'name': name, 'domain': domain, 'hubKind': hub_kind}"
+    , "        if hub_family: body['hubFamily'] = hub_family"
+    , "        if vsm_function: body['vsmFunction'] = vsm_function"
+    , "        if vsm_system: body['vsmSystem'] = vsm_system"
+    , "        return self._request('/hubs', 'POST', body)"
    , ""
    , "    def create_hub_capability_manifest(self, body: dict) -> dict:"
    , "        return self._request('/hub-capability-manifests', 'POST', body)"
--- a/Web/View/HubRegistry/Index.hs
+++ b/Web/View/HubRegistry/Index.hs
@@ -53,6 +53,7 @@ renderRow row@HubRegistryRow { hub, mManifest, mLatestSnapshot } =
                    {hub.name}
                </a>
                <span class="text-xs text-gray-400 font-mono">{hub.hubKind}</span>
+                {classificationBadge hub}
                {gaafBadge gs}
            </div>
            <div class="flex items-center gap-4 text-xs text-gray-500">
@@ -74,6 +75,17 @@ gaafBadge GaafDraftOnly  =
 gaafBadge GaafNoManifest =
    [hsx|<span class="px-2 py-0.5 rounded text-xs bg-red-100 text-red-700">no manifest</span>|]

+classificationBadge :: Hub -> Html
+classificationBadge hub =
+    case (hub.hubFamily, hub.vsmFunction, hub.vsmSystem) of
+        (Just "vsm", Just functionName, Just systemName) ->
+            [hsx|<span class="px-2 py-0.5 rounded text-xs bg-emerald-100 text-emerald-800">VSM {functionName} / {vsmSystemLabel systemName}</span>|]
+        _ -> mempty
+
+vsmSystemLabel :: Text -> Text
+vsmSystemLabel "environment" = "Environment"
+vsmSystemLabel systemName = "System " <> systemName
+
 healthScoreBadge :: Int -> Html
 healthScoreBadge s =
    let cls :: Text
--- a/Web/View/Hubs/Index.hs
+++ b/Web/View/Hubs/Index.hs
@@ -26,6 +26,7 @@ instance View IndexView where
                        <th class="text-left px-4 py-3 font-medium text-gray-700">Slug</th>
                        <th class="text-left px-4 py-3 font-medium text-gray-700">Domain</th>
                        <th class="text-left px-4 py-3 font-medium text-gray-700">Kind</th>
+                        <th class="text-left px-4 py-3 font-medium text-gray-700">Family</th>
                        <th class="px-4 py-3"></th>
                    </tr>
                </thead>
@@ -41,6 +42,17 @@ kindBadge "framework" = [hsx|<span class="px-2 py-0.5 rounded text-xs bg-purple-
 kindBadge "shared"    = [hsx|<span class="px-2 py-0.5 rounded text-xs bg-teal-100 text-teal-800">shared</span>|]
 kindBadge _           = [hsx|<span class="px-2 py-0.5 rounded text-xs bg-blue-100 text-blue-800">domain</span>|]

+classificationBadge :: Hub -> Html
+classificationBadge hub =
+    case (hub.hubFamily, hub.vsmFunction, hub.vsmSystem) of
+        (Just "vsm", Just functionName, Just systemName) ->
+            [hsx|<span class="px-2 py-0.5 rounded text-xs bg-emerald-100 text-emerald-800">VSM {functionName} / {vsmSystemLabel systemName}</span>|]
+        _ -> [hsx|<span class="text-xs text-gray-400">-</span>|]
+
+vsmSystemLabel :: Text -> Text
+vsmSystemLabel "environment" = "Environment"
+vsmSystemLabel systemName = "System " <> systemName
+
 renderHub :: Hub -> Html
 renderHub hub = [hsx|
    <tr class="border-b border-gray-100 hover:bg-gray-50">
@@ -53,6 +65,7 @@ renderHub hub = [hsx|
        <td class="px-4 py-3 text-gray-500 font-mono text-xs">{hub.slug}</td>
        <td class="px-4 py-3 text-gray-500">{hub.domain}</td>
        <td class="px-4 py-3">{kindBadge hub.hubKind}</td>
+        <td class="px-4 py-3">{classificationBadge hub}</td>
        <td class="px-4 py-3 text-right">
            <a href={EditHubAction (hub.id)}
               class="text-gray-500 hover:text-gray-700 text-xs mr-3">Edit</a>
--- a/Web/View/Hubs/Show.hs
+++ b/Web/View/Hubs/Show.hs
@@ -27,6 +27,7 @@ instance View ShowView where
                    <div class="flex items-center gap-2">
                        <h1 class="text-2xl font-semibold">{hub.name}</h1>
                        {kindBadge hub.hubKind}
+                        {classificationBadge hub}
                    </div>
                    <p class="text-sm text-gray-500 mt-1">
                        <span class="font-mono bg-gray-100 px-1 rounded">{hub.slug}</span>
@@ -223,6 +224,17 @@ kindBadge "framework" = [hsx|<span class="px-2 py-0.5 rounded text-xs bg-purple-
 kindBadge "shared"    = [hsx|<span class="px-2 py-0.5 rounded text-xs bg-teal-100 text-teal-800">shared</span>|]
 kindBadge _           = [hsx|<span class="px-2 py-0.5 rounded text-xs bg-blue-100 text-blue-800">domain</span>|]

+classificationBadge :: Hub -> Html
+classificationBadge hub =
+    case (hub.hubFamily, hub.vsmFunction, hub.vsmSystem) of
+        (Just "vsm", Just functionName, Just systemName) ->
+            [hsx|<span class="px-2 py-0.5 rounded text-xs bg-emerald-100 text-emerald-800">VSM {functionName} / {vsmSystemLabel systemName}</span>|]
+        _ -> mempty
+
+vsmSystemLabel :: Text -> Text
+vsmSystemLabel "environment" = "Environment"
+vsmSystemLabel systemName = "System " <> systemName
+
 maybeText :: Maybe Text -> [Text]
 maybeText Nothing  = []
 maybeText (Just t) = [t]