Response.hs

{-# LANGUAGE LambdaCase #-}

module Web.Hyperbole.Types.Response where

import Data.Aeson (Value)
import Data.ByteString.Lazy qualified as BL
import Data.String (IsString (..))
import Data.String.Conversions (cs)
import Data.Text (Text)
import Web.Hyperbole.Data.Encoded (Encoded)
import Web.Hyperbole.Data.URI (URI)
import Web.Hyperbole.Types.Event


newtype Body = Body BL.ByteString


data ViewUpdate = ViewUpdate {viewId :: TargetViewId, body :: Body}


-- | A processed response for the client, which might be a 'ResponseError'
data Response
  = Response ViewUpdate
  | Redirect URI
  | Err ResponseError


data ResponseError
  = NotFound
  | ErrParse String
  | ErrQuery String
  | ErrSession Text String
  | ErrServer Text
  | ErrCustom ServerError
  | ErrInternal
  | ErrNotHandled (Event TargetViewId Encoded Value)
  | ErrAuth Text
instance Show ResponseError where
  show = \case
    NotFound -> "NotFound"
    ErrParse m -> "ErrParse " <> cs m
    ErrQuery m -> "ErrQuery " <> cs m
    ErrSession k m -> "ErrSession " <> cs k <> " " <> cs m
    ErrServer m -> "ErrServer " <> cs m
    ErrCustom err -> "ErrCustom " <> cs err.message
    ErrInternal -> "ErrInternal"
    ErrNotHandled ev -> "ErrNotHandled " <> show ev
    ErrAuth m -> "ErrAuth " <> cs m
instance IsString ResponseError where
  fromString s = ErrServer (cs s)


-- Serialized server error
data ServerError = ServerError
  { message :: Text
  , body :: Body
  }