crypton 2.1.8 → 2.1.9

raw patch · 12 files changed

+540/−57 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• Crypto/PubKey/DSA.hs +41/−8
• Crypto/PubKey/ElGamal.hs +48/−10
• Crypto/PubKey/RSA/PKCS15.hs +120/−3
• Crypto/PubKey/Rabin/Basic.hs +32/−0
• Crypto/PubKey/Rabin/Modified.hs +34/−4
• Crypto/PubKey/Rabin/RW.hs +34/−4
• crypton.cabal +1/−1
• tests/PubKey/DSASpec.hs +17/−9
• tests/PubKey/ElGamalSpec.hs +30/−1
• tests/PubKey/RSASpec.hs +144/−7
• tests/PubKey/RabinSpec.hs +28/−10

@@ -1,5 +1,16 @@ # CHANGELOG for crypton +## 2.1.9++* feat(rsa): PKCS#1 v1.5 operations that take a digest, and ones that take a DigestInfo+  [#305](https://github.com/kazu-yamamoto/crypton/pull/305)+* feat(dsa): sign and verify over a digest+  [#305](https://github.com/kazu-yamamoto/crypton/pull/305)+* feat(elgamal): sign and verify over a digest+  [#305](https://github.com/kazu-yamamoto/crypton/pull/305)+* feat(rabin): Rabin-Williams and Modified Rabin sign and verify over a digest+  [#305](https://github.com/kazu-yamamoto/crypton/pull/305)+ ## 2.1.8  * chore: stop hiding foldl' from Prelude

@@ -41,9 +41,12 @@     -- * Signature primitive     sign,     signWith,+    signDigest,+    signDigestWith,      -- * Verification primitive     verify,+    verifyDigest,      -- * Key pair     KeyPair (..),@@ -59,7 +62,7 @@ import Crypto.Internal.Imports import Crypto.Number.Generate import Crypto.Number.ModArithmetic (expFast, expSafe, inverse, inverseSafe)-import Crypto.PubKey.Internal (dsaTruncHash)+import Crypto.PubKey.Internal (dsaTruncHashDigest) import Crypto.Random.Types  -- | DSA Public Number, usually embedded in DSA Public Key@@ -194,14 +197,31 @@     -> msg     -- ^ message to sign     -> Maybe Signature-signWith k pk hashAlg msg = do+signWith k pk hashAlg msg = signDigestWith k pk (hashWith hashAlg msg)++-- | Sign a digest using the private key and an explicit k number.+--+-- The digest's type says which algorithm made it, so this needs nothing else+-- to name one.  'signWith' takes a @hash@ value and never reads it -- it is+-- there to fix the type -- which leaves a caller that is itself polymorphic+-- in the algorithm with nothing to pass.+signDigestWith+    :: HashAlgorithm hash+    => Integer+    -- ^ k random number+    -> PrivateKey+    -- ^ private key+    -> Digest hash+    -- ^ digest of the message to sign+    -> Maybe Signature+signDigestWith k pk digest = do     -- k comes from the caller and is only invertible when it is coprime with     -- q, which the caller cannot check without knowing q is prime.  It is also     -- a secret worth as much as the private key, so it is inverted without     -- the extended Euclidean algorithm, whose steps follow the bits of what     -- it is given     kInv <- inverseSafe k q-    let hm = dsaTruncHash hashAlg msg q+    let hm = dsaTruncHashDigest digest q         r = expSafe g k p `mod` q         s = (kInv * (hm + x * r)) `mod` q     if r == 0 || s == 0 then Nothing else Just $ Signature r s@@ -214,10 +234,17 @@ sign     :: (ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m)     => PrivateKey -> hash -> msg -> m Signature-sign pk hashAlg msg = do+sign pk hashAlg msg = signDigest pk (hashWith hashAlg msg)++-- | Sign a digest using the private key.  See 'signDigestWith' for why a+-- digest rather than a @hash@ value.+signDigest+    :: (HashAlgorithm hash, MonadRandom m)+    => PrivateKey -> Digest hash -> m Signature+signDigest pk digest = do     k <- generateMax q-    case signWith k pk hashAlg msg of-        Nothing -> sign pk hashAlg msg+    case signDigestWith k pk digest of+        Nothing -> signDigest pk digest         Just sig -> return sig   where     (Params _ _ q) = private_params pk@@ -226,7 +253,13 @@ verify     :: (ByteArrayAccess msg, HashAlgorithm hash)     => hash -> PublicKey -> Signature -> msg -> Bool-verify hashAlg pk (Signature r s) m+verify hashAlg pk sig m = verifyDigest pk sig (hashWith hashAlg m)++-- | Verify a signature over a digest.  See 'signDigestWith' for why a digest+-- rather than a @hash@ value.+verifyDigest+    :: HashAlgorithm hash => PublicKey -> Signature -> Digest hash -> Bool+verifyDigest pk (Signature r s) digest     -- Reject the signature if either 0 < r < q or 0 < s < q is not satisfied.     | r <= 0 || r >= q || s <= 0 || s >= q = False     -- s is invertible for every 0 < s < q when q is prime, but the parameters@@ -235,7 +268,7 @@   where     (Params p g q) = public_params pk     y = public_y pk-    hm = dsaTruncHash hashAlg m q+    hm = dsaTruncHashDigest digest q     v = do         w <- inverse s q         let u1 = (hm * w) `mod` q

