crypton 2.1.0 → 2.1.1

raw patch · 22 files changed

+1021/−30 lines, 22 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +35/−0
• Crypto/Cipher/AES/GCM.hs +27/−0
• Crypto/Cipher/AES/Primitive.hs +75/−0
• Crypto/Cipher/ChaCha/Poly1305.hs +324/−0
• Crypto/PubKey/ECDSA.hs +76/−0
• Crypto/PubKey/RSA/OAEP.hs +3/−4
• Crypto/PubKey/RSA/PKCS15.hs +6/−8
• Crypto/PubKey/RSA/PSS.hs +12/−0
• Crypto/PubKey/RSA/Types.hs +26/−2
• README.md +26/−0
• cbits/aes/armv8.c +5/−4
• cbits/aes/armv8_impl.c +7/−1
• cbits/aes/gcm_fused_x86.c +7/−1
• cbits/aes/gcm_fused_x86.h +2/−1
• cbits/crypton_aes.c +43/−8
• cbits/crypton_aes.h +6/−0
• cbits/crypton_chachapoly.c +156/−0
• cbits/crypton_chachapoly.h +62/−0
• crypton.cabal +3/−1
• tests/BlockCipher/AESSpec.hs +26/−0
• tests/ECDSASpec.hs +34/−0
• tests/StreamCipher/ChaChaPoly1305Spec.hs +60/−0

@@ -1,5 +1,40 @@ # CHANGELOG for crypton +## 2.1.1++* docs(rsa): the haddock says what the optional blinder covers -- that the+  private exponent is not what is at risk, `expSafe` keeping its value out of+  the work, and that what a blinder covers is the input, which without one is+  the ciphertext as it arrived and so a number an attacker may have chosen.+  The eight places taking a `Maybe Blinder` point at t'Blinder' rather than+  repeating half of it; the four in `Crypto.PubKey.RSA.PSS` said nothing at+  all before++* feat(chachapoly): `Crypto.Cipher.ChaCha.Poly1305`, which does a whole+  ChaCha20-Poly1305 message in one call, the shape `Crypto.Cipher.AES.GCM`+  has.  `Crypto.Cipher.ChaChaPoly1305` takes a message in steps, which is+  right when it arrives in pieces and is eight foreign calls and the+  allocations between them when it was already whole.  Measured on an Apple+  M4 through the Haskell interface, a 100-byte message goes 0.97 -> 0.415+  microseconds and a 1400-byte one 2.89 -> 2.36.  The nonce is the twelve+  bytes RFC 8439 defines; eight is the other ChaCha construction and is+  refused rather than quietly encrypted under a scheme nobody asked for++* feat(gcm): `Crypto.Cipher.AES.GCM.decryptWithTag`, which decrypts and hands+  back the tag it computed rather than comparing it.  For a protocol that+  carries the tag apart from the ciphertext, where `decrypt` -- which wants+  the two together -- does not fit.  It returns an `AuthTag`, whose `Eq` is a+  constant-time comparison, so the safe way to use it is also the obvious one++* feat(ecdsa): `Crypto.PubKey.ECDSA` gains the deterministic nonce of RFC+  6979, which `Crypto.PubKey.ECC.ECDSA` already had.  The fast module was the+  one without it, so moving to it for the speed meant giving up the one+  protection against the mistake that hands over an ECDSA private key.  Three+  new names: `deterministicNonce`, and `signDeterministic` and+  `signDigestDeterministic` over it.  Held to the implementation in+  `Crypto.PubKey.ECC.ECDSA`, which is itself held to the vectors in the RFC,+  on P-256, P-384 and P-521 with SHA-1 through SHA-512+ ## 2.1.0  * perf(p256): a signed five-bit window for the variable-point scalar

