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)
import qualified Data.UUID as UUID

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
    let 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 UUID.fromText 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 /= 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
                        ])