From ee1e0fe3559783cb140d87f92a860f73eeac9d88 Mon Sep 17 00:00:00 2001 From: aaron levin Date: Sat, 19 Dec 2015 23:50:00 +0100 Subject: [PATCH] Delayed handler for Lax authentication --- .../Servant/Server/Internal/RoutingApplication.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs index 1455e036..707c0f05 100644 --- a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs +++ b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs @@ -183,7 +183,6 @@ addMethodCheck (Delayed captures method auth body server) new = addAuthStrictCheck :: Delayed (AuthProtected auth usr (usr -> a) 'Strict) -> IO (RouteResult (Maybe auth)) -> Delayed a - -- -> Delayed a addAuthStrictCheck delayed@(Delayed captures method _ body _) new = let newAuth = runDelayed delayed `bindRouteResults` \authProtectionStrict -> new `bindRouteResults` \mAuthData -> case mAuthData of @@ -207,6 +206,17 @@ addAuthStrictCheck delayed@(Delayed captures method _ body _) new = (return . Route . subServerStrict authProtectionStrict) usr in Delayed captures method newAuth body (\_ y _ -> Route y) +-- | Add a method to perform authorization in strict mode. +addAuthLaxCheck :: Delayed (AuthProtected auth usr (Maybe usr -> a) 'Lax) + -> IO (RouteResult (Maybe auth)) + -> Delayed a +addAuthLaxCheck delayed@(Delayed captures method _ body _) new = + let newAuth = runDelayed delayed `bindRouteResults` \authProtectionLax -> new `bindRouteResults` \mAuthData -> + fmap (Route . subServerLax authProtectionLax) + (maybe (pure Nothing) (checkAuthLax authProtectionLax) mAuthData) + + in Delayed captures method newAuth body (\_ y _ -> Route y) + -- | Add a body check to the end of the body block. addBodyCheck :: Delayed (a -> b) -> IO (RouteResult a)