crypto-rng 0.1.2.0 → 0.2.0.0

raw patch · 5 files changed

+122/−111 lines, 5 filesdep +hashabledep +primitivedep +randomdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable, primitive, random

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−1
• crypto-rng.cabal +12/−4
• src/Crypto/RNG.hs +81/−90
• src/Crypto/RNG/Class.hs +16/−13
• src/Crypto/RNG/Utils.hs +4/−3

@@ -1,5 +1,14 @@ # Revision history for crypto-rng +## 0.2.0.0  -- 2022-02-16++* Drop support for GHC < 8.8+* Fix a space leak in randomBytesIO.+* Use a buffered generator.+* Remove modulo bias from randomRIO.+* Improve performance of randomString.+* Add support for a pool of generators for less contention.+ ## 0.1.2.0  -- 2020-05-05  * GHC-8.8 support (MonadFail) and ghc 8.10.1 support.@@ -7,7 +16,6 @@ ## 0.1.1.0  -- 2019-10-08  * Added a 'MonadError' instance for 'CryptoRNGT'.-  ## 0.1.0.2  -- 2018-03-14 

@@ -1,5 +1,5 @@ name:                crypto-rng-version:             0.1.2.0+version:             0.2.0.0 synopsis:            Cryptographic random number generator.  description:         Convenient wrapper for the cryptographic random generator@@ -14,7 +14,7 @@ copyright:           Scrive AB category:            Crypto build-type:          Simple-tested-with:         GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.3 || ==8.10.1+tested-with:         GHC ==8.8.4 || ==8.10.7 || ==9.0.2 extra-source-files:  ChangeLog.md cabal-version:       >=1.10 @@ -23,16 +23,24 @@   location: https://github.com/scrive/crypto-rng.git  library+  ghc-options:        -Wall -Wcompat+   exposed-modules:     Crypto.RNG                        Crypto.RNG.Class                        Crypto.RNG.Utils-  build-depends:       base              >= 4.9    && < 5,++  build-depends:       base              >= 4.13    && < 5,                        DRBG              >= 0.5.5  && < 0.6,-                       bytestring        >= 0.10.8 && < 0.11,+                       bytestring        >= 0.10.8 && < 0.12,                        crypto-api        >= 0.13.2 && < 0.14,+                       hashable          >= 1.1,                        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+   hs-source-dirs:      src+   default-language:    Haskell2010

