diff --git a/example/Main.hs b/example/Main.hs --- a/example/Main.hs +++ b/example/Main.hs @@ -1,5 +1,4 @@ {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} import Data.Maybe (fromJust) @@ -29,9 +28,7 @@ "jws-verify" -> doJwsVerify (tail args) "jwt-sign" -> doJwtSign (tail args) "jwt-verify" -> doJwtVerify (tail args) -#if MIN_VERSION_aeson(0,10,0) "jwk-thumbprint" -> doThumbprint (tail args) -#endif doGen :: [String] -> IO () doGen [kty] = do @@ -40,14 +37,10 @@ "rsa" -> RSAGenParam 256 "ec" -> ECGenParam P_256 "eddsa" -> OKPGenParam Ed25519 -#if MIN_VERSION_aeson(0,10,0) let h = view thumbprint k :: Digest SHA256 kid' = view (re (base64url . digest) . utf8) h k' = set jwkKid (Just kid') k -#else - let k' = k -#endif L.putStr (encode k') -- | Mint a JWT. Args are: @@ -102,7 +95,6 @@ rightOrDie s = either (die . (\e -> s <> ": " <> show e)) pure -#if MIN_VERSION_aeson(0,10,0) -- | Print a base64url-encoded SHA-256 JWK Thumbprint. Args are: -- -- 1. filename of JWK @@ -112,4 +104,3 @@ Just k <- decode <$> L.readFile jwkFilename let h = view thumbprint k :: Digest SHA256 L.putStr $ review (base64url . digest) h -#endif diff --git a/jose.cabal b/jose.cabal --- a/jose.cabal +++ b/jose.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: jose -version: 0.8.4 +version: 0.8.4.1 synopsis: Javascript Object Signing and Encryption and JSON Web Token library description: @@ -12,7 +12,7 @@ . EdDSA signatures (RFC 8037) are supported (Ed25519 only). . - JWK Thumbprint (RFC 7638) is supported (requires /aeson/ >= 0.10). + JWK Thumbprint (RFC 7638) is supported. . JSON Web Encryption (JWE; RFC 7516) is not yet implemented. . @@ -31,7 +31,7 @@ category: Cryptography build-type: Simple tested-with: - GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.2 + GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.4, GHC==9.0.1 flag demos description: Build demonstration programs @@ -43,7 +43,7 @@ build-depends: base >= 4.8 && < 5 - , aeson >= 0.8.0.1 + , aeson >= 0.11.1.0 , bytestring == 0.10.* , lens >= 4.16 , mtl >= 2 @@ -79,7 +79,7 @@ build-depends: attoparsec - , base64-bytestring >= 1.1 && < 1.3 + , base64-bytestring >= 1.2.1.0 && < 1.3 , concise >= 0.1 , containers >= 0.5 , cryptonite >= 0.7 @@ -90,7 +90,7 @@ , unordered-containers == 0.2.* , time >= 1.5 , network-uri >= 2.6 - , QuickCheck >= 2 + , QuickCheck >= 2.9 , quickcheck-instances , x509 >= 1.4 , vector @@ -141,7 +141,7 @@ , tasty-hspec >= 1.0 , tasty-quickcheck , hspec - , QuickCheck + , QuickCheck >= 2.9 , quickcheck-instances executable jose-example diff --git a/src/Crypto/JOSE/Compact.hs b/src/Crypto/JOSE/Compact.hs --- a/src/Crypto/JOSE/Compact.hs +++ b/src/Crypto/JOSE/Compact.hs @@ -48,4 +48,4 @@ -- | Encode data to a compact representation. -- encodeCompact :: (ToCompact a) => a -> L.ByteString -encodeCompact = (L.intercalate ".") . toCompact +encodeCompact = L.intercalate "." . toCompact diff --git a/src/Crypto/JOSE/Header.hs b/src/Crypto/JOSE/Header.hs --- a/src/Crypto/JOSE/Header.hs +++ b/src/Crypto/JOSE/Header.hs @@ -169,10 +169,12 @@ -- | Lens for the 'Protection' of a 'HeaderParam' protection :: Lens' (HeaderParam p a) p protection f (HeaderParam p v) = fmap (\p' -> HeaderParam p' v) (f p) +{-# ANN protection "HLint: ignore Avoid lambda using `infix`" #-} -- | Lens for a 'HeaderParam' value param :: Lens' (HeaderParam p a) a param f (HeaderParam p v) = fmap (\v' -> HeaderParam p v') (f v) +{-# ANN param "HLint: ignore Avoid lambda" #-} -- | Getter for whether a parameter is protected isProtected :: (ProtectionIndicator p) => Getter (HeaderParam p a) Bool diff --git a/src/Crypto/JOSE/JWA/JWK.hs b/src/Crypto/JOSE/JWA/JWK.hs --- a/src/Crypto/JOSE/JWA/JWK.hs +++ b/src/Crypto/JOSE/JWA/JWK.hs @@ -77,7 +77,7 @@ import Control.Monad.Except (MonadError) import Data.Bifunctor import Data.Foldable (toList) -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (isJust) import Data.Monoid ((<>)) import Control.Lens hiding ((.=), elements) @@ -444,7 +444,7 @@ 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) + opt' f = maybe 0 (unB64I . f) opt unB64I (Types.Base64Integer x) = x rsaPrivateKey _ = throwing _KeyMismatch "not an RSA private key" @@ -710,9 +710,8 @@ X25519Key pk _ -> Just (X25519Key pk Nothing) instance AsPublicKey KeyMaterial where - asPublicKey = to (\x -> case x of + asPublicKey = to $ \case OctKeyMaterial _ -> Nothing RSAKeyMaterial k -> RSAKeyMaterial <$> view asPublicKey k ECKeyMaterial k -> ECKeyMaterial <$> view asPublicKey k OKPKeyMaterial k -> OKPKeyMaterial <$> view asPublicKey k - ) diff --git a/src/Crypto/JOSE/JWE.hs b/src/Crypto/JOSE/JWE.hs --- a/src/Crypto/JOSE/JWE.hs +++ b/src/Crypto/JOSE/JWE.hs @@ -96,8 +96,8 @@ <*> headerOptional "jwk" hp hu <*> headerOptional "kid" hp hu <*> headerOptional "x5u" hp hu - <*> ((fmap . fmap . fmap . fmap) - (\(Types.Base64X509 cert) -> cert) (headerOptional "x5c" hp hu)) + <*> (fmap . fmap . fmap . fmap) + (\(Types.Base64X509 cert) -> cert) (headerOptional "x5c" hp hu) <*> headerOptional "x5t" hp hu <*> headerOptional "x5t#S256" hp hu <*> headerOptional "typ" hp hu @@ -145,7 +145,7 @@ -- parseParamsFor :: HasParams b => Proxy b -> Maybe Object -> Maybe Object -> Parser a data JWE a p = JWE - { _protectedRaw :: (Maybe T.Text) -- ^ Encoded protected header, if available + { _protectedRaw :: Maybe T.Text -- ^ Encoded protected header, if available , _jweIv :: Maybe Types.Base64Octets -- ^ JWE Initialization Vector , _jweAad :: Maybe Types.Base64Octets -- ^ JWE AAD , _jweCiphertext :: Types.Base64Octets -- ^ JWE Ciphertext diff --git a/src/Crypto/JOSE/JWK.hs b/src/Crypto/JOSE/JWK.hs --- a/src/Crypto/JOSE/JWK.hs +++ b/src/Crypto/JOSE/JWK.hs @@ -12,7 +12,6 @@ -- See the License for the specific language governing permissions and -- limitations under the License. -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} @@ -72,13 +71,11 @@ , fromOctets , fromX509Certificate -#if MIN_VERSION_aeson(0,10,0) -- * JWK Thumbprint , thumbprint , digest , Types.base64url , module Crypto.Hash -#endif -- * JWK Set , JWKSet(..) @@ -336,7 +333,6 @@ OKPKeyMaterial _ -> throwing _KeyMismatch "Cannot sign with OKP ECDH key" -#if MIN_VERSION_aeson(0,10,0) -- | Compute the JWK Thumbprint of a JWK -- thumbprint :: HashAlgorithm a => Getter JWK (Digest a) @@ -369,4 +365,3 @@ b64 = Types.Base64Octets . BA.convert okpSeries crv pk = "crv" .= (crv :: T.Text) <> "kty" .= ("OKP" :: T.Text) <> "x" .= b64 pk -#endif diff --git a/src/Crypto/JOSE/JWS.hs b/src/Crypto/JOSE/JWS.hs --- a/src/Crypto/JOSE/JWS.hs +++ b/src/Crypto/JOSE/JWS.hs @@ -236,7 +236,7 @@ -- | Construct a minimal header with the given algorithm and -- protection indicator for the /alg/ header. -- -newJWSHeader :: (p, Alg) -> (JWSHeader p) +newJWSHeader :: (p, Alg) -> JWSHeader p newJWSHeader a = JWSHeader (uncurry HeaderParam a) z z z z z z z z z z where z = Nothing @@ -323,7 +323,7 @@ Nothing -> id Just o -> ("header" .= o :) in - object $ (pro . unp) [("signature" .= sig)] + object $ (pro . unp) ["signature" .= sig] instance HasParams JWSHeader where @@ -333,8 +333,8 @@ <*> headerOptional "jwk" hp hu <*> headerOptional "kid" hp hu <*> headerOptional "x5u" hp hu - <*> ((fmap . fmap . fmap . fmap) - (\(Types.Base64X509 cert) -> cert) (headerOptional "x5c" hp hu)) + <*> (fmap . fmap . fmap . fmap) + (\(Types.Base64X509 cert) -> cert) (headerOptional "x5c" hp hu) <*> headerOptional "x5t" hp hu <*> headerOptional "x5t#S256" hp hu <*> headerOptional "typ" hp hu @@ -344,7 +344,7 @@ (fromMaybe mempty hp <> fromMaybe mempty hu)) params h = catMaybes - [ Just (view (alg . isProtected) h, "alg" .= (view (alg . param) h)) + [ Just (view (alg . isProtected) h, "alg" .= view (alg . param) h) , fmap (\p -> (view isProtected p, "jku" .= view param p)) (view jku h) , fmap (\p -> (view isProtected p, "jwk" .= view param p)) (view jwk h) , fmap (\p -> (view isProtected p, "kid" .= view param p)) (view kid h) @@ -486,7 +486,7 @@ , ProtectionIndicator p ) => s -- ^ Payload - -> t ((a p), JWK) -- ^ Traversable of header, key pairs + -> t (a p, JWK) -- ^ Traversable of header, key pairs -> m (JWS t p a) signJWS s = let s' = view recons s @@ -533,12 +533,12 @@ validationSettingsAlgorithms :: Lens' a (S.Set Alg) validationSettingsAlgorithms = validationSettings . go where go f (ValidationSettings algs pol) = - (\algs' -> ValidationSettings algs' pol) <$> f algs + (`ValidationSettings` pol) <$> f algs validationSettingsValidationPolicy :: Lens' a ValidationPolicy validationSettingsValidationPolicy = validationSettings . go where go f (ValidationSettings algs pol) = - (\pol' -> ValidationSettings algs pol') <$> f pol + ValidationSettings algs <$> f pol instance HasValidationSettings ValidationSettings where validationSettings = id diff --git a/src/Crypto/JOSE/Types.hs b/src/Crypto/JOSE/Types.hs --- a/src/Crypto/JOSE/Types.hs +++ b/src/Crypto/JOSE/Types.hs @@ -96,8 +96,8 @@ go :: Integer -> Integer -> Gen Integer go 0 n = pure n go k n = - (n * 256 +) . fromIntegral <$> (arbitraryBoundedIntegral :: Gen Word8) - >>= go (k - 1) + (arbitraryBoundedIntegral :: Gen Word8) + >>= go (k - 1) . (n * 256 +) . fromIntegral instance Arbitrary Base64Integer where diff --git a/src/Crypto/JOSE/Types/Orphans.hs b/src/Crypto/JOSE/Types/Orphans.hs --- a/src/Crypto/JOSE/Types/Orphans.hs +++ b/src/Crypto/JOSE/Types/Orphans.hs @@ -12,44 +12,18 @@ -- See the License for the specific language governing permissions and -- limitations under the License. -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Crypto.JOSE.Types.Orphans where -import Data.List.NonEmpty (NonEmpty(..)) +import Data.Aeson import qualified Data.Text as T import Network.URI (URI, parseURI) -import Test.QuickCheck -#if ! MIN_VERSION_aeson(0,11,1) -import Data.Foldable (toList) -import qualified Data.Vector as V -#endif -import Data.Aeson - - -#if ! MIN_VERSION_aeson(0,11,1) -instance FromJSON a => FromJSON (NonEmpty a) where - parseJSON = withArray "NonEmpty [a]" $ \v -> case toList v of - [] -> fail "Non-empty list required" - (x:xs) -> mapM parseJSON (x :| xs) - -instance ToJSON a => ToJSON (NonEmpty a) where - toJSON = Array . V.fromList . map toJSON . toList -#endif - - instance FromJSON URI where parseJSON = withText "URI" $ maybe (fail "not a URI") return . parseURI . T.unpack instance ToJSON URI where toJSON = String . T.pack . show - - -#if ! MIN_VERSION_QuickCheck(2,9,0) -instance Arbitrary a => Arbitrary (NonEmpty a) where - arbitrary = (:|) <$> arbitrary <*> arbitrary -#endif diff --git a/src/Crypto/JWT.hs b/src/Crypto/JWT.hs --- a/src/Crypto/JWT.hs +++ b/src/Crypto/JWT.hs @@ -130,7 +130,7 @@ import Control.Lens.Cons.Extras (recons) import Control.Monad.Error.Lens (throwing, throwing_) import Control.Monad.Except (MonadError) -import Control.Monad.Reader (ReaderT, ask, runReaderT) +import Control.Monad.Reader (ReaderT, asks, runReaderT) import Data.Aeson import qualified Data.HashMap.Strict as M import qualified Data.Text as T @@ -436,14 +436,13 @@ -> ClaimsSet -> m ClaimsSet validateClaimsSet conf claims = - traverse_ (($ claims) . ($ conf)) + claims <$ traverse_ (($ claims) . ($ conf)) [ validateExpClaim , validateIatClaim , validateNbfClaim , validateIssClaim , validateAudClaim ] - *> pure claims validateExpClaim :: (MonadTime m, HasAllowedSkew a, AsJWTError e, MonadError e m) @@ -511,7 +510,7 @@ newtype WrappedUTCTime = WrappedUTCTime { getUTCTime :: UTCTime } instance Monad m => MonadTime (ReaderT WrappedUTCTime m) where - currentTime = getUTCTime <$> ask + currentTime = asks getUTCTime -- | Cryptographically verify a JWS JWT, then validate the diff --git a/test/JWK.hs b/test/JWK.hs --- a/test/JWK.hs +++ b/test/JWK.hs @@ -12,7 +12,6 @@ -- See the License for the specific language governing permissions and -- limitations under the License. -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module JWK where @@ -41,9 +40,7 @@ jwkAppendixC1Spec jwsAppendixA1Spec cfrgSpec -#if MIN_VERSION_aeson(0,10,0) thumbprintSpec -#endif jwsAppendixA1Spec :: Spec jwsAppendixA1Spec = describe "RFC 7515 A.1.1. JWK" $ do @@ -307,7 +304,6 @@ <> "\"x\":\"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo\"}" -#if MIN_VERSION_aeson(0,10,0) thumbprintSpec :: Spec thumbprintSpec = describe "JWK Thumbprint" $ do describe "RFC 7638 ยง3.1. Example JWK Thumbprint Computation" $ do @@ -333,4 +329,3 @@ it "correctly computes thumbprint of Ed25519 key" $ review (base64url . digest) (view thumbprint k :: Digest SHA256) `shouldBe` ("kPrK_qmxVWaYVA9wwBF6Iuo3vVzz7TxHCTwXBygrS4k" :: B.ByteString) -#endif diff --git a/test/JWT.hs b/test/JWT.hs --- a/test/JWT.hs +++ b/test/JWT.hs @@ -23,6 +23,8 @@ import Control.Lens import Control.Lens.Extras (is) +import Control.Monad.Except (runExceptT) +import Control.Monad.Trans (liftIO) import Control.Monad.Reader (MonadReader(..), ReaderT, runReaderT) import Control.Monad.State (execState) import Control.Monad.Time (MonadTime(..)) @@ -70,6 +72,14 @@ <> "\"http://example.com/is_root\":true}" in decode claimsJSON `shouldBe` Just exampleClaimsSet + + it "JWT compact round-trip" $ do + jwk <- genJWK $ RSAGenParam 256 + res <- runExceptT $ do + token <- signClaims jwk (newJWSHeader ((), RS512)) emptyClaimsSet + token' <- decodeCompact . encodeCompact $ token + liftIO $ token' `shouldBe` token + either (error . show) return (res :: Either JWTError ()) :: IO () it "formats to a parsable and equal value" $ decode (encode exampleClaimsSet) `shouldBe` Just exampleClaimsSet diff --git a/test/Properties.hs b/test/Properties.hs --- a/test/Properties.hs +++ b/test/Properties.hs @@ -34,14 +34,14 @@ properties = testGroup "Properties" [ testProperty "SizedBase64Integer round-trip" - (prop_roundTrip :: SizedBase64Integer -> Bool) - , testProperty "JWK round-trip" (prop_roundTrip :: JWK -> Bool) + (prop_roundTrip :: SizedBase64Integer -> Property) + , testProperty "JWK round-trip" (prop_roundTrip :: JWK -> Property) , testProperty "RSA gen, sign and verify" prop_rsaSignAndVerify , testProperty "gen, sign with best alg, verify" prop_bestJWSAlg ] -prop_roundTrip :: (Eq a, ToJSON a, FromJSON a) => a -> Bool -prop_roundTrip a = decode (encode [a]) == Just [a] +prop_roundTrip :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Property +prop_roundTrip a = decode (encode [a]) === Just [a] debugRoundTrip :: (Show a, Arbitrary a, ToJSON a, FromJSON a)