feat(P6/T02-T03): EnvelopeEmissionContract and InteractionReportingContract

T02: EnvelopeEmissionContractsController (index+show, read-only); widgetEnvelope
helper validates against contract v1.0 required attributes with inline warning
on missing view-context; adapterStatusBadge helper added to Application.Helper.View.

T03: InteractionReportingContractsController (index+show, read-only); API endpoint
POST /api/v1/interaction-events with bearer token auth against hub.api_key,
contract v1.0 field validation, and 201/422/401 responses.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

Web/Controller/ApiInteractionEvents.hs

@@ -0,0 +1,104 @@
+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)
+
+-- | Accepted event types per InteractionReportingContract v1.0
+apiAcceptedEventTypes :: [Text]
+apiAcceptedEventTypes = ["clicked", "viewed", "submitted", "dismissed", "errored"]
+
+instance Controller ApiInteractionEventsController where
+
+    action CreateApiInteractionEventAction = do
+        -- Method guard — only POST accepted.
+        when (requestMethod ?request /= "POST") do
+            setStatus 405
+            respondJson (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
+                setStatus 401
+                respondJson (object ["error" .= ("Authorization: Bearer <hub-api-key> required" :: Text)])
+            Just apiKey -> do
+                mHub <- query @Hub
+                    |> filterWhere (#apiKey, Just apiKey)
+                    |> fetchOneOrNothing
+                case mHub of
+                    Nothing -> do
+                        setStatus 401
+                        respondJson (object ["error" .= ("Invalid or unknown API key" :: Text)])
+                    Just hub -> createEventForHub hub
+
+createEventForHub :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Hub -> IO ResponseReceived
+createEventForHub hub = do
+    -- Validate required fields per contract v1.0
+    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
+        setStatus 422
+        respondJson (object
+            [ "error"   .= ("Missing required fields" :: Text)
+            , "missing" .= missing
+            ])
+
+    let Just wIdText = widgetIdText
+        Just evType  = eventType
+
+    unless (evType `elem` apiAcceptedEventTypes) do
+        setStatus 422
+        respondJson (object
+            [ "error"    .= ("Unacceptable event_type" :: Text)
+            , "accepted" .= apiAcceptedEventTypes
+            ])
+
+    -- Resolve widget — must belong to this hub.
+    case readMay wIdText of
+        Nothing -> do
+            setStatus 422
+            respondJson (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
+                    setStatus 422
+                    respondJson (object ["error" .= ("Widget not found" :: Text)])
+                Just widget -> do
+                    when (widget.hubId /= hub.id) do
+                        setStatus 403
+                        respondJson (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
+
+                    setStatus 201
+                    respondJson (object
+                        [ "id"          .= event.id
+                        , "widget_id"   .= event.widgetId
+                        , "event_type"  .= event.eventType
+                        , "occurred_at" .= event.occurredAt
+                        ])

Web/Controller/EnvelopeEmissionContracts.hs

@@ -0,0 +1,21 @@
+module Web.Controller.EnvelopeEmissionContracts where
+
+import Web.Types
+import Web.View.EnvelopeEmissionContracts.Index
+import Web.View.EnvelopeEmissionContracts.Show
+import Generated.Types
+import IHP.Prelude
+import IHP.ControllerPrelude
+
+instance Controller EnvelopeEmissionContractsController where
+    beforeAction = ensureIsUser
+
+    action EnvelopeEmissionContractsAction = do
+        contracts <- query @EnvelopeEmissionContract
+            |> orderByDesc #createdAt
+            |> fetch
+        render IndexView { contracts }
+
+    action ShowEnvelopeEmissionContractAction { envelopeEmissionContractId } = do
+        contract <- fetch envelopeEmissionContractId
+        render ShowView { contract }

Web/Controller/InteractionReportingContracts.hs

@@ -0,0 +1,21 @@
+module Web.Controller.InteractionReportingContracts where
+
+import Web.Types
+import Web.View.InteractionReportingContracts.Index
+import Web.View.InteractionReportingContracts.Show
+import Generated.Types
+import IHP.Prelude
+import IHP.ControllerPrelude
+
+instance Controller InteractionReportingContractsController where
+    beforeAction = ensureIsUser
+
+    action InteractionReportingContractsAction = do
+        contracts <- query @InteractionReportingContract
+            |> orderByDesc #createdAt
+            |> fetch
+        render IndexView { contracts }
+
+    action ShowInteractionReportingContractAction { interactionReportingContractId } = do
+        contract <- fetch interactionReportingContractId
+        render ShowView { contract }