crypto-rng 0.1.2.0 → 0.3.0.1
raw patch · 6 files changed
Files
- ChangeLog.md +21/−1
- crypto-rng.cabal +19/−12
- src/Crypto/RNG.hs +104/−136
- src/Crypto/RNG/Class.hs +16/−16
- src/Crypto/RNG/Unsafe.hs +67/−0
- src/Crypto/RNG/Utils.hs +5/−5
ChangeLog.md view
@@ -1,5 +1,26 @@ # Revision history for crypto-rng +## 0.3.0.1 -- 2022-02-24++* Improve performance with multiple capabilities.++## 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.++## 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 +28,6 @@ ## 0.1.1.0 -- 2019-10-08 * Added a 'MonadError' instance for 'CryptoRNGT'.- ## 0.1.0.2 -- 2018-03-14
crypto-rng.cabal view
@@ -1,9 +1,9 @@ name: crypto-rng-version: 0.1.2.0+version: 0.3.0.1 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.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 || ==9.2.1 extra-source-files: ChangeLog.md cabal-version: >=1.10 @@ -23,16 +23,23 @@ 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,- DRBG >= 0.5.5 && < 0.6,- bytestring >= 0.10.8 && < 0.11,- 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,- transformers-base >= 0.4.4 && < 0.5+ Crypto.RNG.Unsafe++ 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+ default-language: Haskell2010
src/Crypto/RNG.hs view
@@ -1,172 +1,140 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ExplicitForAll #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# 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.------ 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.-module Crypto.RNG (- -- * CryproRNG class+-- 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- , unsafeCryptoRNGState- , randomBytesIO- , randomR- -- * Generation of values in other types- , Random(..)- , boundedIntegralRandom- -- * Monad transformer for carrying rng state+ -- * 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 Prelude hiding (fail) import Control.Applicative import Control.Concurrent+import Control.Monad 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.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.Primitive.SmallArray+import System.Entropy+import qualified Data.ByteString as BS+import qualified Data.ByteString.Short as SBS+import qualified System.Random.Stateful 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))---- | Create a new 'CryptoRNGState', based on system entropy.-newCryptoRNGState :: MonadIO m => m CryptoRNGState-newCryptoRNGState = liftIO $ newGenIO >>= fmap CryptoRNGState . newMVar---- | 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)---- | 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+-- | The random number generator state.+data CryptoRNGState = CryptoRNGState !Int !(SmallArray (MVar Buffer)) -instance Random Int32 where- random = boundedIntegralRandom+-- | A buffer of random bytes for immediate consumption.+newtype Buffer = Buffer { bytes :: BS.ByteString } -instance Random Int64 where- random = boundedIntegralRandom+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 -instance Random Int where- random = boundedIntegralRandom+mkWord :: (Bits a, Integral a) => ByteString -> a+mkWord bs = BS.foldl' (\acc w -> shiftL acc 8 .|. fromIntegral w) 0 bs -instance Random Word8 where- random = boundedIntegralRandom+---------------------------------------- -instance Random Word16 where- random = boundedIntegralRandom+-- | Create a new 'CryptoRNGState' based on system entropy with a buffer size of+-- 32KB.+--+-- One buffer per capability is created.+newCryptoRNGState :: MonadIO m => m CryptoRNGState+newCryptoRNGState = newCryptoRNGStateSized $ 32 * 1024 -instance Random Word32 where- random = boundedIntegralRandom+-- | Create a new 'CryptoRNGState' based on system entropy with buffers of+-- specified size.+--+-- One buffer per capability is created.+newCryptoRNGStateSized+ :: MonadIO m+ => Int -- ^ Buffer size.+ -> m CryptoRNGState+newCryptoRNGStateSized maxBufSize = liftIO $ do+ when (maxBufSize <= 0) $ do+ error "Buffer size must be larger than 0"+ n <- getNumCapabilities+ bufs <- replicateM n . newMVar $ Buffer BS.empty+ pure $ CryptoRNGState maxBufSize (smallArrayFromListN n bufs) -instance Random Word64 where- random = boundedIntegralRandom+-- | Generate a number of cryptographically secure random bytes.+randomBytesIO :: Int -> CryptoRNGState -> IO ByteString+randomBytesIO n (CryptoRNGState maxBufSize bufs) = do+ (cid, _) <- threadCapability =<< myThreadId+ let mbuf = bufs `indexSmallArray` (cid `rem` sizeofSmallArray bufs)+ modifyMVar mbuf $ \buf -> do+ -- Unroll the first step of 'generateBytes' as the vast majority of time+ -- it's enough to get the full amount of requested bytes.+ let (r, newBytes) = BS.splitAt n (bytes buf)+ let k = n - BS.length r+ if k <= 0+ then newBytes `seq` pure (Buffer newBytes, r)+ else do+ (rs, newBuf) <- generateBytes maxBufSize buf k [r]+ pure (newBuf, BS.concat rs) -instance Random Word where- random = boundedIntegralRandom+generateBytes+ :: Int+ -> Buffer+ -> Int+ -> [BS.ByteString]+ -> IO ([BS.ByteString], Buffer)+generateBytes maxBufSize buf n acc = do+ (r, newBytes) <- BS.splitAt n <$> if BS.null (bytes buf)+ then getEntropy maxBufSize+ else pure (bytes buf)+ let newBuf = Buffer newBytes+ k = n - BS.length r+ newBuf `seq` if k <= 0+ then pure (r : acc, newBuf)+ else generateBytes maxBufSize 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 gv m = runReaderT (unCryptoRNGT m) gv+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- {-# 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+instance MonadIO m => CryptoRNG (CryptoRNGT m) where+ randomBytes n = CryptoRNGT ask >>= liftIO . randomBytesIO n+ random = CryptoRNGT ask >>= liftIO . R.uniformM+ randomR bounds = CryptoRNGT ask >>= liftIO . R.uniformRM bounds
src/Crypto/RNG/Class.hs view
@@ -1,29 +1,29 @@-{-# 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 :: Int -> m ByteString --- | Generic, overlapping instance.+ -- | Generate a cryptographically secure value uniformly distributed over all+ -- possible values of that type.+ random :: Uniform a => m a -instance {-# OVERLAPPABLE #-} (- Monad (t m)+ -- | 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
+ src/Crypto/RNG/Unsafe.hs view
@@ -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)
src/Crypto/RNG/Utils.hs view
@@ -1,13 +1,13 @@ 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.+-- | 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