diff --git a/Crypto/Cipher/ChaCha.hs b/Crypto/Cipher/ChaCha.hs index a45f6f7..8dab24b 100644 --- a/Crypto/Cipher/ChaCha.hs +++ b/Crypto/Cipher/ChaCha.hs @@ -90,7 +90,7 @@ combine prev@(State nbRounds prevSt prevOut) src -- we have enough byte in the previous buffer to complete the query -- without having to generate any extra bytes let (b1,b2) = BS.splitAt outputLen prevOut - in (BS.pack $ BS.zipWith xor b1 src, State nbRounds prevSt b2) + in (B.xor b1 src, State nbRounds prevSt b2) | otherwise = unsafeDoIO $ do -- adjusted len is the number of bytes lefts to generate after -- copying from the previous buffer. @@ -106,14 +106,13 @@ combine prev@(State nbRounds prevSt prevOut) src loopXor dstPtr srcPtr prevPtr prevBufLen -- then create a new mutable copy of state - st <- B.copy prevSt (\_ -> return ()) - withByteArray st $ \stPtr -> + B.copy prevSt $ \stPtr -> ccryptonite_chacha_combine nbRounds (dstPtr `plusPtr` prevBufLen) (castPtr stPtr) (srcPtr `plusPtr` prevBufLen) (fromIntegral newBytesToGenerate) - return st + -- return combined byte return ( BS.PS fptr 0 outputLen , State nbRounds newSt (if roundedAlready then BS.empty else BS.PS fptr outputLen nextBufLen)) diff --git a/Crypto/Cipher/RC4.hs b/Crypto/Cipher/RC4.hs index 0c1ea4d..8971783 100644 --- a/Crypto/Cipher/RC4.hs +++ b/Crypto/Cipher/RC4.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module : Crypto.Cipher.RC4 -- License : BSD-style @@ -13,6 +12,8 @@ -- -- Reorganized and simplified to have an opaque context. -- +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Crypto.Cipher.RC4 ( initialize , combine @@ -20,19 +21,16 @@ module Crypto.Cipher.RC4 , State ) where -import Data.Word -import Data.Byteable -import Data.SecureMem -import Foreign.Ptr -import Foreign.ForeignPtr -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as B +import Data.Word +import Foreign.Ptr +import Crypto.Internal.ByteArray (SecureBytes, ByteArray, ByteArrayAccess) +import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.Compat -- | The encryption state for RC4 -newtype State = State SecureMem +newtype State = State SecureBytes + deriving (ByteArrayAccess) -- | C Call for initializing the encryptor foreign import ccall unsafe "cryptonite_rc4.h cryptonite_rc4_init" @@ -52,29 +50,29 @@ foreign import ccall unsafe "cryptonite_rc4.h cryptonite_rc4_combine" -- -- seed the context with an initial key. the key size need to be -- adequate otherwise security takes a hit. -initialize :: Byteable key +initialize :: ByteArrayAccess key => key -- ^ The key -> State -- ^ The RC4 context with the key mixed in initialize key = unsafeDoIO $ do - st <- createSecureMem 264 $ \stPtr -> - withBytePtr key $ \keyPtr -> c_rc4_init keyPtr (fromIntegral $ byteableLength key) (castPtr stPtr) + st <- B.alloc 264 $ \stPtr -> + B.withByteArray key $ \keyPtr -> c_rc4_init keyPtr (fromIntegral $ B.length key) (castPtr stPtr) return $ State st -- | generate the next len bytes of the rc4 stream without combining -- it to anything. -generate :: State -> Int -> (State, ByteString) -generate ctx len = combine ctx (B.replicate len 0) +generate :: ByteArray ba => State -> Int -> (State, ba) +generate ctx len = combine ctx (B.zero len) -- | RC4 xor combination of the rc4 stream with an input -combine :: State -- ^ rc4 context - -> ByteString -- ^ input - -> (State, ByteString) -- ^ new rc4 context, and the output -combine (State prevSt) clearText = unsafeDoIO $ do - outfptr <- B.mallocByteString len - st <- secureMemCopy prevSt - withSecureMemPtr st $ \stPtr -> - withForeignPtr outfptr $ \outptr -> - withBytePtr clearText $ \clearPtr -> - c_rc4_combine (castPtr stPtr) clearPtr (fromIntegral len) outptr - return $! (State st, B.PS outfptr 0 len) +combine :: ByteArray ba + => State -- ^ rc4 context + -> ba -- ^ input + -> (State, ba) -- ^ new rc4 context, and the output +combine (State prevSt) clearText = unsafeDoIO $ + B.allocRet len $ \outptr -> + B.withByteArray clearText $ \clearPtr -> do + st <- B.copy prevSt $ \stPtr -> + c_rc4_combine (castPtr stPtr) clearPtr (fromIntegral len) outptr + return $! State st + --return $! (State st, B.PS outfptr 0 len) where len = B.length clearText diff --git a/Crypto/Cipher/Types/Base.hs b/Crypto/Cipher/Types/Base.hs index 09861d0..d9bb16b 100644 --- a/Crypto/Cipher/Types/Base.hs +++ b/Crypto/Cipher/Types/Base.hs @@ -20,7 +20,7 @@ module Crypto.Cipher.Types.Base import Data.Word import Data.ByteString (ByteString) -import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, SecureBytes, withByteArray) +import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray) import qualified Crypto.Internal.ByteArray as B import Crypto.Error diff --git a/Crypto/Cipher/Types/Block.hs b/Crypto/Cipher/Types/Block.hs index e56457b..a0d584c 100644 --- a/Crypto/Cipher/Types/Block.hs +++ b/Crypto/Cipher/Types/Block.hs @@ -36,7 +36,6 @@ module Crypto.Cipher.Types.Block --, cfb8Decrypt ) where -import Data.Byteable import Data.Word import Crypto.Error import Crypto.Cipher.Types.Base @@ -146,12 +145,12 @@ class BlockCipher cipher => BlockCipher128 cipher where xtsDecrypt = xtsDecryptGeneric -- | Create an IV for a specified block cipher -makeIV :: (Byteable b, BlockCipher c) => b -> Maybe (IV c) +makeIV :: (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c) makeIV b = toIV undefined where toIV :: BlockCipher c => c -> Maybe (IV c) toIV cipher - | byteableLength b == sz = Just (IV $ toBytes b) - | otherwise = Nothing + | B.length b == sz = Just $ IV (B.convert b :: Bytes) + | otherwise = Nothing where sz = blockSize cipher -- | Create an IV that is effectively representing the number 0 diff --git a/Crypto/Data/AFIS.hs b/Crypto/Data/AFIS.hs index 8f173ca..2b06bef 100644 --- a/Crypto/Data/AFIS.hs +++ b/Crypto/Data/AFIS.hs @@ -21,6 +21,8 @@ module Crypto.Data.AFIS import Crypto.Hash import Crypto.Random.Types import Crypto.Internal.Memory (Bytes) +import Crypto.Internal.Bytes (bufSet, bufCopy) +import Crypto.Internal.Compat import Crypto.Internal.ByteArray (withByteArray) import Control.Monad (forM_, foldM) import Data.Byteable @@ -29,11 +31,10 @@ import Data.Word import Data.Bits import Foreign.Storable import Foreign.Ptr -import Foreign.ForeignPtr (withForeignPtr, newForeignPtr_) -import qualified Data.ByteString as B +import Foreign.ForeignPtr (newForeignPtr_) import qualified Data.ByteString.Internal as B -import System.IO.Unsafe (unsafePerformIO) +import qualified Crypto.Internal.ByteArray as B -- | Split data to diffused data, using a random generator and -- an hash algorithm. @@ -62,15 +63,14 @@ split :: (HashAlgorithm a, DRG rng) {-# NOINLINE split #-} split hashF rng expandTimes src | expandTimes <= 1 = error "invalid expandTimes value" - | otherwise = unsafePerformIO $ do - fptr <- B.mallocByteString diffusedLen - rng' <- withForeignPtr fptr runOp - return (B.fromForeignPtr fptr 0 diffusedLen, rng') + | otherwise = unsafeDoIO $ do + (rng', bs) <- B.allocRet diffusedLen runOp + return (bs, rng') where diffusedLen = blockSize * expandTimes blockSize = B.length src runOp dstPtr = do let lastBlock = dstPtr `plusPtr` (blockSize * (expandTimes-1)) - _ <- B.memset lastBlock 0 (fromIntegral blockSize) + bufSet lastBlock 0 blockSize let randomBlockPtrs = map (plusPtr dstPtr . (*) blockSize) [0..(expandTimes-2)] rng' <- foldM fillRandomBlock rng randomBlockPtrs mapM_ (addRandomBlock lastBlock) randomBlockPtrs @@ -81,7 +81,7 @@ split hashF rng expandTimes src diffuse hashF lastBlock blockSize fillRandomBlock g blockPtr = do let (rand :: Bytes, g') = randomBytesGenerate blockSize g - withByteArray rand $ \randPtr -> B.memcpy blockPtr randPtr (fromIntegral blockSize) + withByteArray rand $ \randPtr -> bufCopy blockPtr randPtr (fromIntegral blockSize) return g' -- | Merge previously diffused data back to the original data. @@ -94,9 +94,9 @@ merge :: HashAlgorithm a merge hashF expandTimes bs | r /= 0 = error "diffused data not a multiple of expandTimes" | originalSize <= 0 = error "diffused data null" - | otherwise = unsafePerformIO $ B.create originalSize $ \dstPtr -> - withBytePtr bs $ \srcPtr -> do - _ <- B.memset dstPtr 0 (fromIntegral originalSize) + | otherwise = B.allocAndFreeze originalSize $ \dstPtr -> + B.withByteArray bs $ \srcPtr -> do + bufSet dstPtr 0 originalSize forM_ [0..(expandTimes-2)] $ \i -> do xorMem (srcPtr `plusPtr` (i * originalSize)) dstPtr originalSize diffuse hashF dstPtr originalSize @@ -126,10 +126,10 @@ diffuse :: HashAlgorithm a diffuse hashF src sz = loop src 0 where (full,pad) = sz `quotRem` digestSize loop s i | i < full = do h <- hashBlock i `fmap` byteStringOfPtr s digestSize - withBytePtr h $ \hPtr -> B.memcpy s hPtr (fromIntegral digestSize) + B.withByteArray h $ \hPtr -> bufCopy s hPtr digestSize loop (s `plusPtr` digestSize) (i+1) | pad /= 0 = do h <- hashBlock i `fmap` byteStringOfPtr s pad - withBytePtr h $ \hPtr -> B.memcpy s hPtr (fromIntegral pad) + B.withByteArray h $ \hPtr -> bufCopy s hPtr pad return () | otherwise = return () @@ -139,12 +139,12 @@ diffuse hashF src sz = loop src 0 byteStringOfPtr ptr digestSz = newForeignPtr_ ptr >>= \fptr -> return $ B.fromForeignPtr fptr 0 digestSz hashBlock n b = - toBytes $ hashF $ B.unsafeCreate (B.length b+4) $ \ptr -> do + toBytes $ hashF $ B.allocAndFreeze (B.length b+4) $ \ptr -> do poke ptr (f8 (n `shiftR` 24)) poke (ptr `plusPtr` 1) (f8 (n `shiftR` 16)) poke (ptr `plusPtr` 2) (f8 (n `shiftR` 8)) poke (ptr `plusPtr` 3) (f8 n) --putWord32BE (fromIntegral n) >> putBytes src) - withBytePtr b $ \srcPtr -> B.memcpy (ptr `plusPtr` 4) srcPtr (fromIntegral $ B.length b) + withByteArray b $ \srcPtr -> bufCopy (ptr `plusPtr` 4) srcPtr (B.length b) where f8 :: Int -> Word8 f8 = fromIntegral diff --git a/Crypto/Internal/ByteArray.hs b/Crypto/Internal/ByteArray.hs index 9c49384..606dfc0 100644 --- a/Crypto/Internal/ByteArray.hs +++ b/Crypto/Internal/ByteArray.hs @@ -18,12 +18,14 @@ module Crypto.Internal.ByteArray -- * Inhabitants , Bytes , SecureBytes + , MemView(..) -- * methods , alloc , allocAndFreeze , empty , zero , copy + , take , convert , copyRet , copyAndFreeze @@ -57,6 +59,12 @@ import qualified Data.ByteString.Internal as B import Prelude (flip, return, div, (-), ($), (==), (/=), (<=), (>=), Int, Bool(..), IO, otherwise, sum, map, fmap, snd, (.), min) +data MemView = MemView !(Ptr Word8) !Int + +instance ByteArrayAccess MemView where + length (MemView _ l) = l + withByteArray (MemView p _) f = f (castPtr p) + class ByteArrayAccess ba where length :: ba -> Int withByteArray :: ba -> (Ptr p -> IO a) -> IO a @@ -126,6 +134,13 @@ split n bs return (b1, b2) where len = length bs +take :: ByteArray bs => Int -> bs -> bs +take n bs = + allocAndFreeze m $ \d -> withByteArray bs $ \s -> bufCopy d s m + where + m = min len n + len = length bs + concat :: ByteArray bs => [bs] -> bs concat [] = empty concat allBs = allocAndFreeze total (loop allBs) diff --git a/Crypto/MAC/Poly1305.hs b/Crypto/MAC/Poly1305.hs index b4e05dc..47d9038 100644 --- a/Crypto/MAC/Poly1305.hs +++ b/Crypto/MAC/Poly1305.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module : Crypto.MAC.Poly1305 @@ -9,6 +8,8 @@ -- -- Poly1305 implementation -- +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Crypto.MAC.Poly1305 ( Ctx , Auth(..) @@ -22,27 +23,22 @@ module Crypto.MAC.Poly1305 , auth ) where -import Control.Monad (void) -import Foreign.Ptr -import Foreign.C.Types -import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as B -import Data.ByteString (ByteString) -import Data.Word -import Data.Byteable -import System.IO.Unsafe -import Data.SecureMem +import Foreign.Ptr +import Foreign.C.Types +import Data.Word +import Crypto.Internal.ByteArray (ByteArrayAccess, SecureBytes, Bytes) +import qualified Crypto.Internal.ByteArray as B -- | Poly1305 Context -newtype Ctx = Ctx SecureMem +newtype Ctx = Ctx SecureBytes + deriving (ByteArrayAccess) -- | Poly1305 Auth -newtype Auth = Auth ByteString +newtype Auth = Auth Bytes + deriving (ByteArrayAccess) instance Eq Auth where - (Auth a1) == (Auth a2) = constEqBytes a1 a2 -instance Byteable Auth where - toBytes (Auth b) = b + (Auth a1) == (Auth a2) = B.constEq a1 a2 foreign import ccall unsafe "cryptonite_poly1305.h cryptonite_poly1305_init" c_poly1305_init :: Ptr Ctx -> Ptr Word8 -> IO () @@ -54,55 +50,50 @@ foreign import ccall unsafe "cryptonite_poly1305.h cryptonite_poly1305_finalize" c_poly1305_finalize :: Ptr Word8 -> Ptr Ctx -> IO () -- | initialize a Poly1305 context -initialize :: Byteable key - => key - -> Ctx +initialize :: ByteArrayAccess key + => key + -> Ctx initialize key - | byteableLength key /= 32 = error "Poly1305: key length expected 32 bytes" - | otherwise = Ctx $ unsafePerformIO $ do - withBytePtr key $ \keyPtr -> - createSecureMem 84 $ \ctxPtr -> - c_poly1305_init (castPtr ctxPtr) keyPtr + | B.length key /= 32 = error "Poly1305: key length expected 32 bytes" + | otherwise = Ctx $ B.allocAndFreeze 84 $ \ctxPtr -> + B.withByteArray key $ \keyPtr -> + c_poly1305_init (castPtr ctxPtr) keyPtr {-# NOINLINE initialize #-} -- | update a context with a bytestring -update :: Ctx -> ByteString -> Ctx -update (Ctx prevCtx) d = unsafePerformIO $ do - ctx <- secureMemCopy prevCtx - withSecureMemPtr ctx $ \ctxPtr -> - withBytePtr d $ \dataPtr -> - c_poly1305_update (castPtr ctxPtr) dataPtr (fromIntegral $ B.length d) - return $ Ctx ctx +update :: ByteArrayAccess ba => Ctx -> ba -> Ctx +update (Ctx prevCtx) d = Ctx $ B.copyAndFreeze prevCtx $ \ctxPtr -> + B.withByteArray d $ \dataPtr -> + c_poly1305_update (castPtr ctxPtr) dataPtr (fromIntegral $ B.length d) {-# NOINLINE update #-} -- | updates a context with multiples bytestring -updates :: Ctx -> [ByteString] -> Ctx -updates (Ctx prevCtx) d = unsafePerformIO $ do - ctx <- secureMemCopy prevCtx - withSecureMemPtr ctx (loop d . castPtr) - return $ Ctx ctx +updates :: ByteArrayAccess ba => Ctx -> [ba] -> Ctx +updates (Ctx prevCtx) d = Ctx $ B.copyAndFreeze prevCtx (loop d) where loop [] _ = return () loop (x:xs) ctxPtr = do - withBytePtr x $ \dataPtr -> c_poly1305_update ctxPtr dataPtr (fromIntegral $ B.length x) + B.withByteArray x $ \dataPtr -> c_poly1305_update ctxPtr dataPtr (fromIntegral $ B.length x) loop xs ctxPtr {-# NOINLINE updates #-} -- | finalize the context into a digest bytestring finalize :: Ctx -> Auth -finalize (Ctx prevCtx) = Auth $ B.unsafeCreate 16 $ \dst -> do - ctx <- secureMemCopy prevCtx - withSecureMemPtr ctx $ \ctxPtr -> c_poly1305_finalize dst (castPtr ctxPtr) +finalize (Ctx prevCtx) = Auth $ B.allocAndFreeze 16 $ \dst -> do + _ <- B.copy prevCtx (\ctxPtr -> c_poly1305_finalize dst (castPtr ctxPtr)) :: IO SecureBytes + return () {-# NOINLINE finalize #-} -- | One-pass authorization creation -auth :: Byteable key => key -> ByteString -> Auth +auth :: (ByteArrayAccess key, ByteArrayAccess ba) => key -> ba -> Auth auth key d - | byteableLength key /= 32 = error "Poly1305: key length expected 32 bytes" - | otherwise = Auth $ B.unsafeCreate 16 $ \dst -> do - -- initialize the context - void $ createSecureMem 84 $ \ctxPtr -> withBytePtr key $ \keyPtr -> do - c_poly1305_init (castPtr ctxPtr) keyPtr - withBytePtr d $ \dataPtr -> - c_poly1305_update (castPtr ctxPtr) dataPtr (fromIntegral $ B.length d) - -- finalize - c_poly1305_finalize dst (castPtr ctxPtr) + | B.length key /= 32 = error "Poly1305: key length expected 32 bytes" + | otherwise = Auth $ B.allocAndFreeze 16 $ \dst -> do + _ <- B.alloc 84 (onCtx dst) :: IO SecureBytes + return () + where + onCtx dst ctxPtr = + B.withByteArray key $ \keyPtr -> do + c_poly1305_init (castPtr ctxPtr) keyPtr + B.withByteArray d $ \dataPtr -> + c_poly1305_update (castPtr ctxPtr) dataPtr (fromIntegral $ B.length d) + c_poly1305_finalize dst (castPtr ctxPtr) diff --git a/Crypto/Random/EntropyPool.hs b/Crypto/Random/EntropyPool.hs index dc2ccfa..0d55d19 100644 --- a/Crypto/Random/EntropyPool.hs +++ b/Crypto/Random/EntropyPool.hs @@ -14,9 +14,8 @@ module Crypto.Random.EntropyPool import Control.Concurrent.MVar import Crypto.Random.Entropy.Unsafe -import Crypto.Internal.ByteArray (ByteArray) +import Crypto.Internal.ByteArray (ByteArray, SecureBytes) import qualified Crypto.Internal.ByteArray as B -import Data.SecureMem import Data.Word (Word8) import Data.Maybe (catMaybes) import Foreign.Marshal.Utils (copyBytes) @@ -24,7 +23,7 @@ import Foreign.Ptr (plusPtr, Ptr) -- | Pool of Entropy. contains a self mutating pool of entropy, -- that is always guarantee to contains data. -data EntropyPool = EntropyPool [EntropyBackend] (MVar Int) SecureMem +data EntropyPool = EntropyPool [EntropyBackend] (MVar Int) SecureBytes -- size of entropy pool by default defaultPoolSize :: Int @@ -35,9 +34,8 @@ defaultPoolSize = 4096 -- While you can create as many entropy pool as you want, the pool can be shared between multiples RNGs. createEntropyPoolWith :: Int -> [EntropyBackend] -> IO EntropyPool createEntropyPoolWith poolSize backends = do - sm <- allocateSecureMem poolSize m <- newMVar 0 - withSecureMemPtr sm $ replenish poolSize backends + sm <- B.alloc poolSize (replenish poolSize backends) return $ EntropyPool backends m sm -- | Create a new entropy pool with a default size. @@ -51,10 +49,10 @@ createEntropyPool = do -- | Put a chunk of the entropy pool into a buffer getEntropyPtr :: EntropyPool -> Int -> Ptr Word8 -> IO () getEntropyPtr (EntropyPool backends posM sm) n outPtr = - withSecureMemPtr sm $ \entropyPoolPtr -> + B.withByteArray sm $ \entropyPoolPtr -> modifyMVar_ posM $ \pos -> copyLoop outPtr entropyPoolPtr pos n - where poolSize = secureMemGetSize sm + where poolSize = B.length sm copyLoop d s pos left | left == 0 = return pos | otherwise = do