diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +0.7.8 +----- + +* Switch from EitherT to ExceptT to allow compiling with latest version of 'either' package. + 0.7.7 ----- diff --git a/Jose/Jwe.hs b/Jose/Jwe.hs --- a/Jose/Jwe.hs +++ b/Jose/Jwe.hs @@ -42,7 +42,7 @@ where import Control.Monad.Trans (lift) -import Control.Monad.Trans.Either +import Control.Monad.Trans.Except import Crypto.Cipher.Types (AuthTag(..)) import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder, private_pub) import Crypto.Random (MonadRandom) @@ -66,13 +66,13 @@ -> Jwk -- ^ The key to use to encrypt the content key -> Payload -- ^ The token content (claims or nested JWT) -> m (Either JwtError Jwt) -- ^ The encoded JWE if successful -jwkEncode a e jwk payload = runEitherT $ case jwk of +jwkEncode a e jwk payload = runExceptT $ case jwk of RsaPublicJwk kPub kid _ _ -> doEncode (hdr kid) (doRsa kPub) bytes RsaPrivateJwk kPr kid _ _ -> doEncode (hdr kid) (doRsa (private_pub kPr)) bytes - SymmetricJwk kek kid _ _ -> doEncode (hdr kid) (hoistEither . keyWrap a (BA.convert kek)) bytes - _ -> left $ KeyError "JWK cannot encode a JWE" + SymmetricJwk kek kid _ _ -> doEncode (hdr kid) (ExceptT . return . keyWrap a (BA.convert kek)) bytes + _ -> throwE $ KeyError "JWK cannot encode a JWE" where - doRsa kPub = EitherT . rsaEncrypt kPub a + doRsa kPub = ExceptT . rsaEncrypt kPub a hdr kid = defJweHdr {jweAlg = a, jweEnc = e, jweKid = kid, jweCty = contentType} (contentType, bytes) = case payload of Claims c -> (Nothing, c) @@ -86,21 +86,21 @@ => Jwk -> ByteString -> m (Either JwtError JwtContent) -jwkDecode jwk jwt = runEitherT $ case jwk of +jwkDecode jwk jwt = runExceptT $ case jwk of RsaPrivateJwk kPr _ _ _ -> do blinder <- lift $ generateBlinder (public_n $ private_pub kPr) e <- doDecode (rsaDecrypt (Just blinder) kPr) jwt return (Jwe e) SymmetricJwk kb _ _ _ -> fmap Jwe (doDecode (keyUnwrap (BA.convert kb)) jwt) - _ -> left $ KeyError "JWK cannot decode a JWE" + _ -> throwE $ KeyError "JWK cannot decode a JWE" doDecode :: MonadRandom m => (JweAlg -> ByteString -> Either JwtError ScrubbedBytes) -> ByteString - -> EitherT JwtError m Jwe + -> ExceptT JwtError m Jwe doDecode decodeCek jwt = do - encodedJwt <- hoistEither (P.parseJwt jwt) + encodedJwt <- ExceptT (return (P.parseJwt jwt)) case encodedJwt of P.DecodableJwe hdr (P.EncryptedCEK ek) iv (P.Payload payload) tag (P.AAD aad) -> do let alg = jweAlg hdr @@ -110,17 +110,17 @@ cek = if BA.length decryptedCek == BA.length dummyCek then decryptedCek else dummyCek - claims <- maybe (left BadCrypto) return $ decryptPayload enc cek iv aad tag payload + claims <- maybe (throwE BadCrypto) return $ decryptPayload enc cek iv aad tag payload return (hdr, claims) - _ -> left (BadHeader "Content is not a JWE") + _ -> throwE (BadHeader "Content is not a JWE") doEncode :: (MonadRandom m, ByteArray ba) => JweHeader - -> (ScrubbedBytes -> EitherT JwtError m ByteString) + -> (ScrubbedBytes -> ExceptT JwtError m ByteString) -> ba - -> EitherT JwtError m Jwt + -> ExceptT JwtError m Jwt doEncode h encryptKey claims = do (cmk, iv) <- lift (generateCmkAndIV e) let Just (AuthTag sig, ct) = encryptPayload e cmk iv aad claims @@ -139,7 +139,7 @@ -> PublicKey -- ^ RSA key to encrypt with -> ByteString -- ^ The JWT claims (content) -> m (Either JwtError Jwt) -- ^ The encoded JWE -rsaEncode a e kPub claims = runEitherT $ doEncode (defJweHdr {jweAlg = a, jweEnc = e}) (EitherT . rsaEncrypt kPub a) claims +rsaEncode a e kPub claims = runExceptT $ doEncode (defJweHdr {jweAlg = a, jweEnc = e}) (ExceptT . rsaEncrypt kPub a) claims -- | Decrypts a JWE. @@ -147,6 +147,6 @@ => PrivateKey -- ^ Decryption key -> ByteString -- ^ The encoded JWE -> m (Either JwtError Jwe) -- ^ The decoded JWT, unless an error occurs -rsaDecode pk jwt = runEitherT $ do +rsaDecode pk jwt = runExceptT $ do blinder <- lift $ generateBlinder (public_n $ private_pub pk) doDecode (rsaDecrypt (Just blinder) pk) jwt diff --git a/Jose/Jwt.hs b/Jose/Jwt.hs --- a/Jose/Jwt.hs +++ b/Jose/Jwt.hs @@ -29,7 +29,7 @@ import Control.Monad (msum, when, unless) import Control.Monad.Trans (lift) -import Control.Monad.Trans.Either +import Control.Monad.Trans.Except import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Crypto.PubKey.RSA (PrivateKey(..)) import Crypto.Random (MonadRandom) @@ -57,16 +57,16 @@ -> JwtEncoding -- ^ The encoding algorithm(s) used to encode the payload -> Payload -- ^ The payload (claims) -> m (Either JwtError Jwt) -- ^ The encoded JWT, if successful -encode jwks encoding msg = runEitherT $ case encoding of +encode jwks encoding msg = runExceptT $ case encoding of JwsEncoding None -> case msg of Claims p -> return $ Jwt $ BC.intercalate "." [unsecuredHdr, B64.encode p] - Nested _ -> left BadClaims + Nested _ -> throwE BadClaims JwsEncoding a -> case filter (canEncodeJws a) jwks of - [] -> left (KeyError "No matching key found for JWS algorithm") - (k:_) -> hoistEither =<< lift (Jws.jwkEncode a k msg) + [] -> throwE (KeyError "No matching key found for JWS algorithm") + (k:_) -> ExceptT . return =<< lift (Jws.jwkEncode a k msg) JweEncoding a e -> case filter (canEncodeJwe a) jwks of - [] -> left (KeyError "No matching key found for JWE algorithm") - (k:_) -> hoistEither =<< lift (Jwe.jwkEncode a e k msg) + [] -> throwE (KeyError "No matching key found for JWE algorithm") + (k:_) -> ExceptT . return =<< lift (Jwe.jwkEncode a e k msg) where unsecuredHdr = B64.encode (BC.pack "{\"alg\":\"none\"}") @@ -87,27 +87,27 @@ -> Maybe JwtEncoding -- ^ The expected encoding information -> ByteString -- ^ The encoded JWT -> m (Either JwtError JwtContent) -- ^ The decoded JWT payload, if successful -decode keySet encoding jwt = runEitherT $ do - decodableJwt <- hoistEither (P.parseJwt jwt) +decode keySet encoding jwt = runExceptT $ do + decodableJwt <- ExceptT (return (P.parseJwt jwt)) decodings <- case (decodableJwt, encoding) of (P.Unsecured p, Just (JwsEncoding None)) -> return [Just (Unsecured p)] - (P.Unsecured _, _) -> left (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'") + (P.Unsecured _, _) -> throwE (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'") (P.DecodableJws hdr _ _ _, e) -> do unless (isNothing e || e == Just (JwsEncoding (jwsAlg hdr))) $ - left (BadAlgorithm "Expected 'alg' doesn't match JWS header") + throwE (BadAlgorithm "Expected 'alg' doesn't match JWS header") ks <- checkKeys $ filter (canDecodeJws hdr) keySet mapM decodeWithJws ks (P.DecodableJwe hdr _ _ _ _ _, e) -> do unless (isNothing e || e == Just (JweEncoding (jweAlg hdr) (jweEnc hdr))) $ - left (BadAlgorithm "Expected encoding doesn't match JWE header") + throwE (BadAlgorithm "Expected encoding doesn't match JWE header") ks <- checkKeys $ filter (canDecodeJwe hdr) keySet mapM decodeWithJwe ks case msum decodings of - Nothing -> left $ KeyError "None of the keys was able to decode the JWT" + Nothing -> throwE $ KeyError "None of the keys was able to decode the JWT" Just jwtContent -> return jwtContent where - decodeWithJws :: MonadRandom m => Jwk -> EitherT JwtError m (Maybe JwtContent) + decodeWithJws :: MonadRandom m => Jwk -> ExceptT JwtError m (Maybe JwtContent) decodeWithJws k = either (const $ return Nothing) (return . Just . Jws) $ case k of RsaPublicJwk kPub _ _ _ -> Jws.rsaDecode kPub jwt RsaPrivateJwk kPr _ _ _ -> Jws.rsaDecode (private_pub kPr) jwt @@ -115,10 +115,10 @@ EcPrivateJwk kPr _ _ _ _ -> Jws.ecDecode (ECDSA.toPublicKey kPr) jwt SymmetricJwk kb _ _ _ -> Jws.hmacDecode kb jwt - decodeWithJwe :: MonadRandom m => Jwk -> EitherT JwtError m (Maybe JwtContent) + decodeWithJwe :: MonadRandom m => Jwk -> ExceptT JwtError m (Maybe JwtContent) decodeWithJwe k = fmap (either (const Nothing) Just) (lift (Jwe.jwkDecode k jwt)) - checkKeys [] = left $ KeyError "No suitable key was found to decode the JWT" + checkKeys [] = throwE $ KeyError "No suitable key was found to decode the JWT" checkKeys ks = return ks diff --git a/jose-jwt.cabal b/jose-jwt.cabal --- a/jose-jwt.cabal +++ b/jose-jwt.cabal @@ -1,5 +1,5 @@ Name: jose-jwt -Version: 0.7.7 +Version: 0.7.8 Synopsis: JSON Object Signing and Encryption Library Homepage: http://github.com/tekul/jose-jwt Bug-Reports: http://github.com/tekul/jose-jwt/issues @@ -56,6 +56,8 @@ , mtl >= 2.1.3.1 , text >= 0.11 , time >= 1.4 + , transformers >= 0.3 + , transformers-compat >= 0.4 , unordered-containers >= 0.2 , vector >= 0.10 Ghc-Options: -Wall diff --git a/tests/tests.hs b/tests/tests.hs --- a/tests/tests.hs +++ b/tests/tests.hs @@ -1,2 +1,13 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover #-} +module Main where +import Test.Hspec (hspec) + +import Tests.JwsSpec +import Tests.JweSpec +import Tests.JwkSpec + +main :: IO () +main = hspec $ do + Tests.JwsSpec.spec + Tests.JweSpec.spec + Tests.JwkSpec.spec