jose 0.8.0.0 → 0.8.1.0

raw patch · 6 files changed

+54/−51 lines, 6 filesdep ~lensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: lens

API changes (from Hackage documentation)

Files

• jose.cabal +9/−3
• src/Crypto/JOSE/Error.hs +2/−3
• src/Crypto/JOSE/JWA/JWK.hs +18/−17
• src/Crypto/JOSE/JWK.hs +6/−5
• src/Crypto/JOSE/JWS.hs +10/−14
• src/Crypto/JWT.hs +9/−9

@@ -1,5 +1,5 @@ name:                jose-version:             0.8.0.0+version:             0.8.1.0 synopsis:   Javascript Object Signing and Encryption and JSON Web Token library description:@@ -31,8 +31,12 @@ build-type:          Simple cabal-version:       >= 1.8 tested-with:-  GHC==7.10.3, GHC==8.0.1, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1+  GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.1 +flag demos+  description: Build demonstration programs+  default: False+ library   exposed-modules:     Crypto.JOSE@@ -63,7 +67,7 @@     , concise >= 0.1     , containers >= 0.5     , cryptonite >= 0.7-    , lens >= 4.3+    , lens >= 4.16     , memory >= 0.7     , monad-time >= 0.1     , mtl >= 2@@ -133,6 +137,8 @@     , quickcheck-instances  executable jose-example+  if !flag(demos)+    buildable: False   hs-source-dirs: example   ghc-options:    -Wall   main-is:  Main.hs

@@ -87,9 +87,8 @@ makePrisms ''CompactDecodeError  instance Show CompactDecodeError where-  show err = "CompactDecodeError: " <> case err of-    CompactInvalidNumberOfParts e -> show e-    CompactInvalidText e        -> show e+  show (CompactInvalidNumberOfParts e) = "Invalid number of parts: " <> show e+  show (CompactInvalidText e) = "Invalid text: " <> show e   

