Swap AuthHandlers and subserver placement

if subserver is last it makes it easier to work with.
This commit is contained in:
aaron levin 2015-08-09 11:33:26 -04:00 committed by aaron levin
parent 167e70351b
commit 961c08bdac
4 changed files with 6 additions and 5 deletions

View file

@ -15,6 +15,8 @@
module Servant.Server.Internal module Servant.Server.Internal
( module Servant.Server.Internal ( module Servant.Server.Internal
, module Servant.Server.Internal.Authentication
, module Servant.Server.Internal.PathInfo
, module Servant.Server.Internal.Router , module Servant.Server.Internal.Router
, module Servant.Server.Internal.RoutingApplication , module Servant.Server.Internal.RoutingApplication
, module Servant.Server.Internal.ServantErr , module Servant.Server.Internal.ServantErr

View file

@ -45,8 +45,8 @@ data AuthHandlers authData = AuthHandlers
-- | concrete type to provide when in 'Strict' mode. -- | concrete type to provide when in 'Strict' mode.
data instance AuthProtected authData usr subserver 'Strict = data instance AuthProtected authData usr subserver 'Strict =
AuthProtectedStrict { checkAuthStrict :: authData -> IO (Maybe usr) AuthProtectedStrict { checkAuthStrict :: authData -> IO (Maybe usr)
, subServerStrict :: subserver
, authHandlers :: AuthHandlers authData , authHandlers :: AuthHandlers authData
, subServerStrict :: subserver
} }
-- | concrete type to provide when in 'Lax' mode. -- | concrete type to provide when in 'Lax' mode.
@ -63,8 +63,8 @@ laxProtect = AuthProtectedLax
-- | handy function to build an auth-protected bit of API with a Strict policy -- | handy function to build an auth-protected bit of API with a Strict policy
strictProtect :: (authData -> IO (Maybe usr)) -- ^ check auth strictProtect :: (authData -> IO (Maybe usr)) -- ^ check auth
-> subserver -- ^ handlers for the auth-protected bits of the API
-> AuthHandlers authData -- ^ functions to call on auth failure -> AuthHandlers authData -- ^ functions to call on auth failure
-> subserver -- ^ handlers for the auth-protected bits of the API
-> AuthProtected authData usr subserver 'Strict -> AuthProtected authData usr subserver 'Strict
strictProtect = AuthProtectedStrict strictProtect = AuthProtectedStrict
@ -92,7 +92,7 @@ basicAuthStrict :: KnownSymbol realm
=> (BasicAuth realm -> IO (Maybe usr)) => (BasicAuth realm -> IO (Maybe usr))
-> subserver -> subserver
-> AuthProtected (BasicAuth realm) usr subserver 'Strict -> AuthProtected (BasicAuth realm) usr subserver 'Strict
basicAuthStrict check subserver = strictProtect check subserver basicAuthHandlers basicAuthStrict check subserver = strictProtect check basicAuthHandlers subserver
-- | Basic authentication combinator with lax failure. -- | Basic authentication combinator with lax failure.
basicAuthLax :: KnownSymbol realm basicAuthLax :: KnownSymbol realm

View file

@ -106,7 +106,7 @@ generalizeNat = Nat (pure . runIdentity)
-- | 'Enter' instance for AuthProtectedStrict -- | 'Enter' instance for AuthProtectedStrict
instance Enter subserver arg ret => Enter (AuthProtected authData usr subserver 'Strict) arg (AuthProtected authData usr ret 'Strict) where instance Enter subserver arg ret => Enter (AuthProtected authData usr subserver 'Strict) arg (AuthProtected authData usr ret 'Strict) where
enter arg (AuthProtectedStrict check subserver handlers) = AuthProtectedStrict check (enter arg subserver) handlers enter arg (AuthProtectedStrict check handlers subserver) = AuthProtectedStrict check handlers (enter arg subserver)
-- | 'Enter' instance for AuthProtectedLax -- | 'Enter' instance for AuthProtectedLax

View file

@ -727,7 +727,6 @@ authRequiredApi = Proxy
authRequiredServer :: Server AuthRequiredAPI authRequiredServer :: Server AuthRequiredAPI
authRequiredServer = basicAuthStrict basicAuthFooCheck (const . return $ alice) authRequiredServer = basicAuthStrict basicAuthFooCheck (const . return $ alice)
:<|> basicAuthStrict basicAuthBarCheck (const . return $ jerry) :<|> basicAuthStrict basicAuthBarCheck (const . return $ jerry)
-- authRequiredServer = const (return alice) :<|> const (return jerry)
-- base64-encoded "servant:server" -- base64-encoded "servant:server"
base64ServantColonServer :: ByteString base64ServantColonServer :: ByteString