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

@@ -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