feat: add v2 manifest bootstrap endpoints

Web/Controller/Api/V2/HubCapabilityManifests.hs

@@ -0,0 +1,264 @@
+module Web.Controller.Api.V2.HubCapabilityManifests where
+
+import Web.Types
+import Generated.Types
+import IHP.Prelude
+import IHP.ControllerPrelude
+import Data.Aeson (Value(..), object, toJSON, (.=))
+import IHP.ControllerSupport (getHeader, requestBodyJSON)
+import Network.Wai (requestMethod)
+import Web.Controller.Api.V2.Auth
+    ( requireApiConsumer, paginatedResponse, getPageParams
+    , respondWithStatus )
+import Control.Monad (void)
+import Data.Maybe (mapMaybe)
+import Data.String (fromString)
+import qualified Data.Aeson.Key as K
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.ByteString as BS
+import qualified Data.UUID as UUID
+import qualified Data.Vector as V
+import Database.PostgreSQL.Simple (Only(..))
+
+instance Controller ApiV2HubCapabilityManifestsController where
+
+    action ApiV2IndexHubCapabilityManifestsAction = do
+        case requestMethod ?request of
+            "GET"  -> listManifests
+            "POST" -> createManifest
+            _      -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
+
+    action ApiV2ShowHubCapabilityManifestAction { hubCapabilityManifestId } = do
+        case requestMethod ?request of
+            "GET"   -> showManifest hubCapabilityManifestId
+            "PATCH" -> updateManifest hubCapabilityManifestId
+            _       -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
+
+    action ApiV2CreateHubCapabilityManifestAction = createManifest
+
+    action ApiV2UpdateHubCapabilityManifestAction { hubCapabilityManifestId } =
+        updateManifest hubCapabilityManifestId
+
+    action ApiV2ActivateHubCapabilityManifestAction { hubCapabilityManifestId } = do
+        when (requestMethod ?request /= "POST") do
+            respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
+        activateManifest hubCapabilityManifestId
+
+listManifests :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
+listManifests = do
+    _consumer <- requireApiConsumer
+    (page, perPage) <- getPageParams
+    let pageOffset = (page - 1) * perPage
+        mHubId = paramOrNothing @(Id Hub) "hubId"
+        mStatus = paramOrNothing @Text "status"
+        baseQ = query @HubCapabilityManifest |> orderByDesc #createdAt
+        q1 = case mHubId of
+            Just hubId -> baseQ |> filterWhere (#hubId, hubId)
+            Nothing    -> baseQ
+        q2 = case mStatus of
+            Just status -> q1 |> filterWhere (#status, status)
+            Nothing     -> q1
+    total <- q2 |> fetchCount
+    manifests <- q2
+        |> limit perPage
+        |> offset pageOffset
+        |> fetch
+    renderJson $ paginatedResponse (map manifestToJson manifests) page perPage total
+
+showManifest :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Id HubCapabilityManifest -> IO ()
+showManifest manifestId = do
+    _consumer <- requireApiConsumer
+    manifest <- fetch manifestId
+    renderJson (manifestToJson manifest)
+
+createManifest :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
+createManifest = do
+    _consumer <- requireApiConsumer
+    let hubIdText = paramOrNothing @Text "hubId"
+        manifestVersion = fromMaybe "1.0" (nonEmptyText =<< paramOrNothing @Text "manifestVersion")
+        capabilityDescription = paramOrNothing @Text "capabilityDescription"
+        contact = paramOrNothing @Text "contact"
+
+    when (maybe True (== "") hubIdText) do
+        respondWithStatus 422 $ object
+            [ "error"   .= ("Missing required fields" :: Text)
+            , "missing" .= (["hubId"] :: [Text])
+            ]
+
+    let Just rawHubId = hubIdText
+    case UUID.fromText rawHubId of
+        Nothing -> respondWithStatus 422 $ object
+            ["error" .= ("hubId must be a valid UUID" :: Text)]
+        Just rawId -> do
+            let hubId = Id rawId :: Id Hub
+            mHub <- fetchOneOrNothing hubId
+            case mHub of
+                Nothing -> respondWithStatus 422 $ object ["error" .= ("Hub not found" :: Text)]
+                Just _hub -> do
+                    existing <- query @HubCapabilityManifest
+                        |> filterWhere (#hubId, hubId)
+                        |> fetchOneOrNothing
+                    when (isJust existing) do
+                        respondWithStatus 422 $ object
+                            [ "error" .= ("Hub already has a capability manifest" :: Text)
+                            , "code"  .= ("manifest_already_exists" :: Text)
+                            ]
+                    manifest <- newRecord @HubCapabilityManifest
+                        |> set #hubId hubId
+                        |> set #manifestVersion manifestVersion
+                        |> set #declaredWidgetTypes (toJSON (textArrayFieldFromRequestOrEmpty "declaredWidgetTypes"))
+                        |> set #declaredEventTypes (toJSON (textArrayFieldFromRequestOrEmpty "declaredEventTypes"))
+                        |> set #declaredAnnotationCategories (toJSON (textArrayFieldFromRequestOrEmpty "declaredAnnotationCategories"))
+                        |> set #declaredPolicyScopes (toJSON (textArrayFieldFromRequestOrEmpty "declaredPolicyScopes"))
+                        |> set #capabilityDescription capabilityDescription
+                        |> set #contact contact
+                        |> set #status "draft"
+                        |> createRecord
+                    respondWithStatus 201 (manifestToJson manifest)
+
+updateManifest :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Id HubCapabilityManifest -> IO ()
+updateManifest manifestId = do
+    _consumer <- requireApiConsumer
+    manifest <- fetch manifestId
+    unless (manifest.status == "draft") do
+        respondWithStatus 422 $ object
+            [ "error" .= ("Active manifests are read-only" :: Text)
+            , "code"  .= ("manifest_read_only" :: Text)
+            ]
+
+    let manifestVersion = fromMaybe manifest.manifestVersion (nonEmptyText =<< paramOrNothing @Text "manifestVersion")
+        capabilityDescription = fromMaybe manifest.capabilityDescription (Just <$> paramOrNothing @Text "capabilityDescription")
+        contact = fromMaybe manifest.contact (Just <$> paramOrNothing @Text "contact")
+        declaredWidgetTypes = maybe manifest.declaredWidgetTypes toJSON (textArrayFieldFromRequest "declaredWidgetTypes")
+        declaredEventTypes = maybe manifest.declaredEventTypes toJSON (textArrayFieldFromRequest "declaredEventTypes")
+        declaredAnnotationCategories = maybe manifest.declaredAnnotationCategories toJSON (textArrayFieldFromRequest "declaredAnnotationCategories")
+        declaredPolicyScopes = maybe manifest.declaredPolicyScopes toJSON (textArrayFieldFromRequest "declaredPolicyScopes")
+
+    manifest <- manifest
+        |> set #manifestVersion manifestVersion
+        |> set #declaredWidgetTypes declaredWidgetTypes
+        |> set #declaredEventTypes declaredEventTypes
+        |> set #declaredAnnotationCategories declaredAnnotationCategories
+        |> set #declaredPolicyScopes declaredPolicyScopes
+        |> set #capabilityDescription capabilityDescription
+        |> set #contact contact
+        |> updateRecord
+    renderJson (manifestToJson manifest)
+
+activateManifest :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Id HubCapabilityManifest -> IO ()
+activateManifest manifestId = do
+    _consumer <- requireApiConsumer
+    manifest <- fetch manifestId
+    when (manifest.status == "active") do
+        respondWithStatus 200 (manifestToJson manifest)
+    when (manifest.status == "retired") do
+        respondWithStatus 422 $ object
+            [ "error" .= ("Retired manifests cannot be activated" :: Text)
+            , "code"  .= ("manifest_retired" :: Text)
+            ]
+
+    hub <- fetch manifest.hubId
+    let wTypes = jsonArrayTexts manifest.declaredWidgetTypes
+        eTypes = jsonArrayTexts manifest.declaredEventTypes
+        cats = jsonArrayTexts manifest.declaredAnnotationCategories
+        scopes = jsonArrayTexts manifest.declaredPolicyScopes
+
+    conflicts <- fmap concat $ sequence
+        [ concat <$> mapM (checkConflict "widget_type_registry" hub.id) wTypes
+        , concat <$> mapM (checkConflict "event_type_registry" hub.id) eTypes
+        , concat <$> mapM (checkConflict "annotation_category_registry" hub.id) cats
+        , concat <$> mapM (checkConflict "policy_scope_registry" hub.id) scopes
+        ]
+    unless (null conflicts) do
+        respondWithStatus 422 $ object
+            [ "error"     .= ("Manifest activation blocked by type conflicts" :: Text)
+            , "code"      .= ("manifest_type_conflict" :: Text)
+            , "conflicts" .= conflicts
+            ]
+
+    mapM_ (upsertType "widget_type_registry" hub.id) wTypes
+    mapM_ (upsertType "event_type_registry" hub.id) eTypes
+    mapM_ (upsertType "annotation_category_registry" hub.id) cats
+    mapM_ (upsertType "policy_scope_registry" hub.id) scopes
+    now <- getCurrentTime
+    manifest <- manifest
+        |> set #status "active"
+        |> set #activatedAt (Just now)
+        |> updateRecord
+    renderJson (manifestToJson manifest)
+
+manifestToJson :: HubCapabilityManifest -> Value
+manifestToJson manifest = object
+    [ "id" .= manifest.id
+    , "hubId" .= manifest.hubId
+    , "manifestVersion" .= manifest.manifestVersion
+    , "declaredWidgetTypes" .= manifest.declaredWidgetTypes
+    , "declaredEventTypes" .= manifest.declaredEventTypes
+    , "declaredAnnotationCategories" .= manifest.declaredAnnotationCategories
+    , "declaredPolicyScopes" .= manifest.declaredPolicyScopes
+    , "capabilityDescription" .= manifest.capabilityDescription
+    , "contact" .= manifest.contact
+    , "status" .= manifest.status
+    , "activatedAt" .= manifest.activatedAt
+    , "createdAt" .= manifest.createdAt
+    , "updatedAt" .= manifest.updatedAt
+    ]
+
+textArrayFieldFromRequestOrEmpty :: (?context :: ControllerContext, ?request :: Request) => Text -> [Text]
+textArrayFieldFromRequestOrEmpty fieldName =
+    fromMaybe [] (textArrayFieldFromRequest fieldName)
+
+textArrayFieldFromRequest :: (?context :: ControllerContext, ?request :: Request) => Text -> Maybe [Text]
+textArrayFieldFromRequest fieldName =
+    case getHeader "Content-Type" of
+        Just contentType | "application/json" `BS.isPrefixOf` contentType ->
+            textArrayFieldFromJsonBody fieldName requestBodyJSON
+        _ ->
+            let values = paramList @Text fieldName
+            in if null values then Nothing else Just values
+
+textArrayFieldFromJsonBody :: Text -> Value -> Maybe [Text]
+textArrayFieldFromJsonBody fieldName (Object body) =
+    case KM.lookup (K.fromText fieldName) body of
+        Just (Array values) -> Just (mapMaybe extractText (V.toList values))
+        _ -> Nothing
+  where
+    extractText (String value) = Just value
+    extractText _              = Nothing
+textArrayFieldFromJsonBody _ _ = Nothing
+
+jsonArrayTexts :: Value -> [Text]
+jsonArrayTexts (Array values) = mapMaybe extractText (V.toList values)
+  where
+    extractText (String value) = Just value
+    extractText _              = Nothing
+jsonArrayTexts _ = []
+
+checkConflict ::
+    (?modelContext :: ModelContext) =>
+    Text -> Id Hub -> Text -> IO [Text]
+checkConflict tableName hubId name = do
+    rows <- sqlQuery
+        (fromString $ cs ("SELECT owner_hub_id FROM " <> tableName <> " WHERE name = ?"))
+        (Only name)
+    case rows of
+        [] -> pure []
+        [Only Nothing] -> pure []
+        [Only (Just ownerId)] ->
+            if ownerId == hubId
+                then pure []
+                else pure ["Type '" <> name <> "' in " <> tableName <> " is already owned by another hub"]
+        _ -> pure []
+
+upsertType ::
+    (?modelContext :: ModelContext) =>
+    Text -> Id Hub -> Text -> IO ()
+upsertType tableName hubId name =
+    void $ sqlExec
+        (fromString $ cs ("INSERT INTO " <> tableName <> " (name, label, owner_hub_id, status) "
+         <> "VALUES (?, ?, ?, 'active') ON CONFLICT (name) DO NOTHING"))
+        (name, name, hubId)
+
+nonEmptyText :: Text -> Maybe Text
+nonEmptyText "" = Nothing
+nonEmptyText value = Just value

Web/Controller/Api/V2/OpenApi.hs

@@ -16,7 +16,8 @@ import qualified Data.Text.Encoding as TE
 import qualified Data.Yaml as Yaml  -- yaml package
 import qualified Data.ByteString.Lazy as LBS
 import Application.Helper.TypeRegistry
-    ( activeWidgetTypes, activeEventTypes, activeAnnotationCategories )
+    ( activeWidgetTypes, activeEventTypes, activeAnnotationCategories
+    , activePolicyScopes )
 import Network.HTTP.Types (status200)
 import Network.Wai (responseLBS)
 
@@ -47,10 +48,12 @@ buildOpenApiSpec = do
     let allWidgetTypes = fwWidgetTypes ++ ownedWidgetTypes
     eventTypes  <- activeEventTypes
     annCats     <- activeAnnotationCategories
+    policyScopes <- activePolicyScopes
 
     let wtEnum  = toJSON $ map (.name) allWidgetTypes
     let etEnum  = toJSON $ map (.name) eventTypes
     let acEnum  = toJSON $ map (.name) annCats
+    let psEnum  = toJSON $ map (.name) policyScopes
 
     pure $ object
         [ "openapi" .= ("3.1.0" :: Text)
@@ -76,6 +79,10 @@ buildOpenApiSpec = do
                     [ "type" .= ("string" :: Text)
                     , "enum" .= acEnum
                     ]
+                , "PolicyScope" .= object
+                    [ "type" .= ("string" :: Text)
+                    , "enum" .= psEnum
+                    ]
                 , "PaginationMeta" .= object
                     [ "type" .= ("object" :: Text)
                     , "properties" .= object
@@ -85,6 +92,7 @@ buildOpenApiSpec = do
                         ]
                     ]
                 , "Hub" .= hubSchema
+                , "HubCapabilityManifest" .= manifestSchema
                 , "Widget" .= widgetSchema
                 , "InteractionEvent" .= interactionEventSchema
                 , "Annotation" .= annotationSchema
@@ -114,6 +122,20 @@ buildPaths = object
         , "post" .= writeOp "Hub" "CreateHubRequest"
         ]
     , "/hubs/{id}" .= getShowPath "Hub"
+    , "/hub-capability-manifests" .= object
+        [ "get"  .= listOp "HubCapabilityManifest"
+            [ ("hubId", "string", "uuid")
+            , ("status", "string", "")
+            ]
+        , "post" .= writeOp "HubCapabilityManifest" "CreateHubCapabilityManifestRequest"
+        ]
+    , "/hub-capability-manifests/{id}" .= object
+        [ "get"   .= showOp "HubCapabilityManifest"
+        , "patch" .= writeOpWithSummary "Update HubCapabilityManifest" "HubCapabilityManifest" "UpdateHubCapabilityManifestRequest"
+        ]
+    , "/hub-capability-manifests/{id}/activate" .= object
+        [ "post" .= writeOpWithSummary "Activate HubCapabilityManifest" "HubCapabilityManifest" "ActivateHubCapabilityManifestRequest"
+        ]
     , "/widgets" .= object
         [ "get"  .= listOp "Widget" []
         , "post" .= writeOp "Widget" "CreateWidgetRequest"
@@ -144,6 +166,7 @@ buildPaths = object
     , "/widget-types" .= publicListPath "WidgetTypeRegistry"
     , "/event-types" .= publicListPath "EventTypeRegistry"
     , "/annotation-categories" .= publicListPath "AnnotationCategoryRegistry"
+    , "/policy-scopes" .= publicListPath "PolicyScopeRegistry"
     , "/token" .= tokenPath
     -- Phase 10 — Hub Registry and Widget Marketplace
     , "/hub-registry" .= getListPath "HubRegistryEntry"
@@ -214,8 +237,11 @@ showOp schemaName = object
     ]
 
 writeOp :: Text -> Text -> Value
-writeOp schemaName _reqSchema = object
-    [ "summary"    .= ("Create " <> schemaName)
+writeOp schemaName reqSchema = writeOpWithSummary ("Create " <> schemaName) schemaName reqSchema
+
+writeOpWithSummary :: Text -> Text -> Text -> Value
+writeOpWithSummary summaryText schemaName _reqSchema = object
+    [ "summary"    .= summaryText
     , "security"   .= [object ["BearerAuth" .= ([] :: [Text])]]
     , "requestBody" .= object
         [ "required" .= True
@@ -305,6 +331,26 @@ widgetSchema = object
         ]
     ]
 
+manifestSchema :: Value
+manifestSchema = object
+    [ "type" .= ("object" :: Text)
+    , "properties" .= object
+        [ "id" .= uuidProp
+        , "hubId" .= uuidProp
+        , "manifestVersion" .= strProp
+        , "declaredWidgetTypes" .= object ["type" .= ("array" :: Text), "items" .= object ["$ref" .= ("#/components/schemas/WidgetType" :: Text)]]
+        , "declaredEventTypes" .= object ["type" .= ("array" :: Text), "items" .= object ["$ref" .= ("#/components/schemas/EventType" :: Text)]]
+        , "declaredAnnotationCategories" .= object ["type" .= ("array" :: Text), "items" .= object ["$ref" .= ("#/components/schemas/AnnotationCategory" :: Text)]]
+        , "declaredPolicyScopes" .= object ["type" .= ("array" :: Text), "items" .= object ["$ref" .= ("#/components/schemas/PolicyScope" :: Text)]]
+        , "capabilityDescription" .= strProp
+        , "contact" .= strProp
+        , "status" .= strProp
+        , "activatedAt" .= dtProp
+        , "createdAt" .= dtProp
+        , "updatedAt" .= dtProp
+        ]
+    ]
+
 interactionEventSchema :: Value
 interactionEventSchema = object
     [ "type" .= ("object" :: Text)

Web/Controller/Api/V2/Registries.hs

@@ -4,6 +4,7 @@ module Web.Controller.Api.V2.Registries where
 -- GET /api/v2/widget-types
 -- GET /api/v2/event-types
 -- GET /api/v2/annotation-categories
+-- GET /api/v2/policy-scopes
 
 import Web.Types
 import Generated.Types
@@ -34,6 +35,13 @@ instance Controller ApiV2RegistriesController where
             |> fetch
         renderJson $ map acToJson cats
 
+    action ApiV2ListPolicyScopesAction = do
+        scopes <- query @PolicyScopeRegistry
+            |> filterWhere (#status, "active")
+            |> orderByAsc #name
+            |> fetch
+        renderJson $ map psToJson scopes
+
 wtToJson :: WidgetTypeRegistry -> Value
 wtToJson r = object
     [ "name"       .= r.name
@@ -60,3 +68,12 @@ acToJson r = object
     , "ownerHubId"  .= r.ownerHubId
     , "status"      .= r.status
     ]
+
+psToJson :: PolicyScopeRegistry -> Value
+psToJson r = object
+    [ "name"        .= r.name
+    , "label"       .= r.label_
+    , "description" .= r.description
+    , "ownerHubId"  .= r.ownerHubId
+    , "status"      .= r.status
+    ]

Web/Controller/Api/V2/Sdk.hs

@@ -98,6 +98,18 @@ tsSdkClientClass = T.unlines
     , "    return this.fetch('/hubs', 'POST', body).then(r => r.json());"
     , "  }"
     , ""
+    , "  async createHubCapabilityManifest(body: { hubId: string; manifestVersion?: string; declaredWidgetTypes?: WidgetType[]; declaredEventTypes?: EventType[]; declaredAnnotationCategories?: AnnotationCategory[]; declaredPolicyScopes?: string[]; capabilityDescription?: string; contact?: string }) {"
+    , "    return this.fetch('/hub-capability-manifests', 'POST', body).then(r => r.json());"
+    , "  }"
+    , ""
+    , "  async updateHubCapabilityManifest(id: string, body: { manifestVersion?: string; declaredWidgetTypes?: WidgetType[]; declaredEventTypes?: EventType[]; declaredAnnotationCategories?: AnnotationCategory[]; declaredPolicyScopes?: string[]; capabilityDescription?: string; contact?: string }) {"
+    , "    return this.fetch('/hub-capability-manifests/' + id, 'PATCH', body).then(r => r.json());"
+    , "  }"
+    , ""
+    , "  async activateHubCapabilityManifest(id: string) {"
+    , "    return this.fetch('/hub-capability-manifests/' + id + '/activate', 'POST').then(r => r.json());"
+    , "  }"
+    , ""
     , "  async getWidgets(params?: { page?: number; perPage?: number }) {"
     , "    const q = params ? `?page=${params.page ?? 1}&per_page=${params.perPage ?? 50}` : '';"
     , "    return this.fetch('/widgets' + q).then(r => r.json());"
@@ -160,6 +172,15 @@ pyClientClass = T.unlines
     , "    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_capability_manifest(self, body: dict) -> dict:"
+    , "        return self._request('/hub-capability-manifests', 'POST', body)"
+    , ""
+    , "    def update_hub_capability_manifest(self, manifest_id: str, body: dict) -> dict:"
+    , "        return self._request('/hub-capability-manifests/' + manifest_id, 'PATCH', body)"
+    , ""
+    , "    def activate_hub_capability_manifest(self, manifest_id: str) -> dict:"
+    , "        return self._request('/hub-capability-manifests/' + manifest_id + '/activate', 'POST')"
+    , ""
     , "    def get_widgets(self, page: int = 1, per_page: int = 50) -> dict:"
     , "        return self._request(f'/widgets?page={page}&per_page={per_page}')"
     , ""