@@ -40,6 +40,7 @@     newContext,     encrypt,     decrypt,+    decryptWithTag,      -- * Header protection     HeaderKey,@@ -51,11 +52,13 @@     AES,     AESGCMKey,     gcmFullDecrypt,+    gcmFullDecryptTag,     gcmFullEncrypt,     gcmFullEncryptMask,     gcmKeyInit,     initAES,  )+import Crypto.Cipher.Types (AuthTag) import Crypto.Error import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B@@ -119,6 +122,30 @@     | otherwise = gcmFullDecrypt aes gk nonce aad body tag   where     (body, tag) = B.splitAt (B.length input - taglen) input++-- | Decrypt one message, the tag kept apart, and hand back the tag this end+-- computed.+--+-- For a caller whose protocol hands it the tag separately from the+-- ciphertext, so that 'decrypt' -- which wants the two together and compares+-- them itself -- does not fit.  Compare the two tags with '=='; the 'Eq'+-- instance of t'AuthTag' is a constant-time comparison, and taking them apart+-- to compare the bytes is how this goes wrong.+--+-- Nothing here says whether the message is authentic.  Until the comparison+-- is made and has come out equal, what this returns is not plaintext, it is+-- what the ciphertext turns into, and a caller must not act on it.+{-# INLINABLE decryptWithTag #-}+decryptWithTag+    :: (ByteArrayAccess nonce, ByteArrayAccess aad, ByteArray ba)+    => Context+    -> nonce+    -> aad+    -> ba+    -> Int+    -> (ba, AuthTag)+decryptWithTag (Context aes gk) nonce aad input taglen =+    gcmFullDecryptTag aes gk nonce aad input taglen  ---------------------------------------------------------------- 

@@ -45,6 +45,7 @@     gcmFullEncrypt,     gcmFullEncryptMask,     gcmFullDecrypt,+    gcmFullDecryptTag,     gcmAeadInit,      -- * Incremental OCB@@ -582,6 +583,50 @@         | B.length input <= shortMessage = c_aes_gcm_full_decrypt_unsafe         | otherwise = c_aes_gcm_full_decrypt +-- | Decrypt one message and hand back the tag that was computed over it,+-- rather than comparing it here.+--+-- For a caller that holds the expected tag in a form of its own and will+-- compare it itself.  Compare the two t'AuthTag's with '==', whose instance+-- for that type is a constant-time comparison; taking them apart and+-- comparing the bytes is how this goes wrong.+--+-- Where the tag simply arrives after the ciphertext, 'gcmFullDecrypt' is the+-- one to use: it compares in C and never puts a tag in the caller's hands.+{-# INLINABLE gcmFullDecryptTag #-}+gcmFullDecryptTag+    :: ( ByteArrayAccess iv+       , ByteArrayAccess aad+       , ByteArrayAccess ba+       , ByteArray output+       )+    => AES -> AESGCMKey -> iv -> aad -> ba -> Int -> (output, AuthTag)+gcmFullDecryptTag ctx (AESGCMKey gk) iv aad input taglen = unsafeDoIO $ do+    (tagbs, out) <- B.allocRet (B.length input) $ \outp ->+        B.alloc taglen $ \tagp ->+            B.withByteArray gk $ \gkp ->+                keyToPtr ctx $ \k ->+                    B.withByteArray iv $ \ivp ->+                        B.withByteArray aad $ \aadp ->+                            B.withByteArray input $ \inp ->+                                call+                                    outp+                                    tagp+                                    (castPtr gkp)+                                    k+                                    ivp+                                    (fromIntegral $ B.length iv)+                                    aadp+                                    (fromIntegral $ B.length aad)+                                    inp+                                    (fromIntegral $ B.length input)+                                    (fromIntegral taglen)+    return (out, AuthTag $ B.convert (tagbs :: B.Bytes))+  where+    call+        | B.length input <= shortMessage = c_aes_gcm_full_decrypt_tag_unsafe+        | otherwise = c_aes_gcm_full_decrypt_tag+ -- | append data which is only going to be authenticated to the GCM context. -- -- needs to happen after initialization and before appending encryption/decryption data.@@ -869,6 +914,36 @@         -> Ptr Word8         -> CUInt         -> IO CInt++foreign import ccall "crypton_aes.h crypton_aes_gcm_full_decrypt_tag"+    c_aes_gcm_full_decrypt_tag+        :: Ptr Word8+        -> Ptr Word8+        -> Ptr AESGCM+        -> Ptr AES+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> CUInt+        -> IO ()++foreign import ccall unsafe "crypton_aes.h crypton_aes_gcm_full_decrypt_tag"+    c_aes_gcm_full_decrypt_tag_unsafe+        :: Ptr Word8+        -> Ptr Word8+        -> Ptr AESGCM+        -> Ptr AES+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> CUInt+        -> IO ()  foreign import ccall unsafe "crypton_aes.h crypton_aes_gcm_full_encrypt"     c_aes_gcm_full_encrypt_unsafe

@@ -0,0 +1,324 @@+-- |+-- Module      : Crypto.Cipher.ChaCha.Poly1305+-- License     : BSD-style+-- Maintainer  : Kazu Yamamoto <kazu@iij.ad.jp>+-- Stability   : experimental+-- Portability : Good+--+-- ChaCha20-Poly1305 (RFC 8439) a message at a time.+--+-- "Crypto.Cipher.ChaChaPoly1305" takes a message in pieces: a state is+-- started, the additional data appended, the body encrypted and the tag+-- taken, each a step of its own.  That is what a protocol wants when the+-- message arrives in pieces, and it is eight foreign calls and the+-- allocations between them when the message was already whole.+--+-- Here the whole message goes in one call.+--+-- The functions are the same shape as "Crypto.Cipher.AES.GCM", so a protocol+-- that offers both ciphers can hold them the same way.+module Crypto.Cipher.ChaCha.Poly1305 (+    Context,+    newContext,+    encrypt,+    decrypt,+    decryptWithTag,+) where++import Crypto.Cipher.Types (AuthTag (..))+import Crypto.Error+import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)+import qualified Crypto.Internal.ByteArray as B+import Crypto.Internal.Compat (unsafeDoIO)+import Crypto.Internal.Imports+import Data.Word (Word8)+import Foreign.C.Types (CInt (..), CUInt (..))+import Foreign.Ptr (Ptr, plusPtr)++-- | A key, checked once.+--+-- ChaCha20-Poly1305 has nothing to precompute from a key: the one-time+-- Poly1305 key comes from the nonce, so it differs for every message.  This+-- holds the thirty-two bytes and the knowledge that they are thirty-two, and+-- exists so that the interface is the one "Crypto.Cipher.AES.GCM" has.+newtype Context = Context B.ScrubbedBytes++instance NFData Context where+    rnf (Context k) = k `seq` ()++-- | Take a key of 32 bytes.  Any other length is reported as+-- 'CryptoError_KeySizeInvalid'.+newContext :: ByteArrayAccess key => key -> CryptoFailable Context+newContext k+    | B.length k /= 32 = CryptoFailed CryptoError_KeySizeInvalid+    | otherwise = CryptoPassed $ Context (B.convert k)+{-# INLINABLE newContext #-}++-- | Encrypt one message.  The result is the ciphertext with the tag after it,+-- which is the shape 'decrypt' expects.+--+-- The nonce is the twelve bytes RFC 8439 defines; any other length gives+-- 'CryptoError_IvSizeInvalid'.  The tag is at most 16 bytes.+{-# INLINABLE encrypt #-}+encrypt+    :: ( ByteArrayAccess nonce+       , ByteArrayAccess aad+       , ByteArrayAccess ba+       , ByteArray output+       )+    => Context+    -> nonce+    -> aad+    -> ba+    -> Int+    -> CryptoFailable output+encrypt (Context k) nonce aad input taglen+    | not (validNonce nonce) = CryptoFailed CryptoError_IvSizeInvalid+    | badTag taglen = CryptoFailed CryptoError_AuthenticationTagSizeInvalid+    | otherwise =+        CryptoPassed $+            unsafeDoIO $+                B.alloc (B.length input + taglen) $ \out ->+                    B.withByteArray k $ \kp ->+                        B.withByteArray nonce $ \np ->+                            B.withByteArray aad $ \ap ->+                                B.withByteArray input $ \ip ->+                                    (callE (B.length input))+                                        out+                                        (out `plusPtr` B.length input)+                                        (fromIntegral taglen)+                                        kp+                                        np+                                        (fromIntegral $ B.length nonce)+                                        ap+                                        (fromIntegral $ B.length aad)+                                        ip+                                        (fromIntegral $ B.length input)++-- | Decrypt one message, in the shape 'encrypt' produced: the ciphertext with+-- its tag after it.  The tag is compared here, every byte of it whatever the+-- answer, and a message whose tag does not match gives 'Nothing' rather than+-- the plaintext.+--+-- 'Nothing' also comes back when the input is shorter than the tag, or the+-- nonce is not twelve bytes.+{-# INLINABLE decrypt #-}+decrypt+    :: (ByteArrayAccess nonce, ByteArrayAccess aad, ByteArray ba)+    => Context+    -> nonce+    -> aad+    -> ba+    -> Int+    -> Maybe ba+decrypt (Context k) nonce aad input taglen+    | not (validNonce nonce) = Nothing+    | badTag taglen || B.length input < taglen = Nothing+    | otherwise = unsafeDoIO $ do+        (r, out) <- B.allocRet bodylen $ \outp ->+            B.withByteArray k $ \kp ->+                B.withByteArray nonce $ \np ->+                    B.withByteArray aad $ \ap ->+                        B.withByteArray body $ \ip ->+                            B.withByteArray tag $ \tp ->+                                (callD bodylen)+                                    outp+                                    tp+                                    (fromIntegral taglen)+                                    kp+                                    np+                                    (fromIntegral $ B.length nonce)+                                    ap+                                    (fromIntegral $ B.length aad)+                                    ip+                                    (fromIntegral bodylen)+        return $ if r /= 0 then Just out else Nothing+  where+    bodylen = B.length input - taglen+    (body, tag) = B.splitAt bodylen input++-- | Decrypt one message, the tag kept apart, and hand back the tag this end+-- computed.+--+-- For a caller whose protocol carries the tag separately from the ciphertext,+-- so that 'decrypt' -- which wants the two together and compares them itself+-- -- does not fit.  Compare the two tags with '=='; the 'Eq' instance of+-- t'AuthTag' is a constant-time comparison, and taking them apart to compare+-- the bytes is how this goes wrong.+--+-- Nothing here says whether the message is authentic.  Until the comparison+-- is made and has come out equal, what this returns is not plaintext, it is+-- what the ciphertext turns into, and a caller must not act on it.+{-# INLINABLE decryptWithTag #-}+decryptWithTag+    :: (ByteArrayAccess nonce, ByteArrayAccess aad, ByteArray ba)+    => Context+    -> nonce+    -> aad+    -> ba+    -> Int+    -> CryptoFailable (ba, AuthTag)+decryptWithTag (Context k) nonce aad input taglen+    | not (validNonce nonce) = CryptoFailed CryptoError_IvSizeInvalid+    | badTag taglen = CryptoFailed CryptoError_AuthenticationTagSizeInvalid+    | otherwise = CryptoPassed $ unsafeDoIO $ do+        (tagbs, out) <- B.allocRet (B.length input) $ \outp ->+            B.alloc taglen $ \tagp ->+                B.withByteArray k $ \kp ->+                    B.withByteArray nonce $ \np ->+                        B.withByteArray aad $ \ap ->+                            B.withByteArray input $ \ip ->+                                (callT (B.length input))+                                    outp+                                    tagp+                                    (fromIntegral taglen)+                                    kp+                                    np+                                    (fromIntegral $ B.length nonce)+                                    ap+                                    (fromIntegral $ B.length aad)+                                    ip+                                    (fromIntegral $ B.length input)+        return (out, AuthTag $ B.convert (tagbs :: B.Bytes))++-- RFC 8439 is the twelve-byte nonce.  ChaCha20 will take eight, but that is+-- the other construction, with a 64-bit block counter, and it is not what+-- this AEAD is defined over -- so it is refused here rather than quietly+-- encrypting under a scheme nobody asked for.+validNonce :: ByteArrayAccess nonce => nonce -> Bool+validNonce n = B.length n == 12++badTag :: Int -> Bool+badTag t = t < 0 || t > 16++-- | An unsafe call keeps a capability for as long as it runs, so it is only+-- for a message short enough that the run is short.  Four kibibytes is what+-- the AES side uses, and it takes in a datagram of any size a network will+-- carry.+shortMessage :: Int+shortMessage = 4096++callE :: Int -> CEncrypt+callE n+    | n <= shortMessage = c_chachapoly_encrypt_unsafe+    | otherwise = c_chachapoly_encrypt++callD :: Int -> CDecrypt+callD n+    | n <= shortMessage = c_chachapoly_decrypt_unsafe+    | otherwise = c_chachapoly_decrypt++callT :: Int -> CEncrypt+callT n+    | n <= shortMessage = c_chachapoly_decrypt_tag_unsafe+    | otherwise = c_chachapoly_decrypt_tag++type CEncrypt =+    Ptr Word8+    -> Ptr Word8+    -> CUInt+    -> Ptr Word8+    -> Ptr Word8+    -> CUInt+    -> Ptr Word8+    -> CUInt+    -> Ptr Word8+    -> CUInt+    -> IO ()++type CDecrypt =+    Ptr Word8+    -> Ptr Word8+    -> CUInt+    -> Ptr Word8+    -> Ptr Word8+    -> CUInt+    -> Ptr Word8+    -> CUInt+    -> Ptr Word8+    -> CUInt+    -> IO CInt++foreign import ccall "crypton_chachapoly.h crypton_chachapoly_encrypt"+    c_chachapoly_encrypt+        :: Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> IO ()++foreign import ccall unsafe "crypton_chachapoly.h crypton_chachapoly_encrypt"+    c_chachapoly_encrypt_unsafe+        :: Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> IO ()++foreign import ccall "crypton_chachapoly.h crypton_chachapoly_decrypt"+    c_chachapoly_decrypt+        :: Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> IO CInt++foreign import ccall unsafe "crypton_chachapoly.h crypton_chachapoly_decrypt"+    c_chachapoly_decrypt_unsafe+        :: Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> IO CInt++foreign import ccall "crypton_chachapoly.h crypton_chachapoly_decrypt_tag"+    c_chachapoly_decrypt_tag+        :: Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> IO ()++foreign import ccall unsafe "crypton_chachapoly.h crypton_chachapoly_decrypt_tag"+    c_chachapoly_decrypt_tag_unsafe+        :: Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> Ptr Word8+        -> CUInt+        -> IO ()

@@ -48,6 +48,11 @@     signDigest,     verify,     verifyDigest,++    -- * Deterministic nonces+    deterministicNonce,+    signDeterministic,+    signDigestDeterministic, ) where  import Control.Monad@@ -58,8 +63,10 @@ import Crypto.Hash import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) import Crypto.Internal.Imports+import Crypto.Number.Generate (generatePrefix) import Crypto.Number.ModArithmetic (inverseFermat) import qualified Crypto.PubKey.ECC.P256 as P256+import Crypto.Random.HmacDRG (initial, update) import Crypto.Random.Types  import Data.Bits@@ -257,6 +264,75 @@ verify prx hashAlg q sig msg = verifyDigest prx q sig (hashWith hashAlg msg)  -- | Truncate a digest based on curve order size.+-- | Deterministic nonce generation according to RFC 6979.+--+-- The nonce is derived from the private key and the message alone, so a+-- signature made this way needs no random number generator and cannot be the+-- one that repeats a nonce -- which, for ECDSA, hands over the private key.+--+-- The hash used to seed the generator is given separately from the one the+-- message was digested with, as RFC 6979 allows.+--+-- The last argument is what to do with a candidate nonce.  It may answer+-- 'Nothing', in which case another candidate is drawn, which is what+-- 'signDigestDeterministic' does for the r or s that comes out zero:+--+-- > deterministicNonce prx SHA256 priv digest (\k -> signDigestWith prx k priv digest)+deterministicNonce+    :: (EllipticCurveECDSA curve, HashAlgorithm hashDRG, HashAlgorithm hashDigest)+    => proxy curve+    -> hashDRG+    -> PrivateKey curve+    -> Digest hashDigest+    -> (Scalar curve -> Maybe a)+    -> a+deterministicNonce prx alg d digest go = fst $ withDRG state run+  where+    state = update seed $ initial alg+    -- RFC 6979 section 3.2 step d: int2octets(x) || bits2octets(h1).  The+    -- second is the truncated digest taken modulo the order, which is what+    -- scalarAdd with zero does, its contract being to reduce there.+    seed =+        B.append (encodeScalar prx d) (encodeScalar prx z)+            :: B.ScrubbedBytes+    z = scalarAdd prx (tHashDigest prx digest) zeroScalar+    zeroScalar = throwCryptoError $ scalarFromInteger prx 0+    run = do+        k <- generatePrefix (curveOrderBits prx)+        case scalarFromInteger prx k of+            CryptoPassed s+                | scalarIsValid prx s -> maybe run pure (go s)+            _ -> run++-- | Sign a digest with a nonce derived from the private key and the digest,+-- as RFC 6979 says, rather than from a random number generator.+signDigestDeterministic+    :: (EllipticCurveECDSA curve, HashAlgorithm hashDRG, HashAlgorithm hashDigest)+    => proxy curve+    -> hashDRG+    -> PrivateKey curve+    -> Digest hashDigest+    -> Signature curve+signDigestDeterministic prx alg d digest =+    deterministicNonce prx alg d digest $ \k -> signDigestWith prx k d digest++-- | Sign a message with a nonce derived from the private key and the message,+-- as RFC 6979 says, rather than from a random number generator.+signDeterministic+    :: ( EllipticCurveECDSA curve+       , HashAlgorithm hashDRG+       , HashAlgorithm hash+       , ByteArrayAccess msg+       )+    => proxy curve+    -> hashDRG+    -> PrivateKey curve+    -> hash+    -> msg+    -> Signature curve+signDeterministic prx alg d hashAlg msg =+    signDigestDeterministic prx alg d (hashWith hashAlg msg)+ tHashDigest     :: (EllipticCurveECDSA curve, HashAlgorithm hash)     => proxy curve -> Digest hash -> Scalar curve