@@ -57,10 +57,13 @@      -- * Signature primitives     signWith,+    signDigestWith,     sign,+    signDigest,      -- * Verification primitives     verify,+    verifyDigest, ) where  import Crypto.Error@@ -194,8 +197,28 @@     -> msg     -- ^ message to sign     -> Maybe Signature-signWith = signWithBlinder 1+signWith k params priv hashAlg msg =+    signDigestWith k params priv (hashWith hashAlg msg) +-- | Sign a digest with an explicit ephemeral value.+--+-- The digest's type says which algorithm made it, so this needs nothing else+-- to name one.  'signWith' takes a @hash@ value and never reads it -- it is+-- there to fix the type -- which leaves a caller that is itself polymorphic+-- in the algorithm with nothing to pass.+signDigestWith+    :: HashAlgorithm hash+    => Integer+    -- ^ ephemeral value k, in [1, p-2] and coprime with p-1+    -> Params+    -- ^ DH params (p,g)+    -> PrivateNumber+    -- ^ DH private key+    -> Digest hash+    -- ^ digest of the message to sign+    -> Maybe Signature+signDigestWith = signWithBlinder 1+ -- | The same with a blinder for the inversion of @k@. -- -- @k@ is inverted modulo @p-1@, which is even, so Fermat's little theorem@@ -210,15 +233,15 @@ -- When @b@ shares a factor with @p-1@ the algorithm reports it the same way -- it reports one in @k@, and the answer is the same: draw again. signWithBlinder-    :: (ByteArrayAccess msg, HashAlgorithm hash)-    => Integer -> Integer -> Params -> PrivateNumber -> hash -> msg -> Maybe Signature-signWithBlinder b k (Params p g _) (PrivateNumber x) hashAlg msg+    :: HashAlgorithm hash+    => Integer -> Integer -> Params -> PrivateNumber -> Digest hash -> Maybe Signature+signWithBlinder b k (Params p g _) (PrivateNumber x) digest     | k <= 0 || k >= p - 1 || b <= 0 || d > 1 = Nothing     | s == 0 = Nothing     | otherwise = Just $ Signature r s   where     r = expSafe g k p-    h = os2ip $ hashWith hashAlg msg+    h = os2ip digest     s = ((h - x * r) * kInv) `mod` (p - 1)     kInv = (kbInv * b) `mod` (p - 1)     (kbInv, _, d) = gcde ((k * b) `mod` (p - 1)) (p - 1)@@ -239,13 +262,20 @@     -> msg     -- ^ message to sign     -> m Signature-sign params@(Params p _ _) priv hashAlg msg = do+sign params priv hashAlg msg = signDigest params priv (hashWith hashAlg msg)++-- | Sign a digest, drawing the ephemeral value.  See 'signDigestWith' for+-- why a digest rather than a @hash@ value.+signDigest+    :: (HashAlgorithm hash, MonadRandom m)+    => Params -> PrivateNumber -> Digest hash -> m Signature+signDigest params@(Params p _ _) priv digest = do     k <- generateMax (p - 1)     -- and a blinder for the inversion of k, which is the one step here that     -- the extended Euclidean algorithm has to do     b <- generateMax (p - 1)-    case signWithBlinder b k params priv hashAlg msg of-        Nothing -> sign params priv hashAlg msg+    case signWithBlinder b k params priv digest of+        Nothing -> signDigest params priv digest         Just sig -> return sig  -- | verify a signature@@ -257,10 +287,18 @@     -> msg     -> Signature     -> Bool-verify (Params p g _) (PublicNumber y) hashAlg msg (Signature r s)+verify params pub hashAlg msg sig =+    verifyDigest params pub (hashWith hashAlg msg) sig++-- | Verify a signature over a digest.  See 'signDigestWith' for why a digest+-- rather than a @hash@ value.+verifyDigest+    :: HashAlgorithm hash+    => Params -> PublicNumber -> Digest hash -> Signature -> Bool+verifyDigest (Params p g _) (PublicNumber y) digest (Signature r s)     | or [r <= 0, r >= p, s <= 0, s >= (p - 1)] = False     | otherwise = lhs == rhs   where-    h = os2ip $ hashWith hashAlg msg+    h = os2ip digest     lhs = expFast g h p     rhs = (expFast y r p * expFast r s p) `mod` p

