servant-auth-server 0.1.0.1 → 0.2.0.0
raw patch · 4 files changed
+98/−101 lines, 4 filesdep −reflectiondep −scryptdep ~aesondep ~base64-bytestringdep ~blaze-builder
Dependencies removed: reflection, scrypt
Dependency ranges changed: aeson, base64-bytestring, blaze-builder, bytestring, case-insensitive, crypto-api, data-default-class, entropy, http-api-data, jose, lens, monad-time, mtl, servant-auth, servant-server, text, time, unordered-containers, wai
Files
- servant-auth-server.cabal +73/−76
- src/Servant/Auth/Server/Internal.hs +2/−6
- src/Servant/Auth/Server/Internal/JWT.hs +2/−2
- test/Servant/Auth/ServerSpec.hs +21/−17
servant-auth-server.cabal view
@@ -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 <http://github.com/plow-technologies/servant-auth#readme README>. 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
src/Servant/Auth/Server/Internal.hs view
@@ -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"
src/Servant/Auth/Server/Internal/JWT.hs view
@@ -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
test/Servant/Auth/ServerSpec.hs view
@@ -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