@@ -181,10 +181,9 @@  -- | Decrypt a ciphertext using OAEP ----- When the signature is not in a context where an attacker could gain--- information from the timing of the operation, the blinder can be set to None.------ If unsure always set a blinder or use decryptSafer+-- 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.+-- 'decryptSafer' generates one for you. -- -- Following RFC 8017, the ciphertext is rejected unless it is exactly as long -- as the modulus (section 7.1.2, step 1) and its integer representative is

@@ -453,10 +453,9 @@  -- | decrypt message using the private key. ----- When the decryption is not in a context where an attacker could gain--- information from the timing of the operation, the blinder can be set to None.------ If unsure always set a blinder or use decryptSafer+-- 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.+-- 'decryptSafer' generates one for you. -- -- The message is returned un-padded. --@@ -508,10 +507,9 @@  -- | sign message using private key, a hash and its ASN1 description ----- When the signature is not in a context where an attacker could gain--- information from the timing of the operation, the blinder can be set to None.------ If unsure always set a blinder or use signSafer+-- 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.+-- 'signSafer' generates one for you. sign     :: HashAlgorithmASN1 hashAlg     => Maybe Blinder

@@ -69,6 +69,9 @@ -- | Sign using the PSS parameters and the salt explicitely passed as parameters. -- -- the function ignore SaltLength from the PSS Parameters+--+-- See t'Blinder' for what the optional blinder covers and when leaving it out+-- is a decision rather than a default.  'signSafer' generates one for you. signDigestWithSalt     :: HashAlgorithm hash     => ByteString@@ -103,6 +106,9 @@ -- | Sign using the PSS parameters and the salt explicitely passed as parameters. -- -- the function ignore SaltLength from the PSS Parameters+--+-- See t'Blinder' for what the optional blinder covers and when leaving it out+-- is a decision rather than a default.  'signSafer' generates one for you. signWithSalt     :: HashAlgorithm hash     => ByteString@@ -121,6 +127,9 @@     mHash = hashWith (pssHash params) m  -- | Sign using the PSS Parameters+--+-- See t'Blinder' for what the optional blinder covers and when leaving it out+-- is a decision rather than a default.  'signSafer' generates one for you. sign     :: (HashAlgorithm hash, MonadRandom m)     => Maybe Blinder@@ -137,6 +146,9 @@     return (signWithSalt salt blinder params pk m)  -- | Sign using the PSS Parameters+--+-- See t'Blinder' for what the optional blinder covers and when leaving it out+-- is a decision rather than a default.  'signSafer' generates one for you. signDigest     :: (HashAlgorithm hash, MonadRandom m)     => Maybe Blinder

