diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,41 @@ +# crypto-rng-0.3.0.2 (2026-09-17) +* Fix a bug that made the source of random bytes repeat bytes it already + returned. +* If the list of allowed chars is empty, `randomString` raises an error. It + used to return a string of garbage that crashed the program on use. +* A value from `random` no longer keeps the internal buffer of random bytes + alive until the value is evaluated. +* Add support for `random` >= 1.3. +* Drop support for GHC 8.8. + +# crypto-rng-0.3.0.1 (2022-02-24) +* Improve performance with multiple capabilities. + +# crypto-rng-0.3.0.0 (2022-02-21) +* Use the entropy package instead of DRBG. + +# crypto-rng-0.2.0.1 (2022-02-16) +* Better selection strategy for picking generators from the pool. + +# 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. + +# crypto-rng-0.1.2.0 (2020-05-05) +* GHC-8.8 support (MonadFail) and ghc 8.10.1 support. + +# crypto-rng-0.1.1.0 (2019-10-08) +* Added a 'MonadError' instance for 'CryptoRNGT'. + +# crypto-rng-0.1.0.2 (2018-03-14) +* Dropped support for GHC 7.8 and 7.10. + +# crypto-rng-0.1.0.1 (2017-01-18) +* Removed a redundant constraint that led to build failures with GHC 8.0.2. + +# crypto-rng-0.1.0.0 (2016-12-06) +* First version. Released on an unsuspecting world. diff --git a/ChangeLog.md b/ChangeLog.md deleted file mode 100644 --- a/ChangeLog.md +++ /dev/null @@ -1,22 +0,0 @@ -# Revision history for crypto-rng - -## 0.1.2.0 -- 2020-05-05 - -* GHC-8.8 support (MonadFail) and ghc 8.10.1 support. - -## 0.1.1.0 -- 2019-10-08 - -* Added a 'MonadError' instance for 'CryptoRNGT'. - - -## 0.1.0.2 -- 2018-03-14 - -* Dropped support for GHC 7.8 and 7.10. - -## 0.1.0.1 -- 2017-01-18 - -* Removed a redundant constraint that led to build failures with GHC 8.0.2. - -## 0.1.0.0 -- 2016-12-06 - -* First version. Released on an unsuspecting world. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +# crypto-rng + +[![Build Status](https://github.com/scrive/crypto-rng/actions/workflows/haskell-ci.yml/badge.svg?branch=master)](https://github.com/scrive/crypto-rng/actions?query=branch%3Amaster) +[![Hackage](https://img.shields.io/hackage/v/crypto-rng.svg)](https://hackage.haskell.org/package/crypto-rng) +[![Stackage LTS](https://www.stackage.org/package/crypto-rng/badge/lts)](https://www.stackage.org/lts/package/crypto-rng) +[![Stackage Nightly](https://www.stackage.org/package/crypto-rng/badge/nightly)](https://www.stackage.org/nightly/package/crypto-rng) + +A convenient interface to the cryptographically secure random number generator +backed by the [entropy](http://hackage.haskell.org/package/entropy) package. diff --git a/crypto-rng.cabal b/crypto-rng.cabal --- a/crypto-rng.cabal +++ b/crypto-rng.cabal @@ -1,38 +1,75 @@ +cabal-version: 3.0 name: crypto-rng -version: 0.1.2.0 -synopsis: Cryptographic random number generator. +version: 0.3.0.2 +synopsis: Cryptographically secure 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 +license: BSD-3-Clause license-file: LICENSE author: Scrive AB -maintainer: Mikhail Glushenkov , - Jonathan Jouty +maintainer: Andrzej Rybczak 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 -extra-source-files: ChangeLog.md -cabal-version: >=1.10 +tested-with: GHC == { 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.7, 9.8.4, 9.10.3, 9.12.4, 9.14.1 } +extra-doc-files: CHANGELOG.md + , README.md source-repository head type: git location: https://github.com/scrive/crypto-rng.git +common language + ghc-options: -Wall -Wcompat -Wredundant-constraints + -Werror=prepositive-qualified-module + + default-language: Haskell2010 + + default-extensions: FlexibleInstances + GeneralizedNewtypeDeriving + ImportQualifiedPost + MultiParamTypeClasses + TypeApplications + UndecidableInstances + library + import: language + 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.14 && <5 + , bytestring >= 0.10.8 + , entropy >= 0.4 + , exceptions >= 0.8.3 + , monad-control >= 1.0.1 + , mtl >= 2.2 + , primitive >= 0.7.1 + , random >= 1.2 && <1.4 + , transformers-base >= 0.4.4 + hs-source-dirs: src - default-language: Haskell2010 + +test-suite test + import: language + + type: exitcode-stdio-1.0 + main-is: Main.hs + + ghc-options: -threaded -rtsopts + + build-depends: base + , bytestring + , containers >= 0.6 + , crypto-rng + , primitive >= 0.7.1 + , random >= 1.2 + , tasty >= 1.4 + , tasty-hunit >= 0.10 + + hs-source-dirs: test diff --git a/src/Crypto/RNG.hs b/src/Crypto/RNG.hs --- a/src/Crypto/RNG.hs +++ b/src/Crypto/RNG.hs @@ -1,172 +1,141 @@ -{-# 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. +{-# LANGUAGE CPP #-} +-- | Support for generation of cryptographically secure random numbers. -- --- 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. +-- This is a convenience layer on top of "System.Entropy". You pull random +-- values with the class 'CryptoRNG'. A monad keeps the state of the random +-- number generator (RNG). -- --- 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 +-- The state holds one buffer per capability, and an MVar protects each +-- buffer. A thread uses the buffer of the capability it runs on, so threads +-- on different capabilities do not contend. +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 qualified as BS +import Data.Primitive.SmallArray +import GHC.Stack +import System.Entropy +import System.Random.Stateful qualified 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 +#if MIN_VERSION_random(1,3,0) +import Data.ByteString.Unsafe qualified as BSU +import Data.Primitive.ByteArray +#else +import Data.ByteString.Short qualified as SBS +#endif -instance Random Int32 where - random = boundedIntegralRandom +-- | The random number generator state. +data CryptoRNGState = CryptoRNGState !Int !(SmallArray (MVar Buffer)) -instance Random Int64 where - random = boundedIntegralRandom +-- | A buffer of random bytes for immediate consumption. +newtype Buffer = Buffer { bytes :: BS.ByteString } -instance Random Int where - random = boundedIntegralRandom +-- The results are strict, because a lazy result would hold the slice of the +-- buffer and thus the whole buffer until it is evaluated. +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 +#if MIN_VERSION_random(1,3,0) + uniformByteArrayM isPinned n st = do + bs <- randomBytesIO n st + let len = BS.length bs + mba <- if isPinned then newPinnedByteArray len else newByteArray len + BSU.unsafeUseAsCStringLen bs $ \(ptr, _) -> + copyPtrToMutableByteArray mba 0 ptr len + unsafeFreezeByteArray mba +#else + uniformShortByteString n st = SBS.toShort <$!> randomBytesIO n st +#endif -instance Random Word8 where - random = boundedIntegralRandom +mkWord :: (Bits a, Integral a) => BS.ByteString -> a +mkWord bs = BS.foldl' (\acc w -> shiftL acc 8 .|. fromIntegral w) 0 bs -instance Random Word16 where - random = boundedIntegralRandom +---------------------------------------- -instance Random Word32 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 Word64 where - random = boundedIntegralRandom +-- | Create a new 'CryptoRNGState' based on system entropy with buffers of +-- specified size. +-- +-- One buffer per capability is created. +newCryptoRNGStateSized + :: (HasCallStack, 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 Word where - random = boundedIntegralRandom +-- | Generate a number of cryptographically secure random bytes. +randomBytesIO :: Int -> CryptoRNGState -> IO BS.ByteString +randomBytesIO n (CryptoRNGState maxBufSize bufs) = do + (cid, _) <- threadCapability =<< myThreadId + let mbuf = bufs `indexSmallArray` (cid `rem` sizeofSmallArray bufs) + modifyMVar mbuf $ \buf -> do + let (r, newBytes) = BS.splitAt n (bytes buf) + k = n - BS.length r + if k <= 0 + then pure (Buffer newBytes, r) + else do + -- The buffer is drained at this point. One call to the entropy source + -- covers the missing bytes and the new buffer, whichever is larger. + (rest, newerBytes) <- BS.splitAt k <$> getEntropy (max maxBufSize k) + pure (Buffer newerBytes, r <> rest) -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 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,29 +1,29 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstrainedClassMethods #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE UndecidableInstances #-} - -#if __GLASGOW_HASKELL__ < 710 -{-# LANGUAGE OverlappingInstances #-} -#endif - -module Crypto.RNG.Class where +module Crypto.RNG.Class + ( CryptoRNG(..) + ) where import Control.Monad.Trans -import Crypto.Random.DRBG -import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import System.Random qualified as R -- | 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 BS.ByteString --- | Generic, overlapping instance. + -- | Generate a cryptographically secure value uniformly distributed over all + -- possible values of that type. + random :: R.Uniform a => m a -instance {-# OVERLAPPABLE #-} ( - Monad (t m) + -- | Generate a cryptographically secure value in a given, closed range. + randomR :: R.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 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,74 @@ +{-# LANGUAGE CPP #-} +-- | 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 Data.ByteString qualified as BS +import System.Random qualified 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 -> uniformByteString 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) + +uniformByteString :: R.RandomGen g => Int -> g -> (BS.ByteString, g) +#if MIN_VERSION_random(1,3,0) +uniformByteString = R.uniformByteString +#else +uniformByteString = R.genByteString +#endif 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 @@ -1,13 +1,24 @@ -module Crypto.RNG.Utils where +module Crypto.RNG.Utils + ( randomString + ) where import Control.Monad +import Data.Primitive.SmallArray +import GHC.Stack 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)) +-- | Generate random string of specified length that contains allowed chars. +-- +-- The list of allowed chars must not be empty. +randomString :: (HasCallStack, CryptoRNG m) => Int -> [Char] -> m String +randomString n allowedList + | size == 0 = error "List of allowed chars must not be empty" + | otherwise = map (indexSmallArray allowed) + <$> replicateM n (randomR (0, size - 1)) where - len = length allowed_chars - 1 + allowed :: SmallArray Char + allowed = smallArrayFromList allowedList + + size :: Int + size = sizeofSmallArray allowed diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE CPP #-} +module Main (main) where + +import Control.Exception +import Control.Monad +import Data.ByteString qualified as BS +import Data.Set qualified as S +import Test.Tasty +import Test.Tasty.HUnit + +import Crypto.RNG +import Crypto.RNG.Utils + +#if MIN_VERSION_random(1,3,0) +import Data.ByteString.Short qualified as SBS +import Data.Primitive.ByteArray +import System.Random.Stateful qualified as R +#endif + +main :: IO () +main = defaultMain $ testGroup "crypto-rng" + [ testGroup "randomBytesIO" $ map bufferRefill configurations + , testGroup "randomString" + [ testCase "draws from the allowed chars" $ do + rng <- newCryptoRNGState + s <- runCryptoRNGT rng $ randomString 1000 alphabet + assertEqual "length" 1000 (length s) + assertBool "every char is allowed" $ all (`elem` alphabet) s + assertBool "the whole alphabet shows up" $ all (`elem` s) alphabet + , testCase "rejects an empty list of allowed chars" $ do + rng <- newCryptoRNGState + r <- try @ErrorCall $ + evaluate . length =<< runCryptoRNGT rng (randomString 8 "") + case r of + Left _ -> pure () + Right len -> assertFailure $ "returned a string of length " ++ show len + ] +#if MIN_VERSION_random(1,3,0) + , testGroup "uniformByteArrayM" [byteArrays] +#endif + ] + where + alphabet :: [Char] + alphabet = ['a' .. 'z'] ++ ['0' .. '9'] + +#if MIN_VERSION_random(1,3,0) +-- | The conversion from the generated bytes used to prepend a serialized +-- length, so the results were longer than requested and started with bytes +-- that were not random. +byteArrays :: TestTree +byteArrays = testCase "results have the requested length" $ do + rng <- newCryptoRNGState + forM_ [0, 1, 8, 16, 100, 1000] $ \n -> do + forM_ [False, True] $ \isPinned -> do + ba <- R.uniformByteArrayM isPinned n rng + assertEqual ("byte array of " ++ show n) n (sizeofByteArray ba) + when (isPinned && n > 0) $ do + assertBool ("byte array of " ++ show n ++ " is pinned") (isByteArrayPinned ba) + sbs <- R.uniformShortByteStringM n rng + assertEqual ("short byte string of " ++ show n) n (SBS.length sbs) +#endif + +-- | Buffer size paired with the request sizes to cycle through. +-- +-- A request that is larger than the bytes left in the buffer is what triggers a +-- refill, so in each configuration the request sizes do not divide the buffer +-- size evenly. +configurations :: [(Int, [Int])] +configurations = + [ (16, [10]) + , (16, [1, 7, 13, 40]) + , (32, [100]) + , (64, [20]) + , (32 * 1024, [100]) + , (1024, [3000, 10]) + , (1, [1, 2, 3]) + ] + +-- | A refill used to hand out the bytes of the drained buffer a second time, so +-- a returned chunk repeated its own prefix and the repeat showed up again in +-- the following chunk. +bufferRefill :: (Int, [Int]) -> TestTree +bufferRefill (bufSize, sizes) = testCase name $ do + rng <- newCryptoRNGStateSized bufSize + chunks <- forM requestSizes $ \n -> do + chunk <- randomBytesIO n rng + assertEqual ("length of a " ++ show n ++ " byte request") n (BS.length chunk) + assertBool ("a " ++ show n ++ " byte request repeats its own prefix") $ + not (repeatsPrefix 4 chunk) + pure chunk + let ws = windows 8 $ BS.concat chunks + assertEqual "repeated windows" 0 (length ws - S.size (S.fromList ws)) + where + name :: String + name = "buffer of " ++ show bufSize ++ " bytes, requests of " ++ show sizes + + -- Enough requests to drain and refill the buffer several times. + requestSizes :: [Int] + requestSizes = takeUntilTotal (max 30000 (4 * bufSize)) (cycle sizes) + + takeUntilTotal :: Int -> [Int] -> [Int] + takeUntilTotal _ [] = [] + takeUntilTotal remaining (n : ns) + | remaining <= 0 = [] + | otherwise = n : takeUntilTotal (remaining - n) ns + + -- A shift by less than minLen bytes is left out, because a short match + -- happens by chance often enough. + repeatsPrefix :: Int -> BS.ByteString -> Bool + repeatsPrefix minLen chunk = any matches [1 .. BS.length chunk - minLen] + where + matches :: Int -> Bool + matches p = BS.drop p chunk == BS.take (BS.length chunk - p) chunk + + windows :: Int -> BS.ByteString -> [BS.ByteString] + windows k bs + | BS.length bs < k = [] + | otherwise = BS.take k bs : windows k (BS.drop 1 bs)