diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,5 @@ +# Changelog + +- 0.1.0 (2026-11-14) + * Initial release, supporting the xoshiro256++ PRNG, both mutable + and pure, and the ChaCha8Rand CSPRNG. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2026 Jared Tobin + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE BangPatterns #-} + +module Main where + +import Criterion.Main +import qualified Crypto.CSPRNG as CSPRNG +import qualified Crypto.PRNG as PRNG +import qualified Crypto.PRNG.Pure as Pure +import qualified Crypto.Random as Crypton +import qualified Data.ByteString as BS +import Data.Word (Word64) +import GHC.Exts (RealWorld) +import qualified System.Entropy as Entropy +import qualified System.Random.MWC as MWC +import qualified System.Random.PCG as PCG +import qualified System.Random.SplitMix as SM +import qualified System.Random.Stateful as R + +main :: IO () +main = do + prng <- PRNG.new 42 + mc <- CSPRNG.new (BS.replicate 32 0) + mwc <- MWC.create + pcg <- PCG.create + std <- R.newIOGenM (R.mkStdGen 42) + drg <- Crypton.drgNew + let !sm = SM.mkSMGen 42 + !pg = Pure.new 42 + case mc of + Nothing -> error "ppad-random (bench): invalid seed" + Just csprng -> defaultMain [ + bgroup "word64 (x1000)" [ + bench "ppad-random (PRNG)" $ + whnfIO (sum_n (PRNG.word64 prng) 1000) + , bench "ppad-random (PRNG.Pure)" $ + whnf (sum_draws Pure.word64 pg) 1000 + , bench "ppad-random (CSPRNG)" $ + whnfIO (sum_n (CSPRNG.word64 csprng) 1000) + , bench "mwc-random" $ + whnfIO (sum_n (MWC.uniform mwc :: IO Word64) 1000) + , bench "pcg-random" $ + whnfIO (sum_n (PCG.uniform pcg :: IO Word64) 1000) + , bench "random (IOGenM StdGen)" $ + whnfIO (sum_n (R.uniformM std :: IO Word64) 1000) + , bench "splitmix (pure)" $ + whnf (sum_pure SM.nextWord64 sm) 1000 + ] + , bgroup "double (x1000)" [ + bench "ppad-random (PRNG)" $ + whnfIO (sum_n (PRNG.double prng) 1000) + , bench "ppad-random (PRNG.Pure)" $ + whnf (sum_draws Pure.double pg) 1000 + , bench "mwc-random" $ + whnfIO (sum_n (MWC.uniform mwc :: IO Double) 1000) + , bench "pcg-random" $ + whnfIO (sum_n (PCG.uniform pcg :: IO Double) 1000) + , bench "random (IOGenM StdGen)" $ + whnfIO (sum_n (R.uniformDouble01M std) 1000) + , bench "splitmix (pure)" $ + whnf (sum_pure SM.nextDouble sm) 1000 + ] + , bgroup "int_range 1 6 (x1000)" [ + bench "ppad-random (PRNG)" $ + whnfIO (sum_n (PRNG.int_range 1 6 prng) 1000) + , bench "ppad-random (PRNG.Pure)" $ + whnf (sum_draws (Pure.int_range 1 6) pg) 1000 + , bench "ppad-random (CSPRNG)" $ + whnfIO (sum_n (CSPRNG.int_range 1 6 csprng) 1000) + , bench "mwc-random" $ + whnfIO (sum_n (MWC.uniformR (1, 6) mwc :: IO Int) 1000) + , bench "pcg-random" $ + whnfIO (sum_n (PCG.uniformR (1, 6) pcg :: IO Int) 1000) + , bench "random (IOGenM StdGen)" $ + whnfIO (sum_n (R.uniformRM (1, 6) std :: IO Int) 1000) + ] + , bgroup "bytes (32B)" [ + bench "ppad-random (CSPRNG)" $ nfIO (CSPRNG.bytes 32 csprng) + , bench "crypton (ChaChaDRG)" $ nf (crypton_bytes drg) 32 + , bench "entropy (getEntropy)" $ nfIO (Entropy.getEntropy 32) + ] + , bgroup "bytes (1024B)" [ + bench "ppad-random (CSPRNG)" $ nfIO (CSPRNG.bytes 1024 csprng) + , bench "crypton (ChaChaDRG)" $ nf (crypton_bytes drg) 1024 + , bench "entropy (getEntropy)" $ nfIO (Entropy.getEntropy 1024) + ] + , bgroup "CSPRNG" [ + bench "split" $ whnfIO (split_csprng csprng) + ] + ] + +-- sum the results of running an action n times +sum_n :: Num a => IO a -> Int -> IO a +sum_n gen = loop 0 where + loop !acc n + | n <= 0 = pure acc + | otherwise = do + !x <- gen + loop (acc + x) (n - 1) +{-# INLINE sum_n #-} + +-- sum the results of stepping a pure generator n times +sum_pure :: Num a => (g -> (a, g)) -> g -> Int -> a +sum_pure step = loop 0 where + loop !acc !g n + | n <= 0 = acc + | otherwise = + let !(x, ng) = step g + in loop (acc + x) ng (n - 1) +{-# INLINE sum_pure #-} + +crypton_bytes :: Crypton.ChaChaDRG -> Int -> BS.ByteString +crypton_bytes drg n = fst (Crypton.randomBytesGenerate n drg) + +split_csprng :: CSPRNG.Gen RealWorld -> IO () +split_csprng g = do + !_ <- CSPRNG.split g + pure () + +-- sum the results of n draws from a pure generator +sum_draws :: Num a => (Pure.Gen -> Pure.Draw a) -> Pure.Gen -> Int -> a +sum_draws f = loop 0 where + loop !acc !g n + | n <= 0 = acc + | otherwise = case f g of + Pure.Draw x ng -> loop (acc + x) ng (n - 1) +{-# INLINE sum_draws #-} diff --git a/bench/Weight.hs b/bench/Weight.hs new file mode 100644 --- /dev/null +++ b/bench/Weight.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE BangPatterns #-} + +module Main where + +import qualified Crypto.CSPRNG as CSPRNG +import qualified Crypto.PRNG as PRNG +import qualified Crypto.PRNG.Pure as Pure +import qualified Data.ByteString as BS +import Data.Word (Word64) +import Weigh + +-- note that 'weigh' doesn't work properly in a repl +main :: IO () +main = do + prng <- PRNG.new 42 + let !pg = Pure.new 42 + mc <- CSPRNG.new (BS.replicate 32 0) + case mc of + Nothing -> error "ppad-random (weigh): invalid seed" + Just csprng -> mainWith $ do + wgroup "PRNG" $ do + io "word64 (x1000)" (sum_words (PRNG.word64 prng)) 1000 + io "double (x1000)" (sum_doubles (PRNG.double prng)) 1000 + wgroup "PRNG.Pure" $ do + func "word64 (x1000)" (sum_draws Pure.word64 pg) 1000 + func "double (x1000)" (sum_draws Pure.double pg) 1000 + func "int_range 1 6 (x1000)" (sum_draws (Pure.int_range 1 6) pg) 1000 + wgroup "CSPRNG" $ do + io "word64 (x1000)" (sum_words (CSPRNG.word64 csprng)) 1000 + io "bytes (32B)" (\n -> CSPRNG.bytes n csprng) 32 + io "bytes (1024B)" (\n -> CSPRNG.bytes n csprng) 1024 + +sum_words :: IO Word64 -> Int -> IO Word64 +sum_words gen = loop 0 where + loop !acc n + | n <= 0 = pure acc + | otherwise = do + !w <- gen + loop (acc + w) (n - 1) +{-# INLINE sum_words #-} + +sum_doubles :: IO Double -> Int -> IO Double +sum_doubles gen = loop 0 where + loop !acc n + | n <= 0 = pure acc + | otherwise = do + !d <- gen + loop (acc + d) (n - 1) +{-# INLINE sum_doubles #-} + +-- sum the results of n draws from a pure generator +sum_draws :: Num a => (Pure.Gen -> Pure.Draw a) -> Pure.Gen -> Int -> a +sum_draws f = loop 0 where + loop !acc !g n + | n <= 0 = acc + | otherwise = case f g of + Pure.Draw x ng -> loop (acc + x) ng (n - 1) +{-# INLINE sum_draws #-} diff --git a/internal/Crypto/Range.hs b/internal/Crypto/Range.hs new file mode 100644 --- /dev/null +++ b/internal/Crypto/Range.hs @@ -0,0 +1,106 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +-- | +-- Module: Crypto.Range +-- Copyright: (c) 2026 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- Unbiased integers in a range, via Lemire's nearly-divisionless +-- method ("Fast Random Integer Generation in an Interval", 2019). + +module Crypto.Range ( + upto + , upto_pure + , W2(..) + , mul_wide + , _mul_wide_limbs + ) where + +import Data.Bits ((.&.), (.>>.)) +import qualified Data.Bits as B +import Data.Word (Word64) +import GHC.Exts (Word(..), timesWord2#) + +-- | A 128-bit product, as its high and low words. +data W2 = W2 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 + deriving (Eq, Show) + +-- | The full 128-bit product of two words. +mul_wide :: Word64 -> Word64 -> W2 +mul_wide a b + | B.finiteBitSize (0 :: Word) == 64 = + let !(W# x) = fromIntegral a + !(W# y) = fromIntegral b + !(# h, l #) = timesWord2# x y + in W2 (fromIntegral (W# h)) (fromIntegral (W# l)) + | otherwise = _mul_wide_limbs a b +{-# INLINE mul_wide #-} + +-- | The full 128-bit product of two words, via 32-bit limbs, for +-- platforms with 32-bit machine words. +_mul_wide_limbs :: Word64 -> Word64 -> W2 +_mul_wide_limbs a b = + let !a0 = a .&. 0xffffffff + !a1 = a .>>. 32 + !b0 = b .&. 0xffffffff + !b1 = b .>>. 32 + !p00 = a0 * b0 + !p01 = a0 * b1 + !p10 = a1 * b0 + !p11 = a1 * b1 + !mid = (p00 .>>. 32) + (p01 .&. 0xffffffff) + (p10 .&. 0xffffffff) + !hi = p11 + (p01 .>>. 32) + (p10 .>>. 32) + (mid .>>. 32) + in W2 hi (a * b) +{-# INLINE _mul_wide_limbs #-} + +-- | A uniformly-distributed word in [0, n], given an action producing +-- uniformly-distributed words. +-- +-- Each draw x is mapped to the high word of x * (n + 1); draws whose +-- low word falls below 2 ^ 64 mod (n + 1) are rejected, so that +-- every output is equally likely. Rejection is rare for small n, and +-- the remainder is only computed when it might occur. +upto :: Monad m => m Word64 -> Word64 -> m Word64 +upto gen n + | n == maxBound = gen + | otherwise = do + !x <- gen + let !(W2 h l) = mul_wide x s + if l >= s + then pure h + else reject (negate s `rem` s) h l + where + !s = n + 1 + reject !t = loop where + loop !h !l + | l >= t = pure h + | otherwise = do + !x <- gen + let !(W2 nh nl) = mul_wide x s + loop nh nl +{-# INLINE upto #-} + +-- | 'upto' for a pure generator, given its step function. +upto_pure :: (g -> (Word64, g)) -> Word64 -> g -> (Word64, g) +upto_pure step n g0 + | n == maxBound = step g0 + | otherwise = + let !(x, g1) = step g0 + !(W2 h l) = mul_wide x s + in if l >= s + then (h, g1) + else reject (negate s `rem` s) h l g1 + where + !s = n + 1 + reject !t = loop where + loop !h !l !g + | l >= t = (h, g) + | otherwise = + let !(x, ng) = step g + !(W2 nh nl) = mul_wide x s + in loop nh nl ng +{-# INLINE upto_pure #-} diff --git a/lib/Crypto/CSPRNG.hs b/lib/Crypto/CSPRNG.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/CSPRNG.hs @@ -0,0 +1,324 @@ +{-# OPTIONS_HADDOCK prune #-} +{-# LANGUAGE BangPatterns #-} + +-- | +-- Module: Crypto.CSPRNG +-- Copyright: (c) 2026 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- A fast cryptographically-secure pseudorandom number generator: +-- [ChaCha8Rand](https://c2sp.org/chacha8rand), as used by Go's +-- @math/rand/v2@ and runtime. +-- +-- The generator draws 992 bytes of output at a time from ChaCha8, and +-- rekeys itself from the next 32 bytes. Its key and output buffer are +-- erased as they are used, and the native ChaCha8 kernels (on aarch64 +-- and x86_64) zero the stack they use, so that a later disclosure of +-- the process's memory reveals nothing about prior output. This +-- covers the generator's own state only: copies of seeds passed to it +-- and of output it returns are the caller's to manage, and on other +-- platforms the pure Haskell ChaCha8 fallback makes copies of keys and +-- keystream that the garbage collector manages and can't erase. +-- +-- The generator is mutable, living in any 'PrimMonad' (e.g. 'IO' or +-- 'ST s'), and is not thread-safe. Use one generator per thread, +-- deriving more via 'split'. +-- +-- A forked process (e.g. via @forkProcess@), or a restored virtual +-- machine snapshot, inherits a copy of the generator's state, and +-- then produces the same output as the original. Create a new +-- generator in such a child, e.g. via 'new_system', rather than using +-- an inherited one. + +module Crypto.CSPRNG ( + -- * Generator + Gen + , new + , new_system + + -- * Output + , word64 + , word64_range + , int_range + , bytes + + -- * Splitting + , split + + -- * Wiping + , wipe + ) where + +import Control.Monad.Primitive (PrimMonad, PrimState, unsafeIOToPrim) +import Control.Monad.ST (ST) +import qualified Crypto.Cipher.ChaCha as ChaCha +import qualified Crypto.Entropy as Entropy +import qualified Crypto.Range as Range +import Data.Bits ((.&.), complement) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BI +import qualified Data.ByteString.Unsafe as BU +import qualified Data.Primitive.ByteArray as BA +import Data.Word (Word8, Word64, byteSwap64) +import Foreign.ForeignPtr (touchForeignPtr) +import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) +import Foreign.Marshal.Utils (copyBytes) +import Foreign.Ptr (Ptr, castPtr, plusPtr) +import GHC.ByteOrder (ByteOrder(..), targetByteOrder) +import GHC.Exts (RealWorld) + +-- utils ---------------------------------------------------------------------- + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral +{-# INLINE fi #-} + +-- convert between host and little-endian byte order +le64 :: Word64 -> Word64 +le64 w = case targetByteOrder of + LittleEndian -> w + BigEndian -> byteSwap64 w +{-# INLINE le64 #-} + +-- state ---------------------------------------------------------------------- + +-- a generator's state is a pinned byte array, laid out as: +-- +-- offset size contents +-- 0 32 key for the next refill +-- 32 16 zero nonce (12 bytes used) +-- 48 8 position of the next unread byte of output +-- 64 1024 output (992 bytes) and next key (32 bytes) +-- +-- all bytes of output, and all keys, are little-endian. + +-- | A ChaCha8Rand generator. +newtype Gen s = Gen (BA.MutableByteArray s) + +_KEY, _NONCE, _POS, _OUT, _SIZE, _AVAIL :: Int +_KEY = 0 +_NONCE = 32 +_POS = 48 +_OUT = 64 +_SIZE = 1088 +_AVAIL = 992 + +alloc :: PrimMonad m => m (BA.MutableByteArray (PrimState m)) +alloc = do + st <- BA.newPinnedByteArray _SIZE + BA.setByteArray st 0 _SIZE (0 :: Word8) + pure st +{-# INLINE alloc #-} + +read_pos :: PrimMonad m => BA.MutableByteArray (PrimState m) -> m Int +read_pos st = do + !p <- BA.readByteArray st (_POS `quot` 8) + pure $! fi (p :: Word64) +{-# INLINE read_pos #-} + +write_pos :: PrimMonad m => BA.MutableByteArray (PrimState m) -> Int -> m () +write_pos st p = BA.writeByteArray st (_POS `quot` 8) (fi p :: Word64) +{-# INLINE write_pos #-} + +ptr :: BA.MutableByteArray s -> Int -> Ptr Word8 +ptr st off = BA.mutableByteArrayContents st `plusPtr` off +{-# INLINE ptr #-} + +-- ChaCha8Rand iteration: replace the output buffer with 992 fresh +-- bytes of output, and rekey. +refill :: PrimMonad m => BA.MutableByteArray (PrimState m) -> m () +refill st = do + -- sixteen ChaCha8 blocks, with counters 0 to 15, interleaved four + -- at a time and with the final addition covering only the key + unsafeIOToPrim $ + ChaCha._interleaved_into ChaCha.ChaCha8 ChaCha.FeedForwardKey + (ptr st _KEY) 0 (ptr st _NONCE) (ptr st _OUT) 4 + -- the last 32 bytes of output are the next key + BA.copyMutableByteArray st _KEY st (_OUT + _AVAIL) 32 + BA.setByteArray st (_OUT + _AVAIL) 32 (0 :: Word8) + write_pos st 0 +{-# INLINABLE refill #-} +{-# SPECIALIZE refill :: BA.MutableByteArray RealWorld -> IO () #-} +{-# SPECIALIZE refill :: BA.MutableByteArray s -> ST s () #-} + +-- copy the next bytes of output to the destination, erasing them +fill + :: PrimMonad m + => BA.MutableByteArray (PrimState m) + -> Ptr Word8 + -> Int + -> m () +fill st dst n = loop 0 where + loop !off + | off == n = pure () + | otherwise = do + !pos <- read_pos st + if pos == _AVAIL + then do + refill st + loop off + else do + let !k = min (n - off) (_AVAIL - pos) + !d = dst `plusPtr` off :: Ptr Word8 + BA.copyMutableByteArrayToPtr d st (_OUT + pos) k + BA.setByteArray st (_OUT + pos) k (0 :: Word8) + write_pos st (pos + k) + loop (off + k) +{-# INLINABLE fill #-} + +-- generator ------------------------------------------------------------------ + +-- | Create a generator from a 256-bit seed, returning 'Nothing' if the +-- seed is not exactly 32 bytes. +-- +-- The seed must be secret and uniformly random; prefer 'new_system' +-- unless a reproducible stream is required. +-- +-- >>> Just gen <- new "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456" +-- >>> word64 gen +-- 13219109469176600229 +new + :: PrimMonad m + => BS.ByteString + -> m (Maybe (Gen (PrimState m))) +new seed@(BI.PS _ _ l) + | l /= 32 = pure Nothing + | otherwise = do + st <- alloc + unsafeIOToPrim $ BU.unsafeUseAsCString seed $ \sp -> + copyBytes (ptr st _KEY) (castPtr sp) 32 + refill st + pure $! Just (Gen st) +{-# INLINABLE new #-} +{-# SPECIALIZE new :: BS.ByteString -> IO (Maybe (Gen RealWorld)) #-} +{-# SPECIALIZE new :: BS.ByteString -> ST s (Maybe (Gen s)) #-} + +-- | Create a generator seeded from the operating system's entropy +-- source, returning 'Nothing' if that fails. +-- +-- >>> Just gen <- new_system +new_system :: IO (Maybe (Gen RealWorld)) +new_system = do + st <- alloc + ok <- Entropy.fill (ptr st _KEY) 32 + if not ok + then pure Nothing + else do + refill st + pure $! Just (Gen st) + +-- output --------------------------------------------------------------------- + +-- | Generate a uniformly-distributed 'Word64' from the next eight +-- bytes of output, read in little-endian order. If a call to 'bytes' +-- has left the output out of eight-byte alignment, the bytes up to +-- the next boundary are discarded. +-- +-- >>> Just gen <- new "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456" +-- >>> word64 gen +-- 13219109469176600229 +word64 :: PrimMonad m => Gen (PrimState m) -> m Word64 +word64 (Gen st) = do + !pos <- read_pos st + let !aligned = (pos + 7) .&. complement 7 + !p <- if aligned + 8 > _AVAIL + then do + refill st + pure 0 + else pure aligned + let !ix = (_OUT + p) `quot` 8 + !w <- BA.readByteArray st ix + BA.writeByteArray st ix (0 :: Word64) + write_pos st (p + 8) + pure $! le64 w +{-# INLINE word64 #-} + +-- | Generate a uniformly-distributed 'Word64' in the given inclusive +-- range, whose bounds may be given in either order. +-- +-- The result is unbiased; see 'int_range'. +-- +-- >>> Just gen <- new "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456" +-- >>> word64_range 1 6 gen +-- 5 +word64_range + :: PrimMonad m => Word64 -> Word64 -> Gen (PrimState m) -> m Word64 +word64_range a b gen = do + let !lo = min a b + !hi = max a b + !r <- Range.upto (word64 gen) (hi - lo) + pure $! lo + r +{-# INLINE word64_range #-} + +-- | Generate a uniformly-distributed 'Int' in the given inclusive +-- range, whose bounds may be given in either order. +-- +-- The result is unbiased, via Lemire's method: an occasional draw is +-- rejected and replaced, so the number of words consumed, and the +-- running time, depend on the (discarded) rejected words. +-- +-- >>> Just gen <- new "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456" +-- >>> int_range (-10) 10 gen +-- 5 +int_range :: PrimMonad m => Int -> Int -> Gen (PrimState m) -> m Int +int_range a b gen = do + let !lo = min a b + !hi = max a b + !r <- Range.upto (word64 gen) (fi hi - fi lo) + pure $! lo + fi r +{-# INLINE int_range #-} + +-- | Generate the given number of bytes. Non-positive counts yield the +-- empty string. +-- +-- >>> import qualified Data.ByteString.Base16 as B16 +-- >>> Just gen <- new "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456" +-- >>> fmap B16.encode (bytes 8 gen) +-- "a516463d06b673b7" +bytes :: PrimMonad m => Int -> Gen (PrimState m) -> m BS.ByteString +bytes n (Gen st) + | n <= 0 = pure BS.empty + | otherwise = do + fp <- unsafeIOToPrim (BI.mallocByteString n) + fill st (unsafeForeignPtrToPtr fp) n + unsafeIOToPrim (touchForeignPtr fp) + pure $! BI.BS fp n +{-# INLINABLE bytes #-} +{-# SPECIALIZE bytes :: Int -> Gen RealWorld -> IO BS.ByteString #-} +{-# SPECIALIZE bytes :: Int -> Gen s -> ST s BS.ByteString #-} + +-- splitting ------------------------------------------------------------------ + +-- | Derive a new generator, seeded from the next 32 bytes of output. +-- +-- The two generators' outputs are independent; use 'split' to give +-- each thread its own generator. +-- +-- >>> Just gen <- new_system +-- >>> child <- split gen +split :: PrimMonad m => Gen (PrimState m) -> m (Gen (PrimState m)) +split (Gen st) = do + child <- alloc + fill st (ptr child _KEY) 32 + refill child + pure $! Gen child +{-# INLINABLE split #-} + +-- wiping --------------------------------------------------------------------- + +-- | Erase a generator's state. +-- +-- Call this when finished with a generator, to wipe its key and any +-- unused output from memory. The generator must not be used +-- afterwards: it would then produce output from an all-zero key, +-- which is predictable. +-- +-- >>> Just gen <- new_system +-- >>> out <- bytes 32 gen +-- >>> wipe gen +wipe :: PrimMonad m => Gen (PrimState m) -> m () +wipe (Gen st) = do + BA.setByteArray st 0 _SIZE (0 :: Word8) + write_pos st _AVAIL +{-# INLINE wipe #-} diff --git a/lib/Crypto/Entropy.hs b/lib/Crypto/Entropy.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/Entropy.hs @@ -0,0 +1,30 @@ +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Module: Crypto.Entropy +-- Copyright: (c) 2026 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- Entropy from the operating system, via getentropy(3). + +module Crypto.Entropy ( + fill + ) where + +import Data.Word (Word8) +import Foreign.C.Types (CInt(..), CSize(..)) +import Foreign.Ptr (Ptr) + +-- getentropy may block until the system CSPRNG is seeded, so the call +-- is safe rather than unsafe +foreign import ccall safe "getentropy" + c_getentropy :: Ptr Word8 -> CSize -> IO CInt + +-- | Fill the destination with the given number of bytes (at most 256) +-- of entropy from the operating system, returning 'False' on +-- failure. +fill :: Ptr Word8 -> Int -> IO Bool +fill dst n = do + r <- c_getentropy dst (fromIntegral n) + pure $! r == 0 diff --git a/lib/Crypto/PRNG.hs b/lib/Crypto/PRNG.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/PRNG.hs @@ -0,0 +1,228 @@ +{-# OPTIONS_HADDOCK prune #-} +{-# LANGUAGE BangPatterns #-} + +-- | +-- Module: Crypto.PRNG +-- Copyright: (c) 2026 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- A fast, non-cryptographic pseudorandom number generator: +-- [xoshiro256++](https://prng.di.unimi.it/), by David Blackman and +-- Sebastiano Vigna. +-- +-- The generator is mutable, living in any 'PrimMonad' (e.g. 'IO' or +-- 'ST s'), and is not thread-safe. Use one generator per thread, +-- deriving non-overlapping streams via 'copy' and 'jump' or +-- 'long_jump'. +-- +-- Its output is predictable from a small sample; use "Crypto.CSPRNG" +-- for anything that must be unpredictable. "Crypto.PRNG.Pure" offers +-- the same generator, with the same output, as an immutable value. + +module Crypto.PRNG ( + -- * Generator + Gen + , new + , new_system + , from_state + + -- * Output + , word64 + , word64_range + , int_range + , double + + -- * Streams + , copy + , jump + , long_jump + ) where + +import Control.Monad.Primitive (PrimMonad, PrimState) +import Control.Monad.ST (ST) +import qualified Crypto.Range as Range +import Crypto.Xoshiro (S(..)) +import qualified Crypto.Xoshiro as X +import Data.Bits ((.>>.)) +import qualified Data.Primitive.PrimArray as PA +import Data.Word (Word64) +import GHC.Exts (RealWorld) + +-- utils ---------------------------------------------------------------------- + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral +{-# INLINE fi #-} + +-- generator ------------------------------------------------------------------ + +-- | A xoshiro256++ generator. +newtype Gen s = Gen (PA.MutablePrimArray s Word64) + +read_s :: PrimMonad m => Gen (PrimState m) -> m S +read_s (Gen g) = do + !s0 <- PA.readPrimArray g 0 + !s1 <- PA.readPrimArray g 1 + !s2 <- PA.readPrimArray g 2 + !s3 <- PA.readPrimArray g 3 + pure $! S s0 s1 s2 s3 +{-# INLINE read_s #-} + +write_s :: PrimMonad m => Gen (PrimState m) -> S -> m () +write_s (Gen g) (S s0 s1 s2 s3) = do + PA.writePrimArray g 0 s0 + PA.writePrimArray g 1 s1 + PA.writePrimArray g 2 s2 + PA.writePrimArray g 3 s3 +{-# INLINE write_s #-} + +alloc :: PrimMonad m => S -> m (Gen (PrimState m)) +alloc s = do + g <- fmap Gen (PA.newPrimArray 4) + write_s g s + pure g +{-# INLINE alloc #-} + +-- | Create a generator from a 64-bit seed, expanded to the full +-- 256-bit state via splitmix64, per the xoshiro authors' +-- recommendation. +-- +-- >>> gen <- new 42 +-- >>> word64 gen +-- 15021278609987233951 +new :: PrimMonad m => Word64 -> m (Gen (PrimState m)) +new = alloc . X.seed +{-# INLINABLE new #-} +{-# SPECIALIZE new :: Word64 -> IO (Gen RealWorld) #-} +{-# SPECIALIZE new :: Word64 -> ST s (Gen s) #-} + +-- | Create a generator from the given 256-bit state, returning +-- 'Nothing' if it is all zero. +-- +-- >>> Just gen <- from_state 1 2 3 4 +-- >>> word64 gen +-- 41943041 +from_state + :: PrimMonad m + => Word64 + -> Word64 + -> Word64 + -> Word64 + -> m (Maybe (Gen (PrimState m))) +from_state s0 s1 s2 s3 = traverse alloc (X.from_words s0 s1 s2 s3) +{-# INLINABLE from_state #-} + +-- | Create a generator with a 256-bit state drawn from the operating +-- system's entropy source, returning 'Nothing' if that fails. +-- +-- >>> Just gen <- new_system +new_system :: IO (Maybe (Gen RealWorld)) +new_system = X.system >>= traverse alloc + +-- output --------------------------------------------------------------------- + +-- | Generate a uniformly-distributed 'Word64'. +-- +-- >>> Just gen <- from_state 1 2 3 4 +-- >>> word64 gen +-- 41943041 +-- >>> word64 gen +-- 58720359 +word64 :: PrimMonad m => Gen (PrimState m) -> m Word64 +word64 gen = do + !s <- read_s gen + write_s gen (X.next s) + pure $! X.output s +{-# INLINE word64 #-} + +-- | Generate a uniformly-distributed 'Word64' in the given inclusive +-- range, whose bounds may be given in either order. +-- +-- The result is unbiased; see 'int_range'. +-- +-- >>> gen <- new 42 +-- >>> word64_range 1 6 gen +-- 5 +word64_range + :: PrimMonad m => Word64 -> Word64 -> Gen (PrimState m) -> m Word64 +word64_range a b gen = do + let !lo = min a b + !hi = max a b + !r <- Range.upto (word64 gen) (hi - lo) + pure $! lo + r +{-# INLINE word64_range #-} + +-- | Generate a uniformly-distributed 'Int' in the given inclusive +-- range, whose bounds may be given in either order. +-- +-- The result is unbiased, via Lemire's method: an occasional draw is +-- rejected and replaced, so the number of words consumed varies. +-- +-- >>> gen <- new 42 +-- >>> int_range (-10) 10 gen +-- 7 +int_range :: PrimMonad m => Int -> Int -> Gen (PrimState m) -> m Int +int_range a b gen = do + let !lo = min a b + !hi = max a b + !r <- Range.upto (word64 gen) (fi hi - fi lo) + pure $! lo + fi r +{-# INLINE int_range #-} + +-- | Generate a uniformly-distributed 'Double' in [0, 1), from the +-- upper 53 bits of a 'Word64'. +-- +-- >>> Just gen <- from_state 1 2 3 4 +-- >>> double gen +-- 2.2737367544323206e-12 +double :: PrimMonad m => Gen (PrimState m) -> m Double +double gen = do + !w <- word64 gen + -- 2 ^ -53 + pure $! fi (w .>>. 11) * 1.1102230246251565e-16 +{-# INLINE double #-} + +-- streams -------------------------------------------------------------------- + +-- | Copy a generator. The copy produces the same output as the +-- original, independently of it. +-- +-- >>> gen <- new 42 +-- >>> cop <- copy gen +-- >>> (==) <$> word64 gen <*> word64 cop +-- True +copy :: PrimMonad m => Gen (PrimState m) -> m (Gen (PrimState m)) +copy gen = read_s gen >>= alloc +{-# INLINE copy #-} + +-- | Advance a generator by 2 ^ 128 outputs. +-- +-- Copying and then jumping repeatedly yields up to 2 ^ 128 +-- non-overlapping streams of 2 ^ 128 outputs each, e.g. one per +-- thread. +-- +-- >>> gen <- new 42 +-- >>> one <- copy gen +-- >>> jump gen +-- >>> two <- copy gen +-- >>> jump gen +jump :: PrimMonad m => Gen (PrimState m) -> m () +jump gen = do + !s <- read_s gen + write_s gen (X.jump s) +{-# INLINABLE jump #-} + +-- | Advance a generator by 2 ^ 192 outputs. +-- +-- Copying and long-jumping repeatedly yields up to 2 ^ 64 starting +-- points, from each of which 'jump' yields 2 ^ 64 non-overlapping +-- streams. +-- +-- >>> gen <- new 42 +-- >>> long_jump gen +long_jump :: PrimMonad m => Gen (PrimState m) -> m () +long_jump gen = do + !s <- read_s gen + write_s gen (X.long_jump s) +{-# INLINABLE long_jump #-} diff --git a/lib/Crypto/PRNG/Pure.hs b/lib/Crypto/PRNG/Pure.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/PRNG/Pure.hs @@ -0,0 +1,179 @@ +{-# OPTIONS_HADDOCK prune #-} +{-# LANGUAGE BangPatterns #-} + +-- | +-- Module: Crypto.PRNG.Pure +-- Copyright: (c) 2026 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- A fast, non-cryptographic pseudorandom number generator, +-- [xoshiro256++](https://prng.di.unimi.it/), as an immutable value. +-- +-- This is the generator of "Crypto.PRNG", with the same output for the +-- same seed, but threaded through code explicitly: each function +-- returns its result along with the next generator. Generators are +-- values, so using one twice yields the same output twice; derive +-- non-overlapping streams via 'jump' or 'long_jump'. +-- +-- When these functions are inlined into a strict loop, GHC keeps the +-- generator's state in registers and allocates nothing, which is +-- several times faster than the mutable generator. Bind results with +-- @case@ or bang patterns rather than lazy @let@s. Called where GHC +-- can't inline or specialise them, e.g. via a lazy fold or an +-- unspecialised class method, each draw allocates, and the mutable +-- "Crypto.PRNG" may be faster. +-- +-- Its output is predictable from a small sample; use "Crypto.CSPRNG" +-- for anything that must be unpredictable. + +module Crypto.PRNG.Pure ( + -- * Generator + Gen + , Draw(..) + , new + , new_system + , from_state + + -- * Output + , word64 + , word64_range + , int_range + , double + + -- * Streams + , jump + , long_jump + ) where + +import qualified Crypto.Range as Range +import qualified Crypto.Xoshiro as X +import Data.Bits ((.>>.)) +import Data.Word (Word64) + +-- utils ---------------------------------------------------------------------- + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral +{-# INLINE fi #-} + +-- generator ------------------------------------------------------------------ + +-- | A xoshiro256++ generator. +newtype Gen = Gen X.S + +-- | A generated value, along with the next generator. +data Draw a = Draw !a {-# UNPACK #-} !Gen + +-- | Create a generator from a 64-bit seed, expanded to the full +-- 256-bit state via splitmix64, per the xoshiro authors' +-- recommendation. +-- +-- >>> let Draw w _ = word64 (new 42) +-- >>> w +-- 15021278609987233951 +new :: Word64 -> Gen +new = Gen . X.seed +{-# INLINE new #-} + +-- | Create a generator from the given 256-bit state, returning +-- 'Nothing' if it is all zero. +-- +-- >>> let Just gen = from_state 1 2 3 4 +-- >>> let Draw w _ = word64 gen +-- >>> w +-- 41943041 +from_state :: Word64 -> Word64 -> Word64 -> Word64 -> Maybe Gen +from_state s0 s1 s2 s3 = fmap Gen (X.from_words s0 s1 s2 s3) +{-# INLINE from_state #-} + +-- | Create a generator with a 256-bit state drawn from the operating +-- system's entropy source, returning 'Nothing' if that fails. +-- +-- >>> Just gen <- new_system +new_system :: IO (Maybe Gen) +new_system = fmap (fmap Gen) X.system + +-- output --------------------------------------------------------------------- + +-- | Generate a uniformly-distributed 'Word64'. +-- +-- >>> let Just gen = from_state 1 2 3 4 +-- >>> let Draw a g1 = word64 gen +-- >>> let Draw b _ = word64 g1 +-- >>> (a, b) +-- (41943041,58720359) +word64 :: Gen -> Draw Word64 +word64 (Gen s) = Draw (X.output s) (Gen (X.next s)) +{-# INLINE word64 #-} + +-- | Generate a uniformly-distributed 'Word64' in the given inclusive +-- range, whose bounds may be given in either order. +-- +-- The result is unbiased; see 'int_range'. +-- +-- >>> let Draw w _ = word64_range 1 6 (new 42) +-- >>> w +-- 5 +word64_range :: Word64 -> Word64 -> Gen -> Draw Word64 +word64_range a b (Gen s) = + let !lo = min a b + !hi = max a b + !(r, ns) = Range.upto_pure step (hi - lo) s + in Draw (lo + r) (Gen ns) +{-# INLINE word64_range #-} + +-- | Generate a uniformly-distributed 'Int' in the given inclusive +-- range, whose bounds may be given in either order. +-- +-- The result is unbiased, via Lemire's method: an occasional draw is +-- rejected and replaced, so the number of words consumed varies. +-- +-- >>> let Draw x _ = int_range (-10) 10 (new 42) +-- >>> x +-- 7 +int_range :: Int -> Int -> Gen -> Draw Int +int_range a b (Gen s) = + let !lo = min a b + !hi = max a b + !(r, ns) = Range.upto_pure step (fi hi - fi lo) s + in Draw (lo + fi r) (Gen ns) +{-# INLINE int_range #-} + +-- | Generate a uniformly-distributed 'Double' in [0, 1), from the +-- upper 53 bits of a 'Word64'. +-- +-- >>> let Just gen = from_state 1 2 3 4 +-- >>> let Draw d _ = double gen +-- >>> d +-- 2.2737367544323206e-12 +double :: Gen -> Draw Double +double gen = case word64 gen of + -- 2 ^ -53 + Draw w ng -> Draw (fi (w .>>. 11) * 1.1102230246251565e-16) ng +{-# INLINE double #-} + +-- one step of the generator, for 'Range.upto_pure' +step :: X.S -> (Word64, X.S) +step s = (X.output s, X.next s) +{-# INLINE step #-} + +-- streams -------------------------------------------------------------------- + +-- | Advance a generator by 2 ^ 128 outputs. +-- +-- Repeated jumps yield up to 2 ^ 128 non-overlapping streams of +-- 2 ^ 128 outputs each, e.g. one per thread. +-- +-- >>> let gens = take 4 (iterate jump (new 42)) +jump :: Gen -> Gen +jump (Gen s) = Gen (X.jump s) + +-- | Advance a generator by 2 ^ 192 outputs. +-- +-- Repeated long jumps yield up to 2 ^ 64 starting points, from each +-- of which 'jump' yields 2 ^ 64 non-overlapping streams. +-- +-- >>> let starts = take 4 (iterate long_jump (new 42)) +long_jump :: Gen -> Gen +long_jump (Gen s) = Gen (X.long_jump s) diff --git a/lib/Crypto/Xoshiro.hs b/lib/Crypto/Xoshiro.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/Xoshiro.hs @@ -0,0 +1,135 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE BangPatterns #-} + +-- | +-- Module: Crypto.Xoshiro +-- Copyright: (c) 2026 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- The xoshiro256++ state, step function, scrambler, jumps, and +-- seeding, shared by the mutable and pure generators. + +module Crypto.Xoshiro ( + S(..) + , output + , next + , jump + , long_jump + , seed + , from_words + , system + ) where + +import qualified Crypto.Entropy as Entropy +import Data.Bits ((.|.), (.^.), (.<<.), (.>>.)) +import qualified Data.Bits as B +import Data.Word (Word64) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Ptr (Ptr, castPtr) +import Foreign.Storable (peekElemOff) + +rotl :: Word64 -> Int -> Word64 +rotl x k = (x .<<. k) .|. (x .>>. (64 - k)) +{-# INLINE rotl #-} + +-- | A xoshiro256++ state, which must not be all zero. +data S = S + {-# UNPACK #-} !Word64 + {-# UNPACK #-} !Word64 + {-# UNPACK #-} !Word64 + {-# UNPACK #-} !Word64 + +-- | The ++ scrambler: the output for a state. +output :: S -> Word64 +output (S s0 _ _ s3) = rotl (s0 + s3) 23 + s0 +{-# INLINE output #-} + +-- | The linear engine: the next state. +next :: S -> S +next (S s0 s1 s2 s3) = + let !t = s1 .<<. 17 + !a2 = s2 .^. s0 + !a3 = s3 .^. s1 + !b1 = s1 .^. a2 + !b0 = s0 .^. a3 + !b2 = a2 .^. t + !b3 = rotl a3 45 + in S b0 b1 b2 b3 +{-# INLINE next #-} + +xor_s :: S -> S -> S +xor_s (S a0 a1 a2 a3) (S b0 b1 b2 b3) = + S (a0 .^. b0) (a1 .^. b1) (a2 .^. b2) (a3 .^. b3) +{-# INLINE xor_s #-} + +data P = P !S !S + +-- advance the state by the jump polynomial with the given coefficients +leap :: Word64 -> Word64 -> Word64 -> Word64 -> S -> S +leap j0 j1 j2 j3 s0 = + let !(P acc _) = + coef j3 (coef j2 (coef j1 (coef j0 (P (S 0 0 0 0) s0)))) + in acc + where + coef :: Word64 -> P -> P + coef j = loop 0 where + loop :: Int -> P -> P + loop !b p@(P acc s) + | b == 64 = p + | otherwise = + let !nacc | B.testBit j b = xor_s acc s + | otherwise = acc + in loop (b + 1) (P nacc (next s)) + +-- | Advance a state by 2 ^ 128 steps. +jump :: S -> S +jump = leap 0x180ec6d33cfd0aba 0xd5a61266f0c9392c + 0xa9582618e03fc9aa 0x39abdc4529b1661c + +-- | Advance a state by 2 ^ 192 steps. +long_jump :: S -> S +long_jump = leap 0x76e15d3efefdcbbf 0xc5004e441c522fb3 + 0x77710069854ee241 0x39109bb02acbe635 + +data SM = SM {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 + +splitmix64 :: Word64 -> SM +splitmix64 x = + let !nx = x + 0x9e3779b97f4a7c15 + !z0 = (nx .^. (nx .>>. 30)) * 0xbf58476d1ce4e5b9 + !z1 = (z0 .^. (z0 .>>. 27)) * 0x94d049bb133111eb + in SM nx (z1 .^. (z1 .>>. 31)) +{-# INLINE splitmix64 #-} + +-- | A state expanded from a 64-bit seed via splitmix64, per the +-- xoshiro authors' recommendation. It is never all zero. +seed :: Word64 -> S +seed x = + let !(SM x0 s0) = splitmix64 x + !(SM x1 s1) = splitmix64 x0 + !(SM x2 s2) = splitmix64 x1 + !(SM _ s3) = splitmix64 x2 + in S s0 s1 s2 s3 + +-- | A state from the given words, unless they are all zero. +from_words :: Word64 -> Word64 -> Word64 -> Word64 -> Maybe S +from_words s0 s1 s2 s3 + | s0 .|. s1 .|. s2 .|. s3 == 0 = Nothing + | otherwise = Just (S s0 s1 s2 s3) +{-# INLINE from_words #-} + +-- | A state drawn from the operating system's entropy source, unless +-- that fails. +system :: IO (Maybe S) +system = allocaBytes 32 $ \buf -> do + ok <- Entropy.fill buf 32 + if not ok + then pure Nothing + else do + let p = castPtr buf :: Ptr Word64 + s0 <- peekElemOff p 0 + s1 <- peekElemOff p 1 + s2 <- peekElemOff p 2 + s3 <- peekElemOff p 3 + pure $! from_words s0 s1 s2 s3 diff --git a/ppad-random.cabal b/ppad-random.cabal new file mode 100644 --- /dev/null +++ b/ppad-random.cabal @@ -0,0 +1,106 @@ +cabal-version: 3.0 +name: ppad-random +version: 0.1.0 +synopsis: Fast random number generators. +license: MIT +license-file: LICENSE +author: Jared Tobin +maintainer: jared@ppad.tech +category: Cryptography, Random +build-type: Simple +tested-with: GHC == 9.10.3 +extra-doc-files: CHANGELOG +description: + Fast random number generators: the xoshiro256++ PRNG, as a mutable + generator or a pure value, and the ChaCha8Rand CSPRNG, with unbiased + bounded integers and seeding from the operating system. + +flag llvm + description: Use GHC's LLVM backend. + default: False + manual: True + +source-repository head + type: git + location: git.ppad.tech/random.git + +library + default-language: Haskell2010 + hs-source-dirs: lib, internal + ghc-options: + -Wall + if flag(llvm) + ghc-options: -fllvm -O2 + exposed-modules: + Crypto.CSPRNG + , Crypto.PRNG + , Crypto.PRNG.Pure + other-modules: + Crypto.Entropy + , Crypto.Range + , Crypto.Xoshiro + build-depends: + base >= 4.17 && < 5 + , bytestring >= 0.11 && < 0.13 + , ppad-chacha >= 0.3.4 && < 0.4 + , primitive >= 0.8 && < 0.10 + +test-suite random-tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test, internal + main-is: Main.hs + other-modules: + Crypto.Range + , Vectors + + ghc-options: + -rtsopts -Wall -O2 + + build-depends: + base + , bytestring + , ppad-base16 + , ppad-random + , tasty + , tasty-hunit + +benchmark random-bench + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: bench + main-is: Main.hs + + ghc-options: + -rtsopts -O2 -Wall + if flag(llvm) + ghc-options: -fllvm + + build-depends: + base + , bytestring + , criterion + , crypton + , entropy + , mwc-random + , pcg-random + , ppad-random + , random + , splitmix + +benchmark random-weigh + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: bench + main-is: Weight.hs + + ghc-options: + -rtsopts -O2 -Wall + if flag(llvm) + ghc-options: -fllvm + + build-depends: + base + , bytestring + , ppad-random + , weigh diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,457 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Monad (replicateM) +import Control.Monad.ST (runST) +import qualified Crypto.CSPRNG as CSPRNG +import qualified Crypto.PRNG as PRNG +import qualified Crypto.PRNG.Pure as Pure +import qualified Crypto.Range as Range +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Data.Bits ((.<<.), (.|.)) +import Data.Foldable (for_) +import qualified Data.List as L +import Data.Word (Word64) +import GHC.Exts (RealWorld) +import Test.Tasty +import qualified Test.Tasty.HUnit as H +import Vectors (chacha8rand_seed, chacha8rand_hex, chacha8rand_words) + +main :: IO () +main = defaultMain $ testGroup "ppad-random" [ + testGroup "Crypto.PRNG" [ + prng_reference + , prng_jump + , prng_long_jump + , prng_new + , prng_zero_state + , prng_copy + , prng_double + , prng_system + ] + , testGroup "Crypto.PRNG.Pure" [ + pure_reference + , pure_jumps + , pure_new + , pure_zero_state + , pure_agrees + ] + , testGroup "ranges" [ + mul_wide + , prng_word64_range + , prng_int_range_bounds + , prng_int_range_order + , prng_int_range_full + , prng_uniformity + , csprng_word64_range + ] + , testGroup "Crypto.CSPRNG" [ + csprng_words + , csprng_bytes + , csprng_chunks + , csprng_alignment + , csprng_seed_length + , csprng_split + , csprng_st + , csprng_system + ] + ] + +-- utilities ------------------------------------------------------------------ + +hex :: BS.ByteString -> BS.ByteString +hex bs = case B16.decode bs of + Nothing -> error "ppad-random (test): invalid hex" + Just x -> x + +prng_state + :: Word64 -> Word64 -> Word64 -> Word64 -> IO (PRNG.Gen RealWorld) +prng_state s0 s1 s2 s3 = do + mg <- PRNG.from_state s0 s1 s2 s3 + case mg of + Nothing -> H.assertFailure "invalid state" + Just g -> pure g + +csprng_seeded :: BS.ByteString -> IO (CSPRNG.Gen RealWorld) +csprng_seeded seed = do + mg <- CSPRNG.new seed + case mg of + Nothing -> H.assertFailure "invalid seed" + Just g -> pure g + +-- little-endian word at the given index of a bytestring +le64_at :: BS.ByteString -> Int -> Word64 +le64_at bs k = + BS.foldr (\b acc -> (acc .<<. 8) .|. fromIntegral b) 0 + (BS.take 8 (BS.drop (8 * k) bs)) + +-- xoshiro256++ --------------------------------------------------------------- + +-- the vectors below are from Blackman and Vigna's reference +-- implementation, as published by rand_xoshiro (reference outputs) +-- or generated with it (jumps and seeding) + +prng_reference :: TestTree +prng_reference = H.testCase "reference output" $ do + g <- prng_state 1 2 3 4 + out <- replicateM 10 (PRNG.word64 g) + H.assertEqual mempty [ + 41943041, 58720359, 3588806011781223, 3591011842654386 + , 9228616714210784205, 9973669472204895162, 14011001112246962877 + , 12406186145184390807, 15849039046786891736, 10450023813501588000 + ] out + +prng_jump :: TestTree +prng_jump = H.testCase "jump" $ do + g <- prng_state 1 2 3 4 + PRNG.jump g + out <- replicateM 4 (PRNG.word64 g) + H.assertEqual mempty [ + 0xec879073673df437, 0x20d212a39aca1eaa + , 0xc19d712a27e40f57, 0x6ff0e08dc71026a1 + ] out + +prng_long_jump :: TestTree +prng_long_jump = H.testCase "long_jump" $ do + g <- prng_state 1 2 3 4 + PRNG.long_jump g + out <- replicateM 4 (PRNG.word64 g) + H.assertEqual mempty [ + 0xb5c4ea370b330bf5, 0x5173cc693c0fa533 + , 0x1dc5df0151f7b491, 0xe7b055cfeabc4661 + ] out + +prng_new :: TestTree +prng_new = H.testCase "new (splitmix64 seeding)" $ + for_ cases $ \(seed, expected) -> do + g <- PRNG.new seed + out <- replicateM 4 (PRNG.word64 g) + H.assertEqual (show seed) expected out + where + cases = [ + (0, [ 0x53175d61490b23df, 0x61da6f3dc380d507 + , 0x5c0fdf91ec9a7bfc, 0x02eebf8c3bbe5e1a ]) + , (42, [ 0xd0764d4f4476689f, 0x519e4174576f3791 + , 0xfbe07cfb0c24ed8c, 0xb37d9f600cd835b8 ]) + , (maxBound, [ 0x56ccf8ce948e27b2, 0xe68588432e5a5b90 + , 0xe3e9b5a48119ca8b, 0x460f19495532ae73 ]) + ] + +prng_zero_state :: TestTree +prng_zero_state = H.testCase "from_state rejects the zero state" $ do + mg <- PRNG.from_state 0 0 0 0 + case mg of + Nothing -> pure () + Just _ -> H.assertFailure "accepted zero state" + +prng_copy :: TestTree +prng_copy = H.testCase "copy" $ do + g <- PRNG.new 42 + _ <- PRNG.word64 g + c <- PRNG.copy g + a <- replicateM 8 (PRNG.word64 g) + b <- replicateM 8 (PRNG.word64 c) + H.assertEqual "same stream" a b + -- jumping the copy leaves the original alone + PRNG.jump c + x <- replicateM 8 (PRNG.word64 g) + ref <- PRNG.new 42 + y <- fmap (drop 9) (replicateM 17 (PRNG.word64 ref)) + H.assertEqual "original unaffected" y x + +prng_double :: TestTree +prng_double = H.testCase "double" $ do + g <- PRNG.new 42 + c <- PRNG.copy g + ds <- replicateM 1000 (PRNG.double g) + ws <- replicateM 1000 (PRNG.word64 c) + H.assertBool "range" (all (\d -> d >= 0 && d < 1) ds) + H.assertEqual "upper 53 bits" + (fmap (\w -> fromIntegral (w `div` 2048) / 2 ^ (53 :: Int)) ws) ds + +prng_system :: TestTree +prng_system = H.testCase "new_system" $ do + ma <- PRNG.new_system + mb <- PRNG.new_system + case (ma, mb) of + (Just a, Just b) -> do + xs <- replicateM 4 (PRNG.word64 a) + ys <- replicateM 4 (PRNG.word64 b) + H.assertBool "distinct" (xs /= ys) + _ -> H.assertFailure "no entropy" + +-- chacha8rand ---------------------------------------------------------------- + +-- the vectors are the sample output from the C2SP specification + +csprng_words :: TestTree +csprng_words = H.testCase "sample output (word64)" $ do + g <- csprng_seeded chacha8rand_seed + out <- replicateM (length chacha8rand_words) (CSPRNG.word64 g) + H.assertEqual mempty chacha8rand_words out + +csprng_bytes :: TestTree +csprng_bytes = H.testCase "sample output (bytes)" $ do + g <- csprng_seeded chacha8rand_seed + out <- CSPRNG.bytes 2976 g + H.assertEqual mempty (hex chacha8rand_hex) out + +-- requests of assorted sizes, straddling refills, concatenate to the +-- same stream +csprng_chunks :: TestTree +csprng_chunks = H.testCase "sample output (chunked bytes)" $ do + g <- csprng_seeded chacha8rand_seed + let sizes = [0, 1, 7, 13, 100, 900, 992, 1, 962, -3] + out <- traverse (\n -> CSPRNG.bytes n g) sizes + H.assertEqual mempty (hex chacha8rand_hex) (BS.concat out) + +-- after an unaligned 'bytes', 'word64' skips to the next eight-byte +-- boundary, including across a refill +csprng_alignment :: TestTree +csprng_alignment = H.testCase "word64 alignment" $ do + let stream = hex chacha8rand_hex + g <- csprng_seeded chacha8rand_seed + _ <- CSPRNG.bytes 3 g + a <- CSPRNG.word64 g + H.assertEqual "within buffer" (le64_at stream 1) a + _ <- CSPRNG.bytes (992 - 16 - 1) g + b <- CSPRNG.word64 g + H.assertEqual "across refill" (le64_at stream 124) b + +csprng_seed_length :: TestTree +csprng_seed_length = H.testCase "new rejects bad seed lengths" $ + for_ [0, 31, 33] $ \l -> do + mg <- CSPRNG.new (BS.replicate l 0) + case mg of + Nothing -> pure () + Just _ -> H.assertFailure ("accepted length " <> show l) + +-- a child is seeded from the parent's next 32 bytes, which the parent +-- then skips +csprng_split :: TestTree +csprng_split = H.testCase "split" $ do + let stream = hex chacha8rand_hex + g <- csprng_seeded chacha8rand_seed + c <- CSPRNG.split g + r <- csprng_seeded (BS.take 32 stream) + x <- CSPRNG.bytes 2000 c + y <- CSPRNG.bytes 2000 r + H.assertEqual "child" y x + z <- CSPRNG.bytes 100 g + H.assertEqual "parent" (BS.take 100 (BS.drop 32 stream)) z + +csprng_st :: TestTree +csprng_st = H.testCase "ST" $ do + let out = runST $ do + mg <- CSPRNG.new chacha8rand_seed + case mg of + Nothing -> pure [] + Just g -> replicateM 200 (CSPRNG.word64 g) + H.assertEqual mempty (take 200 chacha8rand_words) out + +csprng_system :: TestTree +csprng_system = H.testCase "new_system" $ do + ma <- CSPRNG.new_system + mb <- CSPRNG.new_system + case (ma, mb) of + (Just a, Just b) -> do + x <- CSPRNG.bytes 32 a + y <- CSPRNG.bytes 32 b + H.assertBool "distinct" (x /= y) + _ -> H.assertFailure "no entropy" + +-- ranges --------------------------------------------------------------------- + +-- reference model of Lemire's method over a stream of words, using +-- exact integer arithmetic: a draw w is accepted iff the low word of +-- w * s is at least 2 ^ 64 mod s, yielding the high word +ref_ranges :: [Word64] -> [Word64] -> Maybe [Word64] +ref_ranges [] _ = Just [] +ref_ranges (n : ns) ws + | n == maxBound = case ws of + [] -> Nothing + (w : rest) -> fmap (w :) (ref_ranges ns rest) + | otherwise = draw ws + where + s = toInteger n + 1 + t = 2 ^ (64 :: Int) `mod` s + draw [] = Nothing + draw (w : rest) = + let m = toInteger w * s + in if m `mod` 2 ^ (64 :: Int) >= t + then fmap (fromInteger (m `div` 2 ^ (64 :: Int)) :) + (ref_ranges ns rest) + else draw rest + +-- bounds including some with rejection probabilities near 1 / 2 +range_bounds :: [Word64] +range_bounds = concat . replicate 20 $ [ + 0, 1, 5, 6, 100, 2 ^ (32 :: Int), 2 ^ (63 :: Int) + , 2 ^ (63 :: Int) + 12345, maxBound - 1, maxBound + ] + +mul_wide :: TestTree +mul_wide = H.testCase "mul_wide (native and limbs)" $ + for_ edges $ \a -> for_ edges $ \b -> do + let p = toInteger a * toInteger b + ex = Range.W2 (fromInteger (p `div` 2 ^ (64 :: Int))) + (fromInteger (p `mod` 2 ^ (64 :: Int))) + H.assertEqual (show (a, b)) ex (Range.mul_wide a b) + H.assertEqual (show (a, b)) ex (Range._mul_wide_limbs a b) + where + edges = [ 0, 1, 2, 0xffffffff, 0x100000000, 0x7fffffffffffffff + , 0x8000000000000000, 0xfffffffffffffffe, maxBound + , 0xd0764d4f4476689f, 0x519e4174576f3791 ] + +prng_word64_range :: TestTree +prng_word64_range = H.testCase "PRNG word64_range (reference model)" $ do + g <- PRNG.new 42 + c <- PRNG.copy g + out <- traverse (\n -> PRNG.word64_range 0 n g) range_bounds + ws <- replicateM 1000 (PRNG.word64 c) + H.assertEqual mempty (Just out) (ref_ranges range_bounds ws) + -- an offset range is the same draw, shifted + g1 <- PRNG.new 7 + g2 <- PRNG.copy g1 + x <- PRNG.word64_range 1000 1100 g1 + y <- PRNG.word64_range 0 100 g2 + H.assertEqual "offset" (y + 1000) x + +prng_int_range_bounds :: TestTree +prng_int_range_bounds = H.testCase "PRNG int_range (bounds)" $ do + g <- PRNG.new 42 + for_ cases $ \(lo, hi) -> do + xs <- replicateM 200 (PRNG.int_range lo hi g) + H.assertBool (show (lo, hi)) (all (\x -> x >= lo && x <= hi) xs) + where + cases = [ (-10, 10), (5, 5), (-1, 0), (minBound, minBound + 3) + , (maxBound - 3, maxBound), (minBound, -1), (0, maxBound) ] + +prng_int_range_order :: TestTree +prng_int_range_order = H.testCase "PRNG int_range (bound order)" $ do + g <- PRNG.new 42 + c <- PRNG.copy g + xs <- replicateM 100 (PRNG.int_range (-10) 10 g) + ys <- replicateM 100 (PRNG.int_range 10 (-10) c) + H.assertEqual mempty xs ys + +prng_int_range_full :: TestTree +prng_int_range_full = H.testCase "PRNG int_range (full range)" $ do + g <- PRNG.new 42 + c <- PRNG.copy g + xs <- replicateM 100 (PRNG.int_range minBound maxBound g) + ws <- replicateM 100 (PRNG.word64 c) + H.assertEqual mempty (fmap (\w -> minBound + fromIntegral w) ws) xs + +-- chi-squared over six outcomes from a fixed seed; 20.5 is the 0.999 +-- quantile for five degrees of freedom +prng_uniformity :: TestTree +prng_uniformity = H.testCase "PRNG int_range (uniformity)" $ do + g <- PRNG.new 42 + xs <- replicateM 60000 (PRNG.int_range 1 6 g) + let counts = fmap length (L.group (L.sort xs)) + chi = sum [ (fromIntegral k - 10000) ^ (2 :: Int) / 10000 + | k <- counts ] :: Double + H.assertEqual "outcomes" 6 (length counts) + H.assertBool ("chi-squared " <> show chi) (chi < 20.5) + +-- over the known C2SP stream +csprng_word64_range :: TestTree +csprng_word64_range = H.testCase "CSPRNG word64_range (reference model)" $ do + g <- csprng_seeded chacha8rand_seed + let bounds = take 60 range_bounds + out <- traverse (\n -> CSPRNG.word64_range 0 n g) bounds + H.assertEqual mempty (Just out) (ref_ranges bounds chacha8rand_words) + +-- pure xoshiro256++ ---------------------------------------------------------- + +-- n draws from a pure generator +draws :: (Pure.Gen -> Pure.Draw a) -> Int -> Pure.Gen -> [a] +draws f = go where + go n g + | n <= 0 = [] + | otherwise = case f g of + Pure.Draw x ng -> x : go (n - 1) ng + +pure_state :: Word64 -> Word64 -> Word64 -> Word64 -> IO Pure.Gen +pure_state s0 s1 s2 s3 = case Pure.from_state s0 s1 s2 s3 of + Nothing -> H.assertFailure "invalid state" + Just g -> pure g + +pure_reference :: TestTree +pure_reference = H.testCase "reference output" $ do + g <- pure_state 1 2 3 4 + H.assertEqual mempty [ + 41943041, 58720359, 3588806011781223, 3591011842654386 + , 9228616714210784205, 9973669472204895162, 14011001112246962877 + , 12406186145184390807, 15849039046786891736, 10450023813501588000 + ] (draws Pure.word64 10 g) + +pure_jumps :: TestTree +pure_jumps = H.testCase "jump and long_jump" $ do + g <- pure_state 1 2 3 4 + H.assertEqual "jump" [ + 0xec879073673df437, 0x20d212a39aca1eaa + , 0xc19d712a27e40f57, 0x6ff0e08dc71026a1 + ] (draws Pure.word64 4 (Pure.jump g)) + H.assertEqual "long_jump" [ + 0xb5c4ea370b330bf5, 0x5173cc693c0fa533 + , 0x1dc5df0151f7b491, 0xe7b055cfeabc4661 + ] (draws Pure.word64 4 (Pure.long_jump g)) + +pure_new :: TestTree +pure_new = H.testCase "new (splitmix64 seeding)" $ do + H.assertEqual "0" [ 0x53175d61490b23df, 0x61da6f3dc380d507 + , 0x5c0fdf91ec9a7bfc, 0x02eebf8c3bbe5e1a ] + (draws Pure.word64 4 (Pure.new 0)) + H.assertEqual "42" [ 0xd0764d4f4476689f, 0x519e4174576f3791 + , 0xfbe07cfb0c24ed8c, 0xb37d9f600cd835b8 ] + (draws Pure.word64 4 (Pure.new 42)) + +pure_zero_state :: TestTree +pure_zero_state = H.testCase "from_state rejects the zero state" $ + case Pure.from_state 0 0 0 0 of + Nothing -> pure () + Just _ -> H.assertFailure "accepted zero state" + +data Op = OpWord | OpDouble | OpRange Word64 | OpInt Int Int + +data Out = OutWord Word64 | OutDouble Double | OutInt Int + deriving (Eq, Show) + +-- a mix of operations, including ranges with frequent rejection +ops :: [Op] +ops = concat . replicate 30 $ [ + OpWord, OpDouble, OpRange 6, OpRange (2 ^ (63 :: Int)) + , OpInt (-10) 10, OpInt minBound maxBound, OpRange maxBound + ] + +run_pure :: [Op] -> Pure.Gen -> [Out] +run_pure [] _ = [] +run_pure (o : os) g = case o of + OpWord -> case Pure.word64 g of + Pure.Draw x ng -> OutWord x : run_pure os ng + OpDouble -> case Pure.double g of + Pure.Draw x ng -> OutDouble x : run_pure os ng + OpRange n -> case Pure.word64_range 0 n g of + Pure.Draw x ng -> OutWord x : run_pure os ng + OpInt a b -> case Pure.int_range a b g of + Pure.Draw x ng -> OutInt x : run_pure os ng + +run_mutable :: [Op] -> PRNG.Gen RealWorld -> IO [Out] +run_mutable os g = traverse op os where + op o = case o of + OpWord -> fmap OutWord (PRNG.word64 g) + OpDouble -> fmap OutDouble (PRNG.double g) + OpRange n -> fmap OutWord (PRNG.word64_range 0 n g) + OpInt a b -> fmap OutInt (PRNG.int_range a b g) + +-- the pure and mutable generators produce the same output +pure_agrees :: TestTree +pure_agrees = H.testCase "agrees with Crypto.PRNG" $ + for_ [0, 42, maxBound] $ \seed -> do + m <- PRNG.new seed + out <- run_mutable ops m + H.assertEqual (show seed) out (run_pure ops (Pure.new seed)) diff --git a/test/Vectors.hs b/test/Vectors.hs new file mode 100644 --- /dev/null +++ b/test/Vectors.hs @@ -0,0 +1,242 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- ChaCha8Rand sample output, from etc/chacha8rand.md: the first 2976 +-- bytes of output for the seed "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456", as +-- hex, and as little-endian 64-bit words. + +module Vectors ( + chacha8rand_seed + , chacha8rand_hex + , chacha8rand_words + ) where + +import qualified Data.ByteString as BS +import Data.Word (Word64) + +chacha8rand_seed :: BS.ByteString +chacha8rand_seed = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456" + +chacha8rand_hex :: BS.ByteString +chacha8rand_hex = mconcat [ + "a516463d06b673b73cbc6aa622af60117c288d41d999258cd65cdc7e037ee07e" + , "ad161c2de09eaacf79eaeb8fef0e090e3e5b8b1271d2823c4fa35212c1dd5a9c" + , "a6ee6c7d61bb79df6a739d1f5953d5361fe01e184ed1f0ee3684e50a76fc9b08" + , "68d22acc592be5d9ba8a1b4b44b42feb6166c492a6c8954f2ce6ca173232c6c3" + , "7e2e4e7f36b4eb91c69beca0c6f24c7820beea345cec345ca8da7055518f0a4f" + , "f26b3d11b4dc35fcbc5455644ca40d5be1d921dba33d966df300e55031fcaeee" + , "a55037da3d92372db0c84b6d627a0d3849eed7e3ed68afee7c713b88956635f4" + , "a495243921906a841ba630965410858e93e4ba5d5402dc18433d5aa6f09f8f0f" + , "80f00f19f765f0cc30336739aad176fd3364ba6c9332d29517bd0c07d156746c" + , "62658cffdacf2a466afc346d86abaf5b88290a03782f860c3d16c307e4839ad3" + , "bf2ef2457b2b0ac0a9b16624c6074356d472c0b024047e25fe286c49995eb56f" + , "e0d45c8fa87398ae73370dc62a3657468e3ef2cd1ef9831cc08753c19207dc6f" + , "5c2bfd0da3d2da36b7bd95052993b5a4c502cce43489e14da7e315f004d6c0cd" + , "2103d89af6dba0fb87de39d1a3bee8605687f41e854d8ad14af315227c446663" + , "ee07d0d3972e6805b24ad5c678890e4cc2ed12676a9f1ecfd3cf804c41391406" + , "ad0e5c74e2b6a8d1e810c4458d91a731ec6e2190ad61ccab1aa732202dd94040" + , "68cd40fb6ff6d23c7a859572c051d0dc7e52abd9bc5cb5eaacda1b78ce1d4718" + , "5272dc44d18cf0f7d1407f3db1e004585bd3b2e446a4b15c068a13d228a7d4e6" + , "d8da60ca403e2205686aac0632ec612db8174c87562369ab1cde7676415409c3" + , "2456223237ce1a4f388398130851a9fb112e75520f207f99fa2162e8afaa1611" + , "1935a1b25c3bce07148345bc72bc562978eb406192b788414deaadd4bf6dca56" + , "e50c344923c2e37f8a5f67379c8fc03521d55eeffbc7e11175bcc14e46c8ad98" + , "f803123dc7b263d1f3f3a243e01e768cb7d7eccc6a9db92470032f11aa313e79" + , "395128192adc878e256e09f704ae47420fe26f9222314f51e9a7d245f0b36fdc" + , "ba8ed1cdce30cb15740290f6ecfdc7cb21a08bdc96c6b53fe674d2c8174466d1" + , "787245ea45e4f70557b69d1bcabb20f999cb22dab450190c92e209aff1ba75f8" + , "38f85042b8d7d3be6041d70f08e898f103a77e9b1da5edc9f6f89b4355ef09f7" + , "fc16f1ebfe740cd246756d14eb6856308797d810ecf39a82bc1d557b69f9b815" + , "c9b8648e6c3c82fcbc403b18e8855534681358d671414b67f7e970d61cd83412" + , "195ea5d81052500edca0ecee698d25e87ef6bae852c4d4059955a41601e3dbe8" + , "006f17b1e18cf01c49cb1eb8a4d0f7cc0e432c6b13ea3f3071c8069c136c1d86" + , "87045ee072df415f1d6be21a1e7ebd251da462d604409fbe46851883d458bf65" + , "cc13db69ff7cb2d136bbc1723366a6014d7f727b57d78d57f63c086c068fc719" + , "bb91c3f9d414e0dbb3ff131dddb2fb974f8deff90a1ec931ba432a4098fc4d09" + , "52b737ea1bd69b06ca86d9e862d7725b85bc04598631ee723ec336cdc5fdf5d1" + , "ad7c94a880499bba43ab49ac5ef0e8ece738aeab8411fe655214d3a5deb97c2d" + , "e367e476944871cc8cc678a558a2034cfcd80fcb9edfef006d66e271d4ca2499" + , "e965f7188366f887d8f5551b7cc54dcb594860865a8373d382e440558b5626e5" + , "ec6f58080f04391fe6f89302f0f364b7a850bdf6a24394041a94d39786c8fe76" + , "a2e7ba39d070fb3ea8a8ec681361f4e225241de0967a007cbfc5698e76e5ccbb" + , "c3aa425c98b44f78743822aa91502bf7072ee6b13f333036deb8bbdeeb19738e" + , "00fa59a9bc82392ab3a94b969f8bb9b25119b7ad1410e3f782cc3a70a3fcd0eb" + , "9a41e62f2a4e65ec2c2ea5552d1326b3782950447fc5482216af2d342f0c7132" + , "ec2bcb5a7bb41705370927ca8f717a4c41c5bcd0be4291d688ce52ffb8bc0ee4" + , "d428f8c9dba2443e583f878f4f2f4cc75be499b78e64bf3df8860eee7524f233" + , "657fd416eef9b41ee3442771b8d2f8407245b13cdab486b84df6d6bd6f328620" + , "b982d87d90e53dccdf09e95e9ab4e8a2104c9623788efbdbd5f80def8960dd70" + , "9fc9d9cd631614306503245c3205b804d612ac1403d88374f9f5a71ab91c272b" + , "f0ddab625324e297ab9f2a2314f6845aa27f4bdafc2511f76772b2741da6a51c" + , "45cbdb3a9b6acc38393e65dc85bbe1ddd49ff864fac8d0e988412bcd1efbc502" + , "e55657ca7b13bdf255e11b125de2efad8e3a895d3c1ccd56b95bb6be37d3504c" + , "67f55c6751518c911e6ab5cfff49a6abcd47226ab24ac720da083c85ac6b1671" + , "5dfc84e5e2ef7bb032bf8d582aff45da5e09754d3cb098db4c5aa6aae15a2860" + , "b84031266a683bf90e181cee529746deae9a1204dc32c2ce04ea3518aa6b91eb" + , "ff8843b6c8219cd488488658962da872a866ac7eef483300eb09b255e6676f7f" + , "251b947a0bfb2f53deee8d12e6ad40d923fe89afa1f224dfe05a1988493baa95" + , "4abe944f4049a63d277e3f2c13ad2d69b89eaaca6ee7ae40245065091ea09412" + , "f5e4a4dbab97f76d32701d4c02b62feafc89542992044e5f6ae022ea14299757" + , "73d4aa33d137819af3f2cde76adde6a2476608184f64429f3ebd70c10133d016" + , "6d6546a56f418c903e122ee23b5081e072ccc41691f07c0729f2b764d25cd2cb" + , "314059ec68f4b23dd5ad9b4c730ec04661d87520c70aecd030760bf83ccb3730" + , "c621273a7b3d4c574b8276006a9099ae702e538b41a575b1dd1d23ee51e2b3d8" + , "6619ca5dc2ee33b4939aff5cdc300f5335d33cb5983df09fdf8c55765022c4af" + , "2a408482a2d381ef280a111cf5db0b11f6e827d055b2e19a32836824aae0e37d" + , "e27e06d2ecc383e4e63761278b3229f8ad2c5657adcc13a41fcb6a498b8e11e6" + , "1fc05edaa6dc88825572c188dc7737a5da6e71d5e0f1008aa820a7b7476f8e61" + , "41a892c6b007399ef3343f96ca428b97efd7a798cdb0e47552475f0b6ebd4dde" + , "3f49343f15e45202f94e7303d8e7f050ee67d18ea3667723a039ee0140412441" + , "21bb35e543f68dd0740ba8a9b575f53455f79772f83a342ccbf721d8996d8bcd" + , "ae48fc5672fd76e385283534736eb0e1eb69c1866fb287fade71a9654660c136" + , "808e9c23c247a1db240e7ffc698e206bc3602b6f5b399587f4074919e9beda05" + , "02d95e2f147581b981dc1d02e201175e08ed5e75a2ab750895de519228838d77" + , "31cb9e036ae4fb3bf9d7cbe4fc0447b23d1ec9a7e9ff8569bbda49f23db1efc8" + , "f6c9f4b0647e03b1c3b7d697d19ff6550ca9681dd78925677ea7504f22b8bdbe" + , "a7747300809f583f2a18545963f407d390fdd4100c85f5cf158e40b6df02dac6" + , "85a4b1e2f1eeda9325a6ee8a2033d865fab5d33ea13fb1e28eb60f1338350567" + , "a98f2198652f04c12e8a9b74caad5bee7de3da47f9a3226dafdbf457166d2cb6" + , "0bc20497e67d006ed84138fc13b9f21a228e2e8e34470edc228b95cff1de1d9b" + , "b8663023b0d62e63f2d8be11332dd0dde9564683e1cf47f17a5911d549aa9a39" + , "0903ec796988146b97fb5a6bc34afc6481f07c7fe0782fb81b0e3d329a5c9210" + , "f6633ce19ec751f4c776783180c12f7c227dcbeed92ba135901f6239a5545633" + , "f081b55df3a332cccb69230ba84807c66b159185b0d34d7c9122e26d4bed1cac" + , "f5de34f12dfa2ca3532aea8d91087162f44fcb8f60b155053ca3aa43ace73e14" + , "18c24fcfe70ce9dab5f4bc8225fc684d715d1349184e0937d89fd4f3097e85f7" + , "e78b7603c538750001e66b2fba48f6ed3e5172dd647634aa863bf26e3c8963be" + , "97af050671850b1356abf61e6b5c76dd6bdc979a629a24f3e5b8fa20904f112a" + , "08adc6cf27e0695a50e0a5f136cb4c3ca5f03468597d9e2e89e7fc5868be3024" + , "97e566242f860be9eca959f184285e8957cb2f90a48fab2650fae1545cffefa6" + , "55821a81e5c43a33118649025f518da5f46e5cb2dc095afe18585fab88898903" + , "17c6f62a24f69f2823ea81d39fd59d3d51ae8a8a3dd9d7526f781f513d126ac7" + , "6cc400afed0189f680de90b57108638c91e09189309c2005778178b4999f801f" + , "d89fc1b62e0c171158ba6290773c4344454c87f11ab5acc0a19f808442132e9f" + , "fa19c615bd23b5edc023cc3ed57fd9024c376244a305afac1fa1ff4bd3c6d9dd" + ] + +chacha8rand_words :: [Word64] +chacha8rand_words = [ + 0xb773b6063d4616a5, 0x1160af22a66abc3c, 0x8c2599d9418d287c + , 0x7ee07e037edc5cd6, 0xcfaa9ee02d1c16ad, 0x0e090eef8febea79 + , 0x3c82d271128b5b3e, 0x9c5addc11252a34f, 0xdf79bb617d6ceea6 + , 0x36d553591f9d736a, 0xeef0d14e181ee01f, 0x089bfc760ae58436 + , 0xd9e52b59cc2ad268, 0xeb2fb4444b1b8aba, 0x4f95c8a692c46661 + , 0xc3c6323217cae62c, 0x91ebb4367f4e2e7e, 0x784cf2c6a0ec9bc6 + , 0x5c34ec5c34eabe20, 0x4f0a8f515570daa8, 0xfc35dcb4113d6bf2 + , 0x5b0da44c645554bc, 0x6d963da3db21d9e1, 0xeeaefc3150e500f3 + , 0x2d37923dda3750a5, 0x380d7a626d4bc8b0, 0xeeaf68ede3d7ee49 + , 0xf4356695883b717c, 0x846a9021392495a4, 0x8e8510549630a61b + , 0x18dc02545dbae493, 0x0f8f9ff0a65a3d43, 0xccf065f7190ff080 + , 0xfd76d1aa39673330, 0x95d232936cba6433, 0x6c7456d1070cbd17 + , 0x462acfdaff8c6562, 0x5bafab866d34fc6a, 0x0c862f78030a2988 + , 0xd39a83e407c3163d, 0xc00a2b7b45f22ebf, 0x564307c62466b1a9 + , 0x257e0424b0c072d4, 0x6fb55e99496c28fe, 0xae9873a88f5cd4e0 + , 0x4657362ac60d3773, 0x1c83f91ecdf23e8e, 0x6fdc0792c15387c0 + , 0x36dad2a30dfd2b5c, 0xa4b593290595bdb7, 0x4de18934e4cc02c5 + , 0xcdc0d604f015e3a7, 0xfba0dbf69ad80321, 0x60e8bea3d139de87 + , 0xd18a4d851ef48756, 0x6366447c2215f34a, 0x05682e97d3d007ee + , 0x4c0e8978c6d54ab2, 0xcf1e9f6a6712edc2, 0x061439414c80cfd3 + , 0xd1a8b6e2745c0ead, 0x31a7918d45c410e8, 0xabcc61ad90216eec + , 0x4040d92d2032a71a, 0x3cd2f66ffb40cd68, 0xdcd051c07295857a + , 0xeab55cbcd9ab527e, 0x18471dce781bdaac, 0xf7f08cd144dc7252 + , 0x5804e0b13d7f40d1, 0x5cb1a446e4b2d35b, 0xe6d4a728d2138a06 + , 0x05223e40ca60dad8, 0x2d61ec3206ac6a68, 0xab692356874c17b8 + , 0xc30954417676de1c, 0x4f1ace3732225624, 0xfba9510813988338 + , 0x997f200f52752e11, 0x1116aaafe86221fa, 0x07ce3b5cb2a13519 + , 0x2956bc72bc458314, 0x4188b7926140eb78, 0x56ca6dbfd4adea4d + , 0x7fe3c22349340ce5, 0x35c08f9c37675f8a, 0x11e1c7fbef5ed521 + , 0x98adc8464ec1bc75, 0xd163b2c73d1203f8, 0x8c761ee043a2f3f3 + , 0x24b99d6accecd7b7, 0x793e31aa112f0370, 0x8e87dc2a19285139 + , 0x4247ae04f7096e25, 0x514f3122926fe20f, 0xdc6fb3f045d2a7e9 + , 0x15cb30cecdd18eba, 0xcbc7fdecf6900274, 0x3fb5c696dc8ba021 + , 0xd1664417c8d274e6, 0x05f7e445ea457278, 0xf920bbca1b9db657 + , 0x0c1950b4da22cb99, 0xf875baf1af09e292, 0xbed3d7b84250f838 + , 0xf198e8080fd74160, 0xc9eda51d9b7ea703, 0xf709ef55439bf8f6 + , 0xd20c74feebf116fc, 0x305668eb146d7546, 0x829af3ec10d89787 + , 0x15b8f9697b551dbc, 0xfc823c6c8e64b8c9, 0x345585e8183b40bc + , 0x674b4171d6581368, 0x1234d81cd670e9f7, 0x0e505210d8a55e19 + , 0xe8258d69eeeca0dc, 0x05d4c452e8baf67e, 0xe8dbe30116a45599 + , 0x1cf08ce1b1176f00, 0xccf7d0a4b81ecb49, 0x303fea136b2c430e + , 0x861d6c139c06c871, 0x5f41df72e05e0487, 0x25bd7e1e1ae26b1d + , 0xbe9f4004d662a41d, 0x65bf58d483188546, 0xd1b27cff69db13cc + , 0x01a6663372c1bb36, 0x578dd7577b727f4d, 0x19c78f066c083cf6 + , 0xdbe014d4f9c391bb, 0x97fbb2dd1d13ffb3, 0x31c91e0af9ef8d4f + , 0x094dfc98402a43ba, 0x069bd61bea37b752, 0x5b72d762e8d986ca + , 0x72ee31865904bc85, 0xd1f5fdc5cd36c33e, 0xba9b4980a8947cad + , 0xece8f05eac49ab43, 0x65fe1184abae38e7, 0x2d7cb9dea5d31452 + , 0xcc71489476e467e3, 0x4c03a258a578c68c, 0x00efdf9ecb0fd8fc + , 0x9924cad471e2666d, 0x87f8668318f765e9, 0xcb4dc57c1b55f5d8 + , 0xd373835a86604859, 0xe526568b5540e482, 0x1f39040f08586fec + , 0xb764f3f00293f8e6, 0x049443a2f6bd50a8, 0x76fec88697d3941a + , 0x3efb70d039bae7a2, 0xe2f4611368eca8a8, 0x7c007a96e01d2425 + , 0xbbcce5768e69c5bf, 0x784fb4985c42aac3, 0xf72b5091aa223874 + , 0x3630333fb1e62e07, 0x8e7319ebdebbb8de, 0x2a3982bca959fa00 + , 0xb2b98b9f964ba9b3, 0xf7e31014adb71951, 0xebd0fca3703acc82 + , 0xec654e2a2fe6419a, 0xb326132d55a52e2c, 0x2248c57f44502978 + , 0x32710c2f342daf16, 0x0517b47b5acb2bec, 0x4c7a718fca270937 + , 0xd69142bed0bcc541, 0xe40ebcb8ff52ce88, 0x3e44a2dbc9f828d4 + , 0xc74c2f4f8f873f58, 0x3dbf648eb799e45b, 0x33f22475ee0e86f8 + , 0x1eb4f9ee16d47f65, 0x40f8d2b8712744e3, 0xb886b4da3cb14572 + , 0x2086326fbdd6f64d, 0xcc3de5907dd882b9, 0xa2e8b49a5ee909df + , 0xdbfb8e7823964c10, 0x70dd6089ef0df8d5, 0x30141663cdd9c99f + , 0x04b805325c240365, 0x7483d80314ac12d6, 0x2b271cb91aa7f5f9 + , 0x97e2245362abddf0, 0x5a84f614232a9fab, 0xf71125fcda4b7fa2 + , 0x1ca5a61d74b27267, 0x38cc6a9b3adbcb45, 0xdde1bb85dc653e39 + , 0xe9d0c8fa64f89fd4, 0x02c5fb1ecd2b4188, 0xf2bd137bca5756e5 + , 0xadefe25d121be155, 0x56cd1c3c5d893a8e, 0x4c50d337beb65bb9 + , 0x918c5151675cf567, 0xaba649ffcfb56a1e, 0x20c74ab26a2247cd + , 0x71166bac853c08da, 0xb07befe2e584fc5d, 0xda45ff2a588dbf32 + , 0xdb98b03c4d75095e, 0x60285ae1aaa65a4c, 0xf93b686a263140b8 + , 0xde469752ee1c180e, 0xcec232dc04129aae, 0xeb916baa1835ea04 + , 0xd49c21c8b64388ff, 0x72a82d9658864888, 0x003348ef7eac66a8 + , 0x7f6f67e655b209eb, 0x532ffb0b7a941b25, 0xd940ade6128deede + , 0xdf24f2a1af89fe23, 0x95aa3b4988195ae0, 0x3da649404f94be4a + , 0x692dad132c3f7e27, 0x40aee76ecaaa9eb8, 0x1294a01e09655024 + , 0x6df797abdba4e4f5, 0xea2fb6024c1d7032, 0x5f4e0492295489fc + , 0x57972914ea22e06a, 0x9a8137d133aad473, 0xa2e6dd6ae7cdf2f3 + , 0x9f42644f18086647, 0x16d03301c170bd3e, 0x908c416fa546656d + , 0xe081503be22e123e, 0x077cf09116c4cc72, 0xcbd25cd264b7f229 + , 0x3db2f468ec594031, 0x46c00e734c9badd5, 0xd0ec0ac72075d861 + , 0x3037cb3cf80b7630, 0x574c3d7b3a2721c6, 0xae99906a0076824b + , 0xb175a5418b532e70, 0xd8b3e251ee231ddd, 0xb433eec25dca1966 + , 0x530f30dc5cff9a93, 0x9ff03d98b53cd335, 0xafc4225076558cdf + , 0xef81d3a28284402a, 0x110bdbf51c110a28, 0x9ae1b255d027e8f6 + , 0x7de3e0aa24688332, 0xe483c3ecd2067ee2, 0xf829328b276137e6 + , 0xa413ccad57562cad, 0xe6118e8b496acb1f, 0x8288dca6da5ec01f + , 0xa53777dc88c17255, 0x8a00f1e0d5716eda, 0x618e6f47b7a720a8 + , 0x9e3907b0c692a841, 0x978b42ca963f34f3, 0x75e4b0cd98a7d7ef + , 0xde4dbd6e0b5f4752, 0x0252e4153f34493f, 0x50f0e7d803734ef9 + , 0x237766a38ed167ee, 0x4124414001ee39a0, 0xd08df643e535bb21 + , 0x34f575b5a9a80b74, 0x2c343af87297f755, 0xcd8b6d99d821f7cb + , 0xe376fd7256fc48ae, 0xe1b06e7334352885, 0xfa87b26f86c169eb + , 0x36c1604665a971de, 0xdba147c2239c8e80, 0x6b208e69fc7f0e24 + , 0x8795395b6f2b60c3, 0x05dabee9194907f4, 0xb98175142f5ed902 + , 0x5e1701e2021ddc81, 0x0875aba2755eed08, 0x778d83289251de95 + , 0x3bfbe46a039ecb31, 0xb24704fce4cbd7f9, 0x6985ffe9a7c91e3d + , 0xc8efb13df249dabb, 0xb1037e64b0f4c9f6, 0x55f69fd197d6b7c3 + , 0x672589d71d68a90c, 0xbebdb8224f50a77e, 0x3f589f80007374a7 + , 0xd307f4635954182a, 0xcff5850c10d4fd90, 0xc6da02dfb6408e15 + , 0x93daeef1e2b1a485, 0x65d833208aeea625, 0xe2b13fa13ed3b5fa + , 0x67053538130fb68e, 0xc1042f6598218fa9, 0xee5badca749b8a2e + , 0x6d22a3f947dae37d, 0xb62c6d1657f4dbaf, 0x6e007de69704c20b + , 0x1af2b913fc3841d8, 0xdc0e47348e2e8e22, 0x9b1ddef1cf958b22 + , 0x632ed6b0233066b8, 0xddd02d3311bed8f2, 0xf147cfe1834656e9 + , 0x399aaa49d511597a, 0x6b14886979ec0309, 0x64fc4ac36b5afb97 + , 0xb82f78e07f7cf081, 0x10925c9a323d0e1b, 0xf451c79ee13c63f6 + , 0x7c2fc180317876c7, 0x35a12bd9eecb7d22, 0x335654a539621f90 + , 0xcc32a3f35db581f0, 0xc60748a80b2369cb, 0x7c4dd3b08591156b + , 0xac1ced4b6de22291, 0xa32cfa2df134def5, 0x627108918dea2a53 + , 0x0555b1608fcb4ff4, 0x143ee7ac43aaa33c, 0xdae90ce7cf4fc218 + , 0x4d68fc2582bcf4b5, 0x37094e1849135d71, 0xf7857e09f3d49fd8 + , 0x007538c503768be7, 0xedf648ba2f6be601, 0xaa347664dd72513e + , 0xbe63893c6ef23b86, 0x130b85710605af97, 0xdd765c6b1ef6ab56 + , 0xf3249a629a97dc6b, 0x2a114f9020fab8e5, 0x5a69e027cfc6ad08 + , 0x3c4ccb36f1a5e050, 0x2e9e7d596834f0a5, 0x2430be6858fce789 + , 0xe90b862f2466e597, 0x895e2884f159a9ec, 0x26ab8fa4902fcb57 + , 0xa6efff5c54e1fa50, 0x333ac4e5811a8255, 0xa58d515f02498611 + , 0xfe5a09dcb25c6ef4, 0x03898988ab5f5818, 0x289ff6242af6c617 + , 0x3d9dd59fd381ea23, 0x52d7d93d8a8aae51, 0xc76a123d511f786f + , 0xf68901edaf00c46c, 0x8c630871b590de80, 0x05209c308991e091 + , 0x1f809f99b4788177, 0x11170c2eb6c19fd8, 0x44433c779062ba58 + , 0xc0acb51af1874c45, 0x9f2e134284809fa1, 0xedb523bd15c619fa + , 0x02d97fd53ecc23c0, 0xacaf05a34462374c, 0xddd9c6d34bffa11f + ]