@@ -27,8 +27,32 @@  import GHC.Generics --- | Blinder which is used to obfuscate the timing--- of the decryption primitive (used by decryption and signing).+-- | A blinder, which keeps the timing of the private key operation from+-- saying anything about the number it was given.+--+-- The private exponent is not what is at risk.  'Crypto.Number.ModArithmetic.expSafe',+-- which the exponentiation goes through, keeps the /value/ of an exponent out+-- of the work it does.+--+-- What a blinder covers is the other side.  Without one, the operation runs+-- on the ciphertext as it arrived, so how long it takes depends on a number+-- an attacker may have chosen and can vary -- which is what a remote timing+-- attack on RSA needs.  With one, the input is multiplied by a random value+-- first and that value divided out afterwards, so the timing carries nothing+-- an attacker can steer.+--+-- Every private key operation here takes a @'Maybe' t'Blinder'@.  The+-- @Safer@ form of each -- 'Crypto.PubKey.RSA.PKCS15.decryptSafer',+-- 'Crypto.PubKey.RSA.PKCS15.signSafer' and their kind -- generates one and is+-- the one to reach for.  Pass 'Nothing' only where the input is not attacker+-- controlled and you have decided that it is not.+--+-- A blinder costs one more exponentiation, by the public exponent, which is+-- the cheap direction: measured on an Apple M4, PKCS#1 v1.5 signing goes from+-- about 601 to about 620 microseconds.+--+-- Use a blinder once.  'Crypto.PubKey.RSA.generateBlinder' makes a fresh one;+-- carrying one across operations is not what it is for. data Blinder = Blinder !Integer !Integer     deriving (Show, Eq) 

