-- |
-- Module      : Crypto.Random.AESCtr.Internal
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : stable
-- Portability : unknown
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
module Crypto.Random.AESCtr.Internal where

import qualified Crypto.Cipher.AES as AES

import Data.ByteString (ByteString)
import qualified Data.ByteString as B

{-| An opaque object containing an AES CPRNG -}
data RNG = RNG !AES.AESIV !Int !AES.AES

getNbChunksGenerated :: RNG -> Int
getNbChunksGenerated :: RNG -> Int
getNbChunksGenerated (RNG _ c :: Int
c _) = Int
c

makeParams :: ByteString -> (AES.AES, AES.AESIV)
makeParams :: ByteString -> (AES, AESIV)
makeParams b :: ByteString
b = AES
key AES -> (AES, AESIV) -> (AES, AESIV)
forall a b. a -> b -> b
`seq` AESIV
iv AESIV -> (AES, AESIV) -> (AES, AESIV)
forall a b. a -> b -> b
`seq` (AES
key, AESIV
iv)
  where (keyBS :: ByteString
keyBS, r1 :: ByteString
r1) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt 32 ByteString
b
        (cnt :: ByteString
cnt, _)    = Int -> ByteString -> (ByteString, ByteString)
B.splitAt 16 ByteString
r1
        !key :: AES
key        = ByteString -> AES
forall b. Byteable b => b -> AES
AES.initAES ByteString
keyBS
        !iv :: AESIV
iv         = ByteString -> AESIV
AES.aesIV_ (ByteString -> AESIV) -> ByteString -> AESIV
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.copy ByteString
cnt

makeRNG :: ByteString -> RNG
makeRNG :: ByteString -> RNG
makeRNG b :: ByteString
b = AESIV -> Int -> AES -> RNG
RNG AESIV
iv 0 AES
key
  where (key :: AES
key,iv :: AESIV
iv) = ByteString -> (AES, AESIV)
makeParams ByteString
b

chunkSize :: Int
chunkSize :: Int
chunkSize = 1024

genNextChunk :: RNG -> (ByteString, RNG)
genNextChunk :: RNG -> (ByteString, RNG)
genNextChunk (RNG counter :: AESIV
counter nbChunks :: Int
nbChunks key :: AES
key) =
    ByteString
chunk ByteString -> (ByteString, RNG) -> (ByteString, RNG)
forall a b. a -> b -> b
`seq` RNG
newrng RNG -> (ByteString, RNG) -> (ByteString, RNG)
forall a b. a -> b -> b
`seq` (ByteString
chunk, RNG
newrng)
  where
        newrng :: RNG
newrng = AESIV -> Int -> AES -> RNG
RNG AESIV
newCounter (Int
nbChunksInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) AES
key
        (chunk :: ByteString
chunk,newCounter :: AESIV
newCounter) = AES -> AESIV -> Int -> (ByteString, AESIV)
AES.genCounter AES
key AESIV
counter Int
chunkSize