module Web.Controller.InteractionEvents where import Web.Types import Generated.Types import IHP.Prelude import IHP.ControllerPrelude import Data.Aeson (object, (.=), decode, Value) import Data.Coerce (coerce) 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 let actorId = 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 (coerce 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 ])