{-# options_haddock prune #-}

-- | Description: Internal error combinators
module Polysemy.Account.Api.Server.Error where

import qualified Data.Aeson as Aeson
import Exon.Quote (exon)
import qualified Log
import Servant (ServerError, err401, err409, err500, errBody)

import Polysemy.Account.Data.AccountsError (
  AccountsClientError (Conflict, InvalidAuth, NoAccountId, NoAccountName),
  AccountsError (Client, Internal),
  )

serverErrorLBS :: ServerError -> LByteString -> ServerError
serverErrorLBS :: ServerError -> LByteString -> ServerError
serverErrorLBS ServerError
err LByteString
e =
  ServerError
err { errBody :: LByteString
errBody = LByteString
e }

serverError :: ServerError -> Text -> ServerError
serverError :: ServerError -> Text -> ServerError
serverError ServerError
err =
  ServerError -> LByteString -> ServerError
serverErrorLBS ServerError
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertUtf8 a b => a -> b
encodeUtf8

unauthorized :: Text -> ServerError
unauthorized :: Text -> ServerError
unauthorized =
  ServerError -> Text -> ServerError
serverError ServerError
err401

internal :: Text -> ServerError
internal :: Text -> ServerError
internal =
  ServerError -> Text -> ServerError
serverError ServerError
err500

errJson ::
  ToJSON e =>
  ServerError ->
  e ->
  ServerError
errJson :: forall e. ToJSON e => ServerError -> e -> ServerError
errJson ServerError
err =
  ServerError -> LByteString -> ServerError
serverErrorLBS ServerError
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> LByteString
Aeson.encode

data ClientError =
  ClientError {
    ClientError -> Text
message :: Text
  }
  deriving stock (ClientError -> ClientError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientError -> ClientError -> Bool
$c/= :: ClientError -> ClientError -> Bool
== :: ClientError -> ClientError -> Bool
$c== :: ClientError -> ClientError -> Bool
Eq, Int -> ClientError -> ShowS
[ClientError] -> ShowS
ClientError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientError] -> ShowS
$cshowList :: [ClientError] -> ShowS
show :: ClientError -> String
$cshow :: ClientError -> String
showsPrec :: Int -> ClientError -> ShowS
$cshowsPrec :: Int -> ClientError -> ShowS
Show, forall x. Rep ClientError x -> ClientError
forall x. ClientError -> Rep ClientError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientError x -> ClientError
$cfrom :: forall x. ClientError -> Rep ClientError x
Generic)

json ''ClientError

internalAccountsError ::
  Members [Log, Stop ServerError] r =>
  Text ->
  Sem r a
internalAccountsError :: forall (r :: EffectRow) a.
Members '[Log, Stop ServerError] r =>
Text -> Sem r a
internalAccountsError Text
err = do
  forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.error [exon|Internal accounts error: #{err}|]
  forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (Text -> ServerError
internal Text
"Internal error")

respondError ::
  Member (Stop ServerError) r =>
  ServerError ->
  Text ->
  Sem r a
respondError :: forall (r :: EffectRow) a.
Member (Stop ServerError) r =>
ServerError -> Text -> Sem r a
respondError ServerError
err Text
msg =
  forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (forall e. ToJSON e => ServerError -> e -> ServerError
errJson ServerError
err (Text -> ClientError
ClientError Text
msg))

accountsError ::
  Members [Log, Stop ServerError] r =>
  AccountsError ->
  Sem r a
accountsError :: forall (r :: EffectRow) a.
Members '[Log, Stop ServerError] r =>
AccountsError -> Sem r a
accountsError = \case
  Client AccountsClientError
NoAccountId ->
    forall (r :: EffectRow) a.
Member (Stop ServerError) r =>
ServerError -> Text -> Sem r a
respondError ServerError
err401 Text
"No such account"
  Client AccountsClientError
InvalidAuth ->
    forall (r :: EffectRow) a.
Member (Stop ServerError) r =>
ServerError -> Text -> Sem r a
respondError ServerError
err401 Text
"Invalid credentials"
  Client AccountsClientError
NoAccountName ->
    forall (r :: EffectRow) a.
Member (Stop ServerError) r =>
ServerError -> Text -> Sem r a
respondError ServerError
err401 Text
"No such account"
  Client AccountsClientError
Conflict ->
    forall (r :: EffectRow) a.
Member (Stop ServerError) r =>
ServerError -> Text -> Sem r a
respondError ServerError
err409 Text
"Multiple accounts with same name"
  Internal Text
err ->
    forall (r :: EffectRow) a.
Members '[Log, Stop ServerError] r =>
Text -> Sem r a
internalAccountsError Text
err

jwtError ::
  Members [Stop ServerError, Log] r =>
  Show e =>
  e ->
  Sem r a
jwtError :: forall (r :: EffectRow) e a.
(Members '[Stop ServerError, Log] r, Show e) =>
e -> Sem r a
jwtError e
e = do
  forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.error [exon|JWT generation failed: #{show e}|]
  forall (r :: EffectRow) a.
Member (Stop ServerError) r =>
ServerError -> Text -> Sem r a
respondError ServerError
err500 Text
"Internal error"