diff --git a/servant-auth/servant-auth-client/servant-auth-client.cabal b/servant-auth/servant-auth-client/servant-auth-client.cabal index e38df9686..c8498e320 100644 --- a/servant-auth/servant-auth-client/servant-auth-client.cabal +++ b/servant-auth/servant-auth-client/servant-auth-client.cabal @@ -74,7 +74,7 @@ test-suite spec , transformers >= 0.4.2.0 && < 0.7 , wai >= 3.2.1.2 && < 3.3 , warp >= 3.2.25 && < 3.5 - , jose >= 0.10 && < 0.12 + , jose >= 0.10 && < 0.13 other-modules: Servant.Auth.ClientSpec default-language: Haskell2010 diff --git a/servant-auth/servant-auth-server/servant-auth-server.cabal b/servant-auth/servant-auth-server/servant-auth-server.cabal index 00a97f251..4ac027487 100644 --- a/servant-auth/servant-auth-server/servant-auth-server.cabal +++ b/servant-auth/servant-auth-server/servant-auth-server.cabal @@ -41,7 +41,7 @@ library , data-default >= 0.2 && < 0.9 , entropy >= 0.4.1.3 && < 0.5 , http-types >= 0.12.2 && < 0.13 - , jose >= 0.10 && < 0.12 + , jose >= 0.10 && < 0.13 , lens >= 4.16.1 && < 5.4 , memory >= 0.14.16 && < 0.19 , monad-time >= 0.3.1.0 && < 0.5 diff --git a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs index ea07866ac..7e973c2e0 100644 --- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs +++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Servant.Auth.Server.Internal.JWT where import Control.Lens @@ -30,6 +32,7 @@ jwtAuthCheck jwtSettings = do verifiedJWT <- liftIO $ verifyJWT jwtSettings token maybe mzero pure verifiedJWT +{- FOURMOLU_DISABLE -} -- | Creates a JWT containing the specified data. The data is stored in the -- @dat@ claim. The 'Maybe UTCTime' argument indicates the time at which the -- token expires. @@ -45,7 +48,11 @@ makeJWT v cfg expiry = Jose.runJOSE $ do ejwt <- Jose.signClaims (signingKey cfg) +#if MIN_VERSION_jose(0,12,0) + (Jose.newJWSHeaderProtected alg) +#else (Jose.newJWSHeader ((), alg)) +#endif (addExp $ encodeJWT v) pure $ Jose.encodeCompact ejwt @@ -58,7 +65,12 @@ verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a) verifyJWT jwtCfg input = do keys <- validationKeys jwtCfg verifiedJWT <- Jose.runJOSE $ do - unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input) +#if MIN_VERSION_jose(0,12,0) + unverifiedJWT :: Jose.SignedJWTWithHeader Jose.JWSHeader <- +#else + unverifiedJWT :: Jose.SignedJWT <- +#endif + Jose.decodeCompact (BSL.fromStrict input) Jose.verifyClaims (jwtSettingsToJwtValidationSettings jwtCfg) keys diff --git a/servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs b/servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs index 3cdb56109..946ba9b22 100644 --- a/servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs +++ b/servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs @@ -11,6 +11,7 @@ module Servant.Auth.ServerSpec (spec) where import Control.Lens import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO) +{- FOURMOLU_DISABLE -} import Crypto.JOSE ( Alg (HS256, None) , Error @@ -20,7 +21,11 @@ import Crypto.JOSE , ToCompact , encodeCompact , genJWK +#if MIN_VERSION_jose(0,12,0) + , newJWSHeaderProtected +#else , newJWSHeader +#endif , runJOSE ) import Crypto.JWT @@ -28,6 +33,9 @@ import Crypto.JWT , ClaimsSet , NumericDate (NumericDate) , SignedJWT +#if MIN_VERSION_jose(0,12,0) + , RequiredProtection +#endif , claimAud , claimNbf , emptyClaimsSet @@ -144,7 +152,11 @@ authSpec = jwt <- createJWT theKey +#if MIN_VERSION_jose(0,12,0) + (newJWSHeaderProtected HS256) +#else (newJWSHeader ((), HS256)) +#endif (claims $ toJSON user) opts' <- addJwtToCookie cookieCfg jwt let opts = @@ -167,7 +179,11 @@ authSpec = jwt <- createJWT theKey +#if MIN_VERSION_jose(0,12,0) + (newJWSHeaderProtected HS256) +#else (newJWSHeader ((), HS256)) +#endif (claims $ toJSON user) opts' <- addJwtToCookie cookieCfg jwt let opts = @@ -185,7 +201,11 @@ authSpec = jwt <- createJWT theKey +#if MIN_VERSION_jose(0,12,0) + (newJWSHeaderProtected HS256) +#else (newJWSHeader ((), HS256)) +#endif (claims $ toJSON user) opts' <- addJwtToCookie cookieCfg jwt let opts = @@ -211,7 +231,11 @@ cookieAuthSpec = aroundAll (testWithApplication . pure $ app cookieOnlyApi) $ do it "fails if XSRF header and cookie don't match" $ \port -> property $ \(user :: User) -> do +#if MIN_VERSION_jose(0,12,0) + jwt <- createJWT theKey (newJWSHeaderProtected HS256) (claims $ toJSON user) +#else jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) +#endif opts' <- addJwtToCookie cookieCfg jwt let opts = addCookie @@ -221,7 +245,11 @@ cookieAuthSpec = it "fails with no XSRF header or cookie" $ \port -> property $ \(user :: User) -> do +#if MIN_VERSION_jose(0,12,0) + jwt <- createJWT theKey (newJWSHeaderProtected HS256) (claims $ toJSON user) +#else jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) +#endif opts' <- addJwtToCookie cookieCfg jwt let opts = opts' & checkResponse ?~ mempty resp <- getWith opts (url port) @@ -239,7 +267,11 @@ cookieAuthSpec = it "succeeds if XSRF header and cookie match, and JWT is valid" $ \port -> property $ \(user :: User) -> do +#if MIN_VERSION_jose(0,12,0) + jwt <- createJWT theKey (newJWSHeaderProtected HS256) (claims $ toJSON user) +#else jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) +#endif opts' <- addJwtToCookie cookieCfg jwt let opts = addCookie @@ -286,14 +318,22 @@ cookieAuthSpec = aroundAll (testWithApplication . pure $ appWithCookie cookieOnlyApi cookieCfgNoXsrfGet) $ do it "succeeds with no XSRF header or cookie for GET" $ \port -> property $ \(user :: User) -> do +#if MIN_VERSION_jose(0,12,0) + jwt <- createJWT theKey (newJWSHeaderProtected HS256) (claims $ toJSON user) +#else jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) +#endif opts <- addJwtToCookie cookieCfgNoXsrfGet jwt resp <- getWith opts (url port) resp ^? responseBody . _JSON `shouldBe` Just (length $ name user) it "fails with no XSRF header or cookie for POST" $ \port -> property $ \(user :: User) number -> do +#if MIN_VERSION_jose(0,12,0) + jwt <- createJWT theKey (newJWSHeaderProtected HS256) (claims $ toJSON user) +#else jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) +#endif opts <- addJwtToCookie cookieCfgNoXsrfGet jwt postWith opts (url port) (toJSON (number :: Int)) `shouldHTTPErrorWith` status401 @@ -304,14 +344,22 @@ cookieAuthSpec = aroundAll (testWithApplication . pure $ appWithCookie cookieOnlyApi cookieCfgNoXsrf) $ do it "succeeds with no XSRF header or cookie for GET" $ \port -> property $ \(user :: User) -> do +#if MIN_VERSION_jose(0,12,0) + jwt <- createJWT theKey (newJWSHeaderProtected HS256) (claims $ toJSON user) +#else jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) +#endif opts <- addJwtToCookie cookieCfgNoXsrf jwt resp <- getWith opts (url port) resp ^? responseBody . _JSON `shouldBe` Just (length $ name user) it "succeeds with no XSRF header or cookie for POST" $ \port -> property $ \(user :: User) number -> do +#if MIN_VERSION_jose(0,12,0) + jwt <- createJWT theKey (newJWSHeaderProtected HS256) (claims $ toJSON user) +#else jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user) +#endif opts <- addJwtToCookie cookieCfgNoXsrf jwt resp <- postWith opts (url port) $ toJSON (number :: Int) resp ^? responseBody . _JSON `shouldBe` Just number @@ -360,7 +408,11 @@ jwtAuthSpec = jwt <- createJWT theKey +#if MIN_VERSION_jose(0,12,0) + (newJWSHeaderProtected HS256) +#else (newJWSHeader ((), HS256)) +#endif (claims (toJSON user) & claimAud ?~ Audience ["boo"]) opts <- addJwtToHeader (jwt <&> encodeCompact) getWith opts (url port) `shouldHTTPErrorWith` status401 @@ -370,7 +422,11 @@ jwtAuthSpec = jwt <- createJWT theKey +#if MIN_VERSION_jose(0,12,0) + (newJWSHeaderProtected HS256) +#else (newJWSHeader ((), HS256)) +#endif (claims (toJSON user) & claimAud ?~ Audience ["anythingElse"]) opts <- addJwtToHeader (jwt <&> encodeCompact) resp <- getWith opts (url port) @@ -381,7 +437,11 @@ jwtAuthSpec = jwt <- createJWT theKey +#if MIN_VERSION_jose(0,12,0) + (newJWSHeaderProtected HS256) +#else (newJWSHeader ((), HS256)) +#endif (claims (toJSON user) & claimNbf ?~ NumericDate future) opts <- addJwtToHeader (jwt <&> encodeCompact) getWith opts (url port) `shouldHTTPErrorWith` status401 @@ -403,7 +463,11 @@ jwtAuthSpec = jwt <- createJWT theKey +#if MIN_VERSION_jose(0,12,0) + (newJWSHeaderProtected None) +#else (newJWSHeader ((), None)) +#endif (claims $ toJSON user) opts <- addJwtToHeader (jwt <&> encodeCompact) getWith opts (url port) `shouldHTTPErrorWith` status401 @@ -413,7 +477,11 @@ jwtAuthSpec = pendingWith "Need https://github.com/frasertweedale/hs-jose/issues/19" it "fails if data is not valid JSON" $ \port -> do +#if MIN_VERSION_jose(0,12,0) + jwt <- createJWT theKey (newJWSHeaderProtected HS256) (claims "{{") +#else jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims "{{") +#endif opts <- addJwtToHeader (jwt <&> encodeCompact) getWith opts (url port) `shouldHTTPErrorWith` status401 @@ -421,7 +489,11 @@ jwtAuthSpec = jwt <- createJWT theKey +#if MIN_VERSION_jose(0,12,0) + (newJWSHeaderProtected HS256) +#else (newJWSHeader ((), HS256)) +#endif (claims $ toJSON user) resp <- case jwt <&> encodeCompact of Left (e :: Error) -> fail $ show e @@ -655,7 +727,11 @@ addJwtToHeader = \case pure $ defaults & header "Authorization" .~ ["Bearer " <> BSL.toStrict v] +#if MIN_VERSION_jose(0,12,0) +createJWT :: JWK -> JWSHeader Crypto.JWT.RequiredProtection -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT) +#else createJWT :: JWK -> JWSHeader () -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT) +#endif createJWT k a b = runJOSE $ signClaims k a b addJwtToCookie :: ToCompact a => CookieSettings -> Either Error a -> IO Options diff --git a/servant-auth/servant-auth/servant-auth.cabal b/servant-auth/servant-auth/servant-auth.cabal index 4859c7889..526303bbf 100644 --- a/servant-auth/servant-auth/servant-auth.cabal +++ b/servant-auth/servant-auth/servant-auth.cabal @@ -36,7 +36,7 @@ library base >= 4.16.4.0 && < 4.22 , containers >=0.6.5.1 && < 0.9 , aeson >= 2.0 && < 3 - , jose >= 0.10 && < 0.12 + , jose >= 0.10 && < 0.13 , lens >= 4.16.1 && < 5.4 , servant >= 0.20.2 && < 0.21 , text >= 1.2.3.0 && < 2.2