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
$cshowsPrec :: Int -> ReseedPolicy -> ShowS
showsPrec :: Int -> ReseedPolicy -> ShowS
$cshow :: ReseedPolicy -> String
show :: ReseedPolicy -> String
$cshowList :: [ReseedPolicy] -> ShowS
showList :: [ReseedPolicy] -> ShowS
Show,ReseedPolicy -> ReseedPolicy -> Bool
(ReseedPolicy -> ReseedPolicy -> Bool)
-> (ReseedPolicy -> ReseedPolicy -> Bool) -> Eq ReseedPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReseedPolicy -> ReseedPolicy -> Bool
== :: ReseedPolicy -> ReseedPolicy -> Bool
$c/= :: ReseedPolicy -> ReseedPolicy -> Bool
/= :: 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 :: forall g. CPRG g => Int -> g -> (ByteString, g)
genRandomBytes Int
len g
rng = (\([ByteString]
lbs,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' :: forall g. CPRG g => Int -> g -> ([ByteString], g)
genRandomBytes' Int
len g
rng
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> ([ByteString], g)
forall a. HasCallStack => String -> a
error String
"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 b
g Int
len
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ([], b
g)
| Bool
otherwise = let itBytes :: Int
itBytes = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
20) Int
len
(ByteString
bs, b
g') = Int -> b -> (ByteString, b)
forall g. CPRG g => Int -> g -> (ByteString, g)
cprgGenBytes Int
itBytes b
g
([ByteString]
l, 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 :: forall g a. CPRG g => g -> Int -> (ByteString -> a) -> (a, g)
withRandomBytes g
rng Int
len ByteString -> a
f = (ByteString -> a
f ByteString
bs, g
rng')
where (ByteString
bs, 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 Int
8192
[ByteString]
more <- IO [ByteString]
getBS
[ByteString] -> IO [ByteString]
forall a. a -> IO a
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 SystemRandom
_ = ReseedPolicy
NeverReseed
cprgSupplyEntropy :: ByteString -> SystemRandom -> SystemRandom
cprgSupplyEntropy ByteString
_ SystemRandom
g = SystemRandom
g
cprgGenBytes :: Int -> SystemRandom -> (ByteString, SystemRandom)
cprgGenBytes Int
n (SystemRandom [ByteString]
l) = ([ByteString] -> ByteString
B.concat [ByteString]
l1, [ByteString] -> SystemRandom
SystemRandom [ByteString]
l2)
where ([ByteString]
l1, [ByteString]
l2) = Int -> [ByteString] -> ([ByteString], [ByteString])
lbsSplitAt Int
n [ByteString]
l
lbsSplitAt :: Int -> [ByteString] -> ([ByteString], [ByteString])
lbsSplitAt Int
rBytes (ByteString
x:[ByteString]
xs)
| Int
xLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rBytes =
let (ByteString
b1,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 ([ByteString]
l1,[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