{-# LANGUAGE UndecidableInstances #-}

module Servant.Auth.JWT.WithSession where

import Control.Monad
import Data.Kind
import Servant.Auth.Server
import Servant.Auth.Server.Internal.Class

type JWTWithSession :: Type
data JWTWithSession

instance (WithSession usr, IsAuth JWT usr) => IsAuth JWTWithSession usr where
  type AuthArgs JWTWithSession = SessionCfg ': AuthArgs JWT
  runAuth :: forall (proxy :: * -> *).
proxy JWTWithSession
-> proxy usr -> Unapp (AuthArgs JWTWithSession) (AuthCheck usr)
runAuth proxy JWTWithSession
_ proxy usr
proxyUsr SessionCfg
sessionCfg JWTSettings
jwtSettings =
    (Request -> IO (AuthResult usr)) -> AuthCheck usr
forall val. (Request -> IO (AuthResult val)) -> AuthCheck val
AuthCheck ((Request -> IO (AuthResult usr)) -> AuthCheck usr)
-> (Request -> IO (AuthResult usr)) -> AuthCheck usr
forall a b. (a -> b) -> a -> b
$
      AuthCheck usr -> Request -> IO (AuthResult usr)
forall val. AuthCheck val -> Request -> IO (AuthResult val)
runAuthCheck (proxy JWT -> proxy usr -> Unapp (AuthArgs JWT) (AuthCheck usr)
forall a v (proxy :: * -> *).
IsAuth a v =>
proxy a -> proxy v -> Unapp (AuthArgs a) (AuthCheck v)
forall (proxy :: * -> *).
proxy JWT -> proxy usr -> Unapp (AuthArgs JWT) (AuthCheck usr)
runAuth (proxy JWT
forall a. HasCallStack => a
forall {proxy :: * -> *}. proxy JWT
undefined :: proxy JWT) proxy usr
proxyUsr JWTSettings
jwtSettings)
        (Request -> IO (AuthResult usr))
-> (AuthResult usr -> IO (AuthResult usr))
-> Request
-> IO (AuthResult usr)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
          AuthResult usr
BadPassword -> AuthResult usr -> IO (AuthResult usr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthResult usr
forall val. AuthResult val
BadPassword
          AuthResult usr
NoSuchUser -> AuthResult usr -> IO (AuthResult usr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthResult usr
forall val. AuthResult val
NoSuchUser
          Authenticated usr
u -> SessionCfg -> usr -> IO (AuthResult usr)
forall a. WithSession a => SessionCfg -> a -> IO (AuthResult a)
validateSession SessionCfg
sessionCfg usr
u
          AuthResult usr
Indefinite -> AuthResult usr -> IO (AuthResult usr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthResult usr
forall val. AuthResult val
Indefinite

type WithSession :: Type -> Constraint
class WithSession a where
  validateSession :: SessionCfg -> a -> IO (AuthResult a)

type SessionCfg :: Type
type family SessionCfg