@@ -15,10 +15,16 @@     decryptSafer,     sign,     signSafer,+    signDigest,+    signSaferDigest,+    signDigestInfo,+    signSaferDigestInfo,      -- * Public key operations     encrypt,     verify,+    verifyDigest,+    verifyDigestInfo,      -- * Hash ASN1 description     HashAlgorithmASN1,@@ -554,13 +560,124 @@     -> ByteString     -- ^ Signature     -> Bool-verify hashAlg pk m sm+verify hashAlg pk m sm =+    verifyEncoded pk (makeSignature hashAlg (public_size pk) m) sm++-- | The two checks of RFC 8017 and the comparison, shared by the three+-- verification entry points.  The expected encoding is a thunk and is+-- forced only once the checks have passed, as it was when this was written+-- out inside 'verify'.+verifyEncoded+    :: PublicKey+    -> Either Error ByteString+    -- ^ the encoding a signature of this message would have+    -> ByteString+    -- ^ signature+    -> Bool+verifyEncoded pk expected sm     | B.length sm /= public_size pk = False     | os2ip sm >= public_n pk = False     | otherwise =-        case makeSignature hashAlg (public_size pk) m of+        case expected of             Left _ -> False-            Right s -> s == (ep pk sm)+            Right s -> s == ep pk sm++-- | Sign a digest.+--+-- The digest's type says which algorithm made it, so this needs nothing+-- else to name one: the ASN.1 DigestInfo prefix comes from the+-- 'HashAlgorithmASN1' instance that type selects.  'sign' takes @Maybe+-- hashAlg@ and never reads the value inside the @Just@ -- it is there only+-- to fix the type -- which is no burden when the caller has a value and+-- leaves nothing to pass when the caller is itself polymorphic in the+-- algorithm.+--+-- > signDigest blinder key (hashWith SHA256 message)+--+-- The blinder is optional and 'Nothing' is accepted, but see t'Blinder' for+-- what it covers and when leaving it out is a decision rather than a+-- default.  'signSaferDigest' generates one for you.+signDigest+    :: HashAlgorithmASN1 hashAlg+    => Maybe Blinder+    -- ^ optional blinder+    -> PrivateKey+    -- ^ private key+    -> Digest hashAlg+    -- ^ digest of the message to sign+    -> Either Error ByteString+signDigest blinder pk digest =+    dp blinder pk `fmap` padSignature (private_size pk) (hashDigestASN1 digest)++-- | 'signDigest' with a blinder generated for the occasion, as 'signSafer'+-- is to 'sign'.+signSaferDigest+    :: (HashAlgorithmASN1 hashAlg, MonadRandom m)+    => PrivateKey+    -- ^ private key+    -> Digest hashAlg+    -- ^ digest of the message to sign+    -> m (Either Error ByteString)+signSaferDigest pk digest = do+    blinder <- generateBlinder (private_n pk)+    return (signDigest (Just blinder) pk digest)++-- | Sign something that is already a DigestInfo, the ASN.1 structure+-- naming a hash algorithm and carrying a digest under it.+--+-- This is what @'sign' blinder 'Nothing'@ does.  It needs no+-- 'HashAlgorithmASN1' constraint, because nothing here hashes or encodes:+-- the caller has done both.  @'sign' blinder 'Nothing'@ carries the+-- constraint anyway, and since the type variable then appears nowhere else+-- the caller has to name an algorithm that is never used --+-- @'sign' blinder ('Nothing' :: 'Maybe' 'Crypto.Hash.SHA256')@ -- to say+-- which one it is not using.+signDigestInfo+    :: Maybe Blinder+    -- ^ optional blinder+    -> PrivateKey+    -- ^ private key+    -> ByteString+    -- ^ a DigestInfo, encoded+    -> Either Error ByteString+signDigestInfo blinder pk di =+    dp blinder pk `fmap` padSignature (private_size pk) di++-- | 'signDigestInfo' with a blinder generated for the occasion.+signSaferDigestInfo+    :: MonadRandom m+    => PrivateKey+    -- ^ private key+    -> ByteString+    -- ^ a DigestInfo, encoded+    -> m (Either Error ByteString)+signSaferDigestInfo pk di = do+    blinder <- generateBlinder (private_n pk)+    return (signDigestInfo (Just blinder) pk di)++-- | Verify a signature over a digest.  The checks are 'verify's.+verifyDigest+    :: HashAlgorithmASN1 hashAlg+    => PublicKey+    -> Digest hashAlg+    -- ^ digest of the message+    -> ByteString+    -- ^ signature+    -> Bool+verifyDigest pk digest sm =+    verifyEncoded pk (padSignature (public_size pk) (hashDigestASN1 digest)) sm++-- | Verify a signature over something that is already a DigestInfo, which+-- is what @'verify' 'Nothing'@ does.+verifyDigestInfo+    :: PublicKey+    -> ByteString+    -- ^ a DigestInfo, encoded+    -> ByteString+    -- ^ signature+    -> Bool+verifyDigestInfo pk di sm =+    verifyEncoded pk (padSignature (public_size pk) di) sm  -- | make signature digest, used in 'sign' and 'verify' makeSignature