@@ -73,13 +73,14 @@  import Control.Applicative import Control.Monad (guard)-import Control.Monad.Except (MonadError(throwError))+import Control.Monad.Except (MonadError) import Data.Bifunctor import Data.Foldable (toList) import Data.Maybe (fromMaybe, isJust) import Data.Monoid ((<>))  import Control.Lens hiding ((.=), elements)+import Control.Monad.Error.Lens (throwing, throwing_) import Crypto.Error (onCryptoFailure) import Crypto.Hash import Crypto.MAC.HMAC@@ -278,7 +279,7 @@       Types.sizedIntegerToBS w r <> Types.sizedIntegerToBS w s     privateKey = ECDSA.PrivateKey (curve crv) (d ecD')     d (Types.SizedBase64Integer _ n) = n-  Nothing -> throwError (review _KeyMismatch "not an EC private key")+  Nothing -> throwing _KeyMismatch "not an EC private key"  verifyEC   :: (BA.ByteArrayAccess msg, HashAlgorithm h)@@ -312,7 +313,7 @@  ecPrivateKey :: (MonadError e m, AsError e) => ECKeyParameters -> m Integer ecPrivateKey (ECKeyParameters _ _ _ (Just (Types.SizedBase64Integer _ d))) = pure d-ecPrivateKey _ = throwError (review _KeyMismatch "Not an EC private key")+ecPrivateKey _ = throwing _KeyMismatch "Not an EC private key"   -- | Parameters for RSA Keys@@ -375,7 +376,7 @@ signPKCS15 h k m = do   k' <- rsaPrivateKey k   PKCS15.signSafer (Just h) k' m-    >>= either (throwError . review _RSAError) pure+    >>= either (throwing _RSAError) pure  verifyPKCS15   :: PKCS15.HashAlgorithmASN1 h@@ -395,7 +396,7 @@ signPSS h k m = do   k' <- rsaPrivateKey k   PSS.signSafer (PSS.defaultPSSParams h) k' m-    >>= either (throwError . review _RSAError) pure+    >>= either (throwing _RSAError) pure  verifyPSS   :: (HashAlgorithm h)@@ -413,15 +414,15 @@   (Types.Base64Integer n)   (Types.Base64Integer e)   (Just (RSAPrivateKeyParameters (Types.Base64Integer d) opt)))-  | isJust (opt >>= rsaOth) = throwError $ review _OtherPrimesNotSupported ()-  | n < 2 ^ (2040 :: Integer) = throwError $ review _KeySizeTooSmall ()+  | isJust (opt >>= rsaOth) = throwing_ _OtherPrimesNotSupported+  | n < 2 ^ (2040 :: Integer) = throwing_ _KeySizeTooSmall   | otherwise = pure $     RSA.PrivateKey (RSA.PublicKey (Types.intBytes n) n e) d       (opt' rsaP) (opt' rsaQ) (opt' rsaDp) (opt' rsaDq) (opt' rsaQi)     where       opt' f = fromMaybe 0 (unB64I . f <$> opt)       unB64I (Types.Base64Integer x) = x-rsaPrivateKey _ = throwError $ review _KeyMismatch "not an RSA private key"+rsaPrivateKey _ = throwing _KeyMismatch "not an RSA private key"  rsaPublicKey :: RSAKeyParameters -> RSA.PublicKey rsaPublicKey (RSAKeyParameters (Types.Base64Integer n) (Types.Base64Integer e) _)@@ -458,7 +459,7 @@   -> m B.ByteString signOct h (OctKeyParameters (Types.Base64Octets k)) m =   if B.length k < hashDigestSize h-  then throwError (review _KeySizeTooSmall ())+  then throwing_ _KeySizeTooSmall   else pure $ B.pack $ BA.unpack (hmac k m :: HMAC h)  @@ -537,18 +538,18 @@   -> B.ByteString   -> m B.ByteString signEdDSA (Ed25519Key pk (Just sk)) m = pure . BA.convert $ Ed25519.sign sk pk m-signEdDSA (Ed25519Key _ Nothing) _ = throwError (review _KeyMismatch "not a private key")-signEdDSA _ _ = throwError (review _KeyMismatch "not an EdDSA key")+signEdDSA (Ed25519Key _ Nothing) _ = throwing _KeyMismatch "not a private key"+signEdDSA _ _ = throwing _KeyMismatch "not an EdDSA key"  verifyEdDSA   :: (BA.ByteArrayAccess msg, BA.ByteArrayAccess sig, MonadError e m, AsError e)   => OKPKeyParameters -> msg -> sig -> m Bool verifyEdDSA (Ed25519Key pk _) m s =   onCryptoFailure-    (throwError . review _CryptoError)+    (throwing _CryptoError)     (pure . Ed25519.verify pk m)     (Ed25519.signature s)-verifyEdDSA _ _ _ = throwError (review _AlgorithmMismatch "not an EdDSA key")+verifyEdDSA _ _ _ = throwing _AlgorithmMismatch "not an EdDSA key"   -- | Key material sum type.@@ -630,8 +631,8 @@ sign JWA.JWS.HS384 (OctKeyMaterial k) = signOct SHA384 k sign JWA.JWS.HS512 (OctKeyMaterial k) = signOct SHA512 k sign JWA.JWS.EdDSA (OKPKeyMaterial k) = signEdDSA k-sign h k = \_ -> throwError (review _AlgorithmMismatch-  (show h <> "cannot be used with " <> showKeyType k <> " key"))+sign h k = \_ -> throwing _AlgorithmMismatch+  (show h <> " cannot be used with " <> showKeyType k <> " key")  verify   :: (MonadError e m, AsError e)@@ -654,8 +655,8 @@ verify JWA.JWS.HS384 (OctKeyMaterial k) = \m s -> BA.constEq s <$> signOct SHA384 k m verify JWA.JWS.HS512 (OctKeyMaterial k) = \m s -> BA.constEq s <$> signOct SHA512 k m verify JWA.JWS.EdDSA (OKPKeyMaterial k) = verifyEdDSA k-verify h k = \_ _ -> throwError $ review _AlgorithmMismatch-  (show h <> "cannot be used with " <> showKeyType k <> " key")+verify h k = \_ _ -> throwing _AlgorithmMismatch+  (show h <> " cannot be used with " <> showKeyType k <> " key")  instance Arbitrary KeyMaterial where   arbitrary = oneof

@@ -98,7 +98,8 @@  import Control.Lens hiding ((.=)) import Control.Lens.Cons.Extras (recons)-import Control.Monad.Except (MonadError(throwError))+import Control.Monad.Except (MonadError)+import Control.Monad.Error.Lens (throwing, throwing_) import Crypto.Hash import qualified Crypto.PubKey.RSA as RSA import Data.Aeson@@ -273,7 +274,7 @@   :: (AsError e, MonadError e m)   => X509.SignedCertificate -> m JWK fromX509Certificate =-  maybe (throwError (review _KeyMismatch "X.509 key type not supported")) pure+  maybe (throwing _KeyMismatch "X.509 key type not supported") pure   . fromX509CertificateMaybe  fromX509CertificateMaybe :: X509.SignedCertificate -> Maybe JWK@@ -318,14 +319,14 @@     in       if n >= 2 ^ (2040 :: Integer)       then pure JWA.JWS.PS512-      else throwError (review _KeySizeTooSmall ())+      else throwing_ _KeySizeTooSmall   OctKeyMaterial (OctKeyParameters (Types.Base64Octets k))     | B.length k >= 512 `div` 8 -> pure JWA.JWS.HS512     | B.length k >= 384 `div` 8 -> pure JWA.JWS.HS384     | B.length k >= 256 `div` 8 -> pure JWA.JWS.HS256-    | otherwise -> throwError (review _KeySizeTooSmall ())+    | otherwise -> throwing_ _KeySizeTooSmall   OKPKeyMaterial (Ed25519Key _ _) -> pure JWA.JWS.EdDSA-  OKPKeyMaterial _ -> throwError (review _KeyMismatch "Cannot sign with OKP ECDH key")+  OKPKeyMaterial _ -> throwing _KeyMismatch "Cannot sign with OKP ECDH key"   #if MIN_VERSION_aeson(0,10,0)

