Add JWT token expiration at JWTSettings level with calculated Expiration in NominalDiffTime
This commit is contained in:
Juan Pablo Royo Sales
parent
f0e2316895
commit
48cb5fa01a
5 changed files with 36 additions and 27 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
--
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue