diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # CHANGELOG for crypton +## 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 diff --git a/Crypto/Cipher/AESGCMSIV.hs b/Crypto/Cipher/AESGCMSIV.hs --- a/Crypto/Cipher/AESGCMSIV.hs +++ b/Crypto/Cipher/AESGCMSIV.hs @@ -36,7 +36,7 @@ import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (peekElemOff, poke, pokeElemOff) -import Data.ByteArray +import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) import qualified Data.ByteArray as B import Data.Memory.Endian (toLE) import Data.Memory.PtrMethods (memXor) @@ -96,7 +96,7 @@ le32iv :: Word32 -> Nonce -> Bytes le32iv n (Nonce iv) = B.allocAndFreeze 16 $ \ptr -> do poke ptr (toLE n) - copyByteArrayToPtr iv (ptr `plusPtr` 4) + B.copyByteArrayToPtr iv (ptr `plusPtr` 4) deriveKeys :: BlockCipher128 aes => aes -> Nonce -> (ScrubbedBytes, AES) deriveKeys aes iv = @@ -109,7 +109,7 @@ in (mak, mek) _ -> error "AESGCMSIV: invalid cipher" where - idx n = ecbEncrypt aes (le32iv n iv) `takeView` 8 + idx n = ecbEncrypt aes (le32iv n iv) `B.takeView` 8 buildKey = B.concat . map idx -- Encryption and decryption @@ -152,7 +152,7 @@ decrypt aes iv aad ciphertext (AuthTag tag) | lengthInvalid aad = error "AESGCMSIV: aad is too large" | lengthInvalid ciphertext = error "AESGCMSIV: ciphertext is too large" - | tag `constEq` buildTag mek ss iv = Just plaintext + | tag `B.constEq` buildTag mek ss iv = Just plaintext | otherwise = Nothing where (mak, mek) = deriveKeys aes iv diff --git a/Crypto/Error/Types.hs b/Crypto/Error/Types.hs --- a/Crypto/Error/Types.hs +++ b/Crypto/Error/Types.hs @@ -22,7 +22,6 @@ import qualified Control.Exception as E import Data.Data - -- | Enumeration of all possible errors that can be found in this library data CryptoError = -- symmetric cipher errors diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -113,10 +113,11 @@ . HashAlgorithm a => Context a -> Digest a -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 () +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 @@ -131,17 +132,18 @@ -> ba -> Int -> Digest a -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 () +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 diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs --- a/Crypto/Hash/Types.hs +++ b/Crypto/Hash/Types.hs @@ -20,21 +20,29 @@ Digest (..), ) where -import Data.Primitive.ByteArray (ByteArray, MutableByteArray, writeByteArray, newPinnedByteArray, sizeofByteArray, unsafeFreezeByteArray, withByteArrayContents) -import Control.Monad.Primitive (PrimMonad (..)) import Control.DeepSeq (deepseq) +import Control.Monad.Primitive (PrimMonad (..)) import Control.Monad.ST import Crypto.Internal.ByteArray (ByteArrayAccess (..), Bytes) import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.Imports -import Data.Char (digitToInt, isHexDigit) -import Data.Data (Data) -import Foreign.Ptr (Ptr, castPtr) -import GHC.TypeLits (Nat) import Data.Base16.Types (extractBase16) import Data.ByteString (ByteString) import Data.ByteString.Base16 (encodeBase16) +import Data.Char (digitToInt, isHexDigit) +import Data.Data (Data) +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. -- @@ -101,7 +109,7 @@ -- | Represent a digest for a given hash algorithm. -- -- This type is an instance of 'ByteArrayAccess' from package --- . +-- . -- Module "Data.ByteArray" provides many primitives to work with those values -- including conversion to other types. -- @@ -121,7 +129,7 @@ instance Show (Digest a) where show d = - Text.unpack (extractBase16 $ encodeBase16 (B.convert d :: ByteString)) + Text.unpack (extractBase16 $ encodeBase16 (B.convert d :: ByteString)) instance HashAlgorithm a => Read (Digest a) where readsPrec _ str = runST $ do @@ -130,15 +138,20 @@ where len = hashDigestSize (undefined :: a) -loop :: Int -> MutableByteArray (PrimState (ST s)) -> Int -> String -> ST s [(Digest a, String)] +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 + | not (isHexDigit c) = return [] + | not (isHexDigit d) = return [] + | otherwise = do + let w8 :: Word8 + w8 = fromIntegral $ digitToInt c * 16 + digitToInt d + writeByteArray mut (len - n) w8 + loop len mut (n - 1) ds diff --git a/Crypto/Internal/ByteArray.hs b/Crypto/Internal/ByteArray.hs --- a/Crypto/Internal/ByteArray.hs +++ b/Crypto/Internal/ByteArray.hs @@ -23,10 +23,10 @@ import Data.ByteArray.Mapping import Data.Bits ((.|.)) +import qualified Data.Primitive.ByteArray as Prim import Data.Word (Word8) import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (peekByteOff) -import qualified Data.Primitive.ByteArray as Prim import Crypto.Internal.Compat (unsafeDoIO) diff --git a/Crypto/KDF/BCryptPBKDF.hs b/Crypto/KDF/BCryptPBKDF.hs --- a/Crypto/KDF/BCryptPBKDF.hs +++ b/Crypto/KDF/BCryptPBKDF.hs @@ -76,67 +76,67 @@ -- 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 - 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) + ksClean <- Blowfish.createKeySchedule + ksDirty <- Blowfish.createKeySchedule + 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. finallyErase outFP outLen $ finallyErase passHashFP hashLen $ B.withByteArray pass $ \passPtr -> B.withByteArray salt $ \saltPtr -> - 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) - hashInternalInit shaPtr - hashInternalUpdate shaPtr passPtr (fromIntegral passLen) - hashInternalFinalize shaPtr (castPtr passHashPtr) - -- 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. - 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) - 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) - 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 - -- will have been written to exactly once and every byte - -- of the output will have been used. - forM_ [0 .. outLen - 1] $ \outIdx -> do - let keyIdx = outIdx * blocks + block - 1 - when (keyIdx < keyLen) $ do - w8 <- peekByteOff outPtr outIdx :: IO Word8 - pokeByteOff keyPtr keyIdx w8 + 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) + hashInternalInit shaPtr + hashInternalUpdate shaPtr passPtr (fromIntegral passLen) + hashInternalFinalize shaPtr (castPtr passHashPtr) + -- 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. + 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) + 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) + 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 + -- will have been written to exactly once and every byte + -- of the output will have been used. + forM_ [0 .. outLen - 1] $ \outIdx -> do + let keyIdx = outIdx * blocks + block - 1 + when (keyIdx < keyLen) $ do + w8 <- peekByteOff outPtr outIdx :: IO Word8 + pokeByteOff keyPtr keyIdx w8 -- | Internal hash function used by `generate`. -- @@ -177,8 +177,8 @@ 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 + 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 diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs --- a/Crypto/MAC/KMAC.hs +++ b/Crypto/MAC/KMAC.hs @@ -70,13 +70,14 @@ :: forall a suffix . (HashSHAKE a, ByteArrayAccess suffix) => H.Context a -> suffix -> Digest a -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 () +cshakeFinalize !c s = Digest $ + allocAndFreezePrim (hashDigestSize (undefined :: a)) $ + \(dig :: Ptr (Digest a)) -> do + ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (H.Context a)) -> do + B.withByteArray s $ \d -> + hashInternalUpdate ctx d (fromIntegral $ B.length s) + cshakeInternalFinalize ctx dig + return () -- KMAC diff --git a/Crypto/PubKey/RSA/PKCS15.hs b/Crypto/PubKey/RSA/PKCS15.hs --- a/Crypto/PubKey/RSA/PKCS15.hs +++ b/Crypto/PubKey/RSA/PKCS15.hs @@ -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 -- diff --git a/Crypto/Tutorial.hs b/Crypto/Tutorial.hs --- a/Crypto/Tutorial.hs +++ b/Crypto/Tutorial.hs @@ -16,7 +16,7 @@ -- $api_design -- -- APIs in crypton are often based on type classes from package --- , notably +-- , notably -- 'Data.ByteArray.ByteArrayAccess' and 'Data.ByteArray.ByteArray'. -- Module "Data.ByteArray" provides many primitives that are useful to -- work with crypton types. For example function 'Data.ByteArray.convert' diff --git a/crypton.cabal b/crypton.cabal --- a/crypton.cabal +++ b/crypton.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: crypton -version: 1.1.1 +version: 1.1.2 license: BSD3 license-file: LICENSE copyright: Vincent Hanquez @@ -310,7 +310,7 @@ base16 >=1.0, bytestring, text, - ram >=0.20.1 && <0.22 + ram >=0.20.1 && <0.23 if flag(old_toolchain_inliner) cc-options: -fgnu89-inline