-- | Description: Servant Handlers for the auth API
module Polysemy.Account.Api.Server.Auth where

import Servant (ServerError, ServerT, err401, (:<|>) ((:<|>)))
import Servant.Auth.Server (AuthResult)
import qualified Servant.Auth.Server as AuthResult (AuthResult (..))
import Sqel (Uid (Uid))

import qualified Polysemy.Account.Accounts as Accounts
import qualified Polysemy.Account.Api.Effect.Jwt as Jwt
import Polysemy.Account.Api.Effect.Jwt (Jwt)
import Polysemy.Account.Api.Routes (AuthApi)
import Polysemy.Account.Api.Server.Error (accountsError, jwtError, serverError)
import Polysemy.Account.Data.Account (Account (Account))
import Polysemy.Account.Data.AccountCredentials (AccountCredentials)
import Polysemy.Account.Data.AccountsError (AccountsError)
import Polysemy.Account.Data.AuthToken (AuthToken)
import Polysemy.Account.Data.AuthedAccount (AuthedAccount (AuthedAccount))
import qualified Polysemy.Account.Effect.Accounts as Accounts
import Polysemy.Account.Effect.Accounts (Accounts)

-- | Authenticate an account using the JSON Web Token extracted by Servant.
authAccount ::
  Members [Accounts i p !! AccountsError, Log, Stop ServerError] r =>
  AuthResult (AuthedAccount i p) ->
  Sem r (AuthedAccount i p)
authAccount :: forall i p (r :: EffectRow).
Members
  '[Accounts i p !! AccountsError, Log, Stop ServerError] r =>
AuthResult (AuthedAccount i p) -> Sem r (AuthedAccount i p)
authAccount (AuthResult.Authenticated (AuthedAccount i
accountId i
authId AccountName
_ AccountStatus
_ p
_)) = do
  Uid i
dbId (Account AccountName
name AccountStatus
roles p
accountStatus) <- forall i p (r :: EffectRow).
Member (Accounts i p) r =>
i -> Sem r (Uid i (Account p))
Accounts.byId i
accountId forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! forall (r :: EffectRow) a.
Members '[Log, Stop ServerError] r =>
AccountsError -> Sem r a
accountsError
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall i p.
i -> i -> AccountName -> AccountStatus -> p -> AuthedAccount i p
AuthedAccount i
dbId i
authId AccountName
name AccountStatus
roles p
accountStatus)
authAccount AuthResult (AuthedAccount i p)
_ =
  forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (ServerError -> Text -> ServerError
serverError ServerError
err401 Text
"Invalid credentials")

-- | Log an account in using the credentials in the payload.
login ::
  ∀ e i p r .
  Show e =>
  Members [Jwt (AuthedAccount i p) !! e, Accounts i p !! AccountsError, Log, Stop ServerError] r =>
  AccountCredentials ->
  Sem r AuthToken
login :: forall e i p (r :: EffectRow).
(Show e,
 Members
   '[Jwt (AuthedAccount i p) !! e, Accounts i p !! AccountsError, Log,
     Stop ServerError]
   r) =>
AccountCredentials -> Sem r AuthToken
login AccountCredentials
cred = do
  AuthedAccount i p
account <- forall i p (r :: EffectRow).
Member (Accounts i p) r =>
AccountCredentials -> Sem r (AuthedAccount i p)
Accounts.login AccountCredentials
cred forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! forall (r :: EffectRow) a.
Members '[Log, Stop ServerError] r =>
AccountsError -> Sem r a
accountsError
  forall a (r :: EffectRow). Member (Jwt a) r => a -> Sem r AuthToken
Jwt.makeToken AuthedAccount i p
account forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! forall (r :: EffectRow) e a.
(Members '[Stop ServerError, Log] r, Show e) =>
e -> Sem r a
jwtError

-- | Register an account using the credentials in the payload.
register ::
  Show e =>
  Members [Jwt (AuthedAccount i p) !! e, Accounts i p !! AccountsError, Log, Stop ServerError] r =>
  AccountCredentials ->
  Sem r AuthToken
register :: forall e i p (r :: EffectRow).
(Show e,
 Members
   '[Jwt (AuthedAccount i p) !! e, Accounts i p !! AccountsError, Log,
     Stop ServerError]
   r) =>
AccountCredentials -> Sem r AuthToken
register AccountCredentials
cred = do
  AuthedAccount i p
account <- forall i p (r :: EffectRow).
Member (Accounts i p) r =>
AccountCredentials -> Sem r (AuthedAccount i p)
Accounts.register AccountCredentials
cred forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! forall (r :: EffectRow) a.
Members '[Log, Stop ServerError] r =>
AccountsError -> Sem r a
accountsError
  forall a (r :: EffectRow). Member (Jwt a) r => a -> Sem r AuthToken
Jwt.makeToken AuthedAccount i p
account forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! forall (r :: EffectRow) e a.
(Members '[Stop ServerError, Log] r, Show e) =>
e -> Sem r a
jwtError

-- | Handlers for 'AuthApi'.
authServer ::
  Show e =>
  Members [Jwt (AuthedAccount i p) !! e, Accounts i p !! AccountsError, Log, Stop ServerError] r =>
  ServerT (AuthApi i p) (Sem r)
authServer :: forall e i p (r :: EffectRow).
(Show e,
 Members
   '[Jwt (AuthedAccount i p) !! e, Accounts i p !! AccountsError, Log,
     Stop ServerError]
   r) =>
ServerT (AuthApi i p) (Sem r)
authServer =
  forall i p (r :: EffectRow).
Members
  '[Accounts i p !! AccountsError, Log, Stop ServerError] r =>
AuthResult (AuthedAccount i p) -> Sem r (AuthedAccount i p)
authAccount
  forall a b. a -> b -> a :<|> b
:<|>
  forall e i p (r :: EffectRow).
(Show e,
 Members
   '[Jwt (AuthedAccount i p) !! e, Accounts i p !! AccountsError, Log,
     Stop ServerError]
   r) =>
AccountCredentials -> Sem r AuthToken
login
  forall a b. a -> b -> a :<|> b
:<|>
  forall e i p (r :: EffectRow).
(Show e,
 Members
   '[Jwt (AuthedAccount i p) !! e, Accounts i p !! AccountsError, Log,
     Stop ServerError]
   r) =>
AccountCredentials -> Sem r AuthToken
register