crypto-rng 0.2.0.1 → 0.3.0.0

raw patch · 6 files changed

+162/−139 lines, 6 filesdep +entropydep −DRBGdep −crypto-apidep ~bytestringdep ~exceptionsdep ~monad-controlPVP ok

version bump matches the API change (PVP)

Dependencies added: entropy

Dependencies removed: DRBG, crypto-api

Dependency ranges changed: bytestring, exceptions, monad-control, mtl, random, transformers-base

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• crypto-rng.cabal +14/−14
• src/Crypto/RNG.hs +72/−116
• src/Crypto/RNG/Class.hs +4/−7
• src/Crypto/RNG/Unsafe.hs +67/−0
• src/Crypto/RNG/Utils.hs +1/−2

@@ -1,5 +1,9 @@ # Revision history for crypto-rng +## 0.3.0.0  -- 2022-02-21++* Use the entropy package instead of DRBG.+ ## 0.2.0.1  -- 2022-02-16  * Better selection strategy for picking generators from the pool.

@@ -1,9 +1,9 @@ name:                crypto-rng-version:             0.2.0.1+version:             0.3.0.0 synopsis:            Cryptographic random number generator. -description:         Convenient wrapper for the cryptographic random generator-                     provided by the DRBG package.+description:         Convenient wrapper for the source of random bytes+                     provided by the @entropy@ package.  homepage:            https://github.com/scrive/crypto-rng license:             BSD3@@ -14,7 +14,7 @@ copyright:           Scrive AB category:            Crypto build-type:          Simple-tested-with:         GHC ==8.8.4 || ==8.10.7 || ==9.0.2+tested-with:         GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.1 extra-source-files:  ChangeLog.md cabal-version:       >=1.10 @@ -28,17 +28,17 @@   exposed-modules:     Crypto.RNG                        Crypto.RNG.Class                        Crypto.RNG.Utils+                       Crypto.RNG.Unsafe -  build-depends:       base              >= 4.13    && < 5,-                       DRBG              >= 0.5.5  && < 0.6,-                       bytestring        >= 0.10.8 && < 0.12,-                       crypto-api        >= 0.13.2 && < 0.14,-                       mtl               >= 2.2.1  && < 2.3,-                       exceptions        >= 0.8.3  && < 0.11,-                       monad-control     >= 1.0.1  && < 1.1,-                       primitive         >= 0.7,-                       random            >= 1.2,-                       transformers-base >= 0.4.4  && < 0.5+  build-depends:       base              >= 4.13    && < 5+                     , bytestring        >= 0.10.8+                     , entropy           >= 0.4+                     , exceptions        >= 0.8.3+                     , monad-control     >= 1.0.1+                     , mtl               >= 2.2+                     , primitive         >= 0.7+                     , random            >= 1.2     && <1.3+                     , transformers-base >= 0.4.4    hs-source-dirs:      src 