@@ -25,6 +25,38 @@ -- -- Around all of that is 'Integer' arithmetic, whose cost follows the size of -- the numbers; see "Crypto.PubKey.DSA" for that note at more length.+--+-- == The hash algorithm is passed as a value, and that is not going to change+--+-- 'sign', 'signWith' and 'verify' take a @hash@ argument whose value they+-- never read.  Every 'Crypto.Hash.HashAlgorithm' instance is a nullary+-- constructor, and the algorithm comes from the type; the value is there to+-- carry the type and nothing else.  A caller holding a value loses nothing+-- by it, and a caller that is itself polymorphic in the algorithm has no+-- value to pass.+--+-- Elsewhere in crypton that is answered by taking a+-- 'Crypto.Hash.Digest' instead: the digest carries the algorithm in its+-- type and the bytes in its value, so nothing is passed only to name a+-- type.  "Crypto.PubKey.RSA.PKCS15", "Crypto.PubKey.DSA",+-- "Crypto.PubKey.ElGamal", "Crypto.PubKey.Rabin.RW" and+-- "Crypto.PubKey.Rabin.Modified" all do that.+--+-- This module cannot.  What is hashed here is not the message:+--+-- > h = os2ip $ hashWith hashAlg $ B.append padding m+--+-- and the padding is not the caller's either.  'sign' searches for one,+-- drawing eight bytes at a time until the first octet is non-zero and the+-- Jacobi symbols of the hash modulo each private prime are both 1.  Which+-- bytes get hashed is therefore decided inside the signing operation, after+-- the caller has handed over the message, so there is no digest for a+-- caller to compute in advance.+--+-- A proxy argument would work where a digest cannot.  It is deliberately+-- not added: it would be the one exception to a rule the rest of the+-- library now follows, and this module has no callers asking for it.  See+-- the survey in <https://github.com/kazu-yamamoto/crypton/issues/304>. module Crypto.PubKey.Rabin.Basic (     PublicKey (..),     PrivateKey (..),

@@ -17,7 +17,9 @@     PrivateKey (..),     generate,     sign,+    signDigest,     verify,+    verifyDigest, ) where  import Crypto.Debug (DebugShow (..))@@ -109,10 +111,25 @@     -> ByteString     -- ^ message to sign     -> Either Error Integer-sign pk hashAlg m =+sign pk hashAlg m = signDigest pk (hashWith hashAlg m)++-- | Sign a digest using the private key.+--+-- The digest's type says which algorithm made it, so this needs nothing else+-- to name one.  'sign' takes a @hash@ value and never reads it -- it is there+-- to fix the type -- which leaves a caller that is itself polymorphic in the+-- algorithm with nothing to pass.+signDigest+    :: HashAlgorithm hash+    => PrivateKey+    -- ^ private key+    -> Digest hash+    -- ^ digest of the message to sign+    -> Either Error Integer+signDigest pk digest =     let d = private_d pk         n = public_n $ private_pub pk-        h = os2ip $ hashWith hashAlg m+        h = os2ip digest         limit = (n - 6) `div` 16      in if h > limit             then Left MessageTooLong@@ -135,14 +152,27 @@     -> Integer     -- ^ signature     -> Bool-verify pk hashAlg m s+verify pk hashAlg m s = verifyDigest pk (hashWith hashAlg m) s++-- | Verify a signature over a digest.  See 'signDigest' for why a digest+-- rather than a @hash@ value.+verifyDigest+    :: HashAlgorithm hash+    => PublicKey+    -- ^ public key+    -> Digest hash+    -- ^ digest of the message+    -> Integer+    -- ^ signature+    -> Bool+verifyDigest pk digest s     -- squaring works modulo n, so s + n and -s would verify wherever s does     | s < 0 || s >= n = False     | otherwise = go   where     n = public_n pk     go =-        let h = os2ip $ hashWith hashAlg m+        let h = os2ip digest             s' = expSafe s 2 n             s'' = case s' `mod` 8 of                 6 -> s'