@@ -1,16 +1,12 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE ExplicitForAll             #-}+{-# LANGUAGE BangPatterns               #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE UndecidableInstances       #-} -#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-#endif- -- | Support for generation of cryptographically secure random -- numbers, based on the DRBG package. --@@ -24,118 +20,115 @@ -- 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.-module Crypto.RNG (-  -- * CryproRNG class+module Crypto.RNG+  ( -- * CryptoRNG class     module Crypto.RNG.Class-  -- * Generation of strings and numbers+    -- * Generation of strings and numbers   , CryptoRNGState   , newCryptoRNGState+  , newCryptoRNGStateSized   , unsafeCryptoRNGState   , randomBytesIO-  , randomR-  -- * Generation of values in other types-  , Random(..)-  , boundedIntegralRandom-  -- * Monad transformer for carrying rng state+  , randomIO+  , randomRIO+    -- * Monad transformer for carrying rng state   , CryptoRNGT   , mapCryptoRNGT   , runCryptoRNGT   , withCryptoRNGState   ) where -import Prelude hiding (fail) import Control.Applicative import Control.Concurrent import Control.Monad.Base-import Control.Monad.Catch hiding (fail)-import Control.Monad.Cont hiding (fail)-import Control.Monad.Except hiding (fail)-import Control.Monad.Fail (MonadFail(..))-import Control.Monad.Reader hiding (fail)+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, unpack)-import Data.Int-import Data.List-import Data.Word+import Data.ByteString (ByteString)+import Data.Either+import Data.Hashable+import Data.Primitive.SmallArray+import qualified Data.ByteString as BS+import qualified System.Random as R  import Crypto.RNG.Class --- | The random number generator state.  It sits inside an MVar to--- support concurrent thread access.-newtype CryptoRNGState = CryptoRNGState (MVar (GenAutoReseed HashDRBG HashDRBG))+-- | The random number generator state.+newtype CryptoRNGState = CryptoRNGState (SmallArray (MVar RNG)) +-- | The random number generator.+newtype RNG = RNG (GenBuffered (GenAutoReseed HashDRBG HashDRBG))++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')++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 = liftIO $ do+  tid <- hash <$> myThreadId+  let mrng = pool `indexSmallArray` (tid `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. newCryptoRNGState :: MonadIO m => m CryptoRNGState-newCryptoRNGState = liftIO $ newGenIO >>= fmap CryptoRNGState . newMVar+newCryptoRNGState = newCryptoRNGStateSized =<< liftIO getNumCapabilities +-- | Create a new 'CryptoRNGState', based on system entropy with the pool of a+-- specific 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 -> m CryptoRNGState-unsafeCryptoRNGState s = liftIO $-  either (fail . show) (fmap CryptoRNGState . newMVar) (newGen s)+unsafeCryptoRNGState+  :: MonadIO m+  => [ByteString]+  -- ^ Seeds for each generator from the pool.+  -> 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 (CryptoRNGState gv) = do-  liftIO $ modifyMVar gv $ \g -> do-    (bs, g') <- either (const (fail "Crypto.GlobalRandom.genBytes")) return $-                genBytes n g-    return (g', bs)---- | Generate a cryptographically secure random number in given,--- closed range.-randomR :: (CryptoRNG m, Integral a) => (a, a) -> m a-randomR (minb', maxb') = do-  bs <- randomBytes byteLen-  return . fromIntegral $-    minb + foldl1' (\r a -> shiftL r 8 .|. a) (map toInteger (unpack bs))-            `mod` range-    where-      minb, maxb, range :: Integer-      minb = fromIntegral minb'-      maxb = fromIntegral maxb'-      range = maxb - minb + 1-      byteLen = ceiling $ logBase 2 (fromIntegral range) / (8 :: Double)---- | Helper function for making Random instances.-boundedIntegralRandom :: forall m a. (CryptoRNG m, Integral a, Bounded a) => m a-boundedIntegralRandom = randomR (minBound :: a, maxBound :: a)---- | Class for generating cryptographically secure random values.-class Random a where-  random :: CryptoRNG m => m a--instance Random Int16 where-  random = boundedIntegralRandom--instance Random Int32 where-  random = boundedIntegralRandom--instance Random Int64 where-  random = boundedIntegralRandom--instance Random Int where-  random = boundedIntegralRandom--instance Random Word8 where-  random = boundedIntegralRandom--instance Random Word16 where-  random = boundedIntegralRandom--instance Random Word32 where-  random = boundedIntegralRandom+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') -instance Random Word64 where-  random = boundedIntegralRandom+randomIO :: R.Uniform a => CryptoRNGState -> IO a+randomIO pool = withRNG pool $ \g -> R.uniform g -instance Random Word where-  random = boundedIntegralRandom+randomRIO :: R.UniformRange a => (a, a) -> CryptoRNGState -> IO a+randomRIO bounds pool = withRNG pool $ \g -> R.uniformR bounds g  type InnerCryptoRNGT = ReaderT CryptoRNGState @@ -149,7 +142,7 @@ mapCryptoRNGT f m = withCryptoRNGState $ \s -> f (runCryptoRNGT s m)  runCryptoRNGT :: CryptoRNGState -> CryptoRNGT m a -> m a-runCryptoRNGT gv m = runReaderT (unCryptoRNGT m) gv+runCryptoRNGT pool m = runReaderT (unCryptoRNGT m) pool  withCryptoRNGState :: (CryptoRNGState -> m a) -> CryptoRNGT m a withCryptoRNGState = CryptoRNGT . ReaderT@@ -158,15 +151,13 @@   type StT CryptoRNGT a = StT InnerCryptoRNGT a   liftWith = defaultLiftWith CryptoRNGT unCryptoRNGT   restoreT = defaultRestoreT CryptoRNGT-  {-# INLINE liftWith #-}-  {-# INLINE restoreT #-}  instance MonadBaseControl b m => MonadBaseControl b (CryptoRNGT m) where   type StM (CryptoRNGT m) a = ComposeSt CryptoRNGT m a   liftBaseWith = defaultLiftBaseWith   restoreM     = defaultRestoreM-  {-# INLINE liftBaseWith #-}-  {-# INLINE restoreM #-}  instance {-# OVERLAPPABLE #-} MonadIO m => CryptoRNG (CryptoRNGT m) where-  randomBytes n = CryptoRNGT ask >>= liftIO . randomBytesIO n+  randomBytes n  = CryptoRNGT ask >>= liftIO . randomBytesIO n+  random         = CryptoRNGT ask >>= liftIO . randomIO+  randomR bounds = CryptoRNGT ask >>= liftIO . randomRIO bounds

@@ -1,29 +1,32 @@-{-# LANGUAGE CPP                     #-}-{-# LANGUAGE ConstrainedClassMethods #-}-{-# LANGUAGE FlexibleInstances       #-}-{-# LANGUAGE UndecidableInstances    #-}--#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-#endif-+{-# 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 given number of cryptographically secure random bytes.-  randomBytes :: ByteLength -- ^ number of bytes to generate-              -> m ByteString+  -- | Generate a given number of cryptographically secure random bytes.+  randomBytes+    :: ByteLength -- ^ A number of bytes to generate.+    -> m ByteString --- | Generic, overlapping instance.+  -- | Generate a cryptographically secure value uniformly distributed over all+  -- possible values of that type.+  random :: Uniform a => m a +  -- | Generate a cryptographically secure value in a given, closed range.+  randomR :: UniformRange a => (a, a) -> m a++-- | Generic, overlapping instance. instance {-# OVERLAPPABLE #-} (     Monad (t m)   , MonadTrans t   , CryptoRNG m   ) => CryptoRNG (t m) where     randomBytes = lift . randomBytes+    random      = lift random+    randomR     = lift . randomR

@@ -1,13 +1,14 @@ module Crypto.RNG.Utils where  import Control.Monad+import Data.Primitive.SmallArray  import Crypto.RNG  -- | Generate random string of specified length that contains allowed -- chars. randomString :: CryptoRNG m => Int -> [Char] -> m String-randomString n allowed_chars =-  sequence $ replicate n $ ((!!) allowed_chars `liftM` randomR (0, len))+randomString n allowedList = map (indexSmallArray allowed)+  <$> replicateM n (randomR (0, sizeofSmallArray allowed - 1))   where-    len = length allowed_chars - 1+    allowed = smallArrayFromList allowedList