feat: add v2 hub and widget create endpoints
Some checks failed
Build and Deploy / build-push-deploy (push) Has been cancelled

This commit is contained in:
2026-05-16 08:34:20 +02:00
parent 0a4646bf44
commit 4ebc04e1f4
11 changed files with 536 additions and 154 deletions

View File

@@ -8,6 +8,8 @@ import Web.Controller.Api.V2.InteractionEvents
( declaredEventTypeNames, manifestAllowsEvent, metadataFromJsonBody
, metadataParamOrEmpty
)
import Web.Controller.Api.V2.Hubs (missingRequiredFields, validCreateHubKind)
import Web.Controller.Api.V2.Widgets (missingWidgetCreateFields, validWidgetStatus)
main :: IO ()
main = hspec do
@@ -44,4 +46,32 @@ main = hspec do
metadataParamOrEmpty (Just metadata) `shouldBe` metadata
metadataParamOrEmpty Nothing `shouldBe` object []
describe "API v2 hub and widget create validation" do
it "accepts scriptable domain/shared hub kinds only" do
validCreateHubKind "domain" `shouldBe` True
validCreateHubKind "shared" `shouldBe` True
validCreateHubKind "framework" `shouldBe` False
it "reports missing hub create fields including empty strings" do
missingRequiredFields
[ ("slug", Just "")
, ("name", Nothing)
, ("domain", Just "operations")
]
`shouldBe` ["slug", "name"]
it "accepts widget statuses supported by the UI create flow" do
validWidgetStatus "active" `shouldBe` True
validWidgetStatus "deprecated" `shouldBe` True
validWidgetStatus "draft" `shouldBe` True
validWidgetStatus "archived" `shouldBe` False
it "reports missing widget create fields including empty strings" do
missingWidgetCreateFields
[ ("hubId", Just "")
, ("name", Just "Ops endpoint card")
, ("widgetType", Nothing)
]
`shouldBe` ["hubId", "widgetType"]
LayerBoundary.spec

View File