@@ -21,7 +21,9 @@     encryptWithSeed,     decrypt,     sign,+    signDigest,     verify,+    verifyDigest, ) where  import Crypto.Debug (DebugShow (..))@@ -181,11 +183,26 @@     -> ByteString     -- ^ message to sign     -> Either Error Integer-sign pk hashAlg m =+sign pk hashAlg m = signDigest pk (hashWith hashAlg m)++-- | Sign a digest using the private key.+--+-- The digest's type says which algorithm made it, so this needs nothing else+-- to name one.  'sign' takes a @hash@ value and never reads it -- it is there+-- to fix the type -- which leaves a caller that is itself polymorphic in the+-- algorithm with nothing to pass.+signDigest+    :: HashAlgorithm hash+    => PrivateKey+    -- ^ private key+    -> Digest hash+    -- ^ digest of the message to sign+    -> Either Error Integer+signDigest pk digest =     let d = private_d pk         n = public_n $ private_pub pk      in do-            m' <- ep1 n $ os2ip $ hashWith hashAlg m+            m' <- ep1 n $ os2ip digest             return $ dp1 d n m'  -- | Verify signature using hash algorithm and public key.@@ -200,11 +217,24 @@     -> Integer     -- ^ signature     -> Bool-verify pk hashAlg m s+verify pk hashAlg m s = verifyDigest pk (hashWith hashAlg m) s++-- | Verify a signature over a digest.  See 'signDigest' for why a digest+-- rather than a @hash@ value.+verifyDigest+    :: HashAlgorithm hash+    => PublicKey+    -- ^ public key+    -> Digest hash+    -- ^ digest of the message+    -> Integer+    -- ^ signature+    -> Bool+verifyDigest pk digest s     -- squaring works modulo n, so s + n and -s would verify wherever s does     | s < 0 || s >= n = False     | otherwise =-        let h = os2ip $ hashWith hashAlg m+        let h = os2ip digest             h' = dp2 n $ ep2 n s          in h' == h   where

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               crypton-version:            2.1.8+version:            2.1.9 -- crypton's own code is BSD-3-Clause.  The parts of -- cbits/aes/gcm_fused_x86.c that follow picotls's fusion are MIT, and the -- vendored s2n-bignum assembly in cbits/s2n is taken under ISC; each has

@@ -386,19 +386,27 @@         , DSA.public_params = pgq vector         } -doSignatureTest hashAlg i vector = it (show i) (actual `shouldBe` expected)+-- Both routes, and each against the vector rather than against the other:+-- they share everything below the hash, so a test that only made them agree+-- would pass with that shared part broken.+doSignatureTest hashAlg i vector = describe (show i) $ do+    it "signWith" $+        DSA.signWith (k vector) key hashAlg (msg vector) `shouldBe` expected+    it "signDigestWith" $+        DSA.signDigestWith (k vector) key (hashWith hashAlg (msg vector))+            `shouldBe` expected   where+    key = vectorToPrivate vector     expected = Just $ DSA.Signature (r vector) (s vector)-    actual = DSA.signWith (k vector) (vectorToPrivate vector) hashAlg (msg vector) -doVerifyTest hashAlg i vector = it (show i) (actual `shouldBe` True)+doVerifyTest hashAlg i vector = describe (show i) $ do+    it "verify" $+        DSA.verify hashAlg pub sig (msg vector) `shouldBe` True+    it "verifyDigest" $+        DSA.verifyDigest pub sig (hashWith hashAlg (msg vector)) `shouldBe` True   where-    actual =-        DSA.verify-            hashAlg-            (vectorToPublic vector)-            (DSA.Signature (r vector) (s vector))-            (msg vector)+    pub = vectorToPublic vector+    sig = DSA.Signature (r vector) (s vector)  -- | Both sign and verify invert a value modulo q with 'fromJust'.  The -- inverse does not exist when the value shares a factor with q, and neither

