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)