module Crypto.Random.API
( CPRG(..)
, ReseedPolicy(..)
, genRandomBytes
, genRandomBytes'
, withRandomBytes
, getSystemEntropy
, SystemRandom
, getSystemRandomGen
) where
import Control.Applicative
import qualified Data.ByteString as B
import Data.ByteString (ByteString)
import qualified System.Entropy as SE
import System.IO.Unsafe (unsafeInterleaveIO)
import Data.Word
data ReseedPolicy =
NeverReseed
| ReseedInBytes Word64
deriving (Int -> ReseedPolicy -> ShowS
[ReseedPolicy] -> ShowS
ReseedPolicy -> String
(Int -> ReseedPolicy -> ShowS)
-> (ReseedPolicy -> String)
-> ([ReseedPolicy] -> ShowS)
-> Show ReseedPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReseedPolicy] -> ShowS
$cshowList :: [ReseedPolicy] -> ShowS
show :: ReseedPolicy -> String
$cshow :: ReseedPolicy -> String
showsPrec :: Int -> ReseedPolicy -> ShowS
$cshowsPrec :: Int -> ReseedPolicy -> ShowS
Show,ReseedPolicy -> ReseedPolicy -> Bool
(ReseedPolicy -> ReseedPolicy -> Bool)
-> (ReseedPolicy -> ReseedPolicy -> Bool) -> Eq ReseedPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReseedPolicy -> ReseedPolicy -> Bool
$c/= :: ReseedPolicy -> ReseedPolicy -> Bool
== :: ReseedPolicy -> ReseedPolicy -> Bool
$c== :: ReseedPolicy -> ReseedPolicy -> Bool
Eq)
class CPRG g where
cprgNeedReseed :: g -> ReseedPolicy
cprgSupplyEntropy :: ByteString -> g -> g
cprgGenBytes :: Int -> g -> (ByteString, g)
genRandomBytes :: CPRG g => Int
-> g
-> (ByteString, g)
genRandomBytes :: Int -> g -> (ByteString, g)
genRandomBytes len :: Int
len rng :: g
rng = (\(lbs :: [ByteString]
lbs,g :: g
g) -> ([ByteString] -> ByteString
B.concat [ByteString]
lbs, g
g)) (([ByteString], g) -> (ByteString, g))
-> ([ByteString], g) -> (ByteString, g)
forall a b. (a -> b) -> a -> b
$ Int -> g -> ([ByteString], g)
forall g. CPRG g => Int -> g -> ([ByteString], g)
genRandomBytes' Int
len g
rng
genRandomBytes' :: CPRG g => Int
-> g
-> ([ByteString], g)
genRandomBytes' :: Int -> g -> ([ByteString], g)
genRandomBytes' len :: Int
len rng :: g
rng
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> ([ByteString], g)
forall a. HasCallStack => String -> a
error "genBytes: cannot request negative amount of bytes."
| Bool
otherwise = g -> Int -> ([ByteString], g)
forall b. CPRG b => b -> Int -> ([ByteString], b)
loop g
rng Int
len
where loop :: b -> Int -> ([ByteString], b)
loop g :: b
g len :: Int
len
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ([], b
g)
| Bool
otherwise = let itBytes :: Int
itBytes = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^20) Int
len
(bs :: ByteString
bs, g' :: b
g') = Int -> b -> (ByteString, b)
forall g. CPRG g => Int -> g -> (ByteString, g)
cprgGenBytes Int
itBytes b
g
(l :: [ByteString]
l, g'' :: b
g'') = Int -> b -> ([ByteString], b)
forall g. CPRG g => Int -> g -> ([ByteString], g)
genRandomBytes' (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
itBytes) b
g'
in (ByteString
bsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
l, b
g'')
withRandomBytes :: CPRG g => g -> Int -> (ByteString -> a) -> (a, g)
withRandomBytes :: g -> Int -> (ByteString -> a) -> (a, g)
withRandomBytes rng :: g
rng len :: Int
len f :: ByteString -> a
f = (ByteString -> a
f ByteString
bs, g
rng')
where (bs :: ByteString
bs, rng' :: g
rng') = Int -> g -> (ByteString, g)
forall g. CPRG g => Int -> g -> (ByteString, g)
genRandomBytes Int
len g
rng
getSystemEntropy :: Int -> IO ByteString
getSystemEntropy :: Int -> IO ByteString
getSystemEntropy = Int -> IO ByteString
SE.getEntropy
data SystemRandom = SystemRandom [B.ByteString]
getSystemRandomGen :: IO SystemRandom
getSystemRandomGen :: IO SystemRandom
getSystemRandomGen = do
CryptHandle
ch <- IO CryptHandle
SE.openHandle
let getBS :: IO [ByteString]
getBS = IO [ByteString] -> IO [ByteString]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [ByteString] -> IO [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ do
ByteString
bs <- CryptHandle -> Int -> IO ByteString
SE.hGetEntropy CryptHandle
ch 8192
[ByteString]
more <- IO [ByteString]
getBS
[ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
more)
[ByteString] -> SystemRandom
SystemRandom ([ByteString] -> SystemRandom)
-> IO [ByteString] -> IO SystemRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
getBS
instance CPRG SystemRandom where
cprgNeedReseed :: SystemRandom -> ReseedPolicy
cprgNeedReseed _ = ReseedPolicy
NeverReseed
cprgSupplyEntropy :: ByteString -> SystemRandom -> SystemRandom
cprgSupplyEntropy _ g :: SystemRandom
g = SystemRandom
g
cprgGenBytes :: Int -> SystemRandom -> (ByteString, SystemRandom)
cprgGenBytes n :: Int
n (SystemRandom l :: [ByteString]
l) = ([ByteString] -> ByteString
B.concat [ByteString]
l1, [ByteString] -> SystemRandom
SystemRandom [ByteString]
l2)
where (l1 :: [ByteString]
l1, l2 :: [ByteString]
l2) = Int -> [ByteString] -> ([ByteString], [ByteString])
lbsSplitAt Int
n [ByteString]
l
lbsSplitAt :: Int -> [ByteString] -> ([ByteString], [ByteString])
lbsSplitAt rBytes :: Int
rBytes (x :: ByteString
x:xs :: [ByteString]
xs)
| Int
xLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rBytes =
let (b1 :: ByteString
b1,b2 :: ByteString
b2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
rBytes ByteString
x
in ([ByteString
b1], ByteString
b2ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
xs)
| Bool
otherwise =
let (l1 :: [ByteString]
l1,l2 :: [ByteString]
l2) = Int -> [ByteString] -> ([ByteString], [ByteString])
lbsSplitAt (Int
rBytesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
xLen) [ByteString]
xs
in (ByteString
xByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
l1,[ByteString]
l2)
where xLen :: Int
xLen = ByteString -> Int
B.length ByteString
x