@@ -3,7 +3,7 @@ module PubKey.ElGamalSpec (spec) where  import Crypto.Error-import Crypto.Hash (SHA256 (..))+import Crypto.Hash (SHA256 (..), hashWith) import qualified Crypto.PubKey.DH as DH import qualified Crypto.PubKey.ElGamal as ElGamal import Crypto.Random (drgNewTest, withDRG)@@ -103,6 +103,35 @@                     `shouldBe` False     it "rejects a signature with r out of range" $         ElGamal.verify params pub SHA256 msg (ElGamal.Signature 0 1) `shouldBe` False+    -- The digest route and the hash-value route, crossed: a signature made+    -- by one has to verify under the other.  Each route alone would pass+    -- with its own arguments in the wrong order; crossing them would not.+    it "verifies under the digest route what the hash route signed" $+        case ElGamal.signWith k params priv SHA256 msg of+            Nothing -> expectationFailure "expected a signature"+            Just sig ->+                ElGamal.verifyDigest params pub (hashWith SHA256 msg) sig+                    `shouldBe` True+    it "verifies under the hash route what the digest route signed" $+        case ElGamal.signDigestWith k params priv (hashWith SHA256 msg) of+            Nothing -> expectationFailure "expected a signature"+            Just sig -> ElGamal.verify params pub SHA256 msg sig `shouldBe` True+    it "rejects a digest of another message" $+        case ElGamal.signDigestWith k params priv (hashWith SHA256 msg) of+            Nothing -> expectationFailure "expected a signature"+            Just sig ->+                ElGamal.verifyDigest+                    params+                    pub+                    (hashWith SHA256 ("other" :: ByteString))+                    sig+                    `shouldBe` False+    it "verifies what signDigest signs when it draws k itself" $+        let (sig, _) =+                withDRG+                    (drgNewTest (1, 2, 3, 4, 5))+                    (ElGamal.signDigest params priv (hashWith SHA256 msg))+         in ElGamal.verifyDigest params pub (hashWith SHA256 msg) sig `shouldBe` True     -- 'sign' draws a blinder for the inversion of k, so it takes a path     -- 'signWith' does not: the inverse comes back from a different number     -- than the one wanted, times the blinder