@@ -43,6 +43,32 @@     ghci> processorOptions     [AESNI,PCLMUL] +RSA is the other place to know about, and there the choice is the caller's.+The private key operations in `Crypto.PubKey.RSA.PKCS15`, `.OAEP` and `.PSS`+take a `Maybe Blinder`, and `Nothing` is no harder to write than the safe+form:++    decrypt     :: Maybe Blinder -> PrivateKey -> ByteString -> ...+    decryptSafer :: MonadRandom m => PrivateKey -> ByteString -> m ...++The exponent itself is not what is at risk.  `expSafe` keeps the *value* of an+exponent out of the work it does, so the private exponent does not leak+through the exponentiation.  What a blinder covers is the other side: without+one, the operation runs on the ciphertext the caller was handed, so how long+it takes depends on a number an attacker may have chosen and can vary.  That+is what a remote timing attack on RSA needs.  With a blinder the input is+multiplied by a random value first and the result divided out afterwards, so+the timing carries nothing an attacker can steer.++`decryptSafer` and `signSafer` generate the blinder themselves and are the+ones to reach for.  Pass `Nothing` only where the input is not attacker+controlled and you have decided that it is not.++The RSA rows in the tables below are the unblinded path.  A blinder costs one+more exponentiation, by the public exponent, which is the cheap direction:+measured on the M4, signing goes from about 601 to about 620 microseconds,+three per cent.+ Performance ----------- 

@@ -434,20 +434,21 @@                                     aes_key *key, const uint8_t *nonce,                                     const uint8_t *aad, uint32_t aadlen,                                     const uint8_t *in, uint32_t inlen,-                                    const uint8_t *tag, uint32_t taglen)+                                    const uint8_t *tag, uint32_t taglen,+                                    uint8_t *outtag) { 	switch (key->strength) { 	case 0: 		return crypton_aes_armv8_gcm_fused_dec128(out, ht, key, nonce, 		                                          aad, aadlen, in, inlen,-		                                          tag, taglen);+		                                          tag, taglen, outtag); 	case 1: 		return crypton_aes_armv8_gcm_fused_dec192(out, ht, key, nonce, 		                                          aad, aadlen, in, inlen,-		                                          tag, taglen);+		                                          tag, taglen, outtag); 	default: 		return crypton_aes_armv8_gcm_fused_dec256(out, ht, key, nonce, 		                                          aad, aadlen, in, inlen,-		                                          tag, taglen);+		                                          tag, taglen, outtag); 	} }

@@ -664,7 +664,8 @@                                            aes_key *key, const uint8_t *nonce,                                            const uint8_t *aad, uint32_t aadlen,                                            const uint8_t *in, uint32_t inlen,-                                           const uint8_t *tagp, uint32_t taglen)+                                           const uint8_t *tagp, uint32_t taglen,+                                           uint8_t *outtag) { 	const uint8_t *rk = FWD(key); 	uint8x16_t s[WAY];@@ -733,6 +734,11 @@ 	FG_ABSORB(vld1q_u8(lenb));  	vst1q_u8(want, veorq_u8(tag, ek0));+	if (outtag) {+		/* The caller holds the expected tag and will compare it itself. */+		memcpy(outtag, want, taglen);+		return 1;+	} 	for (i = 0; i < taglen; i++) 		diff |= (uint8_t) (want[i] ^ tagp[i]); 	return diff == 0;

@@ -843,7 +843,8 @@                                   const aes_key *key, const uint8_t *nonce,                                   const uint8_t *aad, size_t aadlen,                                   const uint8_t *in, size_t inlen,-                                  const uint8_t *tag, size_t taglen)+                                  const uint8_t *tag, size_t taglen,+                                  uint8_t *outtag) {     const uint8_t *rk = key->data;     const int rounds = key->nbr;@@ -979,6 +980,11 @@     {         uint8_t got[16];         _mm_storeu_si128((__m128i *) got, want);+        if (outtag) {+            /* The caller holds the expected tag and will compare it itself. */+            memcpy(outtag, got, taglen);+            return 1;+        }         for (i = 0; i < taglen; i++)             diff |= (uint8_t) (got[i] ^ tag[i]);     }

@@ -49,6 +49,7 @@                               const aes_key *key, const uint8_t *nonce,                               const uint8_t *aad, size_t aadlen,                               const uint8_t *in, size_t inlen,-                              const uint8_t *tag, size_t taglen);+                              const uint8_t *tag, size_t taglen,+                              uint8_t *outtag);  #endif

@@ -65,7 +65,8 @@                                     aes_key *key, const uint8_t *nonce,                                     const uint8_t *aad, uint32_t aadlen,                                     const uint8_t *in, uint32_t inlen,-                                    const uint8_t *tag, uint32_t taglen);+                                    const uint8_t *tag, uint32_t taglen,+                                    uint8_t *outtag); void crypton_aes_armv8_gcm_fused(uint8_t *out, const block128 *ht,                                  aes_key *key, const uint8_t *nonce,                                  const uint8_t *aad, uint32_t aadlen,@@ -752,11 +753,19 @@  * caller: returns 1 when it matches and 0 when it does not, comparing every  * byte either way.  The plaintext is written whatever the answer, so a caller  * that gets 0 must not use it. */-int crypton_aes_gcm_full_decrypt(uint8_t *output, const aes_gcm_key *gcmkey, aes_key *key,-                                 uint8_t *iv, uint32_t ivlen,-                                 uint8_t *aad, uint32_t aadlen,-                                 uint8_t *input, uint32_t length,-                                 const uint8_t *tag, uint32_t taglen)+/* Decrypt, and either compare the tag or hand it back.+ *+ * With outtag NULL this is the verifying form: the tag is compared here, a+ * byte at a time over its whole length whichever way the answer goes, and the+ * answer is the return value.  With outtag not NULL the computed tag is+ * written there instead and the return value is 1 -- for a caller that holds+ * the expected tag in a form of its own and will compare it itself. */+static int gcm_full_decrypt(uint8_t *output, const aes_gcm_key *gcmkey, aes_key *key,+                            uint8_t *iv, uint32_t ivlen,+                            uint8_t *aad, uint32_t aadlen,+                            uint8_t *input, uint32_t length,+                            const uint8_t *tag, uint32_t taglen,+                            uint8_t *outtag) { 	aes_gcm gcm; 	uint8_t expected[16];@@ -773,7 +782,7 @@ 	    && crypton_aes_cpu_options[CPU_PCLMUL]) 		return crypton_gcm_fused_decrypt(output, &gcmkey->fused, key, 		                                 iv, aad, aadlen, input,-		                                 length, tag, taglen);+		                                 length, tag, taglen, outtag); #endif #ifdef WITH_ARMV8_CRYPTO 	if (ivlen == 12@@ -781,7 +790,8 @@ 	    && crypton_aes_cpu_options[CPU_PCLMUL]) 		return crypton_aes_armv8_gcm_fused_dec(output, gcmkey->gcm.htable, 		                                       key, iv, aad, aadlen,-		                                       input, length, tag, taglen);+		                                       input, length, tag, taglen,+		                                       outtag); #endif 	memcpy(gcm.htable, gcmkey->gcm.htable, sizeof(gcm.htable)); 	gcm_message_init(&gcm, iv, ivlen);@@ -791,9 +801,34 @@ 		crypton_aes_gcm_decrypt(output, &gcm, key, input, length); 	crypton_aes_gcm_finish(expected, &gcm, key); +	if (outtag) {+		memcpy(outtag, expected, taglen);+		return 1;+	} 	for (i = 0; i < taglen; i++) 		diff |= (uint8_t) (expected[i] ^ tag[i]); 	return diff == 0;+}++int crypton_aes_gcm_full_decrypt(uint8_t *output, const aes_gcm_key *gcmkey, aes_key *key,+                                 uint8_t *iv, uint32_t ivlen,+                                 uint8_t *aad, uint32_t aadlen,+                                 uint8_t *input, uint32_t length,+                                 const uint8_t *tag, uint32_t taglen)+{+	return gcm_full_decrypt(output, gcmkey, key, iv, ivlen, aad, aadlen,+	                        input, length, tag, taglen, NULL);+}++void crypton_aes_gcm_full_decrypt_tag(uint8_t *output, uint8_t *outtag,+                                      const aes_gcm_key *gcmkey, aes_key *key,+                                      uint8_t *iv, uint32_t ivlen,+                                      uint8_t *aad, uint32_t aadlen,+                                      uint8_t *input, uint32_t length,+                                      uint32_t taglen)+{+	(void) gcm_full_decrypt(output, gcmkey, key, iv, ivlen, aad, aadlen,+	                        input, length, NULL, taglen, outtag); }  static inline uint8_t ccm_b0_flags(uint32_t has_adata, uint32_t m, uint32_t l)

