{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

module Data.KeyStore.KS.CPRNG
    ( CPRNG
    , newCPRNG
    , testCPRNG
    , generateCPRNG
    ) where

import           Crypto.Random
import qualified Data.ByteArray                 as BA
import           System.IO.Unsafe


newtype CPRNG
    = CPRNG { CPRNG -> SystemDRG
_CPRNG :: SystemDRG }
    deriving (forall byteArray.
ByteArray byteArray =>
Int -> CPRNG -> (byteArray, CPRNG)
forall gen.
(forall byteArray.
 ByteArray byteArray =>
 Int -> gen -> (byteArray, gen))
-> DRG gen
randomBytesGenerate :: forall byteArray.
ByteArray byteArray =>
Int -> CPRNG -> (byteArray, CPRNG)
$crandomBytesGenerate :: forall byteArray.
ByteArray byteArray =>
Int -> CPRNG -> (byteArray, CPRNG)
DRG)


newCPRNG :: IO CPRNG
newCPRNG :: IO CPRNG
newCPRNG = SystemDRG -> CPRNG
CPRNG forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemDRG
getSystemDRG

testCPRNG :: CPRNG
testCPRNG :: CPRNG
testCPRNG = forall a. IO a -> a
unsafePerformIO IO CPRNG
newCPRNG

generateCPRNG :: BA.ByteArray ba => Int -> CPRNG -> (ba,CPRNG)
generateCPRNG :: forall byteArray.
ByteArray byteArray =>
Int -> CPRNG -> (byteArray, CPRNG)
generateCPRNG = forall gen byteArray.
(DRG gen, ByteArray byteArray) =>
Int -> gen -> (byteArray, gen)
randomBytesGenerate