diff --git a/servant-auth-server/servant-auth-server.cabal b/servant-auth-server/servant-auth-server.cabal index 9457815..a4ec1cb 100644 --- a/servant-auth-server/servant-auth-server.cabal +++ b/servant-auth-server/servant-auth-server.cabal @@ -1,5 +1,5 @@ name: servant-auth-server -version: 0.4.0.0 +version: 0.4.0.1 synopsis: servant-server/servant-auth compatibility description: This package provides the required instances for using the @Auth@ combinator in your 'servant' server. diff --git a/servant-auth-server/src/Servant/Auth/Server.hs b/servant-auth-server/src/Servant/Auth/Server.hs index 6c8b044..f481f8b 100644 --- a/servant-auth-server/src/Servant/Auth/Server.hs +++ b/servant-auth-server/src/Servant/Auth/Server.hs @@ -40,6 +40,7 @@ module Servant.Auth.Server Auth , AuthResult(..) , AuthCheck(..) + , IsAuth ---------------------------------------------------------------------------- -- * JWT diff --git a/servant-auth-server/src/Servant/Auth/Server/Internal.hs b/servant-auth-server/src/Servant/Auth/Server/Internal.hs index 1dfa13d..a3352c3 100644 --- a/servant-auth-server/src/Servant/Auth/Server/Internal.hs +++ b/servant-auth-server/src/Servant/Auth/Server/Internal.hs @@ -6,26 +6,17 @@ module Servant.Auth.Server.Internal where import Control.Monad.Trans (liftIO) import Servant ((:>), Handler, HasServer (..), - Proxy (..), - HasContextEntry(getContextEntry)) + Proxy (..)) import Servant.Auth -import Servant.Auth.Server.Internal.AddSetCookie import Servant.Auth.Server.Internal.Class -import Servant.Auth.Server.Internal.Cookie -import Servant.Auth.Server.Internal.ConfigTypes -import Servant.Auth.Server.Internal.JWT import Servant.Auth.Server.Internal.Types import Servant.Server.Internal.RoutingApplication -instance ( n ~ 'S ('S 'Z) - , HasServer (AddSetCookiesApi n api) ctxs, AreAuths auths ctxs v + +instance ( AreAuths auths ctxs v , HasServer api ctxs -- this constraint is needed to implement hoistServer - , AddSetCookies n (ServerT api Handler) (ServerT (AddSetCookiesApi n api) Handler) - , ToJWT v - , HasContextEntry ctxs CookieSettings - , HasContextEntry ctxs JWTSettings ) => HasServer (Auth auths v :> api) ctxs where type ServerT (Auth auths v :> api) m = AuthResult v -> ServerT api m @@ -34,38 +25,19 @@ instance ( n ~ 'S ('S 'Z) #endif route _ context subserver = - route (Proxy :: Proxy (AddSetCookiesApi n api)) + route (Proxy :: Proxy api) context (fmap go subserver `addAuthCheck` authCheck) where - authCheck :: DelayedIO (AuthResult v, SetCookieList ('S ('S 'Z))) + authCheck :: DelayedIO (AuthResult v) authCheck = withRequest $ \req -> liftIO $ do authResult <- runAuthCheck (runAuths (Proxy :: Proxy auths) context) req - cookies <- makeCookies authResult - return (authResult, cookies) - - jwtSettings :: JWTSettings - jwtSettings = getContextEntry context - - cookieSettings :: CookieSettings - cookieSettings = getContextEntry context - - makeCookies :: AuthResult v -> IO (SetCookieList ('S ('S 'Z))) - makeCookies authResult = do - xsrf <- makeXsrfCookie cookieSettings - fmap (Just xsrf `SetCookieCons`) $ - case authResult of - (Authenticated v) -> do - ejwt <- makeSessionCookie cookieSettings jwtSettings v - case ejwt of - Nothing -> return $ Nothing `SetCookieCons` SetCookieNil - Just jwt -> return $ Just jwt `SetCookieCons` SetCookieNil - _ -> return $ Nothing `SetCookieCons` SetCookieNil + return (authResult) go :: ( old ~ ServerT api Handler - , new ~ ServerT (AddSetCookiesApi n api) Handler + , new ~ ServerT api Handler ) => (AuthResult v -> ServerT api Handler) - -> (AuthResult v, SetCookieList n) -> new - go fn (authResult, cookies) = addSetCookies cookies $ fn authResult + -> (AuthResult v) -> new + go fn (authResult) = fn authResult diff --git a/servant-auth/servant-auth.cabal b/servant-auth/servant-auth.cabal index 457c305..b9672a7 100644 --- a/servant-auth/servant-auth.cabal +++ b/servant-auth/servant-auth.cabal @@ -34,7 +34,7 @@ library ghc-options: -Wall build-depends: base >= 4.8 && < 4.12 - , servant >= 0.9.1 && < 0.15 + , servant >= 0.14.1 && < 0.15 exposed-modules: Servant.Auth default-language: Haskell2010 diff --git a/stack.yaml b/stack.yaml index 2737676..969eab2 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-11.14 +resolver: lts-12.9 apply-ghc-options: targets packages: - servant-auth