diff --git a/Crypto/Random/Entropy.hs b/Crypto/Random/Entropy.hs index a3c314a..d80251d 100644 --- a/Crypto/Random/Entropy.hs +++ b/Crypto/Random/Entropy.hs @@ -5,108 +5,15 @@ -- Stability : experimental -- Portability : Good -- -{-# LANGUAGE CPP #-} -{-# LANGUAGE ExistentialQuantification #-} module Crypto.Random.Entropy - ( EntropyPool - , createEntropyPool - , getEntropyPtr - , getEntropyFrom - , getEntropy + ( getEntropy ) where -import Control.Concurrent.MVar import Data.Maybe (catMaybes) import Data.SecureMem -import Data.Word (Word8) -import Foreign.Marshal.Utils (copyBytes) -import Foreign.Ptr (plusPtr, Ptr) import Crypto.Random.Types - -import Crypto.Random.Entropy.Source -#ifdef SUPPORT_RDRAND -import Crypto.Random.Entropy.RDRand -#endif -#ifdef WINDOWS -import Crypto.Random.Entropy.Windows -#else -import Crypto.Random.Entropy.Unix -#endif - -supportedBackends :: [IO (Maybe EntropyBackend)] -supportedBackends = - [ -#ifdef SUPPORT_RDRAND - openBackend (undefined :: RDRand), -#endif -#ifdef WINDOWS - openBackend (undefined :: WinCryptoAPI) -#else - openBackend (undefined :: DevRandom), openBackend (undefined :: DevURandom) -#endif - ] - -data EntropyBackend = forall b . EntropySource b => EntropyBackend b - -openBackend :: EntropySource b => b -> IO (Maybe EntropyBackend) -openBackend b = fmap EntropyBackend `fmap` callOpen b - where callOpen :: EntropySource b => b -> IO (Maybe b) - callOpen _ = entropyOpen - -gatherBackend :: EntropyBackend -> Ptr Word8 -> Int -> IO Int -gatherBackend (EntropyBackend backend) ptr n = entropyGather backend ptr n - --- | Pool of Entropy. contains a self mutating pool of entropy, --- that is always guarantee to contains data. -data EntropyPool = EntropyPool [EntropyBackend] (MVar Int) SecureMem - --- size of entropy pool by default -defaultPoolSize :: Int -defaultPoolSize = 4096 - --- | Create a new entropy pool of a specific size --- --- 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 - return $ EntropyPool backends m sm - --- | Create a new entropy pool with a default size. --- --- While you can create as many entropy pool as you want, the pool can be shared between multiples RNGs. -createEntropyPool :: IO EntropyPool -createEntropyPool = do - backends <- catMaybes `fmap` sequence supportedBackends - createEntropyPoolWith defaultPoolSize backends - --- | 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 -> - modifyMVar_ posM $ \pos -> - copyLoop outPtr entropyPoolPtr pos n - where poolSize = secureMemGetSize sm - copyLoop d s pos left - | left == 0 = return pos - | otherwise = do - wrappedPos <- - if pos == poolSize - then replenish poolSize backends s >> return 0 - else return pos - let m = min (poolSize - wrappedPos) left - copyBytes d (s `plusPtr` wrappedPos) m - copyLoop (d `plusPtr` m) s (wrappedPos + m) (left - m) - --- | Grab a chunk of entropy from the entropy pool. -getEntropyFrom :: EntropyPool -> Int -> IO Random -getEntropyFrom pool n = do - out <- allocateSecureMem n - withSecureMemPtr out $ getEntropyPtr pool n - return $ Random out +import Crypto.Random.Entropy.Unsafe -- | Get some entropy from the system source of entropy getEntropy :: Int -> IO Random @@ -115,16 +22,3 @@ getEntropy n = do out <- allocateSecureMem n withSecureMemPtr out $ replenish n backends return $ Random out - --- Refill the entropy in a buffer -replenish :: Int -> [EntropyBackend] -> Ptr Word8 -> IO () -replenish _ [] _ = fail "cryptonite: random: cannot get any source of entropy on this system" -replenish poolSize backends ptr = loop 0 backends ptr poolSize - where loop :: Int -> [EntropyBackend] -> Ptr Word8 -> Int -> IO () - loop retry [] p n | n == 0 = return () - | retry == 3 = error "cryptonite: random: cannot fully replenish" - | otherwise = loop (retry+1) backends p n - loop _ (_:_) _ 0 = return () - loop retry (b:bs) p n = do - r <- gatherBackend b p n - loop retry bs (p `plusPtr` r) (n - r) diff --git a/Crypto/Random/Entropy/Backend.hs b/Crypto/Random/Entropy/Backend.hs new file mode 100644 index 0000000..08b5691 --- /dev/null +++ b/Crypto/Random/Entropy/Backend.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExistentialQuantification #-} +module Crypto.Random.Entropy.Backend + ( EntropyBackend + , supportedBackends + , gatherBackend + ) where + +import Foreign.Ptr +import Data.Word (Word8) +import Crypto.Random.Entropy.Source +#ifdef SUPPORT_RDRAND +import Crypto.Random.Entropy.RDRand +#endif +#ifdef WINDOWS +import Crypto.Random.Entropy.Windows +#else +import Crypto.Random.Entropy.Unix +#endif + +supportedBackends :: [IO (Maybe EntropyBackend)] +supportedBackends = + [ +#ifdef SUPPORT_RDRAND + openBackend (undefined :: RDRand), +#endif +#ifdef WINDOWS + openBackend (undefined :: WinCryptoAPI) +#else + openBackend (undefined :: DevRandom), openBackend (undefined :: DevURandom) +#endif + ] + +data EntropyBackend = forall b . EntropySource b => EntropyBackend b + +openBackend :: EntropySource b => b -> IO (Maybe EntropyBackend) +openBackend b = fmap EntropyBackend `fmap` callOpen b + where callOpen :: EntropySource b => b -> IO (Maybe b) + callOpen _ = entropyOpen + +gatherBackend :: EntropyBackend -> Ptr Word8 -> Int -> IO Int +gatherBackend (EntropyBackend backend) ptr n = entropyGather backend ptr n diff --git a/Crypto/Random/Entropy/Source.hs b/Crypto/Random/Entropy/Source.hs index 49d7f61..0ef1468 100644 --- a/Crypto/Random/Entropy/Source.hs +++ b/Crypto/Random/Entropy/Source.hs @@ -5,6 +5,8 @@ -- Stability : experimental -- Portability : Good -- +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExistentialQuantification #-} module Crypto.Random.Entropy.Source where import Foreign.Ptr diff --git a/Crypto/Random/Entropy/Unsafe.hs b/Crypto/Random/Entropy/Unsafe.hs new file mode 100644 index 0000000..3690b2c --- /dev/null +++ b/Crypto/Random/Entropy/Unsafe.hs @@ -0,0 +1,28 @@ +-- | +-- Module : Crypto.Random.Entropy.Unsafe +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +module Crypto.Random.Entropy.Unsafe + ( replenish + , module Crypto.Random.Entropy.Backend + ) where + +import Data.Word (Word8) +import Foreign.Ptr (Ptr, plusPtr) +import Crypto.Random.Entropy.Backend + +-- Refill the entropy in a buffer +replenish :: Int -> [EntropyBackend] -> Ptr Word8 -> IO () +replenish _ [] _ = fail "cryptonite: random: cannot get any source of entropy on this system" +replenish poolSize backends ptr = loop 0 backends ptr poolSize + where loop :: Int -> [EntropyBackend] -> Ptr Word8 -> Int -> IO () + loop retry [] p n | n == 0 = return () + | retry == 3 = error "cryptonite: random: cannot fully replenish" + | otherwise = loop (retry+1) backends p n + loop _ (_:_) _ 0 = return () + loop retry (b:bs) p n = do + r <- gatherBackend b p n + loop retry bs (p `plusPtr` r) (n - r) diff --git a/Crypto/Random/EntropyPool.hs b/Crypto/Random/EntropyPool.hs new file mode 100644 index 0000000..e22bbe1 --- /dev/null +++ b/Crypto/Random/EntropyPool.hs @@ -0,0 +1,73 @@ +-- | +-- Module : Crypto.Random.EntropyPool +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +module Crypto.Random.EntropyPool + ( EntropyPool + , createEntropyPool + , createEntropyPoolWith + , getEntropyFrom + ) where + +import Control.Concurrent.MVar +import Crypto.Random.Entropy.Unsafe +import Crypto.Random.Types +import Data.SecureMem +import Data.Word (Word8) +import Data.Maybe (catMaybes) +import Foreign.Marshal.Utils (copyBytes) +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 + +-- size of entropy pool by default +defaultPoolSize :: Int +defaultPoolSize = 4096 + +-- | Create a new entropy pool of a specific size +-- +-- 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 + return $ EntropyPool backends m sm + +-- | Create a new entropy pool with a default size. +-- +-- While you can create as many entropy pool as you want, the pool can be shared between multiples RNGs. +createEntropyPool :: IO EntropyPool +createEntropyPool = do + backends <- catMaybes `fmap` sequence supportedBackends + createEntropyPoolWith defaultPoolSize backends + +-- | 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 -> + modifyMVar_ posM $ \pos -> + copyLoop outPtr entropyPoolPtr pos n + where poolSize = secureMemGetSize sm + copyLoop d s pos left + | left == 0 = return pos + | otherwise = do + wrappedPos <- + if pos == poolSize + then replenish poolSize backends s >> return 0 + else return pos + let m = min (poolSize - wrappedPos) left + copyBytes d (s `plusPtr` wrappedPos) m + copyLoop (d `plusPtr` m) s (wrappedPos + m) (left - m) + +-- | Grab a chunk of entropy from the entropy pool. +getEntropyFrom :: EntropyPool -> Int -> IO Random +getEntropyFrom pool n = do + out <- allocateSecureMem n + withSecureMemPtr out $ getEntropyPtr pool n + return $ Random out diff --git a/cryptonite.cabal b/cryptonite.cabal index 9f8030e..ef856b7 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -47,10 +47,13 @@ Library Crypto.Hash.Whirlpool Crypto.Random.Types Crypto.Random.Entropy + , Crypto.Random.EntropyPool + , Crypto.Random.Entropy.Unsafe Other-modules: Crypto.Hash.Internal , Crypto.Hash.Utils , Crypto.Hash.Types , Crypto.Random.Entropy.Source + , Crypto.Random.Entropy.Backend Build-depends: base >= 4.5 && < 5 , bytestring , securemem