{-# LANGUAGE UndecidableInstances #-}
module Servant.Auth.Server.Internal.Class where
import Servant.Auth
import Data.Monoid
import Servant hiding (BasicAuth)
import Servant.Auth.JWT
import Servant.Auth.Server.Internal.Types
import Servant.Auth.Server.Internal.ConfigTypes
import Servant.Auth.Server.Internal.BasicAuth
import Servant.Auth.Server.Internal.Cookie
import Servant.Auth.Server.Internal.JWT (jwtAuthCheck)
class IsAuth a v where
type family AuthArgs a :: [*]
runAuth :: proxy a -> proxy v -> Unapp (AuthArgs a) (AuthCheck v)
instance FromJWT usr => IsAuth Cookie usr where
type AuthArgs Cookie = '[CookieSettings, JWTSettings]
runAuth _ _ = cookieAuthCheck
instance FromJWT usr => IsAuth JWT usr where
type AuthArgs JWT = '[JWTSettings]
runAuth _ _ = jwtAuthCheck
instance FromBasicAuthData usr => IsAuth BasicAuth usr where
type AuthArgs BasicAuth = '[BasicAuthCfg]
runAuth _ _ = basicAuthCheck
class AreAuths (as :: [*]) (ctxs :: [*]) v where
runAuths :: proxy as -> Context ctxs -> AuthCheck v
instance AreAuths '[] ctxs v where
runAuths _ _ = mempty
instance ( AuthCheck v ~ App (AuthArgs a) (Unapp (AuthArgs a) (AuthCheck v))
, IsAuth a v
, AreAuths as ctxs v
, AppCtx ctxs (AuthArgs a) (Unapp (AuthArgs a) (AuthCheck v))
) => AreAuths (a ': as) ctxs v where
runAuths _ ctxs = go <> runAuths (Proxy :: Proxy as) ctxs
where
go = appCtx (Proxy :: Proxy (AuthArgs a))
ctxs
(runAuth (Proxy :: Proxy a) (Proxy :: Proxy v))
type family Unapp ls res where
Unapp '[] res = res
Unapp (arg1 ': rest) res = arg1 -> Unapp rest res
type family App ls res where
App '[] res = res
App (arg1 ': rest) (arg1 -> res) = App rest res
class AppCtx ctx ls res where
appCtx :: proxy ls -> Context ctx -> res -> App ls res
instance ( HasContextEntry ctxs ctx
, AppCtx ctxs rest res
) => AppCtx ctxs (ctx ': rest) (ctx -> res) where
appCtx _ ctx fn = appCtx (Proxy :: Proxy rest) ctx $ fn $ getContextEntry ctx
instance AppCtx ctx '[] res where
appCtx _ _ r = r