jose 0.5.0.1 → 0.5.0.2

raw patch · 3 files changed

+111/−5 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• jose.cabal +4/−4
• src/Crypto/JWT.hs +49/−1
• test/JWT.hs +58/−0

@@ -1,14 +1,14 @@ name:                jose-version:             0.5.0.1+version:             0.5.0.2 synopsis:   Javascript Object Signing and Encryption and JSON Web Token library description:   .   An implementation of the Javascript Object Signing and Encryption-  (JOSE) and JSON Web Token (JWT; RFC 5717) formats.+  (JOSE) and JSON Web Token (JWT; RFC 7519) formats.   .-  The JSON Web Signature (JWS; RFC 5715) implementation is complete.-  JSON Web Encryption (JWE; RFC 5716) is not yet implemented.+  The JSON Web Signature (JWS; RFC 7515) implementation is complete.+  JSON Web Encryption (JWE; RFC 7516) is not yet implemented.   .   All JWS algorithms (HMAC, ECDSA, RSASSA-PKCS-v1_5 and RSASSA-PSS)   are implemented, however, the ECDSA implementation is is

@@ -26,7 +26,7 @@ module Crypto.JWT   (     JWT(..)-+  , JWTCrypto(..)   , JWTError(..)   , AsJWTError(..) @@ -35,6 +35,8 @@   , HasJWTValidationSettings(..)   , HasAllowedSkew(..)   , HasAudiencePredicate(..)+  , HasIssuerPredicate(..)+  , HasCheckIssuedAt(..)    , createJWSJWT   , validateJWSJWT@@ -92,7 +94,9 @@   = JWSError Error   | JWTExpired   | JWTNotYetValid+  | JWTNotInIssuer   | JWTNotInAudience+  | JWTIssuedAtFuture   deriving (Eq, Show) makeClassyPrisms ''JWTError @@ -266,9 +270,11 @@ data JWTValidationSettings = JWTValidationSettings   { _jwtValidationSettingsValidationSettings :: ValidationSettings   , _jwtValidationSettingsAllowedSkew :: NominalDiffTime+  , _jwtValidationSettingsCheckIssuedAt :: Bool   -- ^ The allowed skew is interpreted in absolute terms;   --   a nonzero value always expands the validity period.   , _jwtValidationSettingsAudiencePredicate :: StringOrURI -> Bool+  , _jwtValidationSettingsIssuerPredicate :: StringOrURI -> Bool   } makeClassy ''JWTValidationSettings @@ -279,17 +285,27 @@   allowedSkew :: Lens' s NominalDiffTime class HasAudiencePredicate s where   audiencePredicate :: Lens' s (StringOrURI -> Bool)+class HasIssuerPredicate s where+  issuerPredicate :: Lens' s (StringOrURI -> Bool)+class HasCheckIssuedAt s where+  checkIssuedAt :: Lens' s Bool  instance HasJWTValidationSettings a => HasAllowedSkew a where   allowedSkew = jwtValidationSettingsAllowedSkew instance HasJWTValidationSettings a => HasAudiencePredicate a where   audiencePredicate = jwtValidationSettingsAudiencePredicate+instance HasJWTValidationSettings a => HasIssuerPredicate a where+  issuerPredicate = jwtValidationSettingsIssuerPredicate+instance HasJWTValidationSettings a => HasCheckIssuedAt a where+  checkIssuedAt = jwtValidationSettingsCheckIssuedAt  defaultJWTValidationSettings :: JWTValidationSettings defaultJWTValidationSettings = JWTValidationSettings   defaultValidationSettings   0+  False   (const False)+  (const True)  -- | Validate the claims made by a ClaimsSet. Currently only inspects -- the /exp/ and /nbf/ claims. N.B. These checks are also performed by@@ -299,6 +315,8 @@ validateClaimsSet   ::     ( MonadTime m, HasAllowedSkew a, HasAudiencePredicate a+    , HasIssuerPredicate a+    , HasCheckIssuedAt a     , AsJWTError e, MonadError e m     )   => a@@ -307,7 +325,9 @@ validateClaimsSet conf claims =   sequence_     [ validateExpClaim conf claims+    , validateIatClaim conf claims     , validateNbfClaim conf claims+    , validateIssClaim conf claims     , validateAudClaim conf claims     ] @@ -323,6 +343,18 @@     else throwError (review _JWTExpired ()) validateExpClaim _ _ = pure () +validateIatClaim+  :: (MonadTime m, HasCheckIssuedAt a, HasAllowedSkew a, AsJWTError e, MonadError e m)+  => a+  -> ClaimsSet+  -> m ()+validateIatClaim conf (ClaimsSet _ _ _ _ _ (Just t) _ _) = do+  now <- currentTime+  when (view checkIssuedAt conf) $+    when ((view _NumericDate t) > addUTCTime (abs (view allowedSkew conf)) now) $+    throwError (review _JWTIssuedAtFuture ())+validateIatClaim _ _ = pure ()+ validateNbfClaim   :: (MonadTime m, HasAllowedSkew a, AsJWTError e, MonadError e m)   => a@@ -350,6 +382,20 @@       )     (preview (claimAud . _Just . _Audience) claims) +validateIssClaim+  :: (HasIssuerPredicate s, AsJWTError e, MonadError e m)+  => s+  -> ClaimsSet+  -> m ()+validateIssClaim conf claims =+  maybe+    (pure ())+    (\iss ->+      if view issuerPredicate conf iss+      then pure ()+      else throwError (review _JWTNotInIssuer ())+      )+    (preview (claimIss . _Just) claims)  -- | Data representing the JOSE aspects of a JWT. --@@ -386,6 +432,8 @@ validateJWSJWT   ::     ( MonadTime m, HasAllowedSkew a, HasAudiencePredicate a+    , HasIssuerPredicate a+    , HasCheckIssuedAt a     , HasValidationSettings a     , AsError e, AsJWTError e, MonadError e m     )

