-- |
-- Module      : Crypto.Random.API
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good

module Crypto.Random.API
    ( CPRG(..)
    , ReseedPolicy(..)
    , genRandomBytes
    , genRandomBytes'
    , withRandomBytes
    , getSystemEntropy
    -- * System Random generator
    , 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

-- | This is the reseed policy requested by the CPRG
data ReseedPolicy =
      NeverReseed          -- ^ there is no need to reseed as either
                           -- the RG doesn't supports it, it's done automatically
                           -- or pratically the reseeding period exceed a Word64 type.
    | ReseedInBytes Word64 -- ^ the RG need to be reseed in the number
                           -- of bytes joined to the type. it should be done before
                           -- the number reached 0, otherwise an user of the RG
                           -- might request too many bytes and get repeated random bytes.
    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)

-- | A class of Cryptographic Secure Random generator.
--
-- The main difference with the generic haskell RNG is that
-- it return bytes instead of integer.
--
-- It is quite similar to the CryptoRandomGen class in crypto-api
-- except that error are not returned to the user. Instead
-- the user is suppose to handle reseeding by using the NeedReseed
-- and SupplyEntropy methods. For other type of errors, the user
-- is expected to generate bytes with the parameters bounds explicity
-- defined here.
-- 
-- The CPRG need to be able to generate up to 2^20 bytes in one call,
--
class CPRG g where
    -- | Provide a way to query the CPRG to calculate when new entropy
    -- is required to be supplied so the CPRG doesn't repeat output, and
    -- break assumptions. This returns the number of bytes before
    -- which supply entropy should have been called.
    cprgNeedReseed    :: g -> ReseedPolicy

    -- | Supply entropy to the CPRG, that can be used now or later
    -- to reseed the CPRG. This should be used in conjunction to
    -- NeedReseed to know when to supply entropy.
    cprgSupplyEntropy :: ByteString -> g -> g

    -- | Generate bytes using the CPRG and the number specified.
    --
    -- For user of the API, it's recommended to use genRandomBytes
    -- instead of this method directly. the CPRG need to be able
    -- to supply at minimum 2^20 bytes at a time.
    cprgGenBytes      :: Int -> g -> (ByteString, g)

-- | Generate bytes using the cprg in parameter.
--
-- If the number of bytes requested is really high,
-- it's preferable to use 'genRandomBytes' for better memory efficiency.
genRandomBytes :: CPRG g => Int -- ^ number of bytes to return
                         -> g   -- ^ CPRG to use
                         -> (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

-- | Generate bytes using the cprg in parameter.
--
-- This is not tail recursive and an excessive len (>= 2^29) parameter would
-- result in stack overflow.
genRandomBytes' :: CPRG g => Int -- ^ number of bytes to return
                          -> g   -- ^ CPRG to use
                          -> ([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'')

-- | this is equivalent to using Control.Arrow 'first' with 'genRandomBytes'.
--
-- namely it generate @len bytes and map the bytes to the function @f
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

-- | Return system entropy using the entropy package 'getEntropy'
getSystemEntropy :: Int -> IO ByteString
getSystemEntropy :: Int -> IO ByteString
getSystemEntropy = Int -> IO ByteString
SE.getEntropy

-- | This is a simple generator that pull bytes from the system entropy
-- directly. Its randomness and security properties are absolutely
-- depends on the underlaying system implementation.
data SystemRandom = SystemRandom [B.ByteString]

-- | Get a random number generator based on the standard system entropy source
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