@@ -94,7 +94,8 @@  import Control.Lens hiding ((.=)) import Control.Lens.Cons.Extras (recons)-import Control.Monad.Except (MonadError(throwError), unless)+import Control.Monad.Error.Lens (throwing, throwing_)+import Control.Monad.Except (MonadError, unless) import Data.Aeson import qualified Data.ByteString as B import qualified Data.HashMap.Strict as M@@ -454,15 +455,13 @@       (h', p', s') <- (,,) <$> t 0 h <*> t 1 p <*> t 2 s       let o = object [ ("payload", p'), ("protected", h'), ("signature", s') ]       case fromJSON o of-        Error e -> throwError (review _JSONDecodeError e)+        Error e -> throwing _JSONDecodeError e         Success a -> pure a-    xs' -> throwError $-            review (_CompactDecodeError . _CompactInvalidNumberOfParts)+    xs' -> throwing (_CompactDecodeError . _CompactInvalidNumberOfParts)             (InvalidNumberOfParts 3 (fromIntegral (length xs')))     where-      textErr n e = review (_CompactDecodeError . _CompactInvalidText)-        (CompactTextError n e)-      t n = either (throwError . textErr n) (pure . String)+      l = _CompactDecodeError . _CompactInvalidText+      t n = either (throwing l . CompactTextError n) (pure . String)         . T.decodeUtf8' . view recons  @@ -614,17 +613,14 @@     policy = conf ^. validationPolicy     shouldValidateSig = (`elem` algs) . view (header . alg . param) -    applyPolicy AnyValidated xs =-      unless (or xs) (throwError (review _JWSNoValidSignatures ()))-    applyPolicy AllValidated [] =-      throwError (review _JWSNoSignatures ())-    applyPolicy AllValidated xs =-      unless (and xs) (throwError (review _JWSInvalidSignature ()))+    applyPolicy AnyValidated xs = unless (or xs) (throwing_ _JWSNoValidSignatures)+    applyPolicy AllValidated [] = throwing_ _JWSNoSignatures+    applyPolicy AllValidated xs = unless (and xs) (throwing_ _JWSInvalidSignature)      validate payload sig = do       keys <- getVerificationKeys (view header sig) payload k       if null keys-        then throwError (review _NoUsableKeys ())+        then throwing_ _NoUsableKeys         else pure $ any ((== Right True) . verifySig p sig) keys   in do     payload <- (dec . view recons) p'

@@ -125,10 +125,11 @@  import Control.Lens (   makeClassy, makeClassyPrisms, makePrisms,-  Lens', _Just, over, preview, review, view,+  Lens', _Just, over, preview, view,   Prism', prism', Cons, iso, AsEmpty) import Control.Lens.Cons.Extras (recons)-import Control.Monad.Except (MonadError(throwError))+import Control.Monad.Error.Lens (throwing, throwing_)+import Control.Monad.Except (MonadError) import Control.Monad.Reader (ReaderT, ask, runReaderT) import Data.Aeson import qualified Data.HashMap.Strict as M@@ -453,7 +454,7 @@   traverse_ (\t -> do     now <- currentTime     unless (now < addUTCTime (abs (view allowedSkew conf)) (view _NumericDate t)) $-      throwError (review _JWTExpired ()))+      throwing_ _JWTExpired )   . preview (claimExp . _Just)  validateIatClaim@@ -466,7 +467,7 @@     now <- currentTime     when (view checkIssuedAt conf) $       when (view _NumericDate t > addUTCTime (abs (view allowedSkew conf)) now) $-        throwError (review _JWTIssuedAtFuture ()))+        throwing_ _JWTIssuedAtFuture )     . preview (claimIat . _Just)  validateNbfClaim@@ -478,7 +479,7 @@   traverse_ (\t -> do     now <- currentTime     unless (now >= addUTCTime (negate (abs (view allowedSkew conf))) (view _NumericDate t)) $-      throwError (review _JWTNotYetValid ()))+      throwing_ _JWTNotYetValid )   . preview (claimNbf . _Just)  validateAudClaim@@ -489,7 +490,7 @@ validateAudClaim conf =   traverse_     (\auds -> unless (or (view audiencePredicate conf <$> auds)) $-        throwError (review _JWTNotInAudience ()))+        throwing_ _JWTNotInAudience )   . preview (claimAud . _Just . _Audience)  validateIssClaim@@ -499,8 +500,7 @@   -> m () validateIssClaim conf =   traverse_ (\iss ->-    unless (view issuerPredicate conf iss) $-      throwError (review _JWTNotInIssuer ()))+    unless (view issuerPredicate conf iss) (throwing_ _JWTNotInIssuer) )   . preview (claimIss . _Just)  -- | A digitally signed or MACed JWT@@ -542,7 +542,7 @@   -- verified before the claims.   verifyJWSWithPayload f conf k jws >>= validateClaimsSet conf   where-    f = either (throwError . review _JWTClaimsSetDecodeError) pure . eitherDecode+    f = either (throwing _JWTClaimsSetDecodeError) pure . eitherDecode   -- | Cryptographically verify a JWS JWT, then validate the