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

module Web.Controller.InteractionEvents where

import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (object, (.=), decode, Value)
import qualified Data.Aeson as A
import qualified Data.Text as T
import qualified Data.ByteString.Lazy.Char8 as LBSC
import IHP.Controller.Render (renderJson, renderJsonWithStatusCode)
import Network.HTTP.Types (status422)

-- Valid canonical event types
validEventTypes :: [Text]
validEventTypes =
    [ "viewed", "clicked", "submitted", "abandoned", "retried", "failed"
    , "commented", "flagged_confusing", "flagged_helpful"
    , "blocked_by_policy", "escalated"
    , "accepted_recommendation", "rejected_recommendation"
    ]

instance Controller InteractionEventsController where
    action CreateInteractionEventAction { widgetId } = do
        let eventType = param @Text "event_type"
        unless (eventType `elem` validEventTypes) do
            renderJsonWithStatusCode status422 (object ["error" .= ("unknown event_type" :: Text), "valid" .= validEventTypes])

        let mUser = currentUserOrNothing @User
        let actorId        = fmap (\(Id uuid) -> uuid) (fmap (.id) mUser)
            actorType      = maybe "anonymous" (const "user") mUser
            actorTypeParam = paramOrDefault @Text actorType "actor_type"
            viewContextRef = paramOrNothing @Text "view_context_ref"
            metadataRaw    = paramOrDefault @Text "{}" "metadata"

        let metadata = case decode (LBSC.pack (cs metadataRaw)) of
                Just v  -> v
                Nothing -> object [] :: A.Value

        event <- newRecord @InteractionEvent
            |> set #widgetId       widgetId
            |> set #eventType      eventType
            |> set #actorId        actorId
            |> set #actorType      actorTypeParam
            |> set #viewContextRef viewContextRef
            |> set #metadata       metadata
            |> createRecord

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