module Web.Controller.ApiInteractionEvents where import Web.Types import Generated.Types import IHP.Prelude import IHP.ControllerPrelude import Data.Aeson (object, (.=)) import qualified Data.Text as T import Network.Wai (requestMethod, requestHeaders, responseLBS, ResponseReceived) import Network.HTTP.Types (status201, status401, status403, status405, status422) import IHP.Controller.Render (renderJson, renderJsonWithStatusCode) import Application.Helper.TypeRegistry (validateEventType) import qualified Data.UUID as UUID instance Controller ApiInteractionEventsController where action CreateApiInteractionEventAction = do -- Method guard — only POST accepted. when (requestMethod ?request /= "POST") do renderJsonWithStatusCode status405 (object ["error" .= ("Method not allowed" :: Text)]) -- Bearer token auth — validate against hub.api_key. let authHeader = lookup "Authorization" (requestHeaders ?request) let mApiKey = authHeader >>= \h -> let t = cs h :: Text in if "Bearer " `T.isPrefixOf` t then Just (T.drop 7 t) else Nothing case mApiKey of Nothing -> do renderJsonWithStatusCode status401 (object ["error" .= ("Authorization: Bearer required" :: Text)]) Just apiKey -> do mHub <- query @Hub |> filterWhere (#apiKey, Just apiKey) |> fetchOneOrNothing case mHub of Nothing -> do renderJsonWithStatusCode status401 (object ["error" .= ("Invalid or unknown API key" :: Text)]) Just hub -> createEventForHub hub createEventForHub :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Hub -> IO () createEventForHub hub = do -- Validate required fields per contract v1.0 let widgetIdText = paramOrNothing @Text "widget_id" eventType = paramOrNothing @Text "event_type" _occurredAt = paramOrNothing @Text "occurred_at" let missing = catMaybes [ if isNothing widgetIdText then Just ("widget_id" :: Text) else Nothing , if isNothing eventType then Just "event_type" else Nothing , if isNothing _occurredAt then Just "occurred_at" else Nothing ] unless (null missing) do renderJsonWithStatusCode status422 (object [ "error" .= ("Missing required fields" :: Text) , "missing" .= missing ]) let Just wIdText = widgetIdText Just evType = eventType evTypeResult <- liftIO $ validateEventType evType case evTypeResult of Left _ -> do renderJsonWithStatusCode status422 (object [ "error" .= ("Unacceptable event_type" :: Text) , "hint" .= ("Register the event type in the Type Registry before submitting" :: Text) ]) Right () -> pure () -- Resolve widget — must belong to this hub. case UUID.fromText wIdText of Nothing -> do renderJsonWithStatusCode status422 (object ["error" .= ("widget_id must be a valid UUID" :: Text)]) Just rawId -> do let wId = Id rawId :: Id Widget mWidget <- fetchOneOrNothing wId case mWidget of Nothing -> do renderJsonWithStatusCode status422 (object ["error" .= ("Widget not found" :: Text)]) Just widget -> do when (widget.hubId /= hub.id) do renderJsonWithStatusCode status403 (object ["error" .= ("Widget does not belong to this hub" :: Text)]) event <- newRecord @InteractionEvent |> set #widgetId widget.id |> set #eventType evType |> set #actorType "external_adapter" |> createRecord renderJsonWithStatusCode status201 (object [ "id" .= event.id , "widget_id" .= event.widgetId , "event_type" .= event.eventType , "occurred_at" .= event.occurredAt ])