fix(api): unblock production build

Web/Controller/Api/V2/InteractionEvents.hs

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