@@ -10,25 +10,15 @@ import Web.Controller.Api.V2.Auth
, respondWithStatus )
import Application.Helper.TypeRegistry (validateAnnotationCategory)
import qualified Data.UUID as UUID
import Network.Wai (requestMethod)
instance Controller ApiV2AnnotationsController where
action ApiV2IndexAnnotationsAction = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
let mWidgetId = paramOrNothing @(Id Widget) "widgetId"
mCategory = paramOrNothing @Text "category"
let off = (page - 1) * perPage
let baseQ = query @Annotation |> orderByDesc #createdAt
let q1 = case mWidgetId of
Just wId -> baseQ |> filterWhere (#widgetId, wId)
Nothing -> baseQ
let q2 = case mCategory of
Just cat -> q1 |> filterWhere (#category, cat)
Nothing -> q1
total <- q2 |> fetchCount
anns <- q2 |> limit perPage |> offset off |> fetch
renderJson $ paginatedResponse (map annotationToJson anns) page perPage total
case requestMethod ?request of
"GET" -> listAnnotations
"POST" -> createAnnotation
_ -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
action ApiV2ShowAnnotationAction { annotationId } = do
_consumer <- requireApiConsumer
@@ -36,54 +26,75 @@ instance Controller ApiV2AnnotationsController where
renderJson (annotationToJson ann)
-- POST /api/v2/annotations
action ApiV2CreateAnnotationAction = do
_consumer <- requireApiConsumer
let widgetIdText = paramOrNothing @Text "widgetId"
category = paramOrNothing @Text "category"
body = paramOrNothing @Text "body"
action ApiV2CreateAnnotationAction = createAnnotation
let missing = catMaybes
[ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
, if isNothing category then Just "category" else Nothing
, if isNothing body then Just "body" else Nothing
]
unless (null missing) do
respondWithStatus 422 $ object
[ "error" .= ("Missing required fields" :: Text)
, "missing" .= missing
]
listAnnotations :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
listAnnotations = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
let mWidgetId = paramOrNothing @(Id Widget) "widgetId"
mCategory = paramOrNothing @Text "category"
let off = (page - 1) * perPage
let baseQ = query @Annotation |> orderByDesc #createdAt
let q1 = case mWidgetId of
Just wId -> baseQ |> filterWhere (#widgetId, wId)
Nothing -> baseQ
let q2 = case mCategory of
Just cat -> q1 |> filterWhere (#category, cat)
Nothing -> q1
total <- q2 |> fetchCount
anns <- q2 |> limit perPage |> offset off |> fetch
renderJson $ paginatedResponse (map annotationToJson anns) page perPage total
let Just wIdText = widgetIdText
Just cat = category
Just bodyTxt = body
createAnnotation :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
createAnnotation = do
_consumer <- requireApiConsumer
let widgetIdText = paramOrNothing @Text "widgetId"
category = paramOrNothing @Text "category"
body = paramOrNothing @Text "body"
catResult <- liftIO $ validateAnnotationCategory cat
case catResult of
Left _ -> respondWithStatus 422 $ object
[ "error" .= ("Unregistered annotation category" :: Text)
, "code" .= ("unregistered_category" :: Text)
, "value" .= cat
, "registry" .= ("/api/v2/annotation-categories" :: Text)
]
Right () -> pure ()
let missing = catMaybes
[ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
, if isNothing category then Just "category" else Nothing
, if isNothing body then Just "body" else Nothing
]
unless (null missing) do
respondWithStatus 422 $ object
[ "error" .= ("Missing required fields" :: Text)
, "missing" .= missing
]
case UUID.fromText wIdText of
Nothing -> respondWithStatus 422 $ object
["error" .= ("widgetId must be a valid UUID" :: Text)]
Just rawId -> do
let wId = Id rawId :: Id Widget
mWidget <- fetchOneOrNothing wId
case mWidget of
Nothing -> respondWithStatus 422 $ object
["error" .= ("Widget not found" :: Text)]
Just _widget -> do
ann <- newRecord @Annotation
|> set #widgetId wId
|> set #category cat
|> set #body bodyTxt
|> set #actorType "api"
|> createRecord
renderJson (annotationToJson ann)
let Just wIdText = widgetIdText
Just cat = category
Just bodyTxt = body
catResult <- liftIO $ validateAnnotationCategory cat
case catResult of
Left _ -> respondWithStatus 422 $ object
[ "error" .= ("Unregistered annotation category" :: Text)
, "code" .= ("unregistered_category" :: Text)
, "value" .= cat
, "registry" .= ("/api/v2/annotation-categories" :: Text)
]
Right () -> pure ()
case UUID.fromText wIdText of
Nothing -> respondWithStatus 422 $ object
["error" .= ("widgetId must be a valid UUID" :: Text)]
Just rawId -> do
let wId = Id rawId :: Id Widget
mWidget <- fetchOneOrNothing wId
case mWidget of
Nothing -> respondWithStatus 422 $ object
["error" .= ("Widget not found" :: Text)]
Just _widget -> do
ann <- newRecord @Annotation
|> set #widgetId wId
|> set #category cat
|> set #body bodyTxt
|> set #actorType "api"
|> createRecord
respondWithStatus 201 (annotationToJson ann)
annotationToJson :: Annotation -> Value
annotationToJson a = object

View File

@@ -0,0 +1,112 @@
module Web.Controller.Api.V2.Hubs where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (Value, object, (.=))
import Network.Wai (requestMethod)
import Web.Controller.Api.V2.Auth
( requireApiConsumer, paginatedResponse, getPageParams
, respondWithStatus )
instance Controller ApiV2HubsController where
action ApiV2IndexHubsAction = do
case requestMethod ?request of
"GET" -> listHubs
"POST" -> createHub
_ -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
action ApiV2ShowHubAction { hubId } = do
_consumer <- requireApiConsumer
hub <- fetch hubId
renderJson (hubToJson hub)
action ApiV2CreateHubAction = createHub
listHubs :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
listHubs = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
let pageOffset = (page - 1) * perPage
total <- query @Hub |> fetchCount
hubs <- query @Hub
|> orderByAsc #name
|> limit perPage
|> offset pageOffset
|> fetch
renderJson $ paginatedResponse (map hubToJson hubs) page perPage total
createHub :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
createHub = do
_consumer <- requireApiConsumer
let slug = paramOrNothing @Text "slug"
name = paramOrNothing @Text "name"
domain = paramOrNothing @Text "domain"
kind = fromMaybe "domain" (nonEmptyText =<< paramOrNothing @Text "hubKind")
let missing = missingRequiredFields
[ ("slug", slug)
, ("name", name)
, ("domain", domain)
]
unless (null missing) do
respondWithStatus 422 $ object
[ "error" .= ("Missing required fields" :: Text)
, "missing" .= missing
]
unless (validCreateHubKind kind) do
respondWithStatus 422 $ object
[ "error" .= ("Unsupported hubKind" :: Text)
, "code" .= ("unsupported_hub_kind" :: Text)
, "value" .= kind
, "valid" .= validCreateHubKinds
]
let Just slugText = slug
Just nameText = name
Just domainText = domain
existing <- query @Hub
|> filterWhere (#slug, slugText)
|> fetchOneOrNothing
when (isJust existing) do
respondWithStatus 422 $ object
[ "error" .= ("Hub slug already exists" :: Text)
, "code" .= ("duplicate_hub_slug" :: Text)
, "value" .= slugText
]
hub <- newRecord @Hub
|> set #slug slugText
|> set #name nameText
|> set #domain domainText
|> set #hubKind kind
|> createRecord
respondWithStatus 201 (hubToJson hub)
hubToJson :: Hub -> Value
hubToJson hub = object
[ "id" .= hub.id
, "slug" .= hub.slug
, "name" .= hub.name
, "domain" .= hub.domain
, "hubKind" .= hub.hubKind
, "createdAt" .= hub.createdAt
]
validCreateHubKinds :: [Text]
validCreateHubKinds = ["domain", "shared"]
validCreateHubKind :: Text -> Bool
validCreateHubKind kind = kind `elem` validCreateHubKinds
missingRequiredFields :: [(Text, Maybe Text)] -> [Text]
missingRequiredFields fields =
[ name | (name, value) <- fields, maybe True (== "") value ]
nonEmptyText :: Text -> Maybe Text
nonEmptyText "" = Nothing
nonEmptyText value = Just value

View File

@@ -5,7 +5,7 @@ import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (Value(..), object, (.=))
import IHP.ControllerSupport (ControllerContext, getHeader, requestBodyJSON)
import IHP.ControllerSupport (getHeader, requestBodyJSON)
import Web.Controller.Api.V2.Auth
( requireApiConsumer, paginatedResponse, getPageParams
, respondWithStatus )
@@ -20,26 +20,15 @@ import qualified Data.ByteString.Lazy.Char8 as LBSC
import qualified Data.UUID as UUID
import qualified Data.Aeson as A
import qualified Data.Vector as V
import Network.Wai (requestMethod)
instance Controller ApiV2InteractionEventsController where
action ApiV2IndexInteractionEventsAction = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
let mWidgetId = paramOrNothing @(Id Widget) "widgetId"
mEventType = paramOrNothing @Text "eventType"
let off = (page - 1) * perPage
let baseQ = query @InteractionEvent
|> orderByDesc #occurredAt
let q1 = case mWidgetId of
Just wId -> baseQ |> filterWhere (#widgetId, wId)
Nothing -> baseQ
let q2 = case mEventType of
Just et -> q1 |> filterWhere (#eventType, et)
Nothing -> q1
total <- q2 |> fetchCount
events <- q2 |> limit perPage |> offset off |> fetch
renderJson $ paginatedResponse (map eventToJson events) page perPage total
case requestMethod ?request of
"GET" -> listInteractionEvents
"POST" -> createInteractionEvent
_ -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
action ApiV2ShowInteractionEventAction { interactionEventId } = do
_consumer <- requireApiConsumer
@@ -47,75 +36,97 @@ instance Controller ApiV2InteractionEventsController where
renderJson (eventToJson event)
-- POST /api/v2/interaction-events
action ApiV2CreateInteractionEventAction = do
consumer <- requireApiConsumer
let widgetIdText = paramOrNothing @Text "widgetId"
eventType = paramOrNothing @Text "eventType"
viewContext = paramOrNothing @Text "viewContext"
metadata = metadataFromRequest
action ApiV2CreateInteractionEventAction = createInteractionEvent
let missing = catMaybes
[ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
, if isNothing eventType then Just "eventType" else Nothing
]
unless (null missing) do
respondWithStatus 422 $ object
[ "error" .= ("Missing required fields" :: Text)
, "missing" .= missing
]
listInteractionEvents :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
listInteractionEvents = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
let mWidgetId = paramOrNothing @(Id Widget) "widgetId"
mEventType = paramOrNothing @Text "eventType"
let off = (page - 1) * perPage
let baseQ = query @InteractionEvent
|> orderByDesc #occurredAt
let q1 = case mWidgetId of
Just wId -> baseQ |> filterWhere (#widgetId, wId)
Nothing -> baseQ
let q2 = case mEventType of
Just et -> q1 |> filterWhere (#eventType, et)
Nothing -> q1
total <- q2 |> fetchCount
events <- q2 |> limit perPage |> offset off |> fetch
renderJson $ paginatedResponse (map eventToJson events) page perPage total
let Just wIdText = widgetIdText
Just evType = eventType
createInteractionEvent :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
createInteractionEvent = do
consumer <- requireApiConsumer
let widgetIdText = paramOrNothing @Text "widgetId"
eventType = paramOrNothing @Text "eventType"
viewContext = paramOrNothing @Text "viewContext"
metadata = metadataFromRequest
-- Validate against event_type_registry
evResult <- liftIO $ validateEventType evType
case evResult of
Left _ -> respondWithStatus 422 $ object
[ "error" .= ("Unregistered event type" :: Text)
, "code" .= ("unregistered_event_type" :: Text)
, "value" .= evType
, "registry" .= ("/api/v2/event-types" :: Text)
]
Right () -> pure ()
let missing = catMaybes
[ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
, if isNothing eventType then Just "eventType" else Nothing
]
unless (null missing) do
respondWithStatus 422 $ object
[ "error" .= ("Missing required fields" :: Text)
, "missing" .= missing
]
-- If consumer has a manifest, also validate against declared_event_types
forM_ consumer.hubCapabilityManifestId $ \manifestId -> do
manifest <- fetch manifestId
when (manifest.status == "active") do
unless (manifestAllowsEvent evType manifest.declaredEventTypes) do
respondWithStatus 422 $ object
[ "error" .= ("Event type not declared in hub manifest" :: Text)
, "code" .= ("event_type_not_in_manifest" :: Text)
, "value" .= evType
]
let Just wIdText = widgetIdText
Just evType = eventType
case UUID.fromText wIdText of
Nothing -> respondWithStatus 422 $ object
["error" .= ("widgetId must be a valid UUID" :: Text)]
Just rawId -> do
let wId = Id rawId :: Id Widget
mWidget <- fetchOneOrNothing wId
case mWidget of
Nothing -> respondWithStatus 422 $ object
["error" .= ("Widget not found" :: Text)]
Just _widget -> do
event <- newRecord @InteractionEvent
|> set #widgetId wId
|> set #eventType evType
|> set #actorType "api"
|> set #viewContextRef viewContext
|> set #metadata metadata
|> createRecord
-- Dispatch webhooks fire-and-forget
let webhookPayload = object
[ "event" .= ("interaction_event.created" :: Text)
, "resourceId" .= event.id
, "widgetId" .= event.widgetId
, "eventType" .= event.eventType
, "occurredAt" .= event.occurredAt
]
liftIO $ void $ forkIO $ dispatchWebhooks evType webhookPayload
renderJson (eventToJson event)
-- Validate against event_type_registry
evResult <- liftIO $ validateEventType evType
case evResult of
Left _ -> respondWithStatus 422 $ object
[ "error" .= ("Unregistered event type" :: Text)
, "code" .= ("unregistered_event_type" :: Text)
, "value" .= evType
, "registry" .= ("/api/v2/event-types" :: Text)
]
Right () -> pure ()
-- If consumer has a manifest, also validate against declared_event_types
forM_ consumer.hubCapabilityManifestId $ \manifestId -> do
manifest <- fetch manifestId
when (manifest.status == "active") do
unless (manifestAllowsEvent evType manifest.declaredEventTypes) do
respondWithStatus 422 $ object
[ "error" .= ("Event type not declared in hub manifest" :: Text)
, "code" .= ("event_type_not_in_manifest" :: Text)
, "value" .= evType
]
case UUID.fromText wIdText of
Nothing -> respondWithStatus 422 $ object
["error" .= ("widgetId must be a valid UUID" :: Text)]
Just rawId -> do
let wId = Id rawId :: Id Widget
mWidget <- fetchOneOrNothing wId
case mWidget of
Nothing -> respondWithStatus 422 $ object
["error" .= ("Widget not found" :: Text)]
Just _widget -> do
event <- newRecord @InteractionEvent
|> set #widgetId wId
|> set #eventType evType
|> set #actorType "api"
|> set #viewContextRef viewContext
|> set #metadata metadata
|> createRecord
-- Dispatch webhooks fire-and-forget
let webhookPayload = object
[ "event" .= ("interaction_event.created" :: Text)
, "resourceId" .= event.id
, "widgetId" .= event.widgetId
, "eventType" .= event.eventType
, "occurredAt" .= event.occurredAt
]
liftIO $ void $ forkIO $ dispatchWebhooks evType webhookPayload
respondWithStatus 201 (eventToJson event)
eventToJson :: InteractionEvent -> Value
eventToJson e = object

View File

@@ -84,6 +84,7 @@ buildOpenApiSpec = do
, "total" .= object ["type" .= ("integer" :: Text)]
]
]
, "Hub" .= hubSchema
, "Widget" .= widgetSchema
, "InteractionEvent" .= interactionEventSchema
, "Annotation" .= annotationSchema
@@ -108,7 +109,15 @@ buildOpenApiSpec = do
buildPaths :: Value
buildPaths = object
[ "/widgets" .= getListPath "Widget"
[ "/hubs" .= object
[ "get" .= listOp "Hub" []
, "post" .= writeOp "Hub" "CreateHubRequest"
]
, "/hubs/{id}" .= getShowPath "Hub"
, "/widgets" .= object
[ "get" .= listOp "Widget" []
, "post" .= writeOp "Widget" "CreateWidgetRequest"
]
, "/widgets/{id}" .= getShowPath "Widget"
, "/interaction-events" .= object
[ "get" .= listOp "InteractionEvent"
@@ -266,6 +275,19 @@ pageParams =
-- Schemas for all resource types
hubSchema :: Value
hubSchema = object
[ "type" .= ("object" :: Text)
, "properties" .= object
[ "id" .= uuidProp
, "slug" .= strProp
, "name" .= strProp
, "domain" .= strProp
, "hubKind" .= object ["type" .= ("string" :: Text), "enum" .= ["domain" :: Text, "shared"]]
, "createdAt" .= object ["type" .= ("string" :: Text), "format" .= ("date-time" :: Text)]
]
]
widgetSchema :: Value
widgetSchema = object
[ "type" .= ("object" :: Text)

View File

@@ -94,11 +94,19 @@ tsSdkClientClass = T.unlines
, " });"
, " }"
, ""
, " async createHub(body: { slug: string; name: string; domain: string; hubKind?: 'domain' | 'shared' }) {"
, " return this.fetch('/hubs', 'POST', body).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());"
, " }"
, ""
, " async createWidget(body: { hubId: string; name: string; widgetType: WidgetType; capabilityRef?: string; viewContext?: string; policyScope?: string; status?: 'active' | 'deprecated' | 'draft' }) {"
, " return this.fetch('/widgets', 'POST', body).then(r => r.json());"
, " }"
, ""
, " async getInteractionEvents(params?: { widgetId?: string; eventType?: EventType }) {"
, " const qs = new URLSearchParams();"
, " if (params?.widgetId) qs.set('widgetId', params.widgetId);"
@@ -149,9 +157,20 @@ 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 get_widgets(self, page: int = 1, per_page: int = 50) -> dict:"
, " return self._request(f'/widgets?page={page}&per_page={per_page}')"
, ""
, " def create_widget(self, hub_id: str, name: str, widget_type: WidgetType, capability_ref: Optional[str] = None, view_context: Optional[str] = None, policy_scope: Optional[str] = None, status: Optional[str] = None) -> dict:"
, " body: dict = {'hubId': hub_id, 'name': name, 'widgetType': str(widget_type)}"
, " if capability_ref: body['capabilityRef'] = capability_ref"
, " if view_context: body['viewContext'] = view_context"
, " if policy_scope: body['policyScope'] = policy_scope"
, " if status: body['status'] = status"
, " return self._request('/widgets', 'POST', body)"
, ""
, " def get_interaction_events(self, widget_id: Optional[str] = None, event_type: Optional[EventType] = None) -> dict:"
, " qs = urllib.parse.urlencode({k: v for k, v in {'widgetId': widget_id, 'eventType': event_type and str(event_type)}.items() if v})"
, " return self._request('/interaction-events' + ('?' + qs if qs else ''))"

View File

@@ -4,28 +4,158 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (object, (.=), ToJSON, toJSON)
import Web.Controller.Api.V2.Auth (requireApiConsumer, paginatedResponse, getPageParams)
import Data.Aeson (Value, object, (.=))
import Network.Wai (requestMethod)
import qualified Data.UUID as UUID
import Application.Helper.TypeRegistry (validateWidgetType, validatePolicyScope)
import Web.Controller.Api.V2.Auth
( requireApiConsumer, paginatedResponse, getPageParams
, respondWithStatus )
instance Controller ApiV2WidgetsController where
action ApiV2IndexWidgetsAction = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
let pageOffset = (page - 1) * perPage
total <- query @Widget |> fetchCount
widgets <- query @Widget
|> orderByDesc #createdAt
|> limit perPage
|> offset pageOffset
|> fetch
renderJson $ paginatedResponse (map widgetToJson widgets) page perPage total
case requestMethod ?request of
"GET" -> listWidgets
"POST" -> createWidget
_ -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
action ApiV2ShowWidgetAction { widgetId } = do
_consumer <- requireApiConsumer
widget <- fetch widgetId
renderJson (widgetToJson widget)
action ApiV2CreateWidgetAction = createWidget
listWidgets :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
listWidgets = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
let pageOffset = (page - 1) * perPage
total <- query @Widget |> fetchCount
widgets <- query @Widget
|> orderByDesc #createdAt
|> limit perPage
|> offset pageOffset
|> fetch
renderJson $ paginatedResponse (map widgetToJson widgets) page perPage total
createWidget :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
createWidget = do
_consumer <- requireApiConsumer
let hubIdText = paramOrNothing @Text "hubId"
name = paramOrNothing @Text "name"
widgetType = paramOrNothing @Text "widgetType"
capabilityRef = paramOrNothing @Text "capabilityRef"
viewContext = paramOrNothing @Text "viewContext"
policyScope = fromMaybe "internal" (nonEmptyText =<< paramOrNothing @Text "policyScope")
status = fromMaybe "active" (nonEmptyText =<< paramOrNothing @Text "status")
let missing = missingWidgetCreateFields
[ ("hubId", hubIdText)
, ("name", name)
, ("widgetType", widgetType)
]
unless (null missing) do
respondWithStatus 422 $ object
[ "error" .= ("Missing required fields" :: Text)
, "missing" .= missing
]
unless (validWidgetStatus status) do
respondWithStatus 422 $ object
[ "error" .= ("Unsupported widget status" :: Text)
, "code" .= ("unsupported_widget_status" :: Text)
, "value" .= status
, "valid" .= validWidgetStatuses
]
let Just hubIdRaw = hubIdText
Just nameText = name
Just typeText = widgetType
typeResult <- liftIO $ validateWidgetType typeText
case typeResult of
Left _ -> respondWithStatus 422 $ object
[ "error" .= ("Unregistered widget type" :: Text)
, "code" .= ("unregistered_widget_type" :: Text)
, "value" .= typeText
, "registry" .= ("/api/v2/widget-types" :: Text)
]
Right () -> pure ()
scopeResult <- liftIO $ validatePolicyScope policyScope
case scopeResult of
Left _ -> respondWithStatus 422 $ object
[ "error" .= ("Unregistered policy scope" :: Text)
, "code" .= ("unregistered_policy_scope" :: Text)
, "value" .= policyScope
, "registry" .= ("/api/v2/policy-scopes" :: Text)
]
Right () -> pure ()
adapterSpecId <- parseOptionalAdapterSpecId
case UUID.fromText hubIdRaw 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
widget <- newRecord @Widget
|> set #hubId hubId
|> set #name nameText
|> set #widgetType typeText
|> set #capabilityRef capabilityRef
|> set #viewContext viewContext
|> set #policyScope policyScope
|> set #status status
|> set #adapterSpecId adapterSpecId
|> createRecord
_version <- createInitialWidgetVersion widget
respondWithStatus 201 (widgetToJson widget)
parseOptionalAdapterSpecId :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO (Maybe (Id WidgetAdapterSpec))
parseOptionalAdapterSpecId =
case paramOrNothing @Text "adapterSpecId" of
Nothing -> pure Nothing
Just "" -> pure Nothing
Just adapterSpecRaw ->
case UUID.fromText adapterSpecRaw of
Nothing -> respondWithStatus 422 $ object
["error" .= ("adapterSpecId must be a valid UUID" :: Text)]
Just rawId -> do
let adapterSpecId = Id rawId :: Id WidgetAdapterSpec
mAdapterSpec <- fetchOneOrNothing adapterSpecId
case mAdapterSpec of
Nothing -> respondWithStatus 422 $ object
["error" .= ("Widget adapter spec not found" :: Text)]
Just _ -> pure (Just adapterSpecId)
createInitialWidgetVersion :: (?modelContext :: ModelContext) => Widget -> IO WidgetVersion
createInitialWidgetVersion widget =
newRecord @WidgetVersion
|> set #widgetId widget.id
|> set #version 1
|> set #schemaSnapshot (widgetVersionSnapshot widget)
|> createRecord
widgetVersionSnapshot :: Widget -> Value
widgetVersionSnapshot widget = object
[ "name" .= widget.name
, "widget_type" .= widget.widgetType
, "hub_id" .= widget.hubId
, "capability_ref" .= widget.capabilityRef
, "view_context" .= widget.viewContext
, "policy_scope" .= widget.policyScope
, "status" .= widget.status
, "version" .= widget.version
]
widgetToJson :: Widget -> Value
widgetToJson w = object
[ "id" .= w.id
@@ -39,3 +169,17 @@ widgetToJson w = object
, "version" .= w.version
, "createdAt" .= w.createdAt
]
validWidgetStatuses :: [Text]
validWidgetStatuses = ["active", "deprecated", "draft"]
validWidgetStatus :: Text -> Bool
validWidgetStatus status = status `elem` validWidgetStatuses
missingWidgetCreateFields :: [(Text, Maybe Text)] -> [Text]
missingWidgetCreateFields fields =
[ name | (name, value) <- fields, maybe True (== "") value ]
nonEmptyText :: Text -> Maybe Text
nonEmptyText "" = Nothing
nonEmptyText value = Just value

View File

@@ -48,6 +48,7 @@ import Web.Controller.Api.V2.Registries ()
import Web.Controller.Api.V2.OpenApi ()
import Web.Controller.Api.V2.Token ()
import Web.Controller.Api.V2.Sdk ()
import Web.Controller.Api.V2.Hubs ()
-- Phase 10 — Hub Registry and Widget Marketplace (IHUB-WP-0011)
import Web.Controller.HubRegistry ()
import Web.Controller.WidgetPatterns ()
@@ -116,6 +117,7 @@ instance FrontController WebApplication where
, parseRoute @ApiV2OpenApiController
, parseRoute @ApiV2TokenController
, parseRoute @ApiV2SdkController
, parseRoute @ApiV2HubsController
-- Phase 10 — Hub Registry and Widget Marketplace (IHUB-WP-0011)
, parseRoute @HubRegistryController
, parseRoute @WidgetPatternsController

View File

@@ -89,6 +89,7 @@ instance CanRoute ApiV2WidgetsController where
instance HasPath ApiV2WidgetsController where
pathTo ApiV2IndexWidgetsAction = "/api/v2/widgets"
pathTo ApiV2ShowWidgetAction { widgetId } = "/api/v2/widgets/" <> tshow widgetId
pathTo ApiV2CreateWidgetAction = "/api/v2/widgets"
instance CanRoute ApiV2InteractionEventsController where
parseRoute' = do
@@ -242,6 +243,20 @@ instance HasPath ApiV2HubRegistryController where
pathTo ApiV2IndexHubRegistryAction = "/api/v2/hub-registry"
pathTo ApiV2ShowHubRegistryAction { hubId } = "/api/v2/hub-registry/" <> tshow hubId
instance CanRoute ApiV2HubsController where
parseRoute' = do
_ <- string "/api/v2/hubs"
choice
[ do endOfInput; pure ApiV2IndexHubsAction
, do _ <- string "/"; hId <- parseUUID; endOfInput
pure ApiV2ShowHubAction { hubId = Id hId }
]
instance HasPath ApiV2HubsController where
pathTo ApiV2IndexHubsAction = "/api/v2/hubs"
pathTo ApiV2ShowHubAction { hubId } = "/api/v2/hubs/" <> tshow hubId
pathTo ApiV2CreateHubAction = "/api/v2/hubs"
instance CanRoute ApiV2WidgetPatternsController where
parseRoute' = do
_ <- string "/api/v2/widget-patterns"

View File

@@ -285,6 +285,7 @@ data ApiDashboardController
data ApiV2WidgetsController
= ApiV2IndexWidgetsAction
| ApiV2ShowWidgetAction { widgetId :: !(Id Widget) }
| ApiV2CreateWidgetAction
deriving (Eq, Show, Data)
data ApiV2InteractionEventsController
@@ -400,6 +401,12 @@ data ApiV2HubRegistryController
| ApiV2ShowHubRegistryAction { hubId :: !(Id Hub) }
deriving (Eq, Show, Data)
data ApiV2HubsController
= ApiV2IndexHubsAction
| ApiV2ShowHubAction { hubId :: !(Id Hub) }
| ApiV2CreateHubAction
deriving (Eq, Show, Data)
data ApiV2WidgetPatternsController
= ApiV2IndexWidgetPatternsAction
| ApiV2ShowWidgetPatternAction { widgetPatternId :: !(Id WidgetPattern) }

View File

@@ -79,7 +79,7 @@ The same shape should later work for:
```task
id: IHUB-WP-0019-T01
status: todo
status: done
priority: high
state_hub_task_id: "72c5b7b2-632f-42ab-ac4d-eff123d8f143"
```
@@ -101,6 +101,15 @@ The endpoints should validate the same invariants as the UI controllers:
Done when: a script can create a hub row and seed widgets without direct DB
access.
Implementation note (2026-05-16): added authenticated v2 `POST /api/v2/hubs`
and `POST /api/v2/widgets`, with required-field validation, hub-kind/status
validation, widget type and policy-scope registry checks, hub existence checks,
initial widget-version snapshots, OpenAPI path entries, SDK helper methods, and
focused Hspec helper coverage. The collection controllers now dispatch
GET/POST by HTTP method so the create routes are reachable. Local
`git diff --check` passed; `scripts/compile-check` could not run because this
shell does not have `IHP_LIB`/the IHP dev environment loaded.
---
### T02 — Add manifest and policy-scope API support