servant-auth-server 0.3.0.0 → 0.3.1.0
raw patch · 8 files changed
+89/−255 lines, 8 filesdep ~aesondep ~bytestringdep ~case-insensitive
Dependency ranges changed: aeson, bytestring, case-insensitive, http-api-data, jose, lens, mtl, servant-auth, servant-server, time, wai
Files
- package.yaml +0/−105
- servant-auth-server.cabal +45/−82
- src/Servant/Auth/Server/Internal.hs +6/−0
- src/Servant/Auth/Server/Internal/ConfigTypes.hs +1/−3
- src/Servant/Auth/Server/Internal/Cookie.hs +3/−4
- src/Servant/Auth/Server/Internal/JWT.hs +11/−11
- test/Doctest.hs +0/−26
- test/Servant/Auth/ServerSpec.hs +23/−24
− package.yaml
@@ -1,105 +0,0 @@-name: servant-auth-server-version: 0.3.0.0-synopsis: servant-server/servant-auth compatibility-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>.-homepage: http://github.com/plow-technologies/servant-auth#readme-license: BSD3-license-file: LICENSE-author: Julian K. Arni-maintainer: jkarni@gmail.com-category: Web, Servant, Authentication-copyright: (c) Julian K. Arni-github: plow-technologies/servant-auth-tested-with: GHC == 7.10.2, GHC == 8.0.1--extra-source-files:- - package.yaml--ghc-options: -Wall--dependencies:- - base >= 4.7 && < 4.10- - text >= 1 && < 2- - servant-auth == 0.2.*- # We have an orphan instance for SetCookie, so we need to be careful about upper bounds.- - cookie >= 0.4 && < 0.4.2.2- - wai >= 3.2 && < 3.3- - mtl >= 2.2 && < 2.3- - bytestring >= 0.10 && < 0.11- - bytestring-conversion >= 0.3 && < 0.4- - 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.9.1 && < 0.12- - 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.3 && < 0.4- - http-types >= 0.9 && < 0.10- - tagged >= 0.7.3 && < 0.9---default-extensions:- - AutoDeriveTypeable- - ConstraintKinds- - DataKinds- - DefaultSignatures- - DeriveFoldable- - DeriveFunctor- - DeriveGeneric- - DeriveTraversable- - FlexibleContexts- - FlexibleInstances- - FunctionalDependencies- - GADTs- - KindSignatures- - MultiParamTypeClasses- - OverloadedStrings- - RankNTypes- - ScopedTypeVariables- - TypeFamilies- - TypeOperators--library:- source-dirs: src- other-modules: []--tests:- spec:- main: Spec.hs- source-dirs: test- dependencies:- - servant-auth-server- - hspec > 2 && < 3- - QuickCheck >= 2.8 && < 2.10- - aeson- - lens-aeson- - warp- - wreq- - http-types- - http-client >= 0.4 && < 0.6--executables:- readme:- main: README.lhs- source-dirs: executables- ghc-options: -pgmL markdown-unlit- dependencies:- - servant-auth- - servant-auth-server- - servant-server- - warp- - markdown-unlit- - transformers
servant-auth-server.cabal view
@@ -1,9 +1,5 @@--- This file has been generated from package.yaml by hpack version 0.17.0.------ see: https://github.com/sol/hpack- name: servant-auth-server-version: 0.3.0.0+version: 0.3.1.0 synopsis: servant-server/servant-auth compatibility description: This package provides the required instances for using the @Auth@ combinator in your 'servant' server.@@ -19,13 +15,10 @@ copyright: (c) Julian K. Arni license: BSD3 license-file: LICENSE-tested-with: GHC == 7.10.2, GHC == 8.0.1+tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 build-type: Simple cabal-version: >= 1.10 -extra-source-files:- package.yaml- source-repository head type: git location: https://github.com/plow-technologies/servant-auth@@ -36,30 +29,30 @@ 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 >= 1 && < 2- , servant-auth == 0.2.*- , cookie >= 0.4 && < 0.4.2.2- , wai >= 3.2 && < 3.3- , mtl >= 2.2 && < 2.3+ base >= 4.8 && < 4.11+ , aeson >= 0.11 && < 2+ , base64-bytestring >= 1 && < 2+ , blaze-builder >= 0.4 && < 0.5 , bytestring >= 0.10 && < 0.11 , bytestring-conversion >= 0.3 && < 0.4 , 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.9.1 && < 0.12- , 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+ , cookie >= 0.4 && < 0.4.4 , crypto-api >= 0.13 && < 0.14 , data-default-class >= 0.0 && < 0.2- , http-api-data >= 0.3 && < 0.4- , http-types >= 0.9 && < 0.10+ , entropy >= 0.3 && < 0.4+ , http-api-data >= 0.3 && < 0.3.8+ , http-types >= 0.9 && < 0.11+ , jose >= 0.6 && < 0.7+ , lens >= 4 && < 5+ , monad-time >= 0.2 && < 0.3+ , mtl >= 2.2 && < 2.3+ , servant-auth == 0.3.*+ , servant-server >= 0.9.1 && < 0.13 , tagged >= 0.7.3 && < 0.9+ , text >= 1 && < 2+ , time >= 1.5 && < 1.9+ , unordered-containers >= 0.2 && < 0.3+ , wai >= 3.2 && < 3.3 exposed-modules: Servant.Auth.Server Servant.Auth.Server.Internal@@ -81,37 +74,17 @@ executables 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-tool-depends: markdown-unlit:markdown-unlit build-depends:- base >= 4.7 && < 4.10- , text >= 1 && < 2- , servant-auth == 0.2.*- , cookie >= 0.4 && < 0.4.2.2- , wai >= 3.2 && < 3.3- , mtl >= 2.2 && < 2.3- , bytestring >= 0.10 && < 0.11- , bytestring-conversion >= 0.3 && < 0.4- , 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.9.1 && < 0.12- , 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.3 && < 0.4- , http-types >= 0.9 && < 0.10- , tagged >= 0.7.3 && < 0.9+ base , servant-auth , servant-auth-server , servant-server+ , aeson+ , mtl , warp- , markdown-unlit , transformers+ , markdown-unlit default-language: Haskell2010 test-suite spec@@ -121,41 +94,31 @@ test 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-tool-depends: hspec-discover:hspec-discover++ -- dependencies with bounds inherited from the library stanza build-depends:- base >= 4.7 && < 4.10- , text >= 1 && < 2- , servant-auth == 0.2.*- , cookie >= 0.4 && < 0.4.2.2- , wai >= 3.2 && < 3.3- , mtl >= 2.2 && < 2.3- , bytestring >= 0.10 && < 0.11- , bytestring-conversion >= 0.3 && < 0.4- , 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.9.1 && < 0.12- , 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.3 && < 0.4- , http-types >= 0.9 && < 0.10- , tagged >= 0.7.3 && < 0.9- , servant-auth-server- , hspec > 2 && < 3- , QuickCheck >= 2.8 && < 2.10+ base , aeson+ , bytestring+ , case-insensitive+ , jose+ , lens+ , mtl+ , time+ , http-types+ , wai+ , servant-server++ -- test dependencies+ build-depends:+ servant-auth-server+ , hspec > 2 && < 3+ , QuickCheck >= 2.8 && < 2.11+ , http-client >= 0.4 && < 0.6 , lens-aeson , warp , wreq- , http-types- , http-client >= 0.4 && < 0.6 other-modules:- Doctest Servant.Auth.ServerSpec default-language: Haskell2010
src/Servant/Auth/Server/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -20,12 +21,17 @@ instance ( n ~ 'S ('S 'Z) , HasServer (AddSetCookiesApi n api) ctxs, 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++#if MIN_VERSION_servant_server(0,12,0)+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s+#endif route _ context subserver = route (Proxy :: Proxy (AddSetCookiesApi n api))
src/Servant/Auth/Server/Internal/ConfigTypes.hs view
@@ -1,6 +1,5 @@ module Servant.Auth.Server.Internal.ConfigTypes where -import Control.Lens import Crypto.JOSE as Jose import Crypto.JWT as Jose import qualified Data.ByteString as BS@@ -90,8 +89,7 @@ jwtSettingsToJwtValidationSettings :: JWTSettings -> Jose.JWTValidationSettings jwtSettingsToJwtValidationSettings s- = defaultJWTValidationSettings- & audiencePredicate .~ (toBool <$> audienceMatches s)+ = defaultJWTValidationSettings (toBool <$> audienceMatches s) where toBool Matches = True toBool DoesNotMatch = False
src/Servant/Auth/Server/Internal/Cookie.hs view
@@ -34,10 +34,9 @@ lookup (sessionCookieName ccfg) cookies verifiedJWT <- liftIO $ runExceptT $ do unverifiedJWT <- Jose.decodeCompact $ BSL.fromStrict jwtCookie- Jose.validateJWSJWT (jwtSettingsToJwtValidationSettings jwtCfg)- (key jwtCfg)- unverifiedJWT- return unverifiedJWT+ Jose.verifyClaims (jwtSettingsToJwtValidationSettings jwtCfg)+ (key jwtCfg)+ unverifiedJWT case verifiedJWT of Left (_ :: Jose.JWTError) -> mzero Right v -> case decodeJWT v of
src/Servant/Auth/Server/Internal/JWT.hs view
@@ -25,9 +25,9 @@ -- The default implementation assumes the data is stored in the unregistered -- @dat@ claim, and uses the @FromJSON@ instance to decode value from there. class FromJWT a where- decodeJWT :: Jose.JWT -> Either T.Text a- default decodeJWT :: FromJSON a => Jose.JWT -> Either T.Text a- decodeJWT m = case HM.lookup "dat" (Jose._unregisteredClaims $ Jose.jwtClaimsSet m ) of+ decodeJWT :: Jose.ClaimsSet -> Either T.Text a+ default decodeJWT :: FromJSON a => Jose.ClaimsSet -> Either T.Text a+ decodeJWT m = case HM.lookup "dat" (m ^. Jose.unregisteredClaims) of Nothing -> Left "Missing 'dat' claim" Just v -> case fromJSON v of Error e -> Left $ T.pack e@@ -55,10 +55,9 @@ return rest verifiedJWT <- liftIO $ runExceptT $ do unverifiedJWT <- Jose.decodeCompact $ BSL.fromStrict token- Jose.validateJWSJWT (jwtSettingsToJwtValidationSettings config)- (key config)- unverifiedJWT- return unverifiedJWT+ Jose.verifyClaims (jwtSettingsToJwtValidationSettings config)+ (key config)+ unverifiedJWT case verifiedJWT of Left (_ :: Jose.JWTError) -> mzero Right v -> case decodeJWT v of@@ -73,11 +72,12 @@ makeJWT :: ToJWT a => a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString) makeJWT v cfg expiry = runExceptT $ do- ejwt <- Jose.createJWSJWT (key cfg)- (Jose.newJWSHeader (Jose.Protected, Jose.HS256))- (addExp $ encodeJWT v)+ alg <- Jose.bestJWSAlg $ key cfg+ ejwt <- Jose.signClaims (key cfg)+ (Jose.newJWSHeader ((), alg))+ (addExp $ encodeJWT v) - Jose.encodeCompact ejwt+ return $ Jose.encodeCompact ejwt where addExp claims = case expiry of Nothing -> claims
− test/Doctest.hs
@@ -1,26 +0,0 @@-module Main (main) where---- Runs doctest on all files in "src" dir. Assumes:--- (a) You are using hpack--- (b) The top-level "default-extensions" are the only extensions besides the--- ones in the files.--import System.FilePath.Glob (glob)-import Test.DocTest (doctest)-import Data.Yaml--newtype Exts = Exts { getExts :: [String] }- deriving (Eq, Show, Read)--instance FromJSON Exts where- parseJSON (Object v) = Exts <$> v .: "default-extensions"- parseJSON _ = fail "expecting object"--main :: IO ()-main = do- hpack' <- decodeFile "package.yaml"- hpack <- case hpack' of- Nothing -> return $ Exts []- Just v -> return v- files <- glob "src/**/*.hs"- doctest $ files ++ fmap ("-X" ++) (getExts hpack)
test/Servant/Auth/ServerSpec.hs view
@@ -6,14 +6,13 @@ import Crypto.JOSE (Alg (HS256, None), Error, JWK, JWSHeader, KeyMaterialGenParam (OctGenParam),- Protection (Protected), ToCompact, encodeCompact, genJWK, newJWSHeader) import Crypto.JWT (Audience (..), ClaimsSet,- JWT, NumericDate (NumericDate),+ SignedJWT, claimAud, claimNbf,- createJWSJWT,+ signClaims, emptyClaimsSet, unregisteredClaims) import Data.Aeson (FromJSON, ToJSON, Value,@@ -114,7 +113,7 @@ context "Setting cookies" $ do it "sets cookies that it itself accepts" $ \port -> property $ \user -> do- jwt <- createJWT theKey (newJWSHeader (Protected, HS256))+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) opts' <- addJwtToCookie jwt let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"])@@ -130,7 +129,7 @@ resp2 ^? responseBody . _JSON `shouldBe` Just (length $ name user) it "uses the Expiry from the configuration" $ \port -> property $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader (Protected, HS256))+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) opts' <- addJwtToCookie jwt let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"])@@ -142,7 +141,7 @@ xxsrf ^. cookieExpiryTime `shouldBe` future it "sets the token cookie as HttpOnly" $ \port -> property $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader (Protected, HS256))+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) opts' <- addJwtToCookie jwt let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"])@@ -166,7 +165,7 @@ it "fails if CSRF header and cookie don't match" $ \port -> property $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user)+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) opts' <- addJwtToCookie jwt let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"]) (xsrfCookieName cookieCfg <> "=blerg")@@ -174,13 +173,13 @@ it "fails if there is no CSRF header and cookie" $ \port -> property $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user)+ jwt <- createJWT theKey (newJWSHeader ((), 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 <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims $ toJSON user)+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) opts' <- addJwtToCookie jwt let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"]) (xsrfCookieName cookieCfg <> "=blah")@@ -199,24 +198,24 @@ it "fails if 'aud' does not match predicate" $ \port -> property $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader (Protected, HS256))+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims (toJSON user) & claimAud .~ Just (Audience ["boo"]))- opts <- addJwtToHeader (jwt >>= encodeCompact)+ opts <- addJwtToHeader (jwt >>= (return . encodeCompact)) getWith opts (url port) `shouldHTTPErrorWith` status401 it "succeeds if 'aud' does match predicate" $ \port -> property $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader (Protected, HS256))+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims (toJSON user) & claimAud .~ Just (Audience ["anythingElse"]))- opts <- addJwtToHeader (jwt >>= encodeCompact)+ opts <- addJwtToHeader (jwt >>= (return . encodeCompact)) resp <- getWith opts (url port) resp ^. responseStatus `shouldBe` status200 it "fails if 'nbf' is set to a future date" $ \port -> property $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader (Protected, HS256))+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims (toJSON user) & claimNbf .~ Just (NumericDate future))- opts <- addJwtToHeader (jwt >>= encodeCompact)+ opts <- addJwtToHeader (jwt >>= (return . encodeCompact)) getWith opts (url port) `shouldHTTPErrorWith` status401 it "fails if 'exp' is set to a past date" $ \port -> property $@@ -233,23 +232,23 @@ resp ^. responseStatus `shouldBe` status200 it "fails if JWT is not signed" $ \port -> property $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader (Protected, None))+ jwt <- createJWT theKey (newJWSHeader ((), None)) (claims $ toJSON user)- opts <- addJwtToHeader (jwt >>= encodeCompact)+ opts <- addJwtToHeader (jwt >>= (return . encodeCompact)) getWith opts (url port) `shouldHTTPErrorWith` status401 it "fails if JWT does not use expected algorithm" $ const $ pendingWith "Need https://github.com/frasertweedale/hs-jose/issues/19" it "fails if data is not valid JSON" $ \port -> do- jwt <- createJWT theKey (newJWSHeader (Protected, HS256)) (claims "{{")- opts <- addJwtToHeader (jwt >>= encodeCompact)+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims "{{")+ opts <- addJwtToHeader (jwt >>= (return .encodeCompact)) getWith opts (url port) `shouldHTTPErrorWith` status401 it "suceeds as wreq's oauth2Bearer" $ \port -> property $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader (Protected, HS256))+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)- resp <- case jwt >>= encodeCompact of+ resp <- case jwt >>= (return . encodeCompact) of Left (e :: Error) -> fail $ show e Right v -> getWith (defaults & auth ?~ oauth2Bearer (BSL.toStrict v)) (url port) resp ^. responseStatus `shouldBe` status200@@ -396,11 +395,11 @@ 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+createJWT :: JWK -> JWSHeader () -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT)+createJWT k a b = runExceptT $ signClaims k a b addJwtToCookie :: ToCompact a => Either Error a -> IO Options-addJwtToCookie jwt = case jwt >>= encodeCompact of+addJwtToCookie jwt = case jwt >>= (return . encodeCompact) of Left e -> fail $ show e Right v -> return $ defaults & header "Cookie" .~ ["JWT-Cookie=" <> BSL.toStrict v]