From 48cb5fa01a831a493452a0b475121cb788544dbb Mon Sep 17 00:00:00 2001 From: Juan Pablo Royo Sales Date: Sun, 31 Jul 2022 16:25:03 +0200 Subject: [PATCH 1/2] Add JWT token expiration at JWTSettings level with calculated Expiration in NominalDiffTime --- servant-auth/servant-auth-server/README.lhs | 2 +- .../Auth/Server/Internal/ConfigTypes.hs | 8 ++++- .../Servant/Auth/Server/Internal/Cookie.hs | 6 ++-- .../src/Servant/Auth/Server/Internal/JWT.hs | 17 ++++++----- .../test/Servant/Auth/ServerSpec.hs | 30 +++++++++++-------- 5 files changed, 36 insertions(+), 27 deletions(-) diff --git a/servant-auth/servant-auth-server/README.lhs b/servant-auth/servant-auth-server/README.lhs index 27259465..7336c326 100644 --- a/servant-auth/servant-auth-server/README.lhs +++ b/servant-auth/servant-auth-server/README.lhs @@ -134,7 +134,7 @@ mainWithJWT = do xs <- words <$> getLine case xs of [name', email'] -> do - etoken <- makeJWT (User name' email') jwtCfg Nothing + etoken <- makeJWT (User name' email') jwtCfg case etoken of Left e -> putStrLn $ "Error generating token:t" ++ show e Right v -> putStrLn $ "New token:\t" ++ show v diff --git a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs index 61e6f33a..a566f013 100644 --- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs +++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs @@ -37,6 +37,10 @@ data JWTSettings = JWTSettings -- | An @aud@ predicate. The @aud@ is a string or URI that identifies the -- intended recipient of the JWT. , audienceMatches :: Jose.StringOrURI -> IsMatch + + -- | How long from now until the jwt expires. Default: @Nothing@. + , expiresIn :: Maybe NominalDiffTime + } deriving (Generic) -- | A @JWTSettings@ where the audience always matches. @@ -45,7 +49,9 @@ defaultJWTSettings k = JWTSettings { signingKey = k , jwtAlg = Nothing , validationKeys = pure $ Jose.JWKSet [k] - , audienceMatches = const Matches } + , audienceMatches = const Matches + , expiresIn = Nothing + } -- | The policies to use when generating cookies. -- diff --git a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs index a91b42de..dcaee048 100644 --- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs +++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs @@ -4,8 +4,6 @@ module Servant.Auth.Server.Internal.Cookie where import Blaze.ByteString.Builder (toByteString) import Control.Monad.Except import Control.Monad.Reader -import qualified Crypto.JOSE as Jose -import qualified Crypto.JWT as Jose import Data.ByteArray (constEq) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as BS64 @@ -21,7 +19,7 @@ import Servant (AddHeader, addHeader) import System.Entropy (getEntropy) import Web.Cookie -import Servant.Auth.JWT (FromJWT (decodeJWT), ToJWT) +import Servant.Auth.JWT (FromJWT, ToJWT) import Servant.Auth.Server.Internal.ConfigTypes import Servant.Auth.Server.Internal.JWT (makeJWT, verifyJWT) import Servant.Auth.Server.Internal.Types @@ -80,7 +78,7 @@ makeCsrfCookie = makeXsrfCookie -- | Makes a cookie with session information. makeSessionCookie :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe SetCookie) makeSessionCookie cookieSettings jwtSettings v = do - ejwt <- makeJWT v jwtSettings (cookieExpires cookieSettings) + ejwt <- makeJWT v jwtSettings case ejwt of Left _ -> return Nothing Right jwt -> return 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 0c8c3c54..f060015f 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 @@ -13,7 +13,7 @@ import qualified Data.ByteString.Lazy as BSL import qualified Data.HashMap.Strict as HM import Data.Maybe (fromMaybe) import qualified Data.Text as T -import Data.Time (UTCTime) +import Data.Time (UTCTime, getCurrentTime, addUTCTime) import Network.Wai (requestHeaders) import Servant.Auth.JWT (FromJWT(..), ToJWT(..)) @@ -38,22 +38,23 @@ jwtAuthCheck jwtSettings = do Just v -> return v -- | 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. +-- @dat@ claim. The expiration time 'Maybe NominalDiffTime' is taken from 'JWTSettings' +-- and indicates the time at which the token expires. makeJWT :: ToJWT a - => a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString) -makeJWT v cfg expiry = runExceptT $ do + => a -> JWTSettings -> IO (Either Jose.Error BSL.ByteString) +makeJWT v cfg = runExceptT $ do + currentTime <- ExceptT $ pure <$> getCurrentTime bestAlg <- Jose.bestJWSAlg $ signingKey cfg let alg = fromMaybe bestAlg $ jwtAlg cfg ejwt <- Jose.signClaims (signingKey cfg) (Jose.newJWSHeader ((), alg)) - (addExp $ encodeJWT v) + (addExp currentTime $ encodeJWT v) return $ Jose.encodeCompact ejwt where - addExp claims = case expiry of + addExp currTime claims = case expiresIn cfg of Nothing -> claims - Just e -> claims & Jose.claimExp ?~ Jose.NumericDate e + Just e -> claims & Jose.claimExp ?~ Jose.NumericDate (addUTCTime e currTime) verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a) 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 1810e64d..bc18802b 100644 --- a/servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs +++ b/servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE CPP #-} module Servant.Auth.ServerSpec (spec) where @@ -85,7 +86,7 @@ authSpec it "succeeds if one authentication suceeds" $ \port -> property $ \(user :: User) -> do - jwt <- makeJWT user jwtCfg Nothing + jwt <- makeJWT user jwtCfg opts <- addJwtToHeader jwt resp <- getWith opts (url port) resp ^? responseBody . _JSON `shouldBe` Just (length $ name user) @@ -95,7 +96,7 @@ authSpec it "doesn't clobber pre-existing response headers" $ \port -> property $ \(user :: User) -> do - jwt <- makeJWT user jwtCfg Nothing + jwt <- makeJWT user jwtCfg opts <- addJwtToHeader jwt resp <- getWith opts (url port ++ "/header") resp ^. responseHeader "Blah" `shouldBe` "1797" @@ -104,14 +105,14 @@ authSpec context "Raw" $ do it "gets the response body" $ \port -> property $ \(user :: User) -> do - jwt <- makeJWT user jwtCfg Nothing + jwt <- makeJWT user jwtCfg opts <- addJwtToHeader jwt resp <- getWith opts (url port ++ "/raw") resp ^. responseBody `shouldBe` "how are you?" it "doesn't clobber pre-existing reponse headers" $ \port -> property $ \(user :: User) -> do - jwt <- makeJWT user jwtCfg Nothing + jwt <- makeJWT user jwtCfg opts <- addJwtToHeader jwt resp <- getWith opts (url port ++ "/raw") resp ^. responseHeader "hi" `shouldBe` "there" @@ -146,7 +147,7 @@ authSpec let (cookieJar:_) = resp ^.. responseCookieJar Just xxsrf = find (\x -> cookie_name x == xsrfField xsrfCookieName cookieCfg) $ destroyCookieJar cookieJar - xxsrf ^. cookieExpiryTime `shouldBe` future + xxsrf ^. cookieExpiryTime `shouldBe` futureUTC it "sets the token cookie as HttpOnly" $ \port -> property $ \(user :: User) -> do jwt <- createJWT theKey (newJWSHeader ((), HS256)) @@ -318,19 +319,19 @@ jwtAuthSpec it "fails if 'nbf' is set to a future date" $ \port -> property $ \(user :: User) -> do jwt <- createJWT theKey (newJWSHeader ((), HS256)) - (claims (toJSON user) & claimNbf .~ Just (NumericDate future)) + (claims (toJSON user) & claimNbf .~ Just (NumericDate futureUTC)) opts <- addJwtToHeader (jwt >>= (return . encodeCompact)) getWith opts (url port) `shouldHTTPErrorWith` status401 it "fails if 'exp' is set to a past date" $ \port -> property $ \(user :: User) -> do - jwt <- makeJWT user jwtCfg (Just past) + jwt <- makeJWT user $ jwtCfg {expiresIn = Just past} opts <- addJwtToHeader jwt getWith opts (url port) `shouldHTTPErrorWith` status401 it "succeeds if 'exp' is set to a future date" $ \port -> property $ \(user :: User) -> do - jwt <- makeJWT user jwtCfg (Just future) + jwt <- makeJWT user $ jwtCfg {expiresIn = Just future} opts <- addJwtToHeader jwt resp <- getWith opts (url port) resp ^. responseStatus `shouldBe` status200 @@ -441,7 +442,7 @@ theKey = unsafePerformIO . genJWK $ OctGenParam 256 cookieCfg :: CookieSettings cookieCfg = def - { cookieExpires = Just future + { cookieExpires = Just futureUTC , cookieIsSecure = NotSecure , sessionCookieName = "RuncibleSpoon" , cookieXsrfSetting = pure $ def @@ -527,11 +528,14 @@ server ccfg = ------------------------------------------------------------------------------ -- * Utils {{{ -past :: UTCTime -past = parseTimeOrError True defaultTimeLocale "%Y-%m-%d" "1970-01-01" +past :: NominalDiffTime +past = (-1) * future -future :: UTCTime -future = parseTimeOrError True defaultTimeLocale "%Y-%m-%d" "2070-01-01" +future :: NominalDiffTime +future = 1_000_000 + +futureUTC :: UTCTime +futureUTC = parseTimeOrError True defaultTimeLocale "%Y-%m-%d" "2070-01-01" addJwtToHeader :: Either Error BSL.ByteString -> IO Options addJwtToHeader jwt = case jwt of From 492e637bb4f8b0c754b4be3f96e917e26536dcfd Mon Sep 17 00:00:00 2001 From: Juan Pablo Royo Sales Date: Sun, 31 Jul 2022 16:49:19 +0200 Subject: [PATCH 2/2] Adding changelog --- changelog.d/1599 | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 changelog.d/1599 diff --git a/changelog.d/1599 b/changelog.d/1599 new file mode 100644 index 00000000..a04b4611 --- /dev/null +++ b/changelog.d/1599 @@ -0,0 +1,30 @@ +synopsis: Allow setting a NominalDiffTime for JWT Token expiration on JWTSettings +prs: #1599 + +description: { + +## Introduction + +The ability to set expiration to the `JWT Token` in `servant-auth-server` library, rests on the `CookieSettings` data type configuration and in particular in the field `cookieExpires` as we can appreciate it [here](https://github.com/haskell-servant/servant/blob/f0e2316895ee5fda52ba9d5b2b7e10f8a80a9019/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs#L66). + +## Discussion + +The problems regarding using this field for setting `JWT Token` expiration time are the following: +1. `CookieSettings` are usually created at application startup time and it keeps with the same values during the whole application life cycle. Since `cookieExpires` is an absolute and deterministic point in time, futures `JWT Tokens` will contain precisely the same expiration time leading to an undesired behavior and expiring the token upon creation. +2. `CookieSettings` is a particular Data Type for all the cookies and `JWT Token` should not be coupled to the rest of the cookies. +3. With the current setup and using the automatic authentication schema like the one described [here](https://docs.servant.dev/en/stable/cookbook/jwt-and-basic-auth/JWTAndBasicAuth.html), it is not possible to configure the application to create `JWT Tokens` with specific `DiffTime` expirations, like for example configure the authentication context to create a JWT that expires in 2 hours, even using `CookieSettings.cookieExpires`. +4. The only possible way to do this is using the `acceptLogin` function and the creation of the `CookieSettings` value every time the entity authenticates successfully, but this authentication setup is manual and cannot be done with `BasicAuthentication` combinator. + +## Proposal +The proposal is implemented in this PR and includes the following changes: + +1. Add `expiresIn :: Maybe NominalDiffTime` in `JWTSettings` +2. Remove `Maybe UTCTime` parameter from `makeJWT` function. +3. Calculate expiration on `makeJWT` function using `getCurrentTime + expiresIn` if it is present. + +## Solution + +- The implemented solution will allow to create once `JWTSettings` and `CookieSettings` but allow the user to set an optional `NominalDiffTime` to calculate the expiration of the `JWT Token` upon token creation if the value is present. +- This removes the need of calling explicitly `acceptLogin` and allowing `BasicAuthentication` context to handle the creation of the token by itself. + +}