@@ -168,6 +168,12 @@                                  uint8_t *aad, uint32_t aadlen,                                  uint8_t *input, uint32_t length,                                  const uint8_t *tag, uint32_t taglen);+void crypton_aes_gcm_full_decrypt_tag(uint8_t *output, uint8_t *outtag,+                                      const aes_gcm_key *gcmkey, aes_key *key,+                                      uint8_t *iv, uint32_t ivlen,+                                      uint8_t *aad, uint32_t aadlen,+                                      uint8_t *input, uint32_t length,+                                      uint32_t taglen); void crypton_aes_gcm_aad(aes_gcm *gcm, uint8_t *input, uint32_t length); void crypton_aes_gcm_encrypt(uint8_t *output, aes_gcm *gcm, aes_key *key, uint8_t *input, uint32_t length); void crypton_aes_gcm_decrypt(uint8_t *output, aes_gcm *gcm, aes_key *key, uint8_t *input, uint32_t length);

@@ -0,0 +1,156 @@+/*+ * Copyright (c) 2026 Kazu Yamamoto+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ *    notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ *    notice, this list of conditions and the following disclaimer in the+ *    documentation and/or other materials provided with the distribution.+ *+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+ * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS+ * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+ * POSSIBILITY OF SUCH DAMAGE.+ */++#include <stdint.h>+#include <string.h>++#include "crypton_chacha.h"+#include "crypton_chachapoly.h"+#include "crypton_poly1305.h"++/* RFC 8439.  The one-time Poly1305 key is the first 32 bytes of the ChaCha20+ * keystream at counter 0; a whole 64-byte block is generated so the counter+ * lands on 1, which is where the message starts. */+static void chachapoly_start(crypton_chacha_context *cctx, poly1305_ctx *pctx,+                             const uint8_t *key,+                             const uint8_t *nonce, uint32_t noncelen)+{+	uint8_t block[64];++	crypton_chacha_init(cctx, 20, 32, key, noncelen, nonce);+	crypton_chacha_generate(block, cctx, sizeof(block));+	crypton_poly1305_init(pctx, (poly1305_key *) block);+	memset(block, 0, sizeof(block));+}++/* Poly1305 over an associated or encrypted part, then zeros up to the next+ * multiple of sixteen. */+static void absorb_padded(poly1305_ctx *pctx, const uint8_t *p, uint32_t len)+{+	static const uint8_t zeros[16] = {0};+	uint32_t rem;++	if (len)+		crypton_poly1305_update(pctx, (uint8_t *) p, len);+	rem = len % 16;+	if (rem)+		crypton_poly1305_update(pctx, (uint8_t *) zeros, 16 - rem);+}++/* The two lengths, little endian, eight bytes each, which is what the tag+ * ends on. */+static void absorb_lengths(poly1305_ctx *pctx, uint32_t aadlen, uint32_t inlen)+{+	uint8_t lens[16];+	int i;++	for (i = 0; i < 8; i++)+		lens[i] = (uint8_t) (((uint64_t) aadlen) >> (8 * i));+	for (i = 0; i < 8; i++)+		lens[8 + i] = (uint8_t) (((uint64_t) inlen) >> (8 * i));+	crypton_poly1305_update(pctx, lens, sizeof(lens));+}++void crypton_chachapoly_encrypt(uint8_t *out, uint8_t *tag, uint32_t taglen,+                                const uint8_t *key,+                                const uint8_t *nonce, uint32_t noncelen,+                                const uint8_t *aad, uint32_t aadlen,+                                const uint8_t *input, uint32_t inlen)+{+	crypton_chacha_context cctx;+	poly1305_ctx pctx;+	poly1305_mac mac;++	chachapoly_start(&cctx, &pctx, key, nonce, noncelen);+	absorb_padded(&pctx, aad, aadlen);+	if (inlen)+		crypton_chacha_combine(out, &cctx, input, inlen);+	/* what the tag covers is the ciphertext, which is now in out */+	absorb_padded(&pctx, out, inlen);+	absorb_lengths(&pctx, aadlen, inlen);+	crypton_poly1305_finalize(mac, &pctx);+	memcpy(tag, mac, taglen);++	memset(&cctx, 0, sizeof(cctx));+	memset(&pctx, 0, sizeof(pctx));+}++/* Shared by the two decrypting entry points: with outtag NULL the tag is+ * compared here and the answer returned, otherwise it is written there. */+static int chachapoly_decrypt(uint8_t *out, const uint8_t *tag, uint32_t taglen,+                              uint8_t *outtag, const uint8_t *key,+                              const uint8_t *nonce, uint32_t noncelen,+                              const uint8_t *aad, uint32_t aadlen,+                              const uint8_t *input, uint32_t inlen)+{+	crypton_chacha_context cctx;+	poly1305_ctx pctx;+	poly1305_mac mac;+	uint8_t diff = 0;+	uint32_t i;++	chachapoly_start(&cctx, &pctx, key, nonce, noncelen);+	absorb_padded(&pctx, aad, aadlen);+	/* here the ciphertext is the input, so the tag can be taken before the+	 * plaintext is written and out may alias input */+	absorb_padded(&pctx, input, inlen);+	absorb_lengths(&pctx, aadlen, inlen);+	crypton_poly1305_finalize(mac, &pctx);++	if (inlen)+		crypton_chacha_combine(out, &cctx, input, inlen);++	memset(&cctx, 0, sizeof(cctx));+	memset(&pctx, 0, sizeof(pctx));++	if (outtag) {+		memcpy(outtag, mac, taglen);+		return 1;+	}+	for (i = 0; i < taglen; i++)+		diff |= (uint8_t) (mac[i] ^ tag[i]);+	return diff == 0;+}++int crypton_chachapoly_decrypt(uint8_t *out,+                               const uint8_t *tag, uint32_t taglen,+                               const uint8_t *key,+                               const uint8_t *nonce, uint32_t noncelen,+                               const uint8_t *aad, uint32_t aadlen,+                               const uint8_t *input, uint32_t inlen)+{+	return chachapoly_decrypt(out, tag, taglen, NULL, key, nonce, noncelen,+	                          aad, aadlen, input, inlen);+}++void crypton_chachapoly_decrypt_tag(uint8_t *out, uint8_t *outtag,+                                    uint32_t taglen, const uint8_t *key,+                                    const uint8_t *nonce, uint32_t noncelen,+                                    const uint8_t *aad, uint32_t aadlen,+                                    const uint8_t *input, uint32_t inlen)+{+	(void) chachapoly_decrypt(out, NULL, taglen, outtag, key, nonce,+	                          noncelen, aad, aadlen, input, inlen);+}

