inter-hub-haskell/Web/Controller/ApiInteractionEvents.hs

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, responseLBS, ResponseReceived)
import Network.HTTP.Types (status201, status401, status403, status405, status422)
import IHP.Controller.Render (renderJson, renderJsonWithStatusCode)
import Application.Helper.TypeRegistry (validateEventType)

instance Controller ApiInteractionEventsController where

    action CreateApiInteractionEventAction = do
        -- Method guard — only POST accepted.
        when (requestMethod ?request /= "POST") do
            renderJsonWithStatusCode status405 (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
                renderJsonWithStatusCode status401 (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
                        renderJsonWithStatusCode status401 (object ["error" .= ("Invalid or unknown API key" :: Text)])
                    Just hub -> createEventForHub hub

createEventForHub :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Hub -> IO ()
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
        renderJsonWithStatusCode status422 (object
            [ "error"   .= ("Missing required fields" :: Text)
            , "missing" .= missing
            ])

    let Just wIdText = widgetIdText
        Just evType  = eventType

    evTypeResult <- liftIO $ validateEventType evType
    case evTypeResult of
        Left _ -> do
            renderJsonWithStatusCode status422 (object
                [ "error"    .= ("Unacceptable event_type" :: Text)
                , "hint"     .= ("Register the event type in the Type Registry before submitting" :: Text)
                ])
        Right () -> pure ()

    -- Resolve widget — must belong to this hub.
    case readMay wIdText of
        Nothing -> do
            renderJsonWithStatusCode status422 (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
                    renderJsonWithStatusCode status422 (object ["error" .= ("Widget not found" :: Text)])
                Just widget -> do
                    when (widget.hubId /= toUUID hub.id) do
                        renderJsonWithStatusCode status403 (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

                    renderJsonWithStatusCode status201 (object
                        [ "id"          .= event.id
                        , "widget_id"   .= event.widgetId
                        , "event_type"  .= event.eventType
                        , "occurred_at" .= event.occurredAt
                        ])