diff --git a/servant-auth-server.cabal b/servant-auth-server.cabal --- a/servant-auth-server.cabal +++ b/servant-auth-server.cabal @@ -3,12 +3,17 @@ -- see: https://github.com/sol/hpack name: servant-auth-server -version: 0.1.0.1 +version: 0.2.0.0 synopsis: servant-server/servant-auth compatibility -description: Please see README.md +description: This package provides the required instances for using the @Auth@ combinator + in your 'servant' server. + . + Both cookie- and token- (REST API) based authentication is provided. + . + For a quick overview of the usage, see the . category: Web, Servant, Authentication -homepage: http://github.com/jkarni/servant-auth-server#readme -bug-reports: https://github.com/jkarni/servant-auth-server/issues +homepage: http://github.com/plow-technologies/servant-auth#readme +bug-reports: https://github.com/plow-techologies/servant-auth/issues author: Julian K. Arni maintainer: jkarni@gmail.com copyright: (c) Julian K. Arni @@ -20,7 +25,7 @@ source-repository head type: git - location: https://github.com/jkarni/servant-auth-server + location: https://github.com/plow-techologies/servant-auth library hs-source-dirs: @@ -28,29 +33,27 @@ default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators ghc-options: -Wall build-depends: - base >= 4.7 && < 4.10 - , text - , servant-auth - , cookie >= 0.4 && < 0.5 - , wai - , mtl - , bytestring - , case-insensitive - , jose - , monad-time - , time - , servant-server - , base64-bytestring - , blaze-builder - , reflection - , unordered-containers - , aeson - , lens - , entropy - , scrypt - , crypto-api - , data-default-class - , http-api-data + base >= 4.7 && < 4.10 + , text >= 1 && < 2 + , servant-auth == 0.2.* + , cookie >= 0.4 && < 0.5 + , wai >= 3.2 && < 3.3 + , mtl >= 2.2 && < 2.3 + , bytestring >= 0.10 && < 0.11 + , case-insensitive >= 1.2 && < 1.3 + , jose >= 0.5 && < 0.6 + , monad-time >= 0.2 && < 0.3 + , time >= 1.5 && < 1.7 + , servant-server >= 0.7 && < 0.10 + , base64-bytestring >= 1 && < 2 + , blaze-builder >= 0.4 && < 0.5 + , unordered-containers >= 0.2 && < 0.3 + , aeson >= 0.11 && < 2 + , lens >= 4 && < 5 + , entropy >= 0.3 && < 0.4 + , crypto-api >= 0.13 && < 0.14 + , data-default-class >= 0.0 && < 0.2 + , http-api-data >= 0.2 && < 0.4 exposed-modules: Servant.Auth.Server Servant.Auth.Server.Internal @@ -72,29 +75,27 @@ default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators ghc-options: -Wall -pgmL markdown-unlit build-depends: - base >= 4.7 && < 4.10 - , text - , servant-auth - , cookie >= 0.4 && < 0.5 - , wai - , mtl - , bytestring - , case-insensitive - , jose - , monad-time - , time - , servant-server - , base64-bytestring - , blaze-builder - , reflection - , unordered-containers - , aeson - , lens - , entropy - , scrypt - , crypto-api - , data-default-class - , http-api-data + base >= 4.7 && < 4.10 + , text >= 1 && < 2 + , servant-auth == 0.2.* + , cookie >= 0.4 && < 0.5 + , wai >= 3.2 && < 3.3 + , mtl >= 2.2 && < 2.3 + , bytestring >= 0.10 && < 0.11 + , case-insensitive >= 1.2 && < 1.3 + , jose >= 0.5 && < 0.6 + , monad-time >= 0.2 && < 0.3 + , time >= 1.5 && < 1.7 + , servant-server >= 0.7 && < 0.10 + , base64-bytestring >= 1 && < 2 + , blaze-builder >= 0.4 && < 0.5 + , unordered-containers >= 0.2 && < 0.3 + , aeson >= 0.11 && < 2 + , lens >= 4 && < 5 + , entropy >= 0.3 && < 0.4 + , crypto-api >= 0.13 && < 0.14 + , data-default-class >= 0.0 && < 0.2 + , http-api-data >= 0.2 && < 0.4 , servant-auth , servant-auth-server , servant-server @@ -111,35 +112,31 @@ default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators ghc-options: -Wall build-depends: - base >= 4.7 && < 4.10 - , text - , servant-auth - , cookie >= 0.4 && < 0.5 - , wai - , mtl - , bytestring - , case-insensitive - , jose - , monad-time - , time - , servant-server - , base64-bytestring - , blaze-builder - , reflection - , unordered-containers - , aeson - , lens - , entropy - , scrypt - , crypto-api - , data-default-class - , http-api-data + base >= 4.7 && < 4.10 + , text >= 1 && < 2 + , servant-auth == 0.2.* + , cookie >= 0.4 && < 0.5 + , wai >= 3.2 && < 3.3 + , mtl >= 2.2 && < 2.3 + , bytestring >= 0.10 && < 0.11 + , case-insensitive >= 1.2 && < 1.3 + , jose >= 0.5 && < 0.6 + , monad-time >= 0.2 && < 0.3 + , time >= 1.5 && < 1.7 + , servant-server >= 0.7 && < 0.10 + , base64-bytestring >= 1 && < 2 + , blaze-builder >= 0.4 && < 0.5 + , unordered-containers >= 0.2 && < 0.3 + , aeson >= 0.11 && < 2 + , lens >= 4 && < 5 + , entropy >= 0.3 && < 0.4 + , crypto-api >= 0.13 && < 0.14 + , data-default-class >= 0.0 && < 0.2 + , http-api-data >= 0.2 && < 0.4 , servant-auth-server , hspec > 2 && < 3 , QuickCheck >= 2.8 && < 2.9 , aeson - , wai - , lens , lens-aeson , warp , wreq diff --git a/src/Servant/Auth/Server/Internal.hs b/src/Servant/Auth/Server/Internal.hs --- a/src/Servant/Auth/Server/Internal.hs +++ b/src/Servant/Auth/Server/Internal.hs @@ -3,8 +3,6 @@ module Servant.Auth.Server.Internal where import Control.Monad.Trans (liftIO) -import qualified Crypto.JOSE as Jose -import qualified Crypto.JWT as Jose import qualified Data.ByteString.Lazy as BSL import Servant ((:>), Handler, HasServer (..), Proxy (..), HasContextEntry(getContextEntry)) @@ -57,10 +55,8 @@ makeCookies :: AuthResult v -> IO [Cookie.SetCookie] makeCookies (Authenticated v) = do - ejwt <- Jose.createJWSJWT (key jwtSettings) - (Jose.newJWSHeader (Jose.Protected, Jose.HS256)) - (encodeJWT v) - case ejwt >>= Jose.encodeCompact of + ejwt <- makeJWT v jwtSettings Nothing + case ejwt of Left _ -> return [] Right jwt -> return [Cookie.def { Cookie.setCookieName = "JWT-Cookie" diff --git a/src/Servant/Auth/Server/Internal/JWT.hs b/src/Servant/Auth/Server/Internal/JWT.hs --- a/src/Servant/Auth/Server/Internal/JWT.hs +++ b/src/Servant/Auth/Server/Internal/JWT.hs @@ -70,12 +70,12 @@ -- token expires. makeJWT :: ToJWT a => a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString) -makeJWT v cfg expiry = do +makeJWT v cfg expiry = runExceptT $ do ejwt <- Jose.createJWSJWT (key cfg) (Jose.newJWSHeader (Jose.Protected, Jose.HS256)) (addExp $ encodeJWT v) - return $ ejwt >>= Jose.encodeCompact + Jose.encodeCompact ejwt where addExp claims = case expiry of Nothing -> claims diff --git a/test/Servant/Auth/ServerSpec.hs b/test/Servant/Auth/ServerSpec.hs --- a/test/Servant/Auth/ServerSpec.hs +++ b/test/Servant/Auth/ServerSpec.hs @@ -1,11 +1,13 @@ module Servant.Auth.ServerSpec (spec) where import Control.Lens +import Control.Monad.Except (runExceptT) import Crypto.JOSE (Alg (HS256, None), Error, JWK, + JWSHeader, KeyMaterialGenParam (OctGenParam), Protection (Protected), ToCompact, encodeCompact, genJWK, newJWSHeader) -import Crypto.JWT (Audience (..), ClaimsSet, +import Crypto.JWT (Audience (..), ClaimsSet, JWT, NumericDate (NumericDate), claimAud, claimNbf, createJWSJWT, emptyClaimsSet, unregisteredClaims) @@ -56,8 +58,7 @@ it "succeeds if one authentication suceeds" $ \port -> property $ \(user :: User) -> do - jwt <- makeJWT user jwtCfg Nothing -- (newJWSHeader (Protected, HS256)) - {-(claims $ toJSON user)-} + jwt <- makeJWT user jwtCfg Nothing opts <- addJwtToHeader jwt resp <- getWith opts (url port) resp ^? responseBody . _JSON `shouldBe` Just (length $ name user) @@ -68,7 +69,7 @@ context "Setting cookies" $ do it "sets cookies that it itself accepts" $ \port -> property $ \user -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user) opts' <- addJwtToCookie jwt let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"]) @@ -84,7 +85,7 @@ resp2 ^? responseBody . _JSON `shouldBe` Just (length $ name user) it "uses the Expiry from the configuration" $ \port -> property $ \(user :: User) -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user) opts' <- addJwtToCookie jwt let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"]) @@ -96,7 +97,7 @@ xxsrf ^. cookieExpiryTime `shouldBe` future it "sets the token cookie as HttpOnly" $ \port -> property $ \(user :: User) -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user) opts' <- addJwtToCookie jwt let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"]) @@ -120,7 +121,7 @@ it "fails if CSRF header and cookie don't match" $ \port -> property $ \(user :: User) -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user) + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user) opts' <- addJwtToCookie jwt let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"]) (xsrfCookieName cookieCfg <> "=blerg") @@ -128,13 +129,13 @@ it "fails if there is no CSRF header and cookie" $ \port -> property $ \(user :: User) -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user) + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user) opts <- addJwtToCookie jwt getWith opts (url port) `shouldHTTPErrorWith` status401 it "succeeds if CSRF header and cookie match, and JWT is valid" $ \port -> property $ \(user :: User) -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user) + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user) opts' <- addJwtToCookie jwt let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"]) (xsrfCookieName cookieCfg <> "=blah") @@ -153,14 +154,14 @@ it "fails if 'aud' does not match predicate" $ \port -> property $ \(user :: User) -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims (toJSON user) & claimAud .~ Just (Audience ["boo"])) opts <- addJwtToHeader (jwt >>= encodeCompact) getWith opts (url port) `shouldHTTPErrorWith` status401 it "succeeds if 'aud' does match predicate" $ \port -> property $ \(user :: User) -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims (toJSON user) & claimAud .~ Just (Audience ["anythingElse"])) opts <- addJwtToHeader (jwt >>= encodeCompact) resp <- getWith opts (url port) @@ -168,7 +169,7 @@ it "fails if 'nbf' is set to a future date" $ \port -> property $ \(user :: User) -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims (toJSON user) & claimNbf .~ Just (NumericDate future)) opts <- addJwtToHeader (jwt >>= encodeCompact) getWith opts (url port) `shouldHTTPErrorWith` status401 @@ -187,7 +188,7 @@ resp ^. responseStatus `shouldBe` status200 it "fails if JWT is not signed" $ \port -> property $ \(user :: User) -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, None)) + jwt <- createJWT theKey (newJWSHeader (Protected, None)) (claims $ toJSON user) opts <- addJwtToHeader (jwt >>= encodeCompact) getWith opts (url port) `shouldHTTPErrorWith` status401 @@ -196,12 +197,12 @@ pendingWith "Need https://github.com/frasertweedale/hs-jose/issues/19" it "fails if data is not valid JSON" $ \port -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) (claims "{{") + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims "{{") opts <- addJwtToHeader (jwt >>= encodeCompact) getWith opts (url port) `shouldHTTPErrorWith` status401 it "suceeds as wreq's oauth2Bearer" $ \port -> property $ \(user :: User) -> do - jwt <- createJWSJWT theKey (newJWSHeader (Protected, HS256)) + jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user) resp <- case jwt >>= encodeCompact of Left (e :: Error) -> fail $ show e @@ -255,7 +256,7 @@ type API auths = Auth auths User :> Get '[JSON] Int -jwtOnlyApi :: Proxy (API '[JWT]) +jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT]) jwtOnlyApi = Proxy cookieOnlyApi :: Proxy (API '[Cookie]) @@ -264,7 +265,7 @@ basicAuthApi :: Proxy (API '[BasicAuth]) basicAuthApi = Proxy -jwtAndCookieApi :: Proxy (API '[JWT, Cookie]) +jwtAndCookieApi :: Proxy (API '[Servant.Auth.Server.JWT, Cookie]) jwtAndCookieApi = Proxy theKey :: JWK @@ -325,6 +326,9 @@ Left e -> fail $ show e Right v -> return $ defaults & header "Authorization" .~ ["Bearer " <> BSL.toStrict v] + +createJWT :: JWK -> JWSHeader -> ClaimsSet -> IO (Either Error Crypto.JWT.JWT) +createJWT k a b = runExceptT $ createJWSJWT k a b addJwtToCookie :: ToCompact a => Either Error a -> IO Options addJwtToCookie jwt = case jwt >>= encodeCompact of