@@ -0,0 +1,62 @@+/*+ * Copyright (c) 2026 Kazu Yamamoto+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ *    notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ *    notice, this list of conditions and the following disclaimer in the+ *    documentation and/or other materials provided with the distribution.+ *+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+ * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS+ * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+ * POSSIBILITY OF SUCH DAMAGE.+ */++#ifndef CRYPTON_CHACHAPOLY_H+#define CRYPTON_CHACHAPOLY_H++#include <stdint.h>++/* ChaCha20-Poly1305 (RFC 8439) as one call.+ *+ * The pieces are the ChaCha20 and Poly1305 already here; what these do is+ * hold them together, which the Haskell above used to do at the cost of eight+ * foreign calls and the allocations between them.+ *+ * The nonce is the twelve bytes RFC 8439 defines.  taglen is at most 16.+ */++void crypton_chachapoly_encrypt(uint8_t *out, uint8_t *tag, uint32_t taglen,+                                const uint8_t *key,+                                const uint8_t *nonce, uint32_t noncelen,+                                const uint8_t *aad, uint32_t aadlen,+                                const uint8_t *input, uint32_t inlen);++/* Decrypt and compare, a byte at a time over the whole tag whichever way the+ * answer goes.  Returns non-zero when the tag matched. */+int crypton_chachapoly_decrypt(uint8_t *out,+                               const uint8_t *tag, uint32_t taglen,+                               const uint8_t *key,+                               const uint8_t *nonce, uint32_t noncelen,+                               const uint8_t *aad, uint32_t aadlen,+                               const uint8_t *input, uint32_t inlen);++/* Decrypt and hand the computed tag back rather than comparing it. */+void crypton_chachapoly_decrypt_tag(uint8_t *out, uint8_t *outtag,+                                    uint32_t taglen, const uint8_t *key,+                                    const uint8_t *nonce, uint32_t noncelen,+                                    const uint8_t *aad, uint32_t aadlen,+                                    const uint8_t *input, uint32_t inlen);++#endif

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               crypton-version:            2.1.0+version:            2.1.1 license:            BSD-3-Clause license-file:       LICENSE copyright:          Vincent Hanquez <vincent@snarc.org>@@ -149,6 +149,7 @@         Crypto.Cipher.Camellia         Crypto.Cipher.CAST5         Crypto.Cipher.ChaCha+        Crypto.Cipher.ChaCha.Poly1305         Crypto.Cipher.ChaChaPoly1305         Crypto.Cipher.DES         Crypto.Cipher.RC4@@ -245,6 +246,7 @@         cbits/crypton_blowfish.c         cbits/crypton_camellia.c         cbits/crypton_chacha.c+        cbits/crypton_chachapoly.c         cbits/crypton_cpu.c         cbits/crypton_des.c         cbits/crypton_ecc.c

