packages feed

crypton 1.0.6 → 1.1.5

raw patch · 34 files changed

Files

CHANGELOG.md view
@@ -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.
Crypto/Cipher/AES.hs view
@@ -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 \
Crypto/Cipher/AES/Primitive.hs view
@@ -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 ()
Crypto/Cipher/AESGCMSIV.hs view
@@ -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
Crypto/Cipher/Twofish/Primitive.hs view
@@ -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
Crypto/Cipher/Types/AEAD.hs view
@@ -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
Crypto/ConstructHash/MiyaguchiPreneel.hs view
@@ -16,6 +16,7 @@ ) where  import Data.List (foldl')+import Prelude hiding (foldl')  import Crypto.Cipher.Types import Crypto.Data.Padding (Format (ZERO), pad)
Crypto/Error/Types.hs view
@@ -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
Crypto/Hash.hs view
@@ -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)
Crypto/Hash/IO.hs view
@@ -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 ()
Crypto/Hash/Types.hs view
@@ -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--- <https://hackage.haskell.org/package/memory memory>.+-- <https://hackage.haskell.org/package/ram ram>. -- 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
Crypto/Internal/ByteArray.hs view
@@ -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
Crypto/KDF/BCryptPBKDF.hs view
@@ -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)
Crypto/MAC/CMAC.hs view
@@ -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)
Crypto/MAC/KMAC.hs view
@@ -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
Crypto/Number/F2m.hs view
@@ -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
Crypto/Number/ModArithmetic.hs view
@@ -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
Crypto/PubKey/ECC/P256.hs view
@@ -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
Crypto/PubKey/ECDSA.hs view
@@ -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
Crypto/PubKey/Internal.hs view
@@ -13,6 +13,7 @@  import Data.Bits (shiftR) import Data.List (foldl')+import Prelude hiding (foldl')  import Crypto.Hash import Crypto.Internal.ByteArray (ByteArrayAccess)
Crypto/PubKey/RSA/PKCS15.hs view
@@ -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 --
Crypto/PubKey/RSA/Types.hs view
@@ -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) =
Crypto/Random.hs view
@@ -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
Crypto/Random/Entropy/Unix.hs view
@@ -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
Crypto/Tutorial.hs view
@@ -16,7 +16,7 @@ -- $api_design -- -- APIs in crypton are often based on type classes from package--- <https://hackage.haskell.org/package/memory memory>, notably+-- <https://hackage.haskell.org/package/ram ram>, 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'
cbits/crypton_aes.c view
@@ -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);
cbits/crypton_aes.h view
@@ -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);
cbits/p256/p256.c view
@@ -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);
crypton.cabal view
@@ -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 <vincent@snarc.org> maintainer:         Kazu Yamamoto <kazu@iij.ad.jp> author:             Vincent Hanquez <vincent@snarc.org> 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
tests/BCrypt.hs view
@@ -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"
tests/KAT_AES.hs view
@@ -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
tests/KAT_AES/KATOCB3.hs view
@@ -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"+      )+    -}     ]
tests/KAT_EdDSA.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeOperators #-}  module KAT_EdDSA (tests) where
tests/KAT_PubKey/P256.hs view
@@ -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))                 ]