@@ -1,3 +1,4 @@+{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE OverloadedStrings #-}  module PubKey.RSASpec (spec) where@@ -130,20 +131,26 @@ -- and @s + n@ verify just as well as @s@ itself. doMalleabilityTest :: Show a => a -> VectorRSA -> Spec doMalleabilityTest i vector =-    describe (show i) $ do+    describe (show i) $ mapM_ checks [("verify", verify'), ("verifyDigest", verifyDigest')]+  where+    -- Both routes, and absolutely rather than against each other: they+    -- share the checks of RFC 8017, so a test that only made them agree+    -- would pass with those checks gone.+    checks (name, v) = describe name $ do         it "the signature itself verifies" $-            verify' s `shouldBe` True+            v s `shouldBe` True         it "a leading zero octet is rejected" $-            verify' (B.cons 0 s) `shouldBe` False+            v (B.cons 0 s) `shouldBe` False         it "a trailing zero octet is rejected" $-            verify' (B.snoc s 0) `shouldBe` False+            v (B.snoc s 0) `shouldBe` False         it "s + n is rejected" $-            verify' (i2osp (os2ip s + n vector)) `shouldBe` False+            v (i2osp (os2ip s + n vector)) `shouldBe` False         it "an empty signature is rejected" $-            verify' B.empty `shouldBe` False-  where+            v B.empty `shouldBe` False     s = fromRight (error "doMalleabilityTest") $ sig vector     verify' = RSA.verify (Just SHA1) (vectorToPublic vector) (msg vector)+    verifyDigest' =+        RSA.verifyDigest (vectorToPublic vector) (hashWith SHA1 (msg vector))  -- | The checks RFC 8017 section 7.2.2 puts on an EME-PKCS1-v1_5 block: the -- leading @00 02@, a padding string of at least eight nonzero octets, and the@@ -287,6 +294,135 @@         ]     exponents = [3, 5, 17, 257, 65537, 9, 15, 2] ++-- | Every algorithm with a 'RSA.HashAlgorithmASN1' instance, so that a+-- property quantifies over the lot of them rather than over the two or+-- three somebody thought of.  Adding an instance and forgetting to add it+-- here leaves a hole, which is why the count is asserted below.+data SomeHashASN1+    = forall hashAlg.+        (RSA.HashAlgorithmASN1 hashAlg, Show hashAlg) =>+      SomeHashASN1 hashAlg++instance Show SomeHashASN1 where+    show (SomeHashASN1 h) = show h++instance Arbitrary SomeHashASN1 where+    arbitrary = elements allHashASN1++allHashASN1 :: [SomeHashASN1]+allHashASN1 =+    [ SomeHashASN1 MD2+    , SomeHashASN1 MD5+    , SomeHashASN1 SHA1+    , SomeHashASN1 SHA224+    , SomeHashASN1 SHA256+    , SomeHashASN1 SHA384+    , SomeHashASN1 SHA512+    , SomeHashASN1 SHA512t_224+    , SomeHashASN1 SHA512t_256+    , SomeHashASN1 SHA3_224+    , SomeHashASN1 SHA3_256+    , SomeHashASN1 SHA3_384+    , SomeHashASN1 SHA3_512+    , SomeHashASN1 RIPEMD160+    ]++-- | Bytes of the length a DigestInfo has.  The ones this stands in for run+-- from 34 bytes for MD5 to 83 for SHA-512, and 'RSA.padSignature' refuses+-- anything that does not leave room for the padding, so the wide generator+-- used elsewhere here would be discarded almost every time.+newtype ArbitraryDigestInfo = ArbitraryDigestInfo ByteString+    deriving (Show, Eq)++instance Arbitrary ArbitraryDigestInfo where+    arbitrary = ArbitraryDigestInfo `fmap` arbitraryBSof 0 200++-- | The digest a message has under an algorithm picked at runtime, which is+-- what the existential leaves us able to say.+hashOf :: RSA.HashAlgorithmASN1 hashAlg => hashAlg -> ByteString -> Digest hashAlg+hashOf = hashWith++-- | The operations that take a 'Digest' or a DigestInfo, against the ones+-- that take @Maybe hashAlg@.  Two routes to one signature drift apart+-- unless something holds them together, so for every instance and every+-- message these must answer alike -- on a genuine signature, on a tampered+-- one, and on one of the wrong length.+digestOperationTests :: Spec+digestOperationTests = describe "operations taking a digest" $ do+    it "covers every HashAlgorithmASN1 instance" $+        length allHashASN1 `shouldBe` 14++    prop "signs what sign signs" $ \(SomeHashASN1 h) (ArbitraryBS0_2901 m) ->+        RSA.signDigest Nothing key (hashOf h m)+            === RSA.sign Nothing (Just h) key m++    prop "verifies what verify verifies" $+        \(SomeHashASN1 h) (ArbitraryBS0_2901 m) ->+            case RSA.sign Nothing (Just h) key m of+                Left err -> counterexample (show err) False+                Right s ->+                    let tampered = B.snoc (B.init s) (B.last s + 1)+                        longer = B.snoc s 0+                        dg = hashOf h m+                     in conjoin+                            [ RSA.verifyDigest pub dg s === RSA.verify (Just h) pub m s+                            , RSA.verifyDigest pub dg tampered+                                === RSA.verify (Just h) pub m tampered+                            , RSA.verifyDigest pub dg longer+                                === RSA.verify (Just h) pub m longer+                            ]++    prop "accepts its own signature and rejects a changed one" $+        \(SomeHashASN1 h) (ArbitraryBS0_2901 m) ->+            let dg = hashOf h m+             in case RSA.signDigest Nothing key dg of+                    Left err -> counterexample (show err) False+                    Right s ->+                        let tampered = B.snoc (B.init s) (B.last s + 1)+                         in property (RSA.verifyDigest pub dg s)+                                .&&. property (not (RSA.verifyDigest pub dg tampered))++    prop "blinding leaves the signature where it was" $+        \(SomeHashASN1 h) (ArbitraryBS0_2901 m) testDRG ->+            let dg = hashOf h m+                blinder = withTestDRG testDRG $ RSA.generateBlinder (RSA.public_n pub)+             in RSA.signDigest (Just blinder) key dg === RSA.signDigest Nothing key dg++    prop "signSaferDigest signs what signDigest signs" $+        \(SomeHashASN1 h) (ArbitraryBS0_2901 m) testDRG ->+            let dg = hashOf h m+             in withTestDRG testDRG (RSA.signSaferDigest key dg)+                    === RSA.signDigest Nothing key dg++    -- The DigestInfo pair take no HashAlgorithmASN1 constraint, since+    -- nothing of theirs hashes or encodes.  sign and verify carry it even+    -- for this path, and with the variable appearing nowhere else the+    -- caller has to name an algorithm it is not using -- which is the+    -- annotation below, and the wart these replace.+    prop "signs what sign Nothing signs" $ \(ArbitraryDigestInfo di) ->+        RSA.signDigestInfo Nothing key di+            === RSA.sign Nothing (Nothing :: Maybe SHA256) key di++    prop "verifies what verify Nothing verifies" $ \(ArbitraryDigestInfo di) ->+        case RSA.signDigestInfo Nothing key di of+            Left err -> counterexample (show err) False+            Right s ->+                conjoin+                    [ RSA.verifyDigestInfo pub di s+                        === RSA.verify (Nothing :: Maybe SHA256) pub di s+                    , property (RSA.verifyDigestInfo pub di s)+                    ]++    prop "signSaferDigestInfo signs what signDigestInfo signs" $+        \(ArbitraryDigestInfo di) testDRG ->+            withTestDRG testDRG (RSA.signSaferDigestInfo key di)+                === RSA.signDigestInfo Nothing key di+  where+    vector = firstVector vectorsSHA1+    key = vectorToPrivate vector+    pub = vectorToPublic vector+ spec :: Spec spec = do     keyGenerationTests@@ -302,5 +438,6 @@             sequence_ $                 zipWith doMalleabilityTest [katZero ..] $                     filter vectorHasSignature vectorsSHA1+    digestOperationTests     unpadTests     ciphertextRangeTests

@@ -161,13 +161,22 @@             (message vector)             (BRabin.Signature ((os2ip $ padding vector), (signature vector))) -doModifiedRabinSignTest key i vector = it (show i) (actual `shouldBe` Right (signature vector))+-- Both routes, and each against the vector rather than against the other:+-- they share everything below the hash, so a test that only made them agree+-- would pass with the shared part broken.+doModifiedRabinSignTest key i vector = describe (show i) $ do+    it "sign" $ MRabin.sign key SHA1 (message vector) `shouldBe` expected+    it "signDigest" $+        MRabin.signDigest key (hashWith SHA1 (message vector)) `shouldBe` expected   where-    actual = MRabin.sign key SHA1 (message vector)+    expected = Right (signature vector) -doModifiedRabinVerifyTest key i vector = it (show i) (actual `shouldBe` True)-  where-    actual = MRabin.verify key SHA1 (message vector) (signature vector)+doModifiedRabinVerifyTest key i vector = describe (show i) $ do+    it "verify" $+        MRabin.verify key SHA1 (message vector) (signature vector) `shouldBe` True+    it "verifyDigest" $+        MRabin.verifyDigest key (hashWith SHA1 (message vector)) (signature vector)+            `shouldBe` True  doRwEncryptTest key i vector = it (show i) (actual `shouldBe` Right (cipherText vector))   where@@ -182,13 +191,22 @@   where     actual = RW.decrypt (OAEP.defaultOAEPParams SHA1) key (cipherText vector) -doRwSignTest key i vector = it (show i) (actual `shouldBe` Right (signature vector))+-- Both routes, and each against the vector rather than against the other:+-- they share everything below the hash, so a test that only made them agree+-- would pass with the shared part broken.+doRwSignTest key i vector = describe (show i) $ do+    it "sign" $ RW.sign key SHA1 (message vector) `shouldBe` expected+    it "signDigest" $+        RW.signDigest key (hashWith SHA1 (message vector)) `shouldBe` expected   where-    actual = RW.sign key SHA1 (message vector)+    expected = Right (signature vector) -doRwVerifyTest key i vector = it (show i) (actual `shouldBe` True)-  where-    actual = RW.verify key SHA1 (message vector) (signature vector)+doRwVerifyTest key i vector = describe (show i) $ do+    it "verify" $+        RW.verify key SHA1 (message vector) (signature vector) `shouldBe` True+    it "verifyDigest" $+        RW.verifyDigest key (hashWith SHA1 (message vector)) (signature vector)+            `shouldBe` True  -- | Squaring and the square roots that undo it both work modulo n, so a value -- at or above the modulus behaves exactly like the value it reduces to, and so