@@ -237,6 +237,19 @@         run "AES-128" KATGCM.vectors_aes128_enc         run "AES-192" KATGCM.vectors_aes192_enc         run "AES-256" KATGCM.vectors_aes256_enc+    describe "decryptWithTag hands back the tag encrypt made" $ do+        runTag "AES-128" KATGCM.vectors_aes128_enc+        runTag "AES-192" KATGCM.vectors_aes192_enc+        runTag "AES-256" KATGCM.vectors_aes256_enc+    it "decryptWithTag gives a different tag for a tampered ciphertext" $+        let ctx = ctx16+            sealed = GCM.encrypt ctx iv16 B.empty message 16 :: B.ByteString+            body = B.take (B.length sealed - 16) sealed+            tag = AuthTag (BA.convert (B.drop (B.length sealed - 16) sealed))+            (_, tag') =+                GCM.decryptWithTag ctx iv16 B.empty (flipFirst body) 16+                    :: (B.ByteString, AuthTag)+         in tag' `shouldSatisfy` (/= tag)     describe "refuses a message that was interfered with" $ do         it "a flipped bit in the tag" $ tamper (\(c, t) -> (c, flipFirst t))         it "a flipped bit in the ciphertext" $ tamper (\(c, t) -> (flipFirst c, t))@@ -260,6 +273,19 @@             , let sealed = GCM.encrypt ctx iv aad input taglen :: B.ByteString             , sealed /= out `B.append` tag                 || GCM.decrypt ctx iv aad sealed taglen /= Just input+            ]+                `shouldBe` []+    -- The tag decryptWithTag computes has to be the one encrypt appended, and+    -- the body it returns the one decrypt returns, over the same vectors.+    runTag name vs =+        it name $+            [ (key, iv)+            | (key, iv, aad, input, out, taglen, tag) <- vs+            , let ctx = throwCryptoError (GCM.newContext key)+            , let (body, tag') =+                    GCM.decryptWithTag ctx iv aad out taglen+                        :: (B.ByteString, AuthTag)+            , body /= input || tag' /= AuthTag (BA.convert tag)             ]                 `shouldBe` []     ctx16 = throwCryptoError (GCM.newContext (B.replicate 16 0x2b))

@@ -79,8 +79,42 @@             ECC.signExtendedDigestWith k key digest >>= \s -> pure $ ECC.sign_s (ECC.signature s) <= n `div` 2     pure $ propertyHold [eqTest "normalized" (Just True) check] +-- | The deterministic nonce of RFC 6979, against the implementation in+-- Crypto.PubKey.ECC.ECDSA, which is itself held to the vectors in the RFC by+-- tests/PubKey/ECDSASpec.hs.  Agreeing with it is agreeing with those.+propertyDeterministic+    :: HashAlgorithm hash => hash -> Curve -> ArbitraryBS0_2901 -> Gen Bool+propertyDeterministic hashAlg (Curve c curve _) (ArbitraryBS0_2901 msg) = do+    d <- arbitraryScalar curve+    let prx = Just c -- using Maybe as Proxy+        privECC = ECC.PrivateKey curve d+        privECDSA = throwCryptoError $ ECDSA.scalarFromInteger prx d+        pubECDSA = ECDSA.toPublic prx privECDSA+        digest = hashWith hashAlg msg+        kECC = ECC.deterministicNonce hashAlg privECC digest Just+        kECDSA =+            ECDSA.deterministicNonce prx hashAlg privECDSA digest Just+        sigECDSA = ECDSA.signDeterministic prx hashAlg privECDSA hashAlg msg+        sigWithK = fromJust $ ECDSA.signWith prx kECDSA privECDSA hashAlg msg+    pure $+        propertyHold+            [ eqTest "nonce" kECC (ECDSA.scalarToInteger prx kECDSA)+            , eqTest "signature matches signWith" sigWithK sigECDSA+            , eqTest+                "signature verifies"+                True+                (ECDSA.verify prx hashAlg pubECDSA sigECDSA msg)+            ]+ spec :: Spec spec = do+    modifyMaxSuccess (const 5) $+        describe "RFC 6979 deterministic nonce" $ do+            prop "SHA1" $ propertyDeterministic SHA1+            prop "SHA224" $ propertyDeterministic SHA224+            prop "SHA256" $ propertyDeterministic SHA256+            prop "SHA384" $ propertyDeterministic SHA384+            prop "SHA512" $ propertyDeterministic SHA512     modifyMaxSuccess (const 5) $         describe "verification" $ do             prop "SHA1" $ propertyECDSA SHA1

@@ -2,12 +2,14 @@  module StreamCipher.ChaChaPoly1305Spec where +import qualified Crypto.Cipher.ChaCha.Poly1305 as One import qualified Crypto.Cipher.ChaChaPoly1305 as CP import Crypto.Cipher.Types import Crypto.Error import Imports import MAC.Poly1305Spec () +import Data.Bits (xor) import qualified Data.ByteArray as B (convert) import qualified Data.ByteString as B @@ -129,6 +131,7 @@     it "nonce increment" runNonceInc     it "RFC8439 A5 enc" rfc8439encrypt     it "RFC8439 A5 dec" rfc8439decrypt+    oneShotTests   where     runEncrypt =         let ini =@@ -202,3 +205,60 @@                     B.convert . CP.incrementNonce $                         n10                 ]++-- | Crypto.Cipher.ChaCha.Poly1305 does a whole message in one call where+-- Crypto.Cipher.ChaChaPoly1305 does it in steps.  It has to answer exactly+-- what the steps answer, and what RFC 8439 prints.+oneShotTests :: Spec+oneShotTests = describe "Crypto.Cipher.ChaCha.Poly1305" $ do+    it "RFC 8439 2.8.2, twelve-byte nonce" $+        propertyHoldCase+            [ eqTest "ciphertext" ciphertext (B.take (B.length ciphertext) sealed)+            , eqTest "tag" tag (B.drop (B.length ciphertext) sealed)+            ]+    it "decrypt undoes encrypt" $+        One.decrypt ctx nonce12 aad sealed 16 `shouldBe` Just plaintext+    it "refuses a flipped bit in the ciphertext" $+        One.decrypt ctx nonce12 aad (flipHead sealed) 16+            `shouldBe` (Nothing :: Maybe B.ByteString)+    it "refuses a flipped bit in the tag" $+        One.decrypt ctx nonce12 aad (flipLast sealed) 16+            `shouldBe` (Nothing :: Maybe B.ByteString)+    it "refuses input shorter than the tag" $+        One.decrypt ctx nonce12 aad (B.replicate 8 0) 16+            `shouldBe` (Nothing :: Maybe B.ByteString)+    it "refuses a nonce that is not twelve bytes" $ do+        One.decrypt ctx (B.replicate 10 0) aad sealed 16+            `shouldBe` (Nothing :: Maybe B.ByteString)+        -- eight is the other ChaCha construction, not this AEAD+        One.decrypt ctx (B.replicate 8 0) aad sealed 16+            `shouldBe` (Nothing :: Maybe B.ByteString)+    it "decryptWithTag hands back the tag encrypt made" $+        case One.decryptWithTag ctx nonce12 aad (B.take (B.length ciphertext) sealed) 16 of+            CryptoFailed e -> expectationFailure (show e)+            CryptoPassed (body, t) ->+                propertyHoldCase+                    [ eqTest "plaintext" plaintext body+                    , eqTest "tag" (AuthTag (B.convert tag)) t+                    ]+    it "agrees with the step-at-a-time interface over a different message" $+        let msg = "another message, of a length that is not a multiple of 16" :: B.ByteString+            ad = "\x01\x02\x03" :: B.ByteString+            ini = CP.initialize (throwCryptoError $ CP.key key)+                                (throwCryptoError $ CP.nonce12 nonce12)+            afterAAD = CP.finalizeAAD (CP.appendAAD ad ini)+            (out, afterEnc) = CP.encrypt msg afterAAD+            t = CP.finalize afterEnc+            one = throwCryptoError (One.encrypt ctx nonce12 ad msg 16) :: B.ByteString+         in propertyHoldCase+                [ eqTest "ciphertext" out (B.take (B.length out) one)+                , eqTest "tag" (B.convert t :: B.ByteString) (B.drop (B.length out) one)+                ]+  where+    ctx = throwCryptoError (One.newContext key)+    -- the same nonce the step interface builds from constant and iv+    nonce12 = constant `B.append` iv+    sealed = throwCryptoError (One.encrypt ctx nonce12 aad plaintext 16) :: B.ByteString+    flipHead bs = B.cons (B.head bs `xor` 1) (B.tail bs)+    flipLast bs =+        B.snoc (B.init bs) (B.last bs `xor` 1)