coulomb/inter-hub-haskell
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fix(api): unblock production build

Browse source
This commit is contained in:
tegwick 2026-06-14 14:42:11 +02:00
parent 84ee797e4f
commit a2d0dddddd
6 changed files with 51 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

19
Web/Controller/Api/V2/InteractionEvents.hs
View file

@ -27,7 +27,7 @@ instance Controller ApiV2InteractionEventsController where
action ApiV2IndexInteractionEventsAction = do
case requestMethod ?request of
"GET" -> listInteractionEvents
"POST" -> createInteractionEvent
"POST" -> createApiInteractionEvent
_ -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
action ApiV2ShowInteractionEventAction { interactionEventId } = do
@ -36,7 +36,7 @@ instance Controller ApiV2InteractionEventsController where
renderJson (eventToJson event)
-- POST /api/v2/interaction-events
action ApiV2CreateInteractionEventAction = createInteractionEvent
action ApiV2CreateInteractionEventAction = createApiInteractionEvent
listInteractionEvents :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
listInteractionEvents = do
@ -57,13 +57,13 @@ listInteractionEvents = do
events <- q2 |> limit perPage |> offset off |> fetch
renderJson $ paginatedResponse (map eventToJson events) page perPage total
createInteractionEvent :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
createInteractionEvent = do
createApiInteractionEvent :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
createApiInteractionEvent = do
consumer <- requireApiConsumer
metadata <- metadataFromRequest
let widgetIdText = paramOrNothing @Text "widgetId"
eventType = paramOrNothing @Text "eventType"
viewContext = paramOrNothing @Text "viewContext"
metadata = metadataFromRequest
let missing = catMaybes
[ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
@ -155,13 +155,14 @@ manifestAllowsEvent eventType declaredEventTypes =
metadataParamOrEmpty :: Maybe A.Value -> A.Value
metadataParamOrEmpty = fromMaybe (object [])
metadataFromRequest :: (?context :: ControllerContext) => A.Value
metadataFromRequest :: (?context :: ControllerContext, ?request :: Request) => IO A.Value
metadataFromRequest =
case getHeader "Content-Type" of
Just contentType | "application/json" `BS.isPrefixOf` contentType ->
metadataParamOrEmpty (metadataFromJsonBody requestBodyJSON)
Just contentType | "application/json" `BS.isPrefixOf` contentType -> do
body <- requestBodyJSON
pure $ metadataParamOrEmpty (metadataFromJsonBody body)
_ ->
metadataParamOrEmpty (metadataFromText =<< paramOrNothing @Text "metadata")
pure $ metadataParamOrEmpty (metadataFromText =<< paramOrNothing @Text "metadata")
metadataFromJsonBody :: A.Value -> Maybe A.Value
metadataFromJsonBody (Object body) = KM.lookup "metadata" body