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,42 +0,0 @@ -# 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. - -## 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,45 +1,75 @@ +cabal-version: 3.0 name: crypto-rng -version: 0.3.0.1 -synopsis: Cryptographic random number generator. +version: 0.3.0.2 +synopsis: Cryptographically secure random number generator. 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.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.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 - ghc-options: -Wall -Wcompat + import: language exposed-modules: Crypto.RNG Crypto.RNG.Class Crypto.RNG.Utils Crypto.RNG.Unsafe - build-depends: base >= 4.13 && < 5 + 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 - , random >= 1.2 && <1.3 + , 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,14 +1,13 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} -- | Support for generation of cryptographically secure random numbers. -- --- 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. +-- 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 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 @@ -34,29 +33,47 @@ import Control.Monad.Reader import Control.Monad.Trans.Control import Data.Bits -import Data.ByteString (ByteString) +import Data.ByteString qualified as BS import Data.Primitive.SmallArray +import GHC.Stack import System.Entropy -import qualified Data.ByteString as BS -import qualified Data.ByteString.Short as SBS -import qualified System.Random.Stateful as R +import System.Random.Stateful qualified as R import Crypto.RNG.Class +#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 + -- | The random number generator state. data CryptoRNGState = CryptoRNGState !Int !(SmallArray (MVar Buffer)) -- | A buffer of random bytes for immediate consumption. newtype Buffer = Buffer { bytes :: BS.ByteString } +-- 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 - uniformShortByteString n st = SBS.toShort <$> randomBytesIO n st + 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 -mkWord :: (Bits a, Integral a) => ByteString -> a +mkWord :: (Bits a, Integral a) => BS.ByteString -> a mkWord bs = BS.foldl' (\acc w -> shiftL acc 8 .|. fromIntegral w) 0 bs ---------------------------------------- @@ -73,7 +90,7 @@ -- -- One buffer per capability is created. newCryptoRNGStateSized - :: MonadIO m + :: (HasCallStack, MonadIO m) => Int -- ^ Buffer size. -> m CryptoRNGState newCryptoRNGStateSized maxBufSize = liftIO $ do @@ -84,36 +101,20 @@ pure $ CryptoRNGState maxBufSize (smallArrayFromListN n bufs) -- | Generate a number of cryptographically secure random bytes. -randomBytesIO :: Int -> CryptoRNGState -> IO ByteString +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 - -- 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 + k = n - BS.length r if k <= 0 - then newBytes `seq` pure (Buffer newBytes, r) + then pure (Buffer newBytes, r) else do - (rs, newBuf) <- generateBytes maxBufSize buf k [r] - pure (newBuf, BS.concat rs) - -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) + -- 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) ---------------------------------------- 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,22 +1,22 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE UndecidableInstances #-} -module Crypto.RNG.Class where +module Crypto.RNG.Class + ( CryptoRNG(..) + ) where import Control.Monad.Trans -import Data.ByteString (ByteString) -import System.Random (Uniform, UniformRange) +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 a given number of cryptographically secure random bytes. - randomBytes :: Int -> m ByteString + randomBytes :: Int -> m BS.ByteString -- | Generate a cryptographically secure value uniformly distributed over all -- possible values of that type. - random :: Uniform a => m a + random :: R.Uniform a => m a -- | Generate a cryptographically secure value in a given, closed range. - randomR :: UniformRange a => (a, a) -> m a + randomR :: R.UniformRange a => (a, a) -> m a -- | Generic, overlapping instance. instance {-# OVERLAPPABLE #-} diff --git a/src/Crypto/RNG/Unsafe.hs b/src/Crypto/RNG/Unsafe.hs --- a/src/Crypto/RNG/Unsafe.hs +++ b/src/Crypto/RNG/Unsafe.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} -- | Support for generation of __non cryptographically secure__ random numbers -- for testing purposes. module Crypto.RNG.Unsafe @@ -25,7 +24,8 @@ import Control.Monad.Except import Control.Monad.Reader import Control.Monad.Trans.Control -import qualified System.Random as R +import Data.ByteString qualified as BS +import System.Random qualified as R import Crypto.RNG.Class @@ -57,7 +57,7 @@ withRNGState = RNGT . ReaderT instance MonadIO m => CryptoRNG (RNGT m) where - randomBytes n = RNGT ask >>= (`withRNG` \g -> R.genByteString n g) + 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) @@ -65,3 +65,10 @@ 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 allowedList = map (indexSmallArray allowed) - <$> replicateM n (randomR (0, sizeofSmallArray allowed - 1)) +-- +-- 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 + 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)