diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,10 @@ +# Changelog for dice-entropy-conduit + +## Unreleased changes + +* None + +## 1.0.0.3 + +* Make it build with `stack`. +* Updated dependencies. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +This library uses rejection sampling to provide cryptographically secure `n`-sided dice rolls and random sampling (within a given range). + +## Usage: + +If we want to use the system-specific entropy source (`systemEntropy`) to +produce 10 dice rolls of a 6-sided dice (i.e. range [0,5]), you can write: + +> systemEntropy $$ diceRolls 6 =$= CL.take 10 +> [5,1,3,3,0,5,3,2,2,1] diff --git a/dice-entropy-conduit.cabal b/dice-entropy-conduit.cabal --- a/dice-entropy-conduit.cabal +++ b/dice-entropy-conduit.cabal @@ -1,62 +1,65 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 11ee8a59a75ff863ac20d50ebb04f19822218ed8af64635cc4666664a3bbfbb1 + name: dice-entropy-conduit -version: 1.0.0.1 -cabal-version: >=1.8 -build-type: Simple +version: 1.0.0.3 +synopsis: Cryptographically secure n-sided dice via rejection sampling +description: Please see the README on GitHub at +category: Data, Cryptography +homepage: https://github.com/pwrobinson/dice-entropy-conduit#readme +bug-reports: https://github.com/pwrobinson/dice-entropy-conduit/issues +author: Peter Robinson +maintainer: pwr@lowerbound.io +copyright: 2014-2020 Peter Robinson license: LGPL-2.1 license-file: LICENSE -author: Peter Robinson -maintainer: peter.robinson@monoid.at -copyright: Peter Robinson 2014 -homepage: http://monoid.at/code -tested-with: GHC==7.8.3 -stability: experimental -category: Cryptography, Data -synopsis: Cryptographically secure n-sided dice via rejection sampling. -description: - This library uses rejection sampling to provide cryptographically secure - @n@-sided dice rolls and random sampling (within a given range). - The number of used random bits is close to the information-theoretic optimal - bound. - . - /Usage:/ - . - If we wanted to use the system-specific entropy source ('systemEntropy') to - produce 10 dice rolls of a 6-sided dice (i.e. range [0,5]), we could write: - . - > > systemEntropy $$ diceRolls 6 =$= CL.take 10 - > [5,1,3,3,0,5,3,2,2,1] - . - The function 'testPerformance' yields the actual number of consumed random - bits: - . - > > testPerformance 12 10000 - > Generated 10000 random samples in range [0,11] - > Average number of bits used: 3.5904 - > Entropy lower bound on the number of required bits: 3.5849625007211565 - > Performance ratio: 1.0015167520658164 - . - Feedback is welcome! - -library - hs-source-dirs: src - build-depends: base == 4.* - ,bytestring >= 0.9 - ,entropy >= 0.3.2 - ,conduit >= 1.1.7 - ,transformers >= 0.4.0.0 - - ghc-options: -Wall - exposed-modules: System.Random.Dice - System.Random.Dice.Internal +build-type: Simple +extra-source-files: + README.md + ChangeLog.md +source-repository head + type: git + location: https://github.com/pwrobinson/dice-entropy-conduit -test-suite Main - type: exitcode-stdio-1.0 - x-uses-tf: true - build-depends: base >= 4 && < 5, - QuickCheck >= 2.4, - test-framework >= 0.4.1, - test-framework-quickcheck2 - hs-source-dirs: src, tests - main-is: Tests.hs +library + exposed-modules: + System.Random.Dice + System.Random.Dice.Internal + other-modules: + Paths_dice_entropy_conduit + hs-source-dirs: + src + build-depends: + base >=4.6 && <5 + , bytestring >=0.9 + , conduit >=1.1.7 + , entropy >=0.3.2 + , transformers >=0.4.0.0 + default-language: Haskell2010 +test-suite dice-entropy-conduit-test + type: exitcode-stdio-1.0 + main-is: Tests.hs + other-modules: + System.Random.Dice + System.Random.Dice.Internal + Paths_dice_entropy_conduit + hs-source-dirs: + tests + src + build-depends: + QuickCheck >=2.4 + , base >=4 && <5 + , bytestring >=0.9 + , conduit >=1.1.7 + , entropy >=0.3.2 + , test-framework >=0.4.1 + , test-framework-quickcheck2 + , transformers >=0.4.0.0 + default-language: Haskell2010 diff --git a/src/System/Random/Dice.hs b/src/System/Random/Dice.hs --- a/src/System/Random/Dice.hs +++ b/src/System/Random/Dice.hs @@ -4,7 +4,7 @@ -- Module : System.Random.Dice -- Copyright : Peter Robinson 2014 -- License : LGPL --- +-- -- Maintainer : Peter Robinson -- Stability : experimental -- Portability : portable @@ -14,24 +14,24 @@ -- The algorithm uses rejection sampling and attempts to keep the total number -- of used random bits as close as possible to the information theoretic lower -- bound of @ln(n) / ln(2)@ (for a range of size @n@). --- +-- -- The implementation exposes streams of random values as conduits, see -- 'diceRolls' and 'randomRs'. We also provide IO wrappers around these -- functions, see 'getDiceRolls' and 'getRandomRs'. -- The conduit interface allows us to use a specific entropy source, which has --- type 'Producer' 'IO' 'Word'. +-- type 'Producer' 'IO' 'Word'. -- -- /Usage:/ --- +-- -- If we wanted to use the system-specific entropy source ('systemEntropy') to -- produce 10 dice rolls of a 6-sided dice (i.e. range [0,5]), we could write: -- --- > > systemEntropy $$ diceRolls 6 =$= CL.take 10 +-- > > systemEntropy $$ diceRolls 6 =$= CL.take 10 -- > [5,1,3,3,0,5,3,2,2,1] -- -- The function 'testPerformance' yields the actual number of consumed random -- bits: --- +-- -- > > testPerformance 12 10000 -- > Generated 10000 random samples in range [0,11] -- > Average number of bits used: 3.5904 @@ -43,9 +43,8 @@ , randomRs , getDiceRolls , getRandomRs - , testPerformance + -- , testPerformance , systemEntropy ) where import System.Random.Dice.Internal - diff --git a/src/System/Random/Dice/Internal.hs b/src/System/Random/Dice/Internal.hs --- a/src/System/Random/Dice/Internal.hs +++ b/src/System/Random/Dice/Internal.hs @@ -4,7 +4,7 @@ -- Module : System.Random.Dice.Internal -- Copyright : Peter Robinson 2014 -- License : LGPL --- +-- -- Maintainer : Peter Robinson -- Stability : experimental -- Portability : portable @@ -21,25 +21,25 @@ import Data.Conduit import qualified Data.Conduit.List as CL --- | Converts a number to its base-2 representation (as a list of bits) +-- | Converts a number to its base-2 representation (as a list of bits) -- and prepends zeros to ensure the minimal size. integralToBits :: (Integral n,Integral m) => Int -- ^ minimal number of bits @b@ -> n -- ^ the number @n@ -> [m] -- ^ bit representation of @n@, length >= @b@ -integralToBits b x = reverse $ integralToBits' 0 x +integralToBits b x = reverse $ integralToBits' 0 x where integralToBits' ns 0 = replicate (b-ns) 0 - integralToBits' ns y = - let (a,res) = quotRem y 2 in + integralToBits' ns y = + let (a,res) = quotRem y 2 in fromIntegral res : integralToBits' (ns+1) a - + -- | Convert a list of bits to an integral bitsToIntegral :: (Integral n) =>[n] -> n -bitsToIntegral = extendIntegralWithBits 0 - +bitsToIntegral = extendIntegralWithBits 0 + extendIntegralWithBits :: (Integral n) => n -> [n] -> n extendIntegralWithBits n = foldr (\c r -> 2*r + c) n . reverse @@ -53,15 +53,15 @@ getDiceRolls :: Int -- ^ @n:@ number of sides -> Int -- ^ @k:@ number of rolls -> IO [Int] -getDiceRolls n len = - systemEntropy $$ diceRolls n =$= CL.take len +getDiceRolls n len = + systemEntropy $$ diceRolls n =$= CL.take len -- | Generates a list of random integer values in the specified range. getRandomRs :: (Int,Int) -- ^ (inclusive) range -> Int -- ^ number of samples -> IO [Int] -getRandomRs range len = +getRandomRs range len = systemEntropy $$ randomRs range =$= CL.take len @@ -73,10 +73,10 @@ diceRolls n | fromIntegral n > upperBound || n <= 0 = throw $ AssertionFailed "diceRolls: n-sided dice are supported, for 1 <= n < 2^55." - | n == 1 - = CL.sourceList [0,0..] - | otherwise - = dRoll (fromIntegral n) 1 0 =$= CL.map fst + | n == 1 + = CL.sourceList [0,0..] + | otherwise + = dRoll (fromIntegral n) 1 0 0 =$= CL.map fst -- | Produces a stream of random integer values within a range. @@ -88,60 +88,57 @@ -- | A source of entropy. By default, we use the 'getEntropy' function from --- the entropy package, see 'systemEntropy'. +-- the entropy package, see 'systemEntropy'. -- -- /Warning:/ When combining a source of entropy with other conduits, it is --- important that there is no \"backflow\" due to leftover values that +-- important that there is no \"backflow\" due to leftover values that -- are being returned to the -- source from the conduit. This can be done by fusing the conduit with the -- identity map, e.g: @myEntropySrc $$ Data.Conduit.List.map id =$= myConduit@ --- -systemEntropy :: Producer IO Word8 +-- +systemEntropy :: Producer IO Word8 systemEntropy = do bytes <- B.unpack `liftM` liftIO (getEntropy 8) forM_ bytes yield - systemEntropy + systemEntropy --- | Internal function. Should not be invoked directly. -dRoll :: Word64 -> Word64 -> Word64 -> Conduit Word8 IO (Int,Int) -dRoll n m r = do --- | num > len = print ("end:",num,m,r) >> return [] --- | otherwise = do - let k = ceiling $ (logBase 2 (fromIntegral upperBound) - logBase 2 (fromIntegral m :: Double)) / 8 +-- | Internal function. Should not be invoked directly. +dRoll :: Word64 -> Word64 -> Word64 -> Int -> Conduit Word8 IO (Int,Int) +dRoll n m r cnt = do + let k = ceiling $ (logBase 2 (fromIntegral upperBound) - logBase 2 (fromIntegral m :: Double)) / 8 let m' = 2^(8*k) * m - bits <- (concatMap (integralToBits 8) . B.unpack) + bits <- (concatMap (integralToBits 8) . B.unpack) `liftM` (if k>0 then liftIO $ getEntropy k else return $ B.pack []) let w64 = extendIntegralWithBits r bits let q = m' `div` n - if w64 < n * q + if w64 < n * q then do yield (fromIntegral $ w64 `mod` n,k) - dRoll n q (w64 `div` n) - else dRoll n (m' - n*q) (w64 - n*q) - + dRoll n q (w64 `div` n) (cnt + k) + else dRoll n (m' - n*q) (w64 - n*q) (cnt + k) +{- -- | Compute the performance of the algorithm in terms of used random bits -- versus produced random values. testPerformance :: Int -- ^ number of sides of dice -> Int -- ^ number of samples used for computing average. -> IO () -testPerformance n len +testPerformance n len | fromIntegral n > upperBound = throw $ AssertionFailed "dice: range must be within Word64 bounds." | otherwise = do - nbits <- systemEntropy $= dRoll (fromIntegral n) 1 0 - $$ CL.take len + nbits <- systemEntropy $= dRoll (fromIntegral n) 1 0 0 + $$ CL.take len >>= return . sum . map snd - putStrLn $ "Generated " ++ show len + putStrLn $ "Generated " ++ show len ++ " random samples in range [0," ++ show (n-1) ++ "]" - putStrLn $ "Average number of bits used: " + putStrLn $ "Average number of bits used: " ++ show (8*fromIntegral nbits/ fromIntegral len :: Double) let lbound = logBase 2 (fromIntegral n) :: Double - putStrLn $ "Entropy lower bound on the number of required bits: " + putStrLn $ "Entropy lower bound on the number of required bits: " ++ show lbound - putStrLn $ "Performance ratio: " ++ show (((8*fromIntegral nbits + putStrLn $ "Performance ratio: " ++ show (((8*fromIntegral nbits / fromIntegral len) ::Double) / lbound) - - +-}