@@ -1,169 +1,125 @@-{-# LANGUAGE BangPatterns               #-}-{-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE UndecidableInstances       #-}---- | Support for generation of cryptographically secure random--- numbers, based on the DRBG package.------ This is a convenience layer on top of DRBG, which allows you to--- pull random values by means of the method 'random', while keeping--- the state of the random number generator (RNG) inside a monad.  The--- state is protected by an MVar, which means that concurrent--- generation of random values from several threads works straight out--- of the box.+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+-- | Support for generation of cryptographically secure random numbers. ----- The access to the RNG state is captured by a class.  By making--- instances of this class, client code can enjoy RNG generation from--- their own monads.+-- This is a convenience layer on top of "System.Entropy", which allows you to+-- pull random values by means of the class 'CryptoRNG', while keeping the state+-- of the random number generator (RNG) inside a monad. The state is protected+-- by an MVar, which means that concurrent generation of random values from+-- several threads works straight out of the box. module Crypto.RNG   ( -- * CryptoRNG class     module Crypto.RNG.Class-    -- * Generation of strings and numbers-  , CryptoRNGState-  , newCryptoRNGState-  , newCryptoRNGStateSized-  , unsafeCryptoRNGState-  , randomBytesIO-  , randomIO-  , randomRIO     -- * Monad transformer for carrying rng state   , CryptoRNGT   , mapCryptoRNGT   , runCryptoRNGT   , withCryptoRNGState+    -- * Instantiation of the initial RNG state+  , CryptoRNGState+  , newCryptoRNGState+  , newCryptoRNGStateSized+    -- ** Low-level utils+  , randomBytesIO   ) where  import Control.Applicative import Control.Concurrent+import Control.Monad import Control.Monad.Base import Control.Monad.Catch-import Control.Monad.Cont import Control.Monad.Except import Control.Monad.Reader import Control.Monad.Trans.Control-import Crypto.Random-import Crypto.Random.DRBG import Data.Bits import Data.ByteString (ByteString)-import Data.Either-import Data.Primitive.SmallArray+import System.Entropy import qualified Data.ByteString as BS-import qualified System.Random as R+import qualified Data.ByteString.Short as SBS+import qualified System.Random.Stateful as R  import Crypto.RNG.Class  -- | The random number generator state.-newtype CryptoRNGState = CryptoRNGState (SmallArray (MVar RNG))+newtype CryptoRNGState = CryptoRNGState (MVar Buffer) --- | The random number generator.-newtype RNG = RNG (GenBuffered (GenAutoReseed HashDRBG HashDRBG))+-- | A buffer of random bytes for immediate consumption.+data Buffer = Buffer+  { maxSize :: !Int+  , bytes   :: !BS.ByteString+  } -instance R.RandomGen RNG where-  split = error "split"-  genWord32 (RNG g) = case genBytes 4 g of-    Left err       -> error $ "genBytes failed: " ++ show err-    Right (bs, g') -> (mkWord bs, RNG g')-  genWord64 (RNG g) = case genBytes 8 g of-    Left err       -> error $ "genBytes failed: " ++ show err-    Right (bs, g') -> (mkWord bs, RNG g')+instance R.StatefulGen CryptoRNGState IO where+  uniformWord8  st = mkWord <$> randomBytesIO 1 st+  uniformWord16 st = mkWord <$> randomBytesIO 2 st+  uniformWord32 st = mkWord <$> randomBytesIO 4 st+  uniformWord64 st = mkWord <$> randomBytesIO 8 st+  uniformShortByteString n st = SBS.toShort <$> randomBytesIO n st  mkWord :: (Bits a, Integral a) => ByteString -> a mkWord bs = BS.foldl' (\acc w -> shiftL acc 8 .|. fromIntegral w) 0 bs --- | Work with one of the RNGs from the pool.-withRNG :: CryptoRNGState -> (RNG -> (a, RNG)) -> IO a-withRNG (CryptoRNGState pool) f = do-  -- Selection strategy is based on the id of a capability instead of an id of a-  -- thread as that offers much better performance in a typical scenario when-  -- the size of the pool is equal to the number of capabilities and there are-  -- more threads than capabilities.-  (cid, _) <- threadCapability =<< myThreadId-  let mrng = pool `indexSmallArray` (cid `rem` sizeofSmallArray pool)-  modifyMVar mrng $ \rng -> do-    (a, newRng) <- pure $ f rng-    newRng `seq` pure (newRng, a)- ---------------------------------------- --- | Create a new 'CryptoRNGState', based on system entropy.+-- | Create a new 'CryptoRNGState' based on system entropy with a buffer size of+-- 32KB. newCryptoRNGState :: MonadIO m => m CryptoRNGState-newCryptoRNGState = newCryptoRNGStateSized =<< liftIO getNumCapabilities+newCryptoRNGState = newCryptoRNGStateSized $ 32 * 1024 --- | Create a new 'CryptoRNGState', based on system entropy with the pool of a--- specific size.------ /Note:/ making the pool bigger than the number of capabilities will not--- affect anything.+-- | Create a new 'CryptoRNGState' based on system entropy with a buffer of+-- specified size. newCryptoRNGStateSized   :: MonadIO m-  => Int -- ^ Pool size.-  -> m CryptoRNGState-newCryptoRNGStateSized n = liftIO $ do-  pool <- replicateM n $ newMVar . RNG =<< newGenIO-  pure . CryptoRNGState $ smallArrayFromListN n pool---- | Create a new 'CryptoRNGState', based on a bytestring seed.--- Should only be used for testing.-unsafeCryptoRNGState-  :: MonadIO m-  => [ByteString]-  -- ^ Seeds for each generator from the pool.+  => Int -- ^ Buffer size.   -> m CryptoRNGState-unsafeCryptoRNGState ss = liftIO $ do-  case partitionEithers $ map newGen ss of-    ([], gens) -> do-      pool <- mapM (newMVar . RNG) gens-      pure . CryptoRNGState $ smallArrayFromList pool-    (errs, _)  -> error $ show errs---- | Generate given number of cryptographically secure random bytes.-randomBytesIO :: ByteLength -- ^ number of bytes to generate-              -> CryptoRNGState-              -> IO ByteString-randomBytesIO n pool = withRNG pool $ \(RNG g) ->-  case genBytes n g of-    Left err       -> error $ "genBytes failed: " ++ show err-    Right (bs, g') -> (bs, RNG g')+newCryptoRNGStateSized bufferSize = liftIO $ do+  when (bufferSize <= 0) $ do+    error "Buffer size must be larger than 0"+  CryptoRNGState <$> newMVar (Buffer bufferSize BS.empty) -randomIO :: R.Uniform a => CryptoRNGState -> IO a-randomIO pool = withRNG pool $ \g -> R.uniform g+-- | Generate a number of cryptographically secure random bytes.+randomBytesIO :: Int -> CryptoRNGState -> IO ByteString+randomBytesIO n (CryptoRNGState rng) = modifyMVar rng $ \buf -> do+  (rs, newBuf) <- generateBytes buf n []+  pure (newBuf, BS.concat rs) -randomRIO :: R.UniformRange a => (a, a) -> CryptoRNGState -> IO a-randomRIO bounds pool = withRNG pool $ \g -> R.uniformR bounds g+generateBytes+  :: Buffer+  -> Int+  -> [BS.ByteString]+  -> IO ([BS.ByteString], Buffer)+generateBytes buf n acc = do+  (r, newBytes) <- BS.splitAt n <$> if BS.null (bytes buf)+                                    then getEntropy (maxSize buf)+                                    else pure (bytes buf)+  let newBuf = buf { bytes = newBytes }+      k = n - BS.length r+  newBuf `seq` if k <= 0+    then pure (r : acc, newBuf)+    else generateBytes newBuf k (r : acc) -type InnerCryptoRNGT = ReaderT CryptoRNGState+----------------------------------------  -- | Monad transformer with RNG state.-newtype CryptoRNGT m a = CryptoRNGT { unCryptoRNGT :: InnerCryptoRNGT m a }-  deriving ( Alternative, Applicative, Functor, Monad-           , MonadBase b, MonadCatch, MonadError e, MonadIO, MonadMask, MonadPlus-           , MonadThrow, MonadTrans, MonadFail )+newtype CryptoRNGT m a = CryptoRNGT { unCryptoRNGT :: ReaderT CryptoRNGState m a }+  deriving ( Alternative, Applicative, Functor, Monad, MonadFail, MonadPlus+           , MonadError e, MonadIO,  MonadBase b, MonadBaseControl b+           , MonadThrow, MonadCatch, MonadMask+           , MonadTrans, MonadTransControl+           )  mapCryptoRNGT :: (m a -> n b) -> CryptoRNGT m a -> CryptoRNGT n b-mapCryptoRNGT f m = withCryptoRNGState $ \s -> f (runCryptoRNGT s m)+mapCryptoRNGT f m = withCryptoRNGState $ \rng -> f (runCryptoRNGT rng m)  runCryptoRNGT :: CryptoRNGState -> CryptoRNGT m a -> m a-runCryptoRNGT pool m = runReaderT (unCryptoRNGT m) pool+runCryptoRNGT rng m = runReaderT (unCryptoRNGT m) rng  withCryptoRNGState :: (CryptoRNGState -> m a) -> CryptoRNGT m a withCryptoRNGState = CryptoRNGT . ReaderT -instance MonadTransControl CryptoRNGT where-  type StT CryptoRNGT a = StT InnerCryptoRNGT a-  liftWith = defaultLiftWith CryptoRNGT unCryptoRNGT-  restoreT = defaultRestoreT CryptoRNGT--instance MonadBaseControl b m => MonadBaseControl b (CryptoRNGT m) where-  type StM (CryptoRNGT m) a = ComposeSt CryptoRNGT m a-  liftBaseWith = defaultLiftBaseWith-  restoreM     = defaultRestoreM--instance {-# OVERLAPPABLE #-} MonadIO m => CryptoRNG (CryptoRNGT m) where+instance MonadIO m => CryptoRNG (CryptoRNGT m) where   randomBytes n  = CryptoRNGT ask >>= liftIO . randomBytesIO n-  random         = CryptoRNGT ask >>= liftIO . randomIO-  randomR bounds = CryptoRNGT ask >>= liftIO . randomRIO bounds+  random         = CryptoRNGT ask >>= liftIO . R.uniformM+  randomR bounds = CryptoRNGT ask >>= liftIO . R.uniformRM bounds

@@ -1,18 +1,15 @@-{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} module Crypto.RNG.Class where  import Control.Monad.Trans-import Crypto.Random.DRBG import Data.ByteString (ByteString) import System.Random (Uniform, UniformRange)  -- | Monads carrying around the RNG state. class Monad m => CryptoRNG m where   -- | Generate a given number of cryptographically secure random bytes.-  randomBytes-    :: ByteLength -- ^ A number of bytes to generate.-    -> m ByteString+  randomBytes :: Int -> m ByteString    -- | Generate a cryptographically secure value uniformly distributed over all   -- possible values of that type.@@ -22,8 +19,8 @@   randomR :: UniformRange a => (a, a) -> m a  -- | Generic, overlapping instance.-instance {-# OVERLAPPABLE #-} (-    Monad (t m)+instance {-# OVERLAPPABLE #-}+  ( Monad (t m)   , MonadTrans t   , CryptoRNG m   ) => CryptoRNG (t m) where

@@ -0,0 +1,67 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE UndecidableInstances #-}+-- | Support for generation of __non cryptographically secure__ random numbers+-- for testing purposes.+module Crypto.RNG.Unsafe+  ( -- * CryptoRNG class+    module Crypto.RNG.Class+    -- * Monad transformer for carrying rng state+  , RNGT+  , mapRNGT+  , runRNGT+  , withRNGState+    -- * Instantiation of the initial RNG state+  , RNGState+  , newRNGState+    -- ** Low-level utils+  , withRNG+  ) where++import Control.Applicative+import Control.Concurrent+import Control.Monad+import Control.Monad.Base+import Control.Monad.Catch+import Control.Monad.Except+import Control.Monad.Reader+import Control.Monad.Trans.Control+import qualified System.Random as R++import Crypto.RNG.Class++-- | The random number generator state.+newtype RNGState = RNGState (MVar R.StdGen)++-- | Create a new 'RNGState' with a given seed.+newRNGState :: MonadIO m => Int -> m RNGState+newRNGState seed = liftIO $ do+  RNGState <$> newMVar (R.mkStdGen seed)++----------------------------------------++-- | Monad transformer with RNG state.+newtype RNGT m a = RNGT { unRNGT :: ReaderT RNGState m a }+  deriving ( Alternative, Applicative, Functor, Monad, MonadFail, MonadPlus+           , MonadError e, MonadIO, MonadBase b, MonadBaseControl b+           , MonadThrow, MonadCatch, MonadMask+           , MonadTrans, MonadTransControl+           )++mapRNGT :: (m a -> n b) -> RNGT m a -> RNGT n b+mapRNGT f m = withRNGState $ \rng -> f (runRNGT rng m)++runRNGT :: RNGState -> RNGT m a -> m a+runRNGT rng m = runReaderT (unRNGT m) rng++withRNGState :: (RNGState -> m a) -> RNGT m a+withRNGState = RNGT . ReaderT++instance MonadIO m => CryptoRNG (RNGT m) where+  randomBytes n  = RNGT ask >>= (`withRNG` \g -> R.genByteString n g)+  random         = RNGT ask >>= (`withRNG` \g -> R.uniform g)+  randomR bounds = RNGT ask >>= (`withRNG` \g -> R.uniformR bounds g)++withRNG :: MonadIO m => RNGState -> (R.StdGen -> (a, R.StdGen)) -> m a+withRNG (RNGState rng) f = liftIO . modifyMVar rng $ \g -> do+  (a, newG) <- pure $ f g+  newG `seq` pure (newG, a)

@@ -5,8 +5,7 @@  import Crypto.RNG --- | Generate random string of specified length that contains allowed--- chars.+-- | Generate random string of specified length that contains allowed chars. randomString :: CryptoRNG m => Int -> [Char] -> m String randomString n allowedList = map (indexSmallArray allowed)   <$> replicateM n (randomR (0, sizeofSmallArray allowed - 1))