From 61ee4986431b323b41114e9a7c1010ea297fced0 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Mon, 20 Apr 2015 10:56:39 +0100 Subject: [PATCH] remove further deprecated modules and such --- Crypto/Cipher/AES/Primitive.hs | 43 +++++++++++++++------------------- Crypto/Cipher/ChaCha.hs | 37 ++++++++++++++--------------- Crypto/Internal/ByteArray.hs | 7 +++++- Crypto/Random.hs | 4 +--- 4 files changed, 43 insertions(+), 48 deletions(-) diff --git a/Crypto/Cipher/AES/Primitive.hs b/Crypto/Cipher/AES/Primitive.hs index cbf95d4..251ecae 100644 --- a/Crypto/Cipher/AES/Primitive.hs +++ b/Crypto/Cipher/AES/Primitive.hs @@ -1,8 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | -- Module : Crypto.Cipher.AES.Primitive @@ -66,15 +64,12 @@ import Foreign.C.Types import Foreign.C.String import Data.ByteString.Internal import qualified Data.ByteString as B -import System.IO.Unsafe (unsafePerformIO) import Crypto.Error import Crypto.Cipher.Types -import Crypto.Internal.ByteArray -import Crypto.Internal.Memory import Crypto.Cipher.Types.Block (IV(..)) - -import Data.SecureMem +import Crypto.Internal.Compat +import Crypto.Internal.ByteArray instance Cipher AES where cipherName _ = "AES" @@ -150,18 +145,18 @@ withKey2AndIV key1 key2 iv f = withGCMKeyAndCopySt :: AES -> AESGCM -> (Ptr AESGCM -> Ptr AES -> IO a) -> IO (a, AESGCM) withGCMKeyAndCopySt aes (AESGCM gcmSt) f = keyToPtr aes $ \aesPtr -> do - newSt <- secureMemCopy gcmSt - a <- withSecureMemPtr newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr + newSt <- byteArrayCopy gcmSt (\_ -> return ()) + a <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr return (a, AESGCM newSt) withNewGCMSt :: AESGCM -> (Ptr AESGCM -> IO ()) -> IO AESGCM -withNewGCMSt (AESGCM gcmSt) f = withSecureMemCopy gcmSt (f . castPtr) >>= \sm2 -> return (AESGCM sm2) +withNewGCMSt (AESGCM gcmSt) f = byteArrayCopy gcmSt (f . castPtr) >>= \sm2 -> return (AESGCM sm2) withOCBKeyAndCopySt :: AES -> AESOCB -> (Ptr AESOCB -> Ptr AES -> IO a) -> IO (a, AESOCB) withOCBKeyAndCopySt aes (AESOCB gcmSt) f = keyToPtr aes $ \aesPtr -> do - newSt <- secureMemCopy gcmSt - a <- withSecureMemPtr newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr + newSt <- byteArrayCopy gcmSt (\_ -> return ()) + a <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr return (a, AESOCB newSt) -- | Initialize a new context with a key @@ -174,7 +169,7 @@ initAES k | len == 32 = CryptoPassed $ initWithRounds 14 | otherwise = CryptoFailed CryptoError_KeySizeInvalid where len = byteArrayLength k - initWithRounds nbR = AES $ unsafeCreateSecureMem (16+2*2*16*nbR) aesInit + initWithRounds nbR = AES $ byteArrayAllocAndFreeze (16+2*2*16*nbR) aesInit aesInit ptr = withByteArray k $ \ikey -> c_aes_init (castPtr ptr) (castPtr ikey) (fromIntegral len) @@ -227,7 +222,7 @@ genCounter :: ByteArray ba -> (ba, IV AES) genCounter ctx iv len | len <= 0 = (empty, iv) - | otherwise = unsafePerformIO $ + | otherwise = unsafeDoIO $ keyToPtr ctx $ \k -> ivCopyPtr iv $ \i -> byteArrayAlloc outputLength $ \o -> do @@ -410,8 +405,8 @@ doGCM f ctx iv aad input = (output, tag) -- | initialize a gcm context {-# NOINLINE gcmInit #-} gcmInit :: ByteArrayAccess iv => AES -> iv -> AESGCM -gcmInit ctx iv = unsafePerformIO $ do - sm <- createSecureMem sizeGCM $ \gcmStPtr -> +gcmInit ctx iv = unsafeDoIO $ do + sm <- byteArrayAlloc sizeGCM $ \gcmStPtr -> withKeyAndIV ctx iv $ \k v -> c_aes_gcm_init (castPtr gcmStPtr) k v (fromIntegral $ byteArrayLength iv) return $ AESGCM sm @@ -421,7 +416,7 @@ gcmInit ctx iv = unsafePerformIO $ do -- need to happen after initialization and before appending encryption/decryption data. {-# NOINLINE gcmAppendAAD #-} gcmAppendAAD :: ByteArrayAccess aad => AESGCM -> aad -> AESGCM -gcmAppendAAD gcmSt input = unsafePerformIO doAppend +gcmAppendAAD gcmSt input = unsafeDoIO doAppend where doAppend = withNewGCMSt gcmSt $ \gcmStPtr -> withByteArray input $ \i -> @@ -433,7 +428,7 @@ gcmAppendAAD gcmSt input = unsafePerformIO doAppend -- need to happen after AAD appending, or after initialization if no AAD data. {-# NOINLINE gcmAppendEncrypt #-} gcmAppendEncrypt :: ByteArray ba => AES -> AESGCM -> ba -> (ba, AESGCM) -gcmAppendEncrypt ctx gcm input = unsafePerformIO $ withGCMKeyAndCopySt ctx gcm doEnc +gcmAppendEncrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doEnc where len = byteArrayLength input doEnc gcmStPtr aesPtr = byteArrayAlloc len $ \o -> @@ -446,7 +441,7 @@ gcmAppendEncrypt ctx gcm input = unsafePerformIO $ withGCMKeyAndCopySt ctx gcm d -- need to happen after AAD appending, or after initialization if no AAD data. {-# NOINLINE gcmAppendDecrypt #-} gcmAppendDecrypt :: ByteArray ba => AES -> AESGCM -> ba -> (ba, AESGCM) -gcmAppendDecrypt ctx gcm input = unsafePerformIO $ withGCMKeyAndCopySt ctx gcm doDec +gcmAppendDecrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doDec where len = byteArrayLength input doDec gcmStPtr aesPtr = byteArrayAlloc len $ \o -> @@ -481,8 +476,8 @@ doOCB f ctx iv aad input = (output, tag) -- | initialize an ocb context {-# NOINLINE ocbInit #-} ocbInit :: ByteArrayAccess iv => AES -> iv -> AESOCB -ocbInit ctx iv = unsafePerformIO $ do - sm <- createSecureMem sizeOCB $ \ocbStPtr -> +ocbInit ctx iv = unsafeDoIO $ do + sm <- byteArrayAlloc sizeOCB $ \ocbStPtr -> withKeyAndIV ctx iv $ \k v -> c_aes_ocb_init (castPtr ocbStPtr) k v (fromIntegral $ byteArrayLength iv) return $ AESOCB sm @@ -492,7 +487,7 @@ ocbInit ctx iv = unsafePerformIO $ do -- need to happen after initialization and before appending encryption/decryption data. {-# NOINLINE ocbAppendAAD #-} ocbAppendAAD :: ByteArrayAccess aad => AES -> AESOCB -> aad -> AESOCB -ocbAppendAAD ctx ocb input = unsafePerformIO (snd `fmap` withOCBKeyAndCopySt ctx ocb doAppend) +ocbAppendAAD ctx ocb input = unsafeDoIO (snd `fmap` withOCBKeyAndCopySt ctx ocb doAppend) where doAppend ocbStPtr aesPtr = withByteArray input $ \i -> c_aes_ocb_aad ocbStPtr aesPtr i (fromIntegral $ byteArrayLength input) @@ -503,7 +498,7 @@ ocbAppendAAD ctx ocb input = unsafePerformIO (snd `fmap` withOCBKeyAndCopySt ctx -- need to happen after AAD appending, or after initialization if no AAD data. {-# NOINLINE ocbAppendEncrypt #-} ocbAppendEncrypt :: ByteArray ba => AES -> AESOCB -> ba -> (ba, AESOCB) -ocbAppendEncrypt ctx ocb input = unsafePerformIO $ withOCBKeyAndCopySt ctx ocb doEnc +ocbAppendEncrypt ctx ocb input = unsafeDoIO $ withOCBKeyAndCopySt ctx ocb doEnc where len = byteArrayLength input doEnc ocbStPtr aesPtr = byteArrayAlloc len $ \o -> @@ -516,7 +511,7 @@ ocbAppendEncrypt ctx ocb input = unsafePerformIO $ withOCBKeyAndCopySt ctx ocb d -- need to happen after AAD appending, or after initialization if no AAD data. {-# NOINLINE ocbAppendDecrypt #-} ocbAppendDecrypt :: ByteArray ba => AES -> AESOCB -> ba -> (ba, AESOCB) -ocbAppendDecrypt ctx ocb input = unsafePerformIO $ withOCBKeyAndCopySt ctx ocb doDec +ocbAppendDecrypt ctx ocb input = unsafeDoIO $ withOCBKeyAndCopySt ctx ocb doDec where len = byteArrayLength input doDec ocbStPtr aesPtr = byteArrayAlloc len $ \o -> diff --git a/Crypto/Cipher/ChaCha.hs b/Crypto/Cipher/ChaCha.hs index 6895390..414899c 100644 --- a/Crypto/Cipher/ChaCha.hs +++ b/Crypto/Cipher/ChaCha.hs @@ -17,29 +17,26 @@ module Crypto.Cipher.ChaCha , StateSimple ) where -import Control.Applicative -import Data.SecureMem import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as B import qualified Data.ByteString as B import Crypto.Internal.ByteArray import Crypto.Internal.Compat +import Crypto.Internal.Imports import Data.Byteable -import Data.Word import Data.Bits (xor) import Foreign.Ptr import Foreign.ForeignPtr import Foreign.C.Types import Foreign.Storable -import System.IO.Unsafe -- | ChaCha context -data State = State Int -- number of rounds - SecureMem -- ChaCha's state - ByteString -- previous generated chunk +data State = State Int -- number of rounds + SecureBytes -- ChaCha's state + ByteString -- previous generated chunk -- | ChaCha context for DRG purpose (see Crypto.Random.ChaChaDRG) -newtype StateSimple = StateSimple SecureMem -- just ChaCha's state +newtype StateSimple = StateSimple SecureBytes -- just ChaCha's state round64 :: Int -> (Bool, Int) round64 len @@ -50,7 +47,7 @@ round64 len -- | Initialize a new ChaCha context with the number of rounds, -- the key and the nonce associated. -initialize :: Byteable key +initialize :: ByteArrayAccess key => Int -- ^ number of rounds (8,12,20) -> key -- ^ the key (128 or 256 bits) -> ByteString -- ^ the nonce (64 or 96 bits) @@ -60,12 +57,12 @@ initialize nbRounds key nonce | not (nonceLen `elem` [8,12]) = error "ChaCha: nonce length should be 64 or 96 bits" | not (nbRounds `elem` [8,12,20]) = error "ChaCha: rounds should be 8, 12 or 20" | otherwise = unsafeDoIO $ do - stPtr <- createSecureMem 64 $ \stPtr -> - withBytePtr nonce $ \noncePtr -> - withBytePtr key $ \keyPtr -> + stPtr <- byteArrayAlloc 64 $ \stPtr -> + withByteArray nonce $ \noncePtr -> + withByteArray key $ \keyPtr -> ccryptonite_chacha_init (castPtr stPtr) kLen keyPtr nonceLen noncePtr return $ State nbRounds stPtr B.empty - where kLen = byteableLength key + where kLen = byteArrayLength key nonceLen = B.length nonce -- | Initialize simple ChaCha State @@ -75,7 +72,7 @@ initializeSimple :: ByteArray seed initializeSimple seed | sLen /= 40 = error "ChaCha Random: seed length should be 40 bytes" | otherwise = unsafeDoIO $ do - stPtr <- createSecureMem 64 $ \stPtr -> + stPtr <- byteArrayAlloc 64 $ \stPtr -> withByteArray seed $ \seedPtr -> ccryptonite_chacha_init (castPtr stPtr) 32 seedPtr 8 (seedPtr `plusPtr` 32) return $ StateSimple stPtr @@ -94,7 +91,7 @@ combine prev@(State nbRounds prevSt prevOut) src -- without having to generate any extra bytes let (b1,b2) = B.splitAt outputLen prevOut in (B.pack $ B.zipWith xor b1 src, State nbRounds prevSt b2) - | otherwise = unsafePerformIO $ do + | otherwise = unsafeDoIO $ do -- adjusted len is the number of bytes lefts to generate after -- copying from the previous buffer. let adjustedLen = outputLen - prevBufLen @@ -103,14 +100,14 @@ combine prev@(State nbRounds prevSt prevOut) src fptr <- B.mallocByteString (newBytesToGenerate + prevBufLen) newSt <- withForeignPtr fptr $ \dstPtr -> - withBytePtr src $ \srcPtr -> do + withByteArray src $ \srcPtr -> do -- copy the previous buffer by xor if any withBytePtr prevOut $ \prevPtr -> loopXor dstPtr srcPtr prevPtr prevBufLen -- then create a new mutable copy of state - st <- secureMemCopy prevSt - withSecureMemPtr st $ \stPtr -> + st <- byteArrayCopy prevSt (\_ -> return ()) + withByteArray st $ \stPtr -> ccryptonite_chacha_combine nbRounds (dstPtr `plusPtr` prevBufLen) (castPtr stPtr) @@ -144,9 +141,9 @@ generateSimple :: ByteArray ba -> Int -> (ba, StateSimple) generateSimple (StateSimple prevSt) nbBytes = unsafeDoIO $ do - newSt <- secureMemCopy prevSt + newSt <- byteArrayCopy prevSt (\_ -> return ()) output <- byteArrayAlloc nbBytes $ \dstPtr -> - withSecureMemPtr newSt $ \stPtr -> + withByteArray newSt $ \stPtr -> ccryptonite_chacha_random 8 dstPtr (castPtr stPtr) (fromIntegral nbBytes) return (output, StateSimple newSt) diff --git a/Crypto/Internal/ByteArray.hs b/Crypto/Internal/ByteArray.hs index 495e177..344dd3a 100644 --- a/Crypto/Internal/ByteArray.hs +++ b/Crypto/Internal/ByteArray.hs @@ -11,8 +11,13 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} module Crypto.Internal.ByteArray - ( ByteArray(..) + ( + ByteArray(..) , ByteArrayAccess(..) + -- * Inhabitants + , Bytes + , SecureBytes + -- * methods , byteArrayAlloc , byteArrayAllocAndFreeze , empty diff --git a/Crypto/Random.hs b/Crypto/Random.hs index 5f73a8e..d4a77e6 100644 --- a/Crypto/Random.hs +++ b/Crypto/Random.hs @@ -21,9 +21,7 @@ import Crypto.Random.Types import Crypto.Random.ChaChaDRG import Crypto.Random.Entropy import Crypto.Internal.Memory - -import Control.Applicative -import Data.Word (Word64) +import Crypto.Internal.Imports drgNew :: IO ChaChaDRG drgNew = initialize <$> (getEntropy 40 :: IO SecureBytes)