crypton 1.0.6 → 1.1.4
raw patch · 23 files changed
Files
- CHANGELOG.md +31/−0
- Crypto/Cipher/AESGCMSIV.hs +4/−4
- Crypto/Cipher/Twofish/Primitive.hs +1/−0
- Crypto/ConstructHash/MiyaguchiPreneel.hs +1/−0
- Crypto/Error/Types.hs +0/−6
- Crypto/Hash.hs +24/−30
- Crypto/Hash/IO.hs +5/−2
- Crypto/Hash/Types.hs +45/−25
- Crypto/Internal/ByteArray.hs +18/−1
- Crypto/KDF/BCryptPBKDF.hs +48/−55
- Crypto/MAC/CMAC.hs +1/−0
- Crypto/MAC/KMAC.hs +9/−7
- Crypto/Number/F2m.hs +1/−0
- Crypto/PubKey/ECC/P256.hs +6/−3
- Crypto/PubKey/ECDSA.hs +2/−2
- Crypto/PubKey/Internal.hs +1/−0
- Crypto/PubKey/RSA/PKCS15.hs +9/−7
- Crypto/PubKey/RSA/Types.hs +5/−2
- Crypto/Random.hs +25/−4
- Crypto/Tutorial.hs +1/−1
- crypton.cabal +66/−62
- tests/KAT_EdDSA.hs +1/−0
- tests/KAT_PubKey/P256.hs +51/−1
CHANGELOG.md view
@@ -1,5 +1,36 @@ # CHANGELOG for crypton +## 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/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/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,11 +13,6 @@ ) 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 Control.Monad (when) import qualified Crypto.Cipher.Blowfish.Box 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 `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/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
@@ -347,25 +347,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 +377,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/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'
crypton.cabal view
@@ -1,13 +1,15 @@ cabal-version: 1.18 name: crypton-version: 1.0.6+version: 1.1.4 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/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 =@@ -145,8 +147,11 @@ 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 +203,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)) ]