diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,49 @@ # CHANGELOG for crypton +## 1.1.5 + +* fix(aead): reject undersized tags + [#80](https://github.com/kazu-yamamoto/crypton/pull/80) +* fix(aes): refuse a zero-length AES-GCM IV + [#79](https://github.com/kazu-yamamoto/crypton/pull/79) +* fix(p256): prevent crashes when validating valid points + [#78](https://github.com/kazu-yamamoto/crypton/pull/78) +* feat(asn1): add SHA-3 HashAlgorithmASN1 instances for PKCS#1 v1.5 + [#77](https://github.com/kazu-yamamoto/crypton/pull/77) +* OCB3 conformance + [#76](https://github.com/kazu-yamamoto/crypton/pull/76) + +## 1.1.4 + +* Generic instance for RSA PublicKey and PrivateKey + +## 1.1.3 + +* Ensure that `pointAdd` in `PubKey.ECC.P256` treats the point at infinity as the additive identity. + [#73](https://github.com/kazu-yamamoto/crypton/pull/73) + +## 1.1.2 + +* Preparing `ram` v0.22. +* Generalizing RSA encrypt/decrypt to manipulate ScrubbedBytes directly. + +## 1.1.1 + +* On iOS, ScrubbedBytes based hashing is used for seedNew. On other + plateforms, entropy is used directly as used to be. + [#71](https://github.com/kazu-yamamoto/crypton/pull/71) + +## 1.1.0 + +* Removing "basement" and "memory". + [#67](https://github.com/kazu-yamamoto/crypton/pull/67) + + +## 1.0.7 + +* Stop depending on basement, use upstream dependencies instead +* Stop transitively depending on basement by depending on ram. + ## 1.0.6 * Fix test failures on less common 64-bit arches. diff --git a/Crypto/Cipher/AES.hs b/Crypto/Cipher/AES.hs --- a/Crypto/Cipher/AES.hs +++ b/Crypto/Cipher/AES.hs @@ -55,7 +55,7 @@ ; cbcEncrypt (CSTR aes) (IV iv) = encryptCBC aes (IV iv) \ ; cbcDecrypt (CSTR aes) (IV iv) = decryptCBC aes (IV iv) \ ; ctrCombine (CSTR aes) (IV iv) = encryptCTR aes (IV iv) \ - ; aeadInit AEAD_GCM (CSTR aes) iv = CryptoPassed $ AEAD (gcmMode aes) (gcmInit aes iv) \ + ; aeadInit AEAD_GCM (CSTR aes) iv = gcmAeadInit aes iv \ ; aeadInit AEAD_OCB (CSTR aes) iv = CryptoPassed $ AEAD (ocbMode aes) (ocbInit aes iv) \ ; aeadInit (AEAD_CCM n m l) (CSTR aes) iv = AEAD (ccmMode aes) <$> ccmInit aes iv n m l \ ; aeadInit _ _ _ = CryptoFailed CryptoError_AEADModeNotSupported \ diff --git a/Crypto/Cipher/AES/Primitive.hs b/Crypto/Cipher/AES/Primitive.hs --- a/Crypto/Cipher/AES/Primitive.hs +++ b/Crypto/Cipher/AES/Primitive.hs @@ -42,10 +42,13 @@ -- * Incremental GCM gcmMode, gcmInit, + gcmAeadInit, -- * Incremental OCB ocbMode, + ocbModeWithTagLength, ocbInit, + ocbInitWithTagLength, -- * CCM ccmMode, @@ -82,7 +85,7 @@ cbcEncrypt = encryptCBC cbcDecrypt = decryptCBC ctrCombine = encryptCTR - aeadInit AEAD_GCM aes iv = CryptoPassed $ AEAD (gcmMode aes) (gcmInit aes iv) + aeadInit AEAD_GCM aes iv = gcmAeadInit aes iv aeadInit AEAD_OCB aes iv = CryptoPassed $ AEAD (ocbMode aes) (ocbInit aes iv) aeadInit (AEAD_CCM n m l) aes iv = AEAD (ccmMode aes) <$> ccmInit aes iv n m l aeadInit _ _ _ = CryptoFailed CryptoError_AEADModeNotSupported @@ -90,6 +93,15 @@ xtsEncrypt = encryptXTS xtsDecrypt = decryptXTS +-- | Create an AES AEAD context for GCM, refusing the zero-length IV that +-- SP 800-38D 5.2.1.1 forbids: any length other than 96 bits is fed to +-- GHASH, and for the empty IV that makes J0 the GHASH of the empty +-- string, which leaks the authentication key. +gcmAeadInit :: ByteArrayAccess iv => AES -> iv -> CryptoFailable (AEAD c) +gcmAeadInit aes iv + | B.length iv == 0 = CryptoFailed CryptoError_IvSizeInvalid + | otherwise = CryptoPassed $ AEAD (gcmMode aes) (gcmInit aes iv) + -- | Create an AES AEAD implementation for GCM gcmMode :: AES -> AEADModeImpl AESGCM gcmMode aes = @@ -110,6 +122,15 @@ , aeadImplFinalize = ocbFinish aes } +ocbModeWithTagLength :: AES -> Int -> AEADModeImpl AESOCB +ocbModeWithTagLength aes taglen = + AEADModeImpl + { aeadImplAppendHeader = ocbAppendAAD aes + , aeadImplEncrypt = ocbAppendEncrypt aes + , aeadImplDecrypt = ocbAppendDecrypt aes + , aeadImplFinalize = \ocb _ -> ocbFinish aes ocb taglen + } + -- | Create an AES AEAD implementation for CCM ccmMode :: AES -> AEADModeImpl AESCCM ccmMode aes = @@ -529,9 +550,36 @@ ocbInit ctx iv = unsafeDoIO $ do sm <- B.alloc sizeOCB $ \ocbStPtr -> withKeyAndIV ctx iv $ \k v -> - c_aes_ocb_init (castPtr ocbStPtr) k v (fromIntegral $ B.length iv) + c_aes_ocb_init + (castPtr ocbStPtr) + k + v + (fromIntegral $ B.length iv) + 16 return $ AESOCB sm +-- | initialize an OCB context with a fixed authentication tag length. +-- +-- The tag length is expressed in bytes and must be in [0..16]. +-- The IV length must be in [1..15] bytes per RFC 7253. +{-# NOINLINE ocbInitWithTagLength #-} +ocbInitWithTagLength :: ByteArrayAccess iv => AES -> iv -> Int -> CryptoFailable AESOCB +ocbInitWithTagLength ctx iv taglen + | taglen < 0 || taglen > 16 = CryptoFailed CryptoError_AuthenticationTagSizeInvalid + | ivlen < 1 || ivlen > 15 = CryptoFailed CryptoError_IvSizeInvalid + | otherwise = CryptoPassed $ unsafeDoIO $ do + sm <- B.alloc sizeOCB $ \ocbStPtr -> + withKeyAndIV ctx iv $ \k v -> + c_aes_ocb_init + (castPtr ocbStPtr) + k + v + (fromIntegral ivlen) + (fromIntegral taglen) + return $ AESOCB sm + where + ivlen = B.length iv + -- | append data which is going to just be authenticated to the OCB context. -- -- need to happen after initialization and before appending encryption/decryption data. @@ -722,7 +770,8 @@ c_aes_gcm_finish :: CString -> Ptr AESGCM -> Ptr AES -> IO () foreign import ccall "crypton_aes.h crypton_aes_ocb_init" - c_aes_ocb_init :: Ptr AESOCB -> Ptr AES -> Ptr Word8 -> CUInt -> IO () + c_aes_ocb_init + :: Ptr AESOCB -> Ptr AES -> Ptr Word8 -> CUInt -> CUInt -> IO () foreign import ccall "crypton_aes.h crypton_aes_ocb_aad" c_aes_ocb_aad :: Ptr AESOCB -> Ptr AES -> CString -> CUInt -> IO () diff --git a/Crypto/Cipher/AESGCMSIV.hs b/Crypto/Cipher/AESGCMSIV.hs --- a/Crypto/Cipher/AESGCMSIV.hs +++ b/Crypto/Cipher/AESGCMSIV.hs @@ -36,7 +36,7 @@ import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (peekElemOff, poke, pokeElemOff) -import Data.ByteArray +import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) import qualified Data.ByteArray as B import Data.Memory.Endian (toLE) import Data.Memory.PtrMethods (memXor) @@ -96,7 +96,7 @@ le32iv :: Word32 -> Nonce -> Bytes le32iv n (Nonce iv) = B.allocAndFreeze 16 $ \ptr -> do poke ptr (toLE n) - copyByteArrayToPtr iv (ptr `plusPtr` 4) + B.copyByteArrayToPtr iv (ptr `plusPtr` 4) deriveKeys :: BlockCipher128 aes => aes -> Nonce -> (ScrubbedBytes, AES) deriveKeys aes iv = @@ -109,7 +109,7 @@ in (mak, mek) _ -> error "AESGCMSIV: invalid cipher" where - idx n = ecbEncrypt aes (le32iv n iv) `takeView` 8 + idx n = ecbEncrypt aes (le32iv n iv) `B.takeView` 8 buildKey = B.concat . map idx -- Encryption and decryption @@ -152,7 +152,7 @@ decrypt aes iv aad ciphertext (AuthTag tag) | lengthInvalid aad = error "AESGCMSIV: aad is too large" | lengthInvalid ciphertext = error "AESGCMSIV: ciphertext is too large" - | tag `constEq` buildTag mek ss iv = Just plaintext + | tag `B.constEq` buildTag mek ss iv = Just plaintext | otherwise = Nothing where (mak, mek) = deriveKeys aes iv diff --git a/Crypto/Cipher/Twofish/Primitive.hs b/Crypto/Cipher/Twofish/Primitive.hs --- a/Crypto/Cipher/Twofish/Primitive.hs +++ b/Crypto/Cipher/Twofish/Primitive.hs @@ -16,6 +16,7 @@ import Data.Bits import Data.List (foldl') import Data.Word +import Prelude hiding (foldl') -- Based on the Golang referance implementation -- https://github.com/golang/crypto/blob/master/twofish/twofish.go diff --git a/Crypto/Cipher/Types/AEAD.hs b/Crypto/Cipher/Types/AEAD.hs --- a/Crypto/Cipher/Types/AEAD.hs +++ b/Crypto/Cipher/Types/AEAD.hs @@ -69,7 +69,22 @@ (output, aeadFinal) = aeadEncrypt aead input tag = aeadFinalize aeadFinal taglen +-- | The shortest authentication tag any mode here produces, four bytes +-- (@CCM_M4@). Modes that truncate their tag -- GCM and OCB3 -- will +-- compute one of whatever length they are asked for, down to nothing, so +-- 'aeadSimpleDecrypt' refuses a shorter tag than this rather than +-- authenticate fewer bytes than any supported mode ever emits. +minimumTagLength :: Int +minimumTagLength = 4 + -- | Simple AEAD decryptio. +-- +-- The number of bytes compared is the length of @authTag@. That is the +-- caller's choice of tag length, so a caller reading a tag off the wire +-- must check its length against the one it expects: passing an +-- attacker-supplied tag straight in lets the attacker pick how much of it +-- is verified. Tags shorter than 'minimumTagLength' are rejected +-- outright. aeadSimpleDecrypt :: (ByteArrayAccess aad, ByteArray ba) => AEAD a @@ -83,6 +98,7 @@ -> Maybe ba -- ^ Plaintext aeadSimpleDecrypt aeadIni header input authTag + | B.length authTag < minimumTagLength = Nothing | tag == authTag = Just output | otherwise = Nothing where diff --git a/Crypto/ConstructHash/MiyaguchiPreneel.hs b/Crypto/ConstructHash/MiyaguchiPreneel.hs --- a/Crypto/ConstructHash/MiyaguchiPreneel.hs +++ b/Crypto/ConstructHash/MiyaguchiPreneel.hs @@ -16,6 +16,7 @@ ) where import Data.List (foldl') +import Prelude hiding (foldl') import Crypto.Cipher.Types import Crypto.Data.Padding (Format (ZERO), pad) diff --git a/Crypto/Error/Types.hs b/Crypto/Error/Types.hs --- a/Crypto/Error/Types.hs +++ b/Crypto/Error/Types.hs @@ -22,8 +22,6 @@ import qualified Control.Exception as E import Data.Data -import Basement.Monad (MonadFailure (..)) - -- | Enumeration of all possible errors that can be found in this library data CryptoError = -- symmetric cipher errors @@ -86,10 +84,6 @@ case m1 of CryptoPassed a -> m2 a CryptoFailed e -> CryptoFailed e - -instance MonadFailure CryptoFailable where - type Failure CryptoFailable = CryptoError - mFail = CryptoFailed -- | Throw an CryptoError as exception on CryptoFailed result, -- otherwise return the computed value diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -47,18 +47,14 @@ module Crypto.Hash.Algorithms, ) where -import Basement.Block (Block, unsafeFreeze) -import Basement.Block.Mutable (copyFromPtr, new) -import Basement.Types.OffsetSize (CountOf (..)) import Crypto.Hash.Algorithms import Crypto.Hash.Types -import Crypto.Internal.ByteArray (ByteArrayAccess) +import Crypto.Internal.ByteArray (ByteArrayAccess, allocAndFreezePrim) import qualified Crypto.Internal.ByteArray as B -import Crypto.Internal.Compat (unsafeDoIO) import qualified Data.ByteString.Lazy as L import Data.Int (Int32) -import Data.Word (Word8) -import Foreign.Ptr (Ptr, plusPtr) +import qualified Foreign.Marshal.Utils as FMU +import Foreign.Ptr (Ptr, castPtr, plusPtr) -- | Hash a strict bytestring into a digest. hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a @@ -117,10 +113,11 @@ . HashAlgorithm a => Context a -> Digest a -hashFinalize !c = - Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do - ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig - return () +hashFinalize !c = Digest $ + allocAndFreezePrim (hashDigestSize (undefined :: a)) $ + \(dig :: Ptr (Digest a)) -> do + ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig + return () -- | Update the context with the first N bytes of a bytestring and return the -- digest. The code path is independent from N but much slower than a normal @@ -135,17 +132,18 @@ -> ba -> Int -> Digest a -hashFinalizePrefix !c b len = - Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do - ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> - B.withByteArray b $ \d -> - hashInternalFinalizePrefix - ctx - d - (fromIntegral $ B.length b) - (fromIntegral len) - dig - return () +hashFinalizePrefix !c b len = Digest $ + allocAndFreezePrim (hashDigestSize (undefined :: a)) $ + \(dig :: Ptr (Digest a)) -> do + ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> + B.withByteArray b $ \d -> + hashInternalFinalizePrefix + ctx + d + (fromIntegral $ B.length b) + (fromIntegral len) + dig + return () -- | Initialize a new context for a specified hash algorithm hashInitWith :: HashAlgorithm alg => alg -> Context alg @@ -171,13 +169,9 @@ from :: a -> ba -> Maybe (Digest a) from alg bs | B.length bs == (hashDigestSize alg) = - Just $ Digest $ unsafeDoIO $ copyBytes bs + Just $ Digest $ copyByteArray bs | otherwise = Nothing - copyBytes :: ba -> IO (Block Word8) - copyBytes ba = do - muArray <- new count - B.withByteArray ba $ \ptr -> copyFromPtr ptr muArray 0 count - unsafeFreeze muArray - where - count = CountOf (B.length ba) + copyByteArray ba = allocAndFreezePrim (B.length ba) $ \dst -> + B.withByteArray ba $ \src -> + FMU.copyBytes dst (castPtr src) (B.length ba) diff --git a/Crypto/Hash/IO.hs b/Crypto/Hash/IO.hs --- a/Crypto/Hash/IO.hs +++ b/Crypto/Hash/IO.hs @@ -20,6 +20,7 @@ ) where import Crypto.Hash.Types +import Crypto.Internal.ByteArray (allocAndFreezePrimIO) import qualified Crypto.Internal.ByteArray as B import Foreign.Ptr @@ -66,8 +67,10 @@ hashMutableFinalize :: forall a. HashAlgorithm a => MutableContext a -> IO (Digest a) hashMutableFinalize mc = do - b <- B.alloc (hashDigestSize (undefined :: a)) $ \dig -> B.withByteArray mc $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig - return $ Digest b + ba <- allocAndFreezePrimIO (hashDigestSize (undefined :: a)) $ + \(dig :: Ptr (Digest a)) -> + B.withByteArray mc $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig + return (Digest ba) -- | Reset the mutable context to the initial state of the hash hashMutableReset :: HashAlgorithm a => MutableContext a -> IO () diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs --- a/Crypto/Hash/Types.hs +++ b/Crypto/Hash/Types.hs @@ -20,17 +20,28 @@ Digest (..), ) where -import Basement.Block (Block, unsafeFreeze) -import Basement.Block.Mutable (MutableBlock, new, unsafeWrite) -import Basement.NormalForm (deepseq) -import Basement.Types.OffsetSize (CountOf (..), Offset (..)) +import Control.DeepSeq (deepseq) +import Control.Monad.Primitive (PrimMonad (..)) import Control.Monad.ST -import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes) +import Crypto.Internal.ByteArray (ByteArrayAccess (..), Bytes) import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.Imports +import Data.Base16.Types (extractBase16) +import Data.ByteString (ByteString) +import Data.ByteString.Base16 (encodeBase16) import Data.Char (digitToInt, isHexDigit) import Data.Data (Data) -import Foreign.Ptr (Ptr) +import Data.Primitive.ByteArray ( + ByteArray, + MutableByteArray, + newPinnedByteArray, + sizeofByteArray, + unsafeFreezeByteArray, + withByteArrayContents, + writeByteArray, + ) +import qualified Data.Text as Text +import Foreign.Ptr (Ptr, castPtr) import GHC.TypeLits (Nat) -- | Class representing hashing algorithms. @@ -98,40 +109,49 @@ -- | Represent a digest for a given hash algorithm. -- -- This type is an instance of 'ByteArrayAccess' from package --- . +-- . -- Module "Data.ByteArray" provides many primitives to work with those values -- including conversion to other types. -- -- Creating a digest from a bytearray is also possible with function -- 'Crypto.Hash.digestFromByteString'. -newtype Digest a = Digest (Block Word8) - deriving (Eq, Ord, ByteArrayAccess, Data) +newtype Digest a = Digest ByteArray + deriving (Eq, Ord, Data) type role Digest nominal instance NFData (Digest a) where rnf (Digest u) = u `deepseq` () +instance ByteArrayAccess (Digest a) where + length (Digest ba) = sizeofByteArray ba + withByteArray (Digest ba) f = withByteArrayContents ba (f . castPtr) + instance Show (Digest a) where - show (Digest bs) = - map (toEnum . fromIntegral) $ - B.unpack (B.convertToBase B.Base16 bs :: Bytes) + show d = + Text.unpack (extractBase16 $ encodeBase16 (B.convert d :: ByteString)) instance HashAlgorithm a => Read (Digest a) where readsPrec _ str = runST $ do - mut <- new (CountOf len) - loop mut len str + mut <- newPinnedByteArray len + loop len mut len str where len = hashDigestSize (undefined :: a) - loop :: MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)] - loop mut 0 cs = (\b -> [(Digest b, cs)]) <$> unsafeFreeze mut - loop _ _ [] = return [] - loop _ _ [_] = return [] - loop mut n (c : (d : ds)) - | not (isHexDigit c) = return [] - | not (isHexDigit d) = return [] - | otherwise = do - let w8 = fromIntegral $ digitToInt c * 16 + digitToInt d - unsafeWrite mut (Offset $ len - n) w8 - loop mut (n - 1) ds +loop + :: Int + -> MutableByteArray (PrimState (ST s)) + -> Int + -> String + -> ST s [(Digest a, String)] +loop _ mut 0 cs = (\b -> [(Digest b, cs)]) <$> unsafeFreezeByteArray mut +loop _ _ _ [] = return [] +loop _ _ _ [_] = return [] +loop len mut n (c : (d : ds)) + | not (isHexDigit c) = return [] + | not (isHexDigit d) = return [] + | otherwise = do + let w8 :: Word8 + w8 = fromIntegral $ digitToInt c * 16 + digitToInt d + writeByteArray mut (len - n) w8 + loop len mut (n - 1) ds diff --git a/Crypto/Internal/ByteArray.hs b/Crypto/Internal/ByteArray.hs --- a/Crypto/Internal/ByteArray.hs +++ b/Crypto/Internal/ByteArray.hs @@ -14,6 +14,8 @@ module Data.ByteArray.Mapping, module Data.ByteArray.Encoding, constAllZero, + allocAndFreezePrimIO, + allocAndFreezePrim, ) where import Data.ByteArray @@ -21,11 +23,26 @@ import Data.ByteArray.Mapping import Data.Bits ((.|.)) +import qualified Data.Primitive.ByteArray as Prim import Data.Word (Word8) -import Foreign.Ptr (Ptr) +import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (peekByteOff) import Crypto.Internal.Compat (unsafeDoIO) + +-- | Allocate a pinned 'Prim.ByteArray' of the given size, populate it via a +-- 'Ptr', then freeze and return it. The pointer must not be retained after +-- the action returns. +allocAndFreezePrimIO :: Int -> (Ptr p -> IO ()) -> IO Prim.ByteArray +allocAndFreezePrimIO n f = do + mba <- Prim.newPinnedByteArray n + f (castPtr (Prim.mutableByteArrayContents mba)) + Prim.unsafeFreezeByteArray mba + +-- | The allocation is strictly local, +-- the computation is deterministic, and no IO effects escape. +allocAndFreezePrim :: Int -> (Ptr p -> IO ()) -> Prim.ByteArray +allocAndFreezePrim n = unsafeDoIO . allocAndFreezePrimIO n constAllZero :: ByteArrayAccess ba => ba -> Bool constAllZero b = unsafeDoIO $ withByteArray b $ \p -> loop p 0 0 diff --git a/Crypto/KDF/BCryptPBKDF.hs b/Crypto/KDF/BCryptPBKDF.hs --- a/Crypto/KDF/BCryptPBKDF.hs +++ b/Crypto/KDF/BCryptPBKDF.hs @@ -13,12 +13,7 @@ ) where -import Basement.Block (MutableBlock) -import qualified Basement.Block as Block -import qualified Basement.Block.Mutable as Block -import Basement.Monad (PrimState) -import Basement.Types.OffsetSize (CountOf (..), Offset (..)) -import Control.Exception (finally) +import qualified Control.Exception as E import Control.Monad (when) import qualified Crypto.Cipher.Blowfish.Box as Blowfish import qualified Crypto.Cipher.Blowfish.Primitive as Blowfish @@ -34,9 +29,11 @@ import Crypto.Internal.Compat (unsafeDoIO) import Data.Bits import qualified Data.ByteArray as B +import qualified Data.ByteString.Internal as BSI import Data.Foldable (forM_) import Data.Memory.PtrMethods (memCopy, memSet, memXor) import Data.Word +import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrBytes, withForeignPtr) import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (peekByteOff, pokeByteOff) @@ -76,60 +73,60 @@ deriveKey :: Ptr Word8 -> IO () deriveKey keyPtr = do - -- Allocate all necessary memory. The algorihm shall not allocate - -- any more dynamic memory after this point. Blocks need to be pinned - -- as pointers to them are passed to the SHA512 implementation. + -- Allocate all necessary memory. The algorithm shall not allocate + -- any more dynamic memory after this point. ForeignPtrs allocate + -- pinned memory, so raw pointers to them are stable. ksClean <- Blowfish.createKeySchedule ksDirty <- Blowfish.createKeySchedule - ctxMBlock <- Block.newPinned (CountOf ctxLen :: CountOf Word8) - outMBlock <- Block.newPinned (CountOf outLen :: CountOf Word8) - tmpMBlock <- Block.newPinned (CountOf tmpLen :: CountOf Word8) - blkMBlock <- Block.newPinned (CountOf blkLen :: CountOf Word8) - passHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8) - saltHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8) + ctxFP <- mallocForeignPtrBytes ctxLen :: IO (ForeignPtr Word8) + outFP <- mallocForeignPtrBytes outLen :: IO (ForeignPtr Word8) + tmpFP <- mallocForeignPtrBytes tmpLen :: IO (ForeignPtr Word8) + blkFP <- mallocForeignPtrBytes blkLen :: IO (ForeignPtr Word8) + passHashFP <- mallocForeignPtrBytes hashLen :: IO (ForeignPtr Word8) + saltHashFP <- mallocForeignPtrBytes hashLen :: IO (ForeignPtr Word8) -- Finally erase all memory areas that contain information from -- which the derived key could be reconstructed. - -- As all MutableBlocks are pinned it shall be guaranteed that - -- no temporary trampoline buffers are allocated. - finallyErase outMBlock $ - finallyErase passHashMBlock $ + finallyErase outFP outLen $ + finallyErase passHashFP hashLen $ B.withByteArray pass $ \passPtr -> B.withByteArray salt $ \saltPtr -> - Block.withMutablePtr ctxMBlock $ \ctxPtr -> - Block.withMutablePtr outMBlock $ \outPtr -> - Block.withMutablePtr tmpMBlock $ \tmpPtr -> - Block.withMutablePtr blkMBlock $ \blkPtr -> - Block.withMutablePtr passHashMBlock $ \passHashPtr -> - Block.withMutablePtr saltHashMBlock $ \saltHashPtr -> do + withForeignPtr ctxFP $ \ctxPtr' -> + withForeignPtr outFP $ \outPtr -> + withForeignPtr tmpFP $ \tmpPtr -> + withForeignPtr blkFP $ \blkPtr -> + withForeignPtr passHashFP $ \passHashPtr -> + withForeignPtr saltHashFP $ \saltHashPtr -> do -- Hash the password. - let shaPtr = castPtr ctxPtr :: Ptr (Context SHA512) + let shaPtr = castPtr ctxPtr' :: Ptr (Context SHA512) hashInternalInit shaPtr hashInternalUpdate shaPtr passPtr (fromIntegral passLen) hashInternalFinalize shaPtr (castPtr passHashPtr) - passHashBlock <- Block.unsafeFreeze passHashMBlock + -- Create a stable ByteString view of the password hash + -- (passHashFP is not modified after this point). + let passHashBS = BSI.fromForeignPtr passHashFP 0 hashLen forM_ [1 .. blocks] $ \block -> do -- Poke the increased block counter. - Block.unsafeWrite blkMBlock 0 (fromIntegral $ block `shiftR` 24) - Block.unsafeWrite blkMBlock 1 (fromIntegral $ block `shiftR` 16) - Block.unsafeWrite blkMBlock 2 (fromIntegral $ block `shiftR` 8) - Block.unsafeWrite blkMBlock 3 (fromIntegral $ block `shiftR` 0) + pokeByteOff blkPtr 0 (fromIntegral (block `shiftR` 24) :: Word8) + pokeByteOff blkPtr 1 (fromIntegral (block `shiftR` 16) :: Word8) + pokeByteOff blkPtr 2 (fromIntegral (block `shiftR` 8) :: Word8) + pokeByteOff blkPtr 3 (fromIntegral (block `shiftR` 0 :: Int) :: Word8) -- First round (slightly different). hashInternalInit shaPtr hashInternalUpdate shaPtr saltPtr (fromIntegral saltLen) hashInternalUpdate shaPtr blkPtr (fromIntegral blkLen) hashInternalFinalize shaPtr (castPtr saltHashPtr) - Block.unsafeFreeze saltHashMBlock >>= \x -> do - Blowfish.copyKeySchedule ksDirty ksClean - hashInternalMutable ksDirty passHashBlock x tmpMBlock + let saltHashBS = BSI.fromForeignPtr saltHashFP 0 hashLen + Blowfish.copyKeySchedule ksDirty ksClean + hashInternalMutable ksDirty passHashBS saltHashBS tmpPtr memCopy outPtr tmpPtr outLen -- Remaining rounds. forM_ [2 .. iterCounts params] $ const $ do hashInternalInit shaPtr hashInternalUpdate shaPtr tmpPtr (fromIntegral tmpLen) hashInternalFinalize shaPtr (castPtr saltHashPtr) - Block.unsafeFreeze saltHashMBlock >>= \x -> do - Blowfish.copyKeySchedule ksDirty ksClean - hashInternalMutable ksDirty passHashBlock x tmpMBlock + let saltHashBS2 = BSI.fromForeignPtr saltHashFP 0 hashLen + Blowfish.copyKeySchedule ksDirty ksClean + hashInternalMutable ksDirty passHashBS saltHashBS2 tmpPtr memXor outPtr outPtr tmpPtr outLen -- Spread the current out buffer evenly over the key buffer. -- After both loops have run every byte of the key buffer @@ -154,18 +151,16 @@ | B.length saltHash /= 64 = error "saltHash must be 512 bits" | otherwise = unsafeDoIO $ do ks0 <- Blowfish.createKeySchedule - outMBlock <- Block.newPinned 32 - hashInternalMutable ks0 passHash saltHash outMBlock - B.convert `fmap` Block.freeze outMBlock + B.alloc 32 $ \outPtr -> hashInternalMutable ks0 passHash saltHash outPtr hashInternalMutable :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt) => Blowfish.KeySchedule -> pass -> salt - -> MutableBlock Word8 (PrimState IO) + -> Ptr Word8 -> IO () -hashInternalMutable bfks passHash saltHash outMBlock = do +hashInternalMutable bfks passHash saltHash outPtr = do Blowfish.expandKeyWithSalt bfks passHash saltHash forM_ [0 .. 63 :: Int] $ const $ do Blowfish.expandKey bfks saltHash @@ -176,22 +171,20 @@ store 16 =<< cipher 64 0x6669736853776174 store 24 =<< cipher 64 0x44796e616d697465 where - store :: Offset Word8 -> Word64 -> IO () + store :: Int -> Word64 -> IO () store o w64 = do - Block.unsafeWrite outMBlock (o + 0) (fromIntegral $ w64 `shiftR` 32) - Block.unsafeWrite outMBlock (o + 1) (fromIntegral $ w64 `shiftR` 40) - Block.unsafeWrite outMBlock (o + 2) (fromIntegral $ w64 `shiftR` 48) - Block.unsafeWrite outMBlock (o + 3) (fromIntegral $ w64 `shiftR` 56) - Block.unsafeWrite outMBlock (o + 4) (fromIntegral $ w64 `shiftR` 0) - Block.unsafeWrite outMBlock (o + 5) (fromIntegral $ w64 `shiftR` 8) - Block.unsafeWrite outMBlock (o + 6) (fromIntegral $ w64 `shiftR` 16) - Block.unsafeWrite outMBlock (o + 7) (fromIntegral $ w64 `shiftR` 24) + pokeByteOff outPtr (o + 0) (fromIntegral (w64 `shiftR` 32) :: Word8) + pokeByteOff outPtr (o + 1) (fromIntegral (w64 `shiftR` 40) :: Word8) + pokeByteOff outPtr (o + 2) (fromIntegral (w64 `shiftR` 48) :: Word8) + pokeByteOff outPtr (o + 3) (fromIntegral (w64 `shiftR` 56) :: Word8) + pokeByteOff outPtr (o + 4) (fromIntegral (w64 `shiftR` 0) :: Word8) + pokeByteOff outPtr (o + 5) (fromIntegral (w64 `shiftR` 8) :: Word8) + pokeByteOff outPtr (o + 6) (fromIntegral (w64 `shiftR` 16) :: Word8) + pokeByteOff outPtr (o + 7) (fromIntegral (w64 `shiftR` 24) :: Word8) cipher :: Int -> Word64 -> IO Word64 cipher 0 block = return block cipher i block = Blowfish.cipherBlockMutable bfks block >>= cipher (i - 1) -finallyErase :: MutableBlock Word8 (PrimState IO) -> IO () -> IO () -finallyErase mblock action = - action `finally` Block.withMutablePtr mblock (\ptr -> memSet ptr 0 len) - where - CountOf len = Block.mutableLengthBytes mblock +finallyErase :: ForeignPtr Word8 -> Int -> IO () -> IO () +finallyErase fp len action = + action `E.finally` withForeignPtr fp (\ptr -> memSet ptr 0 len) diff --git a/Crypto/MAC/CMAC.hs b/Crypto/MAC/CMAC.hs --- a/Crypto/MAC/CMAC.hs +++ b/Crypto/MAC/CMAC.hs @@ -19,6 +19,7 @@ import Data.Bits (setBit, shiftL, testBit) import Data.List (foldl') import Data.Word +import Prelude hiding (foldl') import Crypto.Cipher.Types import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, Bytes) diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs --- a/Crypto/MAC/KMAC.hs +++ b/Crypto/MAC/KMAC.hs @@ -29,6 +29,7 @@ import Crypto.Hash.Types (Digest (..), HashAlgorithm (..)) import qualified Crypto.Hash.Types as H import Crypto.Internal.Builder +import Crypto.Internal.ByteArray (allocAndFreezePrim) import Crypto.Internal.Imports import Data.Bits (shiftR) import Data.ByteArray (ByteArrayAccess) @@ -69,13 +70,14 @@ :: forall a suffix . (HashSHAKE a, ByteArrayAccess suffix) => H.Context a -> suffix -> Digest a -cshakeFinalize !c s = - Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \dig -> do - ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (H.Context a)) -> do - B.withByteArray s $ \d -> - hashInternalUpdate ctx d (fromIntegral $ B.length s) - cshakeInternalFinalize ctx dig - return () +cshakeFinalize !c s = Digest $ + allocAndFreezePrim (hashDigestSize (undefined :: a)) $ + \(dig :: Ptr (Digest a)) -> do + ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (H.Context a)) -> do + B.withByteArray s $ \d -> + hashInternalUpdate ctx d (fromIntegral $ B.length s) + cshakeInternalFinalize ctx dig + return () -- KMAC diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -26,6 +26,7 @@ import Crypto.Number.Basic import Data.Bits (setBit, shift, testBit, unsafeShiftR, xor) import Data.List (foldl') +import Prelude hiding (foldl') -- | Binary Polynomial represented by an integer type BinaryPolynomial = Integer diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -21,7 +21,7 @@ squareRoot, ) where -import Control.Exception (Exception, throw) +import qualified Control.Exception as E import Crypto.Number.Basic import Crypto.Number.Compat @@ -29,7 +29,7 @@ data CoprimesAssertionError = CoprimesAssertionError deriving (Show) -instance Exception CoprimesAssertionError +instance E.Exception CoprimesAssertionError -- | Compute the modular exponentiation of base^exponent using -- algorithms design to avoid side channels and timing measurement @@ -109,7 +109,7 @@ inverseCoprimes :: Integer -> Integer -> Integer inverseCoprimes g m = case inverse g m of - Nothing -> throw CoprimesAssertionError + Nothing -> E.throw CoprimesAssertionError Just i -> i -- | Computes the Jacobi symbol (a/n). @@ -148,7 +148,7 @@ data ModulusAssertionError = ModulusAssertionError deriving (Show) -instance Exception ModulusAssertionError +instance E.Exception ModulusAssertionError -- | Modular square root of @g@ modulo a prime @p@. -- @@ -159,7 +159,7 @@ -- parameters only. squareRoot :: Integer -> Integer -> Maybe Integer squareRoot p - | p < 2 = throw ModulusAssertionError + | p < 2 = E.throw ModulusAssertionError | otherwise = case p `divMod` 8 of (v, 3) -> method1 (2 * v + 1) @@ -167,7 +167,7 @@ (u, 5) -> method2 u (_, 1) -> tonelliShanks p (0, 2) -> \a -> Just (if even a then 0 else 1) - _ -> throw ModulusAssertionError + _ -> E.throw ModulusAssertionError where x `eqMod` y = (x - y) `mod` p == 0 @@ -202,7 +202,7 @@ (expFast aa s p) (expFast n s p) e - | otherwise -> throw ModulusAssertionError + | otherwise -> E.throw ModulusAssertionError where aa = a `mod` p p1 = p - 1 diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -110,9 +110,12 @@ -- | Add a point to another point pointAdd :: Point -> Point -> Point -pointAdd a b = withNewPoint $ \dx dy -> - withPoint a $ \ax ay -> withPoint b $ \bx by -> - ccrypton_p256e_point_add ax ay bx by dx dy +pointAdd a b + | pointIsAtInfinity a = b + | pointIsAtInfinity b = a + | otherwise = withNewPoint $ \dx dy -> + withPoint a $ \ax ay -> withPoint b $ \bx by -> + ccrypton_p256e_point_add ax ay bx by dx dy -- | Negate a point pointNegate :: Point -> Point diff --git a/Crypto/PubKey/ECDSA.hs b/Crypto/PubKey/ECDSA.hs --- a/Crypto/PubKey/ECDSA.hs +++ b/Crypto/PubKey/ECDSA.hs @@ -56,7 +56,6 @@ import qualified Crypto.ECC.Simple.Types as Simple import Crypto.Error import Crypto.Hash -import Crypto.Hash.Types import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) import Crypto.Internal.Imports import Crypto.Number.ModArithmetic (inverseFermat) @@ -261,8 +260,9 @@ tHashDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash) => proxy curve -> Digest hash -> Scalar curve -tHashDigest prx (Digest digest) = throwCryptoError $ decodeScalar prx encoded +tHashDigest prx dig = throwCryptoError $ decodeScalar prx encoded where + digest = B.convert dig :: B.Bytes m = curveOrderBits prx d = m - B.length digest * 8 (n, r) = m `divMod` 8 diff --git a/Crypto/PubKey/Internal.hs b/Crypto/PubKey/Internal.hs --- a/Crypto/PubKey/Internal.hs +++ b/Crypto/PubKey/Internal.hs @@ -13,6 +13,7 @@ import Data.Bits (shiftR) import Data.List (foldl') +import Prelude hiding (foldl') import Crypto.Hash import Crypto.Internal.ByteArray (ByteArrayAccess) 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 @@ -247,6 +247,90 @@ , 0x04 , 0x20 ] +instance HashAlgorithmASN1 SHA3_224 where + hashDigestASN1 = + addDigestPrefix + [ 0x30 + , 0x2b + , 0x30 + , 0x0b + , 0x06 + , 0x09 + , 0x60 + , 0x86 + , 0x48 + , 0x01 + , 0x65 + , 0x03 + , 0x04 + , 0x02 + , 0x07 + , 0x04 + , 0x1c + ] +instance HashAlgorithmASN1 SHA3_256 where + hashDigestASN1 = + addDigestPrefix + [ 0x30 + , 0x2f + , 0x30 + , 0x0b + , 0x06 + , 0x09 + , 0x60 + , 0x86 + , 0x48 + , 0x01 + , 0x65 + , 0x03 + , 0x04 + , 0x02 + , 0x08 + , 0x04 + , 0x20 + ] +instance HashAlgorithmASN1 SHA3_384 where + hashDigestASN1 = + addDigestPrefix + [ 0x30 + , 0x3f + , 0x30 + , 0x0b + , 0x06 + , 0x09 + , 0x60 + , 0x86 + , 0x48 + , 0x01 + , 0x65 + , 0x03 + , 0x04 + , 0x02 + , 0x09 + , 0x04 + , 0x30 + ] +instance HashAlgorithmASN1 SHA3_512 where + hashDigestASN1 = + addDigestPrefix + [ 0x30 + , 0x4f + , 0x30 + , 0x0b + , 0x06 + , 0x09 + , 0x60 + , 0x86 + , 0x48 + , 0x01 + , 0x65 + , 0x03 + , 0x04 + , 0x02 + , 0x0a + , 0x04 + , 0x40 + ] instance HashAlgorithmASN1 RIPEMD160 where hashDigestASN1 = addDigestPrefix @@ -283,7 +367,7 @@ -- Start Sequence -- ,Start Sequence -- ,OID oid --- ,Null +-- ,optional parameters (Null for SHA-2, absent for SHA-3) -- ,End Sequence -- ,OctetString digest -- ,End Sequence @@ -347,25 +431,27 @@ -- -- The message is returned un-padded. decrypt - :: Maybe Blinder + :: ByteArray ba + => Maybe Blinder -- ^ optional blinder -> PrivateKey -- ^ RSA private key -> ByteString -- ^ cipher text - -> Either Error ByteString + -> Either Error ba decrypt blinder pk c | B.length c /= (private_size pk) = Left MessageSizeIncorrect - | otherwise = unpad $ dp blinder pk c + -- "convert" must be apply to "c". + | otherwise = unpad $ dp blinder pk $ B.convert c -- | decrypt message using the private key and by automatically generating a blinder. decryptSafer - :: MonadRandom m + :: (MonadRandom m, ByteArray ba) => PrivateKey -- ^ RSA private key -> ByteString -- ^ cipher text - -> m (Either Error ByteString) + -> m (Either Error ba) decryptSafer pk b = do blinder <- generateBlinder (private_n pk) return (decrypt (Just blinder) pk b) @@ -375,12 +461,12 @@ -- The message needs to be smaller than the key size - 11. -- The message should not be padded. encrypt - :: MonadRandom m => PublicKey -> ByteString -> m (Either Error ByteString) + :: (MonadRandom m, ByteArray ba) => PublicKey -> ba -> m (Either Error ByteString) encrypt pk m = do r <- pad (public_size pk) m case r of Left err -> return $ Left err - Right em -> return $ Right (ep pk em) + Right em -> return $ Right (B.convert $ ep pk em) -- | sign message using private key, a hash and its ASN1 description -- diff --git a/Crypto/PubKey/RSA/Types.hs b/Crypto/PubKey/RSA/Types.hs --- a/Crypto/PubKey/RSA/Types.hs +++ b/Crypto/PubKey/RSA/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | @@ -23,6 +24,8 @@ import Crypto.Internal.Imports import Data.Data +import GHC.Generics + -- | Blinder which is used to obfuscate the timing -- of the decryption primitive (used by decryption and signing). data Blinder = Blinder !Integer !Integer @@ -51,7 +54,7 @@ , public_e :: Integer -- ^ public exponent e } - deriving (Show, Read, Eq, Data) + deriving (Show, Read, Eq, Data, Generic) instance NFData PublicKey where rnf (PublicKey sz n e) = rnf n `seq` rnf e `seq` sz `seq` () @@ -81,7 +84,7 @@ , private_qinv :: Integer -- ^ q^(-1) mod p } - deriving (Show, Read, Eq, Data) + deriving (Show, Read, Eq, Data, Generic) instance NFData PrivateKey where rnf (PrivateKey pub d p q dp dq qinv) = diff --git a/Crypto/Random.hs b/Crypto/Random.hs --- a/Crypto/Random.hs +++ b/Crypto/Random.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | @@ -33,7 +34,6 @@ ) where import Crypto.Error -import Crypto.Hash (Digest, SHA512, hash) import Crypto.Internal.Imports import Crypto.Random.ChaChaDRG import Crypto.Random.SystemDRG @@ -43,6 +43,13 @@ import qualified Crypto.Number.Serialize as Serialize +#ifdef INSECURE_ENTROPY +import Crypto.Hash (SHA512, Context) +import Crypto.Hash.IO +import Data.Memory.PtrMethods (memSet) +import Foreign.Ptr (Ptr, castPtr) +#endif + newtype Seed = Seed ScrubbedBytes deriving (ByteArrayAccess) @@ -52,15 +59,29 @@ -- | Create a new Seed from system entropy seedNew :: MonadRandom randomly => randomly Seed + +#ifdef INSECURE_ENTROPY -- The degree of its randomness depends on the source, e.g. for iOS we -- have to compile with DoNotUseEntropy flag, as iOS doesn't allow -- using getentropy, and on some other systems it can be also -- potentially comprisable sources. Hashing of entropy before using -- it as a seed is a common mitigation for attacks via RNG/entropy -- source. -seedNew = - (Seed . B.take seedLength . B.convert . (hash :: ScrubbedBytes -> Digest SHA512)) - `fmap` getRandomBytes 64 +seedNew = (Seed . scrubbedHash512) `fmap` getRandomBytes 64 + +scrubbedHash512 :: ScrubbedBytes -> ScrubbedBytes +scrubbedHash512 = B.take seedLength . hash512 + where + hash512 ba = B.unsafeCreate (hashDigestSize (undefined :: SHA512)) $ hashIO ba + hashIO ba ptr = do + ctx <- hashMutableInit + hashMutableUpdate (ctx :: MutableContext SHA512) ba + B.withByteArray ctx $ \pctx -> do + hashInternalFinalize (castPtr pctx :: Ptr (Context SHA512)) ptr + memSet pctx 0 $ hashInternalContextSize (undefined :: SHA512) +#else +seedNew = Seed `fmap` getRandomBytes seedLength +#endif -- | Convert a Seed to an integer seedToInteger :: Seed -> Integer diff --git a/Crypto/Random/Entropy/Unix.hs b/Crypto/Random/Entropy/Unix.hs --- a/Crypto/Random/Entropy/Unix.hs +++ b/Crypto/Random/Entropy/Unix.hs @@ -11,10 +11,11 @@ DevURandom, ) where -import Control.Exception as E +import qualified Control.Exception as E import Crypto.Random.Entropy.Source import Data.Word (Word8) import Foreign.Ptr +import qualified System.IO.Error as E -- import System.Posix.Types (Fd) import System.IO @@ -49,7 +50,7 @@ openDev :: String -> IO (Maybe H) openDev filepath = - (Just `fmap` openAndNoBuffering) `E.catch` \(_ :: IOException) -> return Nothing + (Just `fmap` openAndNoBuffering) `E.catchIOError` \_ -> return Nothing where openAndNoBuffering = do h <- openBinaryFile filepath ReadMode @@ -64,14 +65,14 @@ Just fd -> f fd `E.finally` closeDev fd closeDev :: H -> IO () -closeDev h = hClose h `E.catch` \(_ :: IOException) -> return () +closeDev h = hClose h `E.catchIOError` \_ -> return () gatherDevEntropy :: H -> Ptr Word8 -> Int -> IO Int gatherDevEntropy h ptr sz = (fromIntegral `fmap` hGetBufSome h ptr (fromIntegral sz)) - `E.catch` \(_ :: IOException) -> return 0 + `E.catchIOError` \_ -> return 0 gatherDevEntropyNonBlock :: H -> Ptr Word8 -> Int -> IO Int gatherDevEntropyNonBlock h ptr sz = (fromIntegral `fmap` hGetBufNonBlocking h ptr (fromIntegral sz)) - `E.catch` \(_ :: IOException) -> return 0 + `E.catchIOError` \_ -> return 0 diff --git a/Crypto/Tutorial.hs b/Crypto/Tutorial.hs --- a/Crypto/Tutorial.hs +++ b/Crypto/Tutorial.hs @@ -16,7 +16,7 @@ -- $api_design -- -- APIs in crypton are often based on type classes from package --- , notably +-- , notably -- 'Data.ByteArray.ByteArrayAccess' and 'Data.ByteArray.ByteArray'. -- Module "Data.ByteArray" provides many primitives that are useful to -- work with crypton types. For example function 'Data.ByteArray.convert' diff --git a/cbits/crypton_aes.c b/cbits/crypton_aes.c --- a/cbits/crypton_aes.c +++ b/cbits/crypton_aes.c @@ -655,7 +655,7 @@ #undef L_CACHED } -void crypton_aes_ocb_init(aes_ocb *ocb, aes_key *key, uint8_t *iv, uint32_t len) +void crypton_aes_ocb_init(aes_ocb *ocb, aes_key *key, uint8_t *iv, uint32_t len, uint32_t taglen) { block128 tmp, nonce, ktop; unsigned char stretch[24]; @@ -665,6 +665,9 @@ if (len > 15) { len = 15; } + if (taglen > 16) { + taglen = 16; + } /* create L*, and L$,L0,L1,L2,L3 */ block128_zero(&tmp); @@ -678,9 +681,11 @@ /* create strech from the nonce */ block128_zero(&nonce); - memcpy(nonce.b + 4, iv, 12); - nonce.b[0] = (unsigned char)(((16 * 8) % 128) << 1); - nonce.b[16-12-1] |= 0x01; + if (len > 0) { + memcpy(nonce.b + (16 - len), iv, len); + nonce.b[16 - len - 1] |= 0x01; + } + nonce.b[0] |= (unsigned char)(((taglen * 8) % 128) << 1); bottom = nonce.b[15] & 0x3F; nonce.b[15] &= 0xC0; crypton_aes_encrypt_block(&ktop, key, &nonce); diff --git a/cbits/crypton_aes.h b/cbits/crypton_aes.h --- a/cbits/crypton_aes.h +++ b/cbits/crypton_aes.h @@ -109,7 +109,7 @@ void crypton_aes_gcm_decrypt(uint8_t *output, aes_gcm *gcm, aes_key *key, uint8_t *input, uint32_t length); void crypton_aes_gcm_finish(uint8_t *tag, aes_gcm *gcm, aes_key *key); -void crypton_aes_ocb_init(aes_ocb *ocb, aes_key *key, uint8_t *iv, uint32_t len); +void crypton_aes_ocb_init(aes_ocb *ocb, aes_key *key, uint8_t *iv, uint32_t len, uint32_t taglen); void crypton_aes_ocb_aad(aes_ocb *ocb, aes_key *key, uint8_t *input, uint32_t length); void crypton_aes_ocb_encrypt(uint8_t *output, aes_ocb *ocb, aes_key *key, uint8_t *input, uint32_t length); void crypton_aes_ocb_decrypt(uint8_t *output, aes_ocb *ocb, aes_key *key, uint8_t *input, uint32_t length); diff --git a/cbits/p256/p256.c b/cbits/p256/p256.c --- a/cbits/p256/p256.c +++ b/cbits/p256/p256.c @@ -104,7 +104,9 @@ borrow += top_c; borrow -= top_a; top_c = (crypton_p256_digit)borrow; - assert((borrow >> P256_BITSPERDIGIT) == 0); + /* A borrow out is a legitimate outcome: the quotient estimate in + crypton_p256_modmul can exceed the true quotient by one. Report it in + the returned top digit (all ones) and let the caller correct. */ return top_c; } @@ -177,6 +179,13 @@ // Subtract reducer from top | tmp. top = subTop(top_reducer, reducer, top, tmp + i); + + // The quotient estimate above can exceed the true quotient by one -- + // with 64-bit digits, whenever the low half of top is zero and the + // digits below it are small -- and the subtraction then borrows. The + // deficit is always less than MOD, so adding MOD back once restores + // the invariant. + top = addM(MOD, top, tmp + i, 0 - (top >> (P256_BITSPERDIGIT - 1))); // top is now either 0 or 1. Make it 0, fixed-timing. assert(top <= 1); diff --git a/crypton.cabal b/crypton.cabal --- a/crypton.cabal +++ b/crypton.cabal @@ -1,13 +1,15 @@ cabal-version: 1.18 name: crypton -version: 1.0.6 +version: 1.1.5 license: BSD3 license-file: LICENSE copyright: Vincent Hanquez maintainer: Kazu Yamamoto author: Vincent Hanquez stability: experimental -tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.2 +tested-with: + ghc ==9.2.8 || ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.1 || ==9.12.1 + homepage: https://github.com/kazu-yamamoto/crypton bug-reports: https://github.com/kazu-yamamoto/crypton/issues synopsis: Cryptography Primitives sink @@ -121,7 +123,6 @@ manual: True library - -- cabal-fmt: expand . -CHANGELOG -CONTRIBUTING -Crypto.Math.Polynomial -Crypto.Random.Entropy.RDRand -Crypto.Random.Entropy.Unix -Crypto.Random.Entropy.Windows -LICENSE -Makefile -QA -README -Setup -Crypto.Cipher.Blowfish.Box -Crypto.Cipher.Blowfish.Primitive -Crypto.Cipher.CAST5.Primitive -Crypto.Cipher.Camellia.Primitive -Crypto.Cipher.DES.Primitive -Crypto.Cipher.Twofish.Primitive -Crypto.Cipher.Types.AEAD -Crypto.Cipher.Types.Base -Crypto.Cipher.Types.Block -Crypto.Cipher.Types.GF -Crypto.Cipher.Types.Stream -Crypto.Cipher.Types.Utils -Crypto.ECC.Simple.Prim -Crypto.ECC.Simple.Types -Crypto.Error.Types -Crypto.Hash.Blake2 -Crypto.Hash.Blake2b -Crypto.Hash.Blake2bp -Crypto.Hash.Blake2s -Crypto.Hash.Blake2sp -Crypto.Hash.Keccak -Crypto.Hash.MD2 -Crypto.Hash.MD4 -Crypto.Hash.MD5 -Crypto.Hash.RIPEMD160 -Crypto.Hash.SHA1 -Crypto.Hash.SHA224 -Crypto.Hash.SHA256 -Crypto.Hash.SHA3 -Crypto.Hash.SHA384 -Crypto.Hash.SHA512 -Crypto.Hash.SHA512t -Crypto.Hash.SHAKE -Crypto.Hash.Skein256 -Crypto.Hash.Skein512 -Crypto.Hash.Tiger -Crypto.Hash.Types -Crypto.Hash.Whirlpool -Crypto.Internal.Builder -Crypto.Internal.ByteArray -Crypto.Internal.Compat -Crypto.Internal.CompatPrim -Crypto.Internal.DeepSeq -Crypto.Internal.Endian -Crypto.Internal.Imports -Crypto.Internal.Nat -Crypto.Internal.WordArray -Crypto.Internal.Words -Crypto.Number.Compat -Crypto.PubKey.ElGamal -Crypto.PubKey.Internal -Crypto.Random.ChaChaDRG -Crypto.Random.Entropy.Backend -Crypto.Random.Entropy.Source -Crypto.Random.HmacDRG -Crypto.Random.Probabilistic -Crypto.Random.SystemDRG -Crypto.Cipher.AES.Primitive exposed-modules: Crypto.Cipher.AES Crypto.Cipher.AESGCMSIV @@ -204,6 +205,37 @@ Crypto.System.CPU Crypto.Tutorial + cc-options: -std=gnu99 + c-sources: + cbits/argon2/argon2.c + cbits/crypton_blake2b.c + cbits/crypton_blake2bp.c + cbits/crypton_blake2s.c + cbits/crypton_blake2sp.c + cbits/crypton_chacha.c + cbits/crypton_cpu.c + cbits/crypton_md2.c + cbits/crypton_md4.c + cbits/crypton_md5.c + cbits/crypton_pbkdf2.c + cbits/crypton_poly1305.c + cbits/crypton_rc4.c + cbits/crypton_ripemd.c + cbits/crypton_salsa.c + cbits/crypton_scrypt.c + cbits/crypton_sha1.c + cbits/crypton_sha256.c + cbits/crypton_sha3.c + cbits/crypton_sha512.c + cbits/crypton_skein256.c + cbits/crypton_skein512.c + cbits/crypton_tiger.c + cbits/crypton_whirlpool.c + cbits/crypton_xsalsa.c + cbits/ed25519/ed25519.c + cbits/p256/p256.c + cbits/p256/p256_ec.c + other-modules: Crypto.Cipher.AES.Primitive Crypto.Cipher.Blowfish.Box @@ -264,37 +296,6 @@ Crypto.Random.Probabilistic Crypto.Random.SystemDRG - cc-options: -std=gnu99 - c-sources: - cbits/argon2/argon2.c - cbits/crypton_blake2b.c - cbits/crypton_blake2bp.c - cbits/crypton_blake2s.c - cbits/crypton_blake2sp.c - cbits/crypton_chacha.c - cbits/crypton_cpu.c - cbits/crypton_md2.c - cbits/crypton_md4.c - cbits/crypton_md5.c - cbits/crypton_pbkdf2.c - cbits/crypton_poly1305.c - cbits/crypton_rc4.c - cbits/crypton_ripemd.c - cbits/crypton_salsa.c - cbits/crypton_scrypt.c - cbits/crypton_sha1.c - cbits/crypton_sha256.c - cbits/crypton_sha3.c - cbits/crypton_sha512.c - cbits/crypton_skein256.c - cbits/crypton_skein512.c - cbits/crypton_tiger.c - cbits/crypton_whirlpool.c - cbits/crypton_xsalsa.c - cbits/ed25519/ed25519.c - cbits/p256/p256.c - cbits/p256/p256_ec.c - default-language: Haskell2010 include-dirs: cbits cbits/ed25519 cbits/decaf/include cbits/decaf/p448 @@ -302,21 +303,25 @@ ghc-options: -Wall -fwarn-tabs -optc-O3 build-depends: - base >=4.13 && <5 - , basement >=0.0.6 - , bytestring - , memory >=0.14.18 + base >=4.13 && <5, + bytestring, + primitive >=0.9, + deepseq, + base16 >=1.0, + bytestring, + text, + ram >=0.20.1 && <0.23 if flag(old_toolchain_inliner) cc-options: -fgnu89-inline - if (arch(x86_64) || arch(aarch64) || arch(loongarch64) || arch(ppc64le) || arch(riscv64) || arch(s390x) || arch(alpha) || arch(ppc64) || arch(sparc64)) + if ((((((((arch(x86_64) || arch(aarch64)) || arch(loongarch64)) || arch(ppc64le)) || arch(riscv64)) || arch(s390x)) || arch(alpha)) || arch(ppc64)) || arch(sparc64)) include-dirs: cbits/include64 else include-dirs: cbits/include32 - if (arch(x86_64) || arch(aarch64) || arch(loongarch64) || arch(ppc64le) || arch(riscv64) || arch(s390x) || arch(alpha) || arch(ppc64) || arch(sparc64)) + if ((((((((arch(x86_64) || arch(aarch64)) || arch(loongarch64)) || arch(ppc64le)) || arch(riscv64)) || arch(s390x)) || arch(alpha)) || arch(ppc64)) || arch(sparc64)) c-sources: cbits/decaf/ed448goldilocks/decaf_all.c cbits/decaf/ed448goldilocks/eddsa.c @@ -340,13 +345,13 @@ include-dirs: cbits/decaf/include/arch_32 cbits/decaf/p448/arch_32 - if (arch(x86_64) || arch(aarch64) || arch(loongarch64) || arch(ppc64le) || arch(riscv64) || arch(s390x) || arch(alpha) || arch(ppc64) || arch(sparc64)) + if ((((((((arch(x86_64) || arch(aarch64)) || arch(loongarch64)) || arch(ppc64le)) || arch(riscv64)) || arch(s390x)) || arch(alpha)) || arch(ppc64)) || arch(sparc64)) c-sources: cbits/curve25519/curve25519-donna-c64.c else c-sources: cbits/curve25519/curve25519-donna.c - if (arch(i386) || arch(x86_64) || arch(loongarch64) || arch(ppc64le) || arch(riscv64) || arch(alpha)) + if (((((arch(i386) || arch(x86_64)) || arch(loongarch64)) || arch(ppc64le)) || arch(riscv64)) || arch(alpha)) cpp-options: -DARCH_IS_LITTLE_ENDIAN if arch(i386) @@ -416,7 +421,7 @@ else other-modules: Crypto.Random.Entropy.Unix - if (impl(ghc) && flag(integer-gmp)) + if (impl(ghc >=0) && flag(integer-gmp)) build-depends: integer-gmp if flag(support_deepseq) @@ -429,12 +434,13 @@ if flag(use_target_attributes) cc-options: -DWITH_TARGET_ATTRIBUTES + if os(ios) + cpp-options: -DINSECURE_ENTROPY + test-suite test-crypton type: exitcode-stdio-1.0 main-is: Tests.hs hs-source-dirs: tests - - -- cabal-fmt: expand tests -Tests other-modules: BCrypt BCryptPBKDF @@ -499,14 +505,14 @@ -Wall -fno-warn-orphans -fno-warn-missing-signatures -rtsopts build-depends: - base >=4.13 && <5 - , bytestring - , crypton - , memory - , tasty - , tasty-hunit - , tasty-kat - , tasty-quickcheck + base >=4.13 && <5, + bytestring, + crypton, + ram, + tasty, + tasty-hunit, + tasty-kat, + tasty-quickcheck benchmark bench-crypton type: exitcode-stdio-1.0 @@ -516,12 +522,10 @@ default-language: Haskell2010 ghc-options: -Wall -fno-warn-missing-signatures build-depends: - base >=4.13 && <5 - , bytestring - , crypton - , deepseq - , gauge - , memory - , random - --- cabal-fmt: indent 4 + base >=4.13 && <5, + bytestring, + crypton, + deepseq, + gauge, + ram, + random diff --git a/tests/BCrypt.hs b/tests/BCrypt.hs --- a/tests/BCrypt.hs +++ b/tests/BCrypt.hs @@ -34,7 +34,7 @@ \\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\ \\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\ \\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\ - \\x00\x01\x02\x03\x04\x05" -- chars after 72 are ignored as usual + \chars after 72 are ignored as usual" ) , ( "$2a$05$/OK.fbVrR/bpIqNJ5ianF.R9xrDjiycxMbQE2bp.vgqlYpW5wx2yy" diff --git a/tests/KAT_AES.hs b/tests/KAT_AES.hs --- a/tests/KAT_AES.hs +++ b/tests/KAT_AES.hs @@ -5,6 +5,8 @@ import BlockCipher import qualified Crypto.Cipher.AES as AES import Crypto.Cipher.Types +import Crypto.Error +import qualified Data.ByteArray as BA import qualified Data.ByteString as B import Data.Maybe import Imports @@ -113,12 +115,55 @@ , kat_AEAD = map toKatGCM KATGCM.vectors_aes256_enc } +-- SP 800-38D 5.2.1.1: 1 <= len(IV) <= 2^64 - 1. A zero-length IV makes +-- J0 the GHASH of the empty string, which leaks the authentication key. +aeadIVLengthTests :: TestTree +aeadIVLengthTests = + testGroup + "AEAD IV length" + [ testCase "96-bit IV accepted" $ + True @=? isRight (initWith (B.replicate 12 0)) + , testCase "8-bit IV accepted" $ + True @=? isRight (initWith (B.replicate 1 0)) + , testCase "empty IV rejected" $ + Left CryptoError_IvSizeInvalid @=? initWith B.empty + ] + where + ctx = throwCryptoError (cipherInit (B.replicate 16 0)) :: AES.AES128 + initWith iv = + eitherCryptoError (() <$ aeadInit AEAD_GCM ctx (iv :: ByteString)) + isRight = either (const False) (const True) + +aeadTagLengthTests :: TestTree +aeadTagLengthTests = + testGroup + "AEAD tag length" + [ testCase "full tag verifies" $ Just message @=? openWith fullTag + , testCase "empty tag rejected" $ Nothing @=? openWith B.empty + , testCase "1-byte tag rejected" $ Nothing @=? openWith (B.take 1 fullTag) + , testCase "3-byte tag rejected" $ Nothing @=? openWith (B.take 3 fullTag) + , testCase "wrong tag rejected" $ + Nothing @=? openWith (B.map (+ 1) fullTag) + ] + where + key = B.replicate 16 0 + iv = B.replicate 12 0 + aad = "additional data" :: ByteString + message = "authenticated message" :: ByteString + ctx = throwCryptoError (cipherInit key) :: AES.AES128 + aead = throwCryptoError (aeadInit AEAD_GCM ctx iv) + (AuthTag tag, ciphertext) = aeadSimpleEncrypt aead aad message 16 + fullTag = BA.convert tag :: ByteString + openWith t = aeadSimpleDecrypt aead aad ciphertext (AuthTag (BA.convert t)) + tests = testGroup "AES" [ testBlockCipher kats128 (undefined :: AES.AES128) , testBlockCipher kats192 (undefined :: AES.AES192) , testBlockCipher kats256 (undefined :: AES.AES256) + , aeadIVLengthTests + , aeadTagLengthTests {- , testProperty "genCtr" $ \(key, iv1) -> let (bs1, iv2) = AES.genCounter key iv1 32 diff --git a/tests/KAT_AES/KATOCB3.hs b/tests/KAT_AES/KATOCB3.hs --- a/tests/KAT_AES/KATOCB3.hs +++ b/tests/KAT_AES/KATOCB3.hs @@ -18,7 +18,47 @@ key1 = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f" nonce1 = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b" +key2 = "\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00" +nonce2 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0d" +nonce_rfc7253_00 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x00" +nonce_rfc7253_01 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x01" +nonce_rfc7253_02 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x02" +nonce_rfc7253_03 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x03" +nonce_rfc7253_04 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x04" +nonce_rfc7253_05 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x05" +nonce_rfc7253_06 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x06" +nonce_rfc7253_07 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x07" +nonce_rfc7253_08 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x08" +nonce_rfc7253_09 = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x09" +nonce_rfc7253_0a = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0a" +nonce_rfc7253_0b = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0b" +nonce_rfc7253_0c = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0c" +nonce_rfc7253_0d = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0d" +nonce_rfc7253_0e = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0e" +nonce_rfc7253_0f = "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0f" +nonce_dkg_120_00 = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x00" +nonce_dkg_120_01 = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x01" +nonce_dkg_120_02 = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x02" +nonce_dkg_120_03 = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x03" +nonce_dkg_120_04 = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x04" +nonce_dkg_120_05 = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x05" +nonce_dkg_120_06 = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x06" +nonce_dkg_120_07 = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x07" +nonce_dkg_120_08 = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x08" +nonce_dkg_120_09 = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x09" +nonce_dkg_120_0a = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0a" +nonce_dkg_120_0b = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0b" +nonce_dkg_120_0c = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0c" +nonce_dkg_120_0d = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0d" +nonce_dkg_120_0e = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0e" +nonce_dkg_120_0f = "\xee\xdd\xcc\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x0f" +bytes8 = "\x00\x01\x02\x03\x04\x05\x06\x07" +bytes16 = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f" +bytes24 = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17" +bytes32 = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f" +bytes40 = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27" + vectors_aes128_enc :: [KATOCB3] vectors_aes128_enc = [ @@ -66,4 +106,289 @@ , 16 , "\x77\x6c\x99\x24\xd6\x72\x3a\x1f\xc4\x52\x45\x32\xac\x3e\x5b\xeb" ) + {- Disabled: 96-bit tag vector + , ( key2 + , nonce2 + , "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27" + , "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27" + , "\x17\x92\xa4\xe3\x1e\x07\x55\xfb\x03\xe3\x1b\x22\x11\x6e\x6c\x2d\xdf\x9e\xfd\x6e\x33\xd5\x36\xf1\xa0\x12\x4b\x0a\x55\xba\xe8\x84\xed\x93\x48\x15\x29\xc7\x6b\x6a" + , 12 + , "\xd0\xc5\x15\xf4\xd1\xcd\xd4\xfd\xac\x4f\x02\xaa" + ) + -} + ] ++ vectors_rfc7253_aes128_tag128 + ++ vectors_dkg_nonce120_aes128 + +vectors_rfc7253_aes128_tag128 :: [KATOCB3] +vectors_rfc7253_aes128_tag128 = + [ ( key1 + , nonce_rfc7253_00 + , "" + , "" + , "" + , 16 + , "\x78\x54\x07\xbf\xff\xc8\xad\x9e\xdc\xc5\x52\x0a\xc9\x11\x1e\xe6" + ) + , ( key1 + , nonce_rfc7253_01 + , bytes8 + , bytes8 + , "\x68\x20\xb3\x65\x7b\x6f\x61\x5a" + , 16 + , "\x57\x25\xbd\xa0\xd3\xb4\xeb\x3a\x25\x7c\x9a\xf1\xf8\xf0\x30\x09" + ) + , ( key1 + , nonce_rfc7253_02 + , bytes8 + , "" + , "" + , 16 + , "\x81\x01\x7f\x82\x03\xf0\x81\x27\x71\x52\xfa\xde\x69\x4a\x0a\x00" + ) + , ( key1 + , nonce_rfc7253_03 + , "" + , bytes8 + , "\x45\xdd\x69\xf8\xf5\xaa\xe7\x24" + , 16 + , "\x14\x05\x4c\xd1\xf3\x5d\x82\x76\x0b\x2c\xd0\x0d\x2f\x99\xbf\xa9" + ) + , ( key1 + , nonce_rfc7253_04 + , bytes16 + , bytes16 + , "\x57\x1d\x53\x5b\x60\xb2\x77\x18\x8b\xe5\x14\x71\x70\xa9\xa2\x2c" + , 16 + , "\x3a\xd7\xa4\xff\x38\x35\xb8\xc5\x70\x1c\x1c\xce\xc8\xfc\x33\x58" + ) + , ( key1 + , nonce_rfc7253_05 + , bytes16 + , "" + , "" + , 16 + , "\x8c\xf7\x61\xb6\x90\x2e\xf7\x64\x46\x2a\xd8\x64\x98\xca\x6b\x97" + ) + , ( key1 + , nonce_rfc7253_06 + , "" + , bytes16 + , "\x5c\xe8\x8e\xc2\xe0\x69\x27\x06\xa9\x15\xc0\x0a\xeb\x8b\x23\x96" + , 16 + , "\xf4\x0e\x1c\x74\x3f\x52\x43\x6b\xdf\x06\xd8\xfa\x1e\xca\x34\x3d" + ) + , ( key1 + , nonce_rfc7253_07 + , bytes24 + , bytes24 + , "\x1c\xa2\x20\x73\x08\xc8\x7c\x01\x07\x56\x10\x4d\x88\x40\xce\x19\x52\xf0\x96\x73\xa4\x48\xa1\x22" + , 16 + , "\xc9\x2c\x62\x24\x10\x51\xf5\x73\x56\xd7\xf3\xc9\x0b\xb0\xe0\x7f" + ) + , ( key1 + , nonce_rfc7253_08 + , bytes24 + , "" + , "" + , 16 + , "\x6d\xc2\x25\xa0\x71\xfc\x1b\x9f\x7c\x69\xf9\x3b\x0f\x1e\x10\xde" + ) + , ( key1 + , nonce_rfc7253_09 + , "" + , bytes24 + , "\x22\x1b\xd0\xde\x7f\xa6\xfe\x99\x3e\xcc\xd7\x69\x46\x0a\x0a\xf2\xd6\xcd\xed\x0c\x39\x5b\x1c\x3c" + , 16 + , "\xe7\x25\xf3\x24\x94\xb9\xf9\x14\xd8\x5c\x0b\x1e\xb3\x83\x57\xff" + ) + , ( key1 + , nonce_rfc7253_0a + , bytes32 + , bytes32 + , "\xbd\x6f\x6c\x49\x62\x01\xc6\x92\x96\xc1\x1e\xfd\x13\x8a\x46\x7a\xbd\x3c\x70\x79\x24\xb9\x64\xde\xaf\xfc\x40\x31\x9a\xf5\xa4\x85" + , 16 + , "\x40\xfb\xba\x18\x6c\x55\x53\xc6\x8a\xd9\xf5\x92\xa7\x9a\x42\x40" + ) + , ( key1 + , nonce_rfc7253_0b + , bytes32 + , "" + , "" + , 16 + , "\xfe\x80\x69\x0b\xee\x8a\x48\x5d\x11\xf3\x29\x65\xbc\x9d\x2a\x32" + ) + , ( key1 + , nonce_rfc7253_0c + , "" + , bytes32 + , "\x29\x42\xbf\xc7\x73\xbd\xa2\x3c\xab\xc6\xac\xfd\x9b\xfd\x58\x35\xbd\x30\x0f\x09\x73\x79\x2e\xf4\x60\x40\xc5\x3f\x14\x32\xbc\xdf" + , 16 + , "\xb5\xe1\xdd\xe3\xbc\x18\xa5\xf8\x40\xb5\x2e\x65\x34\x44\xd5\xdf" + ) + , ( key1 + , nonce_rfc7253_0d + , bytes40 + , bytes40 + , "\xd5\xca\x91\x74\x84\x10\xc1\x75\x1f\xf8\xa2\xf6\x18\x25\x5b\x68\xa0\xa1\x2e\x09\x3f\xf4\x54\x60\x6e\x59\xf9\xc1\xd0\xdd\xc5\x4b\x65\xe8\x62\x8e\x56\x8b\xad\x7a" + , 16 + , "\xed\x07\xba\x06\xa4\xa6\x94\x83\xa7\x03\x54\x90\xc5\x76\x9e\x60" + ) + , ( key1 + , nonce_rfc7253_0e + , bytes40 + , "" + , "" + , 16 + , "\xc5\xcd\x9d\x18\x50\xc1\x41\xe3\x58\x64\x99\x94\xee\x70\x1b\x68" + ) + , ( key1 + , nonce_rfc7253_0f + , "" + , bytes40 + , "\x44\x12\x92\x34\x93\xc5\x7d\x5d\xe0\xd7\x00\xf7\x53\xcc\xe0\xd1\xd2\xd9\x50\x60\x12\x2e\x9f\x15\xa5\xdd\xbf\xc5\x78\x7e\x50\xb5\xcc\x55\xee\x50\x7b\xcb\x08\x4e" + , 16 + , "\x47\x9a\xd3\x63\xac\x36\x6b\x95\xa9\x8c\xa5\xf3\x00\x0b\x14\x79" + ) + ] + +vectors_dkg_nonce120_aes128 :: [KATOCB3] +vectors_dkg_nonce120_aes128 = + [ ( key1 + , nonce_dkg_120_00 + , "" + , "" + , "" + , 16 + , "\x75\x2a\xcd\x21\x32\xc4\x1e\x02\x0e\x41\xfb\x22\x3e\xfd\x77\xb6" + ) + , ( key1 + , nonce_dkg_120_01 + , bytes8 + , bytes8 + , "\x20\x1f\xe4\xd8\x9e\xa7\xbd\x1e" + , 16 + , "\xb5\xb1\x57\x7d\xb1\x62\x83\xb8\xae\xd1\x71\x5a\xd6\xbe\x51\x49" + ) + , ( key1 + , nonce_dkg_120_02 + , bytes8 + , "" + , "" + , 16 + , "\x71\x09\x60\xb9\xee\x00\xb8\xf4\x4d\x2e\x81\x20\xaa\xba\x63\xae" + ) + , ( key1 + , nonce_dkg_120_03 + , "" + , bytes8 + , "\x08\x4e\x86\x95\x70\x19\x4b\xd2" + , 16 + , "\x50\x32\xfe\x9e\x53\x28\xe4\x5d\x50\x7e\x74\xf3\x36\x6e\x20\xd2" + ) + , ( key1 + , nonce_dkg_120_04 + , bytes16 + , bytes16 + , "\x96\x76\xee\x37\xfd\x64\x5c\x07\xc0\xd4\xf7\x0a\xab\xf6\x86\x68" + , 16 + , "\x8e\x39\xb2\xfb\x3f\xc4\xff\x30\xdc\xd1\x82\x7b\x36\xa2\x98\xd3" + ) + , ( key1 + , nonce_dkg_120_05 + , bytes16 + , "" + , "" + , 16 + , "\x9d\x51\x0f\x56\xed\xf7\x2f\xfa\x34\x96\x9b\xce\xf9\x1e\x6d\xe9" + ) + , ( key1 + , nonce_dkg_120_06 + , "" + , bytes16 + , "\xd5\xe1\x5a\xa1\xd2\x32\xab\x57\xf2\x34\x36\x6d\xff\xb2\x55\x74" + , 16 + , "\xa3\x63\x6a\x5f\x3e\x34\x33\xea\x45\x90\xcb\xf4\xf9\xac\x1f\x4d" + ) + , ( key1 + , nonce_dkg_120_07 + , bytes24 + , bytes24 + , "\x1c\x4b\x67\x77\xb7\xf1\x37\xc3\x09\x71\xa9\x3d\xe3\xc5\x6c\xc7\x35\x68\x6a\x6f\x77\x03\x14\x2f" + , 16 + , "\xab\x8a\xcc\x98\x7c\x14\x06\xdf\xf9\x62\x73\xc5\x37\x6e\x62\x10" + ) + , ( key1 + , nonce_dkg_120_08 + , bytes24 + , "" + , "" + , 16 + , "\x96\xe6\x70\xc0\x23\x8f\xb9\x69\xb7\xac\xe4\xab\xaf\x74\x38\xc7" + ) + , ( key1 + , nonce_dkg_120_09 + , "" + , bytes24 + , "\x12\x90\xa6\x86\xd8\x25\xf7\x12\xe5\x94\xbe\x40\x39\xc0\x4d\x3e\x44\xf7\xd1\x34\x2b\x84\xff\xca" + , 16 + , "\xd6\x8b\xbd\xfa\x04\xb5\x80\xea\x9a\x01\xe2\xf4\x56\x53\x99\xc3" + ) + , ( key1 + , nonce_dkg_120_0a + , bytes32 + , bytes32 + , "\xfb\xdf\xc1\x1f\x74\x92\x17\xbb\x7f\xae\x5d\x40\x36\xb8\xf2\x28\x03\x71\x2e\xff\x9e\xf9\x43\x42\xfe\x1b\x68\x49\x68\xd0\xe3\xe3" + , 16 + , "\x81\xa2\x77\xda\xab\x83\x57\x94\x06\xa0\x1e\x26\x75\xa0\x82\xc9" + ) + , ( key1 + , nonce_dkg_120_0b + , bytes32 + , "" + , "" + , 16 + , "\x90\xcd\xa8\xa0\x51\x61\xd2\x87\x33\x61\x37\x4b\x76\xf9\x54\x30" + ) + , ( key1 + , nonce_dkg_120_0c + , "" + , bytes32 + , "\xd1\x32\x0a\xf4\xb6\xff\x8a\xfe\xec\xee\x79\x21\x39\x5d\x4e\x86\x92\x71\x77\x53\xee\x15\xf5\x03\x8e\xb6\x74\xda\x43\xd6\xea\x8d" + , 16 + , "\xbe\x78\x31\xe7\x23\xbe\x47\x1f\x62\xd9\xe7\xf4\x9a\x7d\x3b\x32" + ) + , ( key1 + , nonce_dkg_120_0d + , bytes40 + , bytes40 + , "\x5c\x79\xf1\xc4\xb9\xa2\x04\xed\x33\x23\x61\x6d\x57\x6f\xc5\x00\xe4\xa7\x19\x39\xf0\x3a\x3c\x3d\xe2\xc0\x97\xaf\x2c\x6c\x81\xdc\x3f\x03\x09\xe7\x60\x82\xb1\xf5" + , 16 + , "\x0f\xf8\x52\x29\x59\xff\xe4\x1f\x37\xef\x50\x7e\x90\x76\xd3\x2c" + ) + , ( key1 + , nonce_dkg_120_0e + , bytes40 + , "" + , "" + , 16 + , "\x3b\xf1\x58\xb7\xde\x76\xc5\x15\x1e\xf6\x08\x6a\x82\x5d\x0c\xc4" + ) + , ( key1 + , nonce_dkg_120_0f + , "" + , bytes40 + , "\x34\xda\x59\xd2\xeb\x08\xf4\x78\x22\xd4\x8c\x85\xb6\xa1\xd2\x36\x94\xe1\xd3\xde\x68\x0d\x61\x6d\x7b\x1b\x59\x47\x2c\x13\xe3\x69\xc6\x8d\xca\x69\x9d\xa1\x68\x6a" + , 16 + , "\x33\x9d\x54\x52\x80\x36\x32\x81\x0b\x08\x40\xe6\x80\x4a\xb0\x20" + ) + {- Disabled: 96-bit tag vector + , ( key2 + , nonce_dkg_120_0d + , bytes40 + , bytes40 + , "\x07\xe9\x03\xbf\xc4\x95\x52\x41\x1a\xbc\x86\x5f\x5e\xce\x60\xf6\xfa\xd1\xf5\xa9\xf1\x4d\x30\x70\xfa\x2f\x13\x08\xa5\x63\x20\x7f\xfe\x14\xc1\xee\xa4\x4b\x22\x05" + , 12 + , "\x9c\x74\x84\x31\x9d\x8a\x2c\x53\xc2\x36\xa7\xb3" + ) + -} ] diff --git a/tests/KAT_EdDSA.hs b/tests/KAT_EdDSA.hs --- a/tests/KAT_EdDSA.hs +++ b/tests/KAT_EdDSA.hs @@ -3,6 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} module KAT_EdDSA (tests) where diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -40,7 +40,9 @@ curveGen = ECC.ecc_g . ECC.common_curve $ curve pointP256ToECC :: P256.Point -> ECC.Point -pointP256ToECC = uncurry ECC.Point . P256.pointToIntegers +pointP256ToECC p + | P256.pointIsAtInfinity p = ECC.PointO + | otherwise = uncurry ECC.Point (P256.pointToIntegers p) i2ospScalar :: Integer -> Bytes i2ospScalar i = @@ -71,6 +73,14 @@ xR = 0x72b13dd4354b6b81745195e98cc5ba6970349191ac476bd4553cf35a545a067e yR = 0x8d585cbb2e1327d75241a8a122d7620dc33b13315aa5c9d46d013011744ac264 +-- Two points on the curve whose validation reduces a product whose top +-- digit has a zero low half: x = 2^96, and an x with a repeating bit +-- pattern. Wycheproof ecdh_secp256r1_ecpoint tcId 74 and 93. +xU = 0x0000000000000000000000000000000000000001000000000000000000000000 +yU = 0x7d12de58d54423eb85ae8d157ae416fb004a7eb522ac1b67047ef3cdf9acdc3f +xV = 0x8000003ffffff0000007fffffe000000ffffffc000001ffffff8000003fffffc +yV = 0x0c3527bd081c1c07b313bc1a0c3f845fb2fe22557699ccc8f1354e61a27b7f88 + tests = testGroup "P256" @@ -140,13 +150,22 @@ , testCase "valid-point-1" $ casePointIsValid (xS, yS) , testCase "valid-point-2" $ casePointIsValid (xR, yR) , testCase "valid-point-3" $ casePointIsValid (xT, yT) + , -- The quotient estimate in crypton_p256_modmul can exceed the + -- true quotient, and the resulting borrow used to abort the + -- process on an assertion inside the reduction rather than + -- being corrected. Both points below are on the curve. + testCase "valid-point-reduction-1" $ casePointIsValid (xU, yU) + , testCase "valid-point-reduction-2" $ casePointIsValid (xV, yV) , testCase "point-add-1" $ let s = P256.pointFromIntegers (xS, yS) t = P256.pointFromIntegers (xT, yT) r = P256.pointFromIntegers (xR, yR) in r @=? P256.pointAdd s t + , testProperty "point-add-infinity" casePointAddInfinity , testProperty "lift-to-curve" propertyLiftToCurve , testProperty "point-add" propertyPointAdd + , testProperty "point-add-infinity-identity" propertyPointAddInfinityIdentity + , testProperty "point-add-inverse" propertyPointAddInverse , testProperty "point-negate" propertyPointNegate , testProperty "point-mul" propertyPointMul , testProperty "infinity" $ @@ -198,4 +217,49 @@ in propertyHold [ eqTest "p256" pR (P256.pointMul (unP256Scalar s) p) , eqTest "ecc" peR (pointP256ToECC pR) + ] + + pointInfinity :: P256.Point + pointInfinity = P256.pointFromIntegers (0, 0) + + casePointAddInfinity = + propertyHold + [ eqTest + "infinity + base" + P256.pointBase + (P256.pointAdd pointInfinity P256.pointBase) + , eqTest + "base + infinity" + P256.pointBase + (P256.pointAdd P256.pointBase pointInfinity) + , eqTest + "infinity + infinity" + pointInfinity + (P256.pointAdd pointInfinity pointInfinity) + ] + + propertyPointAddInfinityIdentity r = + let p = P256.toPoint (unP256Scalar r) + in propertyHold + [ eqTest + "infinity + p" + p + (P256.pointAdd pointInfinity p) + , eqTest + "p + infinity" + p + (P256.pointAdd p pointInfinity) + ] + + propertyPointAddInverse r = + let p = P256.toPoint (unP256Scalar r) + in propertyHold + [ eqTest + "p + negate p" + True + (P256.pointIsAtInfinity (P256.pointAdd p (P256.pointNegate p))) + , eqTest + "negate p + p" + True + (P256.pointIsAtInfinity (P256.pointAdd (P256.pointNegate p) p)) ]