@@ -107,6 +107,45 @@           in runReaderT (validateClaimsSet conf' exampleClaimsSet) now             `shouldBe` (Right () :: Either JWTError ()) +    describe "with an Issued At claim" $ do+      let claimsSetWithIat = set claimIat (intDate "2011-02-22 18:43:00") emptyClaimsSet+      let conf = set checkIssuedAt True defaultJWTValidationSettings++      describe "when the current time is after to the Issued At" $ do+        let now = utcTime "2011-03-01 00:00:00"+        it "can be validated" $+          runReaderT (validateClaimsSet conf claimsSetWithIat) now+            `shouldBe` (Right () :: Either JWTError ())++      describe "when the current time is exactly the Issued At" $ do+        let now = utcTime "2011-02-22 18:43:00"+        it "can be validated" $+          runReaderT (validateClaimsSet conf claimsSetWithIat) now+            `shouldBe` (Right () :: Either JWTError ())++      describe "when the current time is prior to the Issued At" $ do+        let now = utcTime "2011-02-22 18:42:59"  -- 1s before issued at+        it "cannot be validated if nonzero skew tolerance < delta" $+          let conf' = set allowedSkew 0 conf+          in runReaderT (validateClaimsSet conf' claimsSetWithIat) now+            `shouldBe` Left JWTIssuedAtFuture+        it "can be validated if nonzero skew tolerance < delta but validation is off" $+          let conf' = set checkIssuedAt False conf+          in runReaderT (validateClaimsSet conf' claimsSetWithIat) now+            `shouldBe` (Right () :: Either JWTError ())+        it "can be validated if nonzero skew tolerance = delta" $+          let conf' = set allowedSkew 1 conf+          in runReaderT (validateClaimsSet conf' claimsSetWithIat) now+            `shouldBe` (Right () :: Either JWTError ())+        it "can be validated if nonzero skew tolerance > delta" $+          let conf' = set allowedSkew 2 conf+          in runReaderT (validateClaimsSet conf' claimsSetWithIat) now+            `shouldBe` (Right () :: Either JWTError ())+        it "can be validated if negative skew tolerance = -delta" $+          let conf' = set allowedSkew (-1) conf+          in runReaderT (validateClaimsSet conf' claimsSetWithIat) now+            `shouldBe` (Right () :: Either JWTError ())+     describe "with a Not Before claim" $ do       let         claimsSet = emptyClaimsSet & claimNbf .~ intDate "2016-07-05 17:37:22"@@ -196,6 +235,25 @@         let claims = emptyClaimsSet & set claimAud (Just (Audience ["foo"]))         it "serialises to string" $ encode claims `shouldBe` "{\"aud\":\"foo\"}"         it "round trips" $ decode (encode claims) `shouldBe` Just claims++    describe "with an Issuer claim" $ do+      let now = utcTime "2001-01-01 00:00:00"+      let conf' = set issuerPredicate (== "baz") conf+      describe "when issuer is nonempty, and predicate is matched" $ do+        let claims = emptyClaimsSet & set claimIss (Just "baz")+        it "can be validated" $+          runReaderT (validateClaimsSet conf' claims) now+            `shouldBe` (Right () :: Either JWTError ())+      describe "when issuer is nonempty but predicate is not matched" $ do+        let claims = emptyClaimsSet & set claimIss (Just "bar")+        it "cannot be validated" $+          runReaderT (validateClaimsSet conf' claims) now+            `shouldBe` Left JWTNotInIssuer+      describe "when claim is empty, and default predicate is unconditionally true" $ do+        let claims = emptyClaimsSet & set claimIss (Just "")+        it "can be validated" $+          runReaderT (validateClaimsSet conf claims) now+            `shouldBe` (Right () :: Either JWTError ())    describe "StringOrURI" $     it "parses from JSON correctly" $ do