use 'throwing' instead of 'throwError . review'

src/Crypto/JOSE/JWA/JWK.hs

@@ -73,13 +73,14 @@ module Crypto.JOSE.JWA.JWK (
 
 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 @@ signEC h k m = case view ecD k of
       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 @@ ecCoordBytes P_521 = 66
 
 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
 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
 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 @@ rsaPrivateKey (RSAKeyParameters
   (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 @@ signOct
   -> 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 @@ signEdDSA
   -> 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.HS256 (OctKeyMaterial k) = signOct SHA256 k
 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,7 +655,7 @@ verify JWA.JWS.HS256 (OctKeyMaterial k) = \m s -> BA.constEq s <$> signOct SHA25
 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
+verify h k = \_ _ -> throwing _AlgorithmMismatch
   (show h <> "cannot be used with " <> showKeyType k <> " key")
 
 instance Arbitrary KeyMaterial where

src/Crypto/JOSE/JWK.hs

@@ -98,7 +98,8 @@ import Data.Word (Word8)
 
 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 @@ fromX509Certificate
   :: (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 @@ bestJWSAlg jwk = case view jwkMaterial jwk of
     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)

src/Crypto/JOSE/JWS.hs

@@ -94,7 +94,8 @@ import Data.Word (Word8)
 
 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 @@ instance HasParams a => FromCompact (JWS Identity () a) where
       (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 @@ verifyJWSWithPayload dec conf k (JWS p@(Types.Base64Octets p') sigs) =
     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'

src/Crypto/JWT.hs

@@ -125,10 +125,11 @@ import qualified Data.String
 
 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 @@ validateExpClaim conf =
   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 @@ validateIatClaim conf =
     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 @@ validateNbfClaim conf =
   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
 validateAudClaim conf =
   traverse_
     (\auds -> unless (or (view audiencePredicate conf <$> auds)) $
-        throwError (review _JWTNotInAudience ()))
+        throwing_ _JWTNotInAudience )
   . preview (claimAud . _Just . _Audience)
 
 validateIssClaim
@@ -499,8 +500,7 @@ validateIssClaim
   -> 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 @@ verifyClaims conf k jws =
   -- 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