fix: honor v2 interaction event contract

Web/Controller/Api/V2/InteractionEvents.hs

@@ -4,8 +4,8 @@ import Web.Types
 import Generated.Types
 import IHP.Prelude
 import IHP.ControllerPrelude
-import Data.Aeson (object, (.=))
-import qualified Data.Text as T
+import Data.Aeson (Value(..), object, (.=))
+import IHP.ControllerSupport (ControllerContext, getHeader, requestBodyJSON)
 import Web.Controller.Api.V2.Auth
     ( requireApiConsumer, paginatedResponse, getPageParams
     , respondWithStatus )
@@ -13,8 +13,13 @@ import Application.Helper.TypeRegistry (validateEventType)
 import Web.Job.WebhookDeliveryJob (dispatchWebhooks)
 import Control.Concurrent (forkIO)
 import Control.Monad (void)
+import Data.Maybe (fromMaybe, mapMaybe)
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.ByteString as BS
+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
 
 instance Controller ApiV2InteractionEventsController where
 
@@ -47,6 +52,7 @@ instance Controller ApiV2InteractionEventsController where
         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
@@ -76,9 +82,7 @@ instance Controller ApiV2InteractionEventsController where
         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
+                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)
@@ -100,6 +104,7 @@ instance Controller ApiV2InteractionEventsController where
                             |> set #eventType evType
                             |> set #actorType "api"
                             |> set #viewContextRef viewContext
+                            |> set #metadata metadata
                             |> createRecord
                         -- Dispatch webhooks fire-and-forget
                         let webhookPayload = object
@@ -109,7 +114,7 @@ instance Controller ApiV2InteractionEventsController where
                                 , "eventType"  .= event.eventType
                                 , "occurredAt" .= event.occurredAt
                                 ]
-                        liftIO $ void $ forkIO $ dispatchWebhooks "clicked" webhookPayload
+                        liftIO $ void $ forkIO $ dispatchWebhooks evType webhookPayload
                         renderJson (eventToJson event)
 
 eventToJson :: InteractionEvent -> Value
@@ -123,3 +128,33 @@ eventToJson e = object
     , "metadata"       .= e.metadata
     , "occurredAt"     .= e.occurredAt
     ]
+
+declaredEventTypeNames :: A.Value -> [Text]
+declaredEventTypeNames (Array values) = mapMaybe extractText (V.toList values)
+  where
+    extractText (String value) = Just value
+    extractText _              = Nothing
+declaredEventTypeNames _ = []
+
+manifestAllowsEvent :: Text -> A.Value -> Bool
+manifestAllowsEvent eventType declaredEventTypes =
+    let declared = declaredEventTypeNames declaredEventTypes
+    in null declared || eventType `elem` declared
+
+metadataParamOrEmpty :: Maybe A.Value -> A.Value
+metadataParamOrEmpty = fromMaybe (object [])
+
+metadataFromRequest :: (?context :: ControllerContext) => A.Value
+metadataFromRequest =
+    case getHeader "Content-Type" of
+        Just contentType | "application/json" `BS.isPrefixOf` contentType ->
+            metadataParamOrEmpty (metadataFromJsonBody requestBodyJSON)
+        _ ->
+            metadataParamOrEmpty (metadataFromText =<< paramOrNothing @Text "metadata")
+
+metadataFromJsonBody :: A.Value -> Maybe A.Value
+metadataFromJsonBody (Object body) = KM.lookup "metadata" body
+metadataFromJsonBody _             = Nothing
+
+metadataFromText :: Text -> Maybe A.Value
+metadataFromText raw = A.decode (LBSC.pack (cs raw))