Reorganize entropy interfaces.

* separate pool into a different module
* only export by default a simple gathering function
* export an unsafe module with all the memory methods

Crypto/Random/Entropy.hs

@@ -5,108 +5,15 @@
 -- Stability   : experimental
 -- Portability : Good
 --
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ExistentialQuantification #-}
 module Crypto.Random.Entropy
-    ( EntropyPool
+    ( getEntropy
-    , createEntropyPool
-    , getEntropyPtr
-    , getEntropyFrom
-    , 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.Unsafe
-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
 
 -- | 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)

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

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

Crypto/Random/Entropy/Unsafe.hs

@@ -0,0 +1,28 @@
+-- |
+-- Module      : Crypto.Random.Entropy.Unsafe
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- 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)

Crypto/Random/EntropyPool.hs

@@ -0,0 +1,73 @@
+-- |
+-- Module      : Crypto.Random.EntropyPool
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- 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

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