module Web.Controller.Api.V2.InteractionEvents where import Web.Types import Generated.Types import IHP.Prelude import IHP.ControllerPrelude import Data.Aeson (object, (.=)) import qualified Data.Text as T import Web.Controller.Api.V2.Auth ( requireApiConsumer, paginatedResponse, getPageParams , respondWithStatus ) import Application.Helper.TypeRegistry (validateEventType) import Web.Job.WebhookDeliveryJob (dispatchWebhooks) import Control.Concurrent (forkIO) import Control.Monad (void) import qualified Data.UUID as UUID import qualified Data.Aeson as A 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 action ApiV2ShowInteractionEventAction { interactionEventId } = do _consumer <- requireApiConsumer event <- fetch interactionEventId 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" 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 ] let Just wIdText = widgetIdText Just evType = eventType -- 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 let declared = case manifest.declaredEventTypes of _ -> [] :: [Text] -- JSONB array decoded via aeson unless (null declared || evType `elem` declared) 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 |> 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 "clicked" webhookPayload renderJson (eventToJson event) eventToJson :: InteractionEvent -> Value eventToJson e = object [ "id" .= e.id , "widgetId" .= e.widgetId , "eventType" .= e.eventType , "actorId" .= e.actorId , "actorType" .= e.actorType , "viewContextRef" .= e.viewContextRef , "metadata" .= e.metadata , "occurredAt" .= e.occurredAt ]