inter-hub-haskell/Web/Controller/Api/V2/InteractionEvents.hs

module Web.Controller.Api.V2.InteractionEvents where

import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (object, (.=))
import qualified Data.Text as T
import Web.Controller.Api.V2.Auth
    ( requireApiConsumer, paginatedResponse, getPageParams
    , respondWithStatus )
import Application.Helper.TypeRegistry (validateEventType)
import Web.Job.WebhookDeliveryJob (dispatchWebhooks)
import Control.Concurrent (forkIO)
import qualified Data.Aeson as A

instance Controller ApiV2InteractionEventsController where

    action ApiV2IndexInteractionEventsAction = do
        _consumer <- requireApiConsumer
        (page, perPage) <- getPageParams
        mWidgetId  <- paramOrNothing @(Id Widget) "widgetId"
        mEventType <- paramOrNothing @Text "eventType"
        let off = (page - 1) * perPage
        let baseQ = query @InteractionEvent
                |> orderByDesc #occurredAt
        let q1 = case mWidgetId  of
                    Just wId -> baseQ |> filterWhere (#widgetId, wId)
                    Nothing  -> baseQ
        let q2 = case mEventType of
                    Just et  -> q1 |> filterWhere (#eventType, et)
                    Nothing  -> q1
        total  <- q2 |> fetchCount
        events <- q2 |> limit perPage |> offset off |> fetch
        renderJson $ paginatedResponse (map eventToJson events) page perPage total

    action ApiV2ShowInteractionEventAction { interactionEventId } = do
        _consumer <- requireApiConsumer
        event <- fetch interactionEventId
        renderJson (eventToJson event)

    -- POST /api/v2/interaction-events
    action ApiV2CreateInteractionEventAction = do
        consumer <- requireApiConsumer
        widgetIdText <- paramOrNothing @Text "widgetId"
        eventType    <- paramOrNothing @Text "eventType"
        viewContext  <- paramOrNothing @Text "viewContext"

        let missing = catMaybes
                [ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
                , if isNothing eventType    then Just "eventType"           else Nothing
                ]
        unless (null missing) do
            respondWithStatus 422 $ object
                [ "error"   .= ("Missing required fields" :: Text)
                , "missing" .= missing
                ]

        let Just wIdText = widgetIdText
            Just evType  = eventType

        -- Validate against event_type_registry
        evResult <- liftIO $ validateEventType evType
        case evResult of
            Left _ -> respondWithStatus 422 $ object
                [ "error"    .= ("Unregistered event type" :: Text)
                , "code"     .= ("unregistered_event_type" :: Text)
                , "value"    .= evType
                , "registry" .= ("/api/v2/event-types" :: Text)
                ]
            Right () -> pure ()

        -- If consumer has a manifest, also validate against declared_event_types
        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
                    respondWithStatus 422 $ object
                        [ "error" .= ("Event type not declared in hub manifest" :: Text)
                        , "code"  .= ("event_type_not_in_manifest" :: Text)
                        , "value" .= evType
                        ]

        case readMay wIdText of
            Nothing -> respondWithStatus 422 $ object
                ["error" .= ("widgetId must be a valid UUID" :: Text)]
            Just rawId -> do
                let wId = Id rawId :: Id Widget
                mWidget <- fetchOneOrNothing wId
                case mWidget of
                    Nothing -> respondWithStatus 422 $ object
                        ["error" .= ("Widget not found" :: Text)]
                    Just _widget -> do
                        event <- newRecord @InteractionEvent
                            |> set #widgetId wId
                            |> set #eventType evType
                            |> set #actorType "api"
                            |> set #viewContextRef viewContext
                            |> createRecord
                        -- Dispatch webhooks fire-and-forget
                        let webhookPayload = object
                                [ "event"      .= ("interaction_event.created" :: Text)
                                , "resourceId" .= event.id
                                , "widgetId"   .= event.widgetId
                                , "eventType"  .= event.eventType
                                , "occurredAt" .= event.occurredAt
                                ]
                        liftIO $ void $ forkIO $ dispatchWebhooks "clicked" webhookPayload
                        setStatus 201
                        renderJson (eventToJson event)

eventToJson :: InteractionEvent -> Value
eventToJson e = object
    [ "id"             .= e.id
    , "widgetId"       .= e.widgetId
    , "eventType"      .= e.eventType
    , "actorId"        .= e.actorId
    , "actorType"      .= e.actorType
    , "viewContextRef" .= e.viewContextRef
    , "metadata"       .= e.metadata
    , "occurredAt"     .= e.occurredAt
    ]