diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/Crypto/PubKey/DSA.hs b/Crypto/PubKey/DSA.hs --- a/Crypto/PubKey/DSA.hs +++ b/Crypto/PubKey/DSA.hs @@ -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 diff --git a/Crypto/PubKey/ElGamal.hs b/Crypto/PubKey/ElGamal.hs --- a/Crypto/PubKey/ElGamal.hs +++ b/Crypto/PubKey/ElGamal.hs @@ -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 diff --git a/Crypto/PubKey/RSA/PKCS15.hs b/Crypto/PubKey/RSA/PKCS15.hs --- a/Crypto/PubKey/RSA/PKCS15.hs +++ b/Crypto/PubKey/RSA/PKCS15.hs @@ -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 diff --git a/Crypto/PubKey/Rabin/Basic.hs b/Crypto/PubKey/Rabin/Basic.hs --- a/Crypto/PubKey/Rabin/Basic.hs +++ b/Crypto/PubKey/Rabin/Basic.hs @@ -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 . module Crypto.PubKey.Rabin.Basic ( PublicKey (..), PrivateKey (..), diff --git a/Crypto/PubKey/Rabin/Modified.hs b/Crypto/PubKey/Rabin/Modified.hs --- a/Crypto/PubKey/Rabin/Modified.hs +++ b/Crypto/PubKey/Rabin/Modified.hs @@ -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' diff --git a/Crypto/PubKey/Rabin/RW.hs b/Crypto/PubKey/Rabin/RW.hs --- a/Crypto/PubKey/Rabin/RW.hs +++ b/Crypto/PubKey/Rabin/RW.hs @@ -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 diff --git a/crypton.cabal b/crypton.cabal --- a/crypton.cabal +++ b/crypton.cabal @@ -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 diff --git a/tests/PubKey/DSASpec.hs b/tests/PubKey/DSASpec.hs --- a/tests/PubKey/DSASpec.hs +++ b/tests/PubKey/DSASpec.hs @@ -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 diff --git a/tests/PubKey/ElGamalSpec.hs b/tests/PubKey/ElGamalSpec.hs --- a/tests/PubKey/ElGamalSpec.hs +++ b/tests/PubKey/ElGamalSpec.hs @@ -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 diff --git a/tests/PubKey/RSASpec.hs b/tests/PubKey/RSASpec.hs --- a/tests/PubKey/RSASpec.hs +++ b/tests/PubKey/RSASpec.hs @@ -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 diff --git a/tests/PubKey/RabinSpec.hs b/tests/PubKey/RabinSpec.hs --- a/tests/PubKey/RabinSpec.hs +++ b/tests/PubKey/RabinSpec.hs @@ -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