-- | Description: Server runners using 'Jwt' for authentication
module Polysemy.Account.Api.Native where

import Servant (
  Context (EmptyContext, (:.)),
  DefaultErrorFormatters,
  ErrorFormatters,
  HasContextEntry,
  HasServer,
  ServerError,
  ServerT,
  type (.++),
  )
import Servant.Auth.Server (CookieSettings, JWTSettings, defaultCookieSettings)

import qualified Polysemy.Account.Api.Effect.Jwt as Jwt
import Polysemy.Account.Api.Effect.Jwt (Jwt)
import Polysemy.Account.Api.NativeContext (ServerReady, runServer)
import Polysemy.Account.Data.Port (Port)

-- | The Servant context for 'Jwt' servers.
type AuthContext =
  [JWTSettings, CookieSettings]

-- | Servant constraint for servers using JWT.
type ServerAuth api =
  HasServer api AuthContext

-- | Run a Servant server with JSON Web Token authentication using settings from 'Jwt'.
--
-- This variant allows supplying additional 'Context's.
runServerJwtWith ::
  ∀ (api :: Type) (context :: [Type]) a e r .
  HasContextEntry (context .++ DefaultErrorFormatters) ErrorFormatters =>
  HasServer api (AuthContext ++ context) =>
  Members [Sync ServerReady, Jwt a !! e, Log, Interrupt, Error Text, Final IO] r =>
  Context context ->
  ServerT api (Sem (Stop ServerError : r)) ->
  Port ->
  Sem r ()
runServerJwtWith :: forall api (context :: [*]) a e (r :: EffectRow).
(HasContextEntry
   (context .++ DefaultErrorFormatters) ErrorFormatters,
 HasServer api (AuthContext ++ context),
 Members
   '[Sync ServerReady, Jwt a !! e, Log, Interrupt, Error Text,
     Final IO]
   r) =>
Context context
-> ServerT api (Sem (Stop ServerError : r)) -> Port -> Sem r ()
runServerJwtWith Context context
ctx ServerT api (Sem (Stop ServerError : r))
srv Port
port = do
  JWTSettings
jwtSettings <- forall a (r :: EffectRow). Member (Jwt a) r => Sem r JWTSettings
Jwt.settings forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> Sem r a -> Sem r a
!>> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw Text
"Jwt initialization failed"
  forall api (context :: [*]) (r :: EffectRow).
(HasServer api context,
 HasContextEntry
   (context .++ DefaultErrorFormatters) ErrorFormatters,
 Members '[Sync ServerReady, Log, Interrupt, Final IO] r) =>
ServerT api (Sem (Stop ServerError : r))
-> Context context -> Port -> Sem r ()
runServer @api ServerT api (Sem (Stop ServerError : r))
srv (JWTSettings
jwtSettings forall x (xs :: [*]). x -> Context xs -> Context (x : xs)
:. CookieSettings
defaultCookieSettings forall x (xs :: [*]). x -> Context xs -> Context (x : xs)
:. Context context
ctx) Port
port

-- | Run a Servant server with JSON Web Token authentication using settings from 'Jwt'.
runServerJwt ::
  ∀ (api :: Type) a e r .
  ServerAuth api =>
  Members [Sync ServerReady, Jwt a !! e, Log, Interrupt, Error Text, Final IO] r =>
  ServerT api (Sem (Stop ServerError : r)) ->
  Port ->
  Sem r ()
runServerJwt :: forall api a e (r :: EffectRow).
(ServerAuth api,
 Members
   '[Sync ServerReady, Jwt a !! e, Log, Interrupt, Error Text,
     Final IO]
   r) =>
ServerT api (Sem (Stop ServerError : r)) -> Port -> Sem r ()
runServerJwt =
  forall api (context :: [*]) a e (r :: EffectRow).
(HasContextEntry
   (context .++ DefaultErrorFormatters) ErrorFormatters,
 HasServer api (AuthContext ++ context),
 Members
   '[Sync ServerReady, Jwt a !! e, Log, Interrupt, Error Text,
     Final IO]
   r) =>
Context context
-> ServerT api (Sem (Stop ServerError : r)) -> Port -> Sem r ()
runServerJwtWith @api Context '[]
EmptyContext