diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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. diff --git a/crypto-rng.cabal b/crypto-rng.cabal --- a/crypto-rng.cabal +++ b/crypto-rng.cabal @@ -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 diff --git a/src/Crypto/RNG.hs b/src/Crypto/RNG.hs --- a/src/Crypto/RNG.hs +++ b/src/Crypto/RNG.hs @@ -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 diff --git a/src/Crypto/RNG/Class.hs b/src/Crypto/RNG/Class.hs --- a/src/Crypto/RNG/Class.hs +++ b/src/Crypto/RNG/Class.hs @@ -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 diff --git a/src/Crypto/RNG/Unsafe.hs b/src/Crypto/RNG/Unsafe.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/RNG/Unsafe.hs @@ -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) diff --git a/src/Crypto/RNG/Utils.hs b/src/Crypto/RNG/Utils.hs --- a/src/Crypto/RNG/Utils.hs +++ b/src/Crypto/RNG/Utils.hs @@ -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))