-- | This sets up the recommended implementation of chacha20 cipher.

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE CPP                  #-}

--
-- The orphan instance declaration separates the implementation and
-- setting the recommended instances. Therefore, we ignore the warning.
--

module Raaz.Cipher.ChaCha20.Recommendation
       ( chacha20Random, RandomBuf, getBufferPointer, randomBufferSize
       ) where

import Control.Applicative
import Prelude

import Raaz.Core
import Raaz.Cipher.ChaCha20.Internal

#ifdef HAVE_VECTOR_256
import Raaz.Cipher.ChaCha20.Implementation.Vector256
#else
import Raaz.Cipher.ChaCha20.Implementation.CPortable
#endif

------------ Setting the recommended implementation -------------------

instance Recommendation ChaCha20 where
         recommended :: ChaCha20 -> Implementation ChaCha20
recommended ChaCha20
_ = Implementation ChaCha20
SomeCipherI ChaCha20
implementation


--------------- Some information used by Raaz/Random/ChaCha20PRG.hs -------------

-- | The chacha stream cipher is also used as the prg for generating
-- random bytes. Such a prg needs to keep an auxilary buffer type so
-- that one can generate random bytes not just of block size but
-- smaller. This memory type is essentially for maintaining such a
-- buffer.

newtype RandomBuf = RandomBuf { RandomBuf -> Pointer
unBuf :: Pointer }



instance Memory RandomBuf where

  memoryAlloc :: Alloc RandomBuf
memoryAlloc     = Pointer -> RandomBuf
RandomBuf (Pointer -> RandomBuf)
-> TwistRF AllocField (BYTES Int) Pointer -> Alloc RandomBuf
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ALIGN -> TwistRF AllocField (BYTES Int) Pointer
forall l.
LengthUnit l =>
l -> TwistRF AllocField (BYTES Int) Pointer
pointerAlloc ALIGN
sz
    where sz :: ALIGN
sz = BLOCKS ChaCha20 -> Alignment -> ALIGN
forall l. LengthUnit l => l -> Alignment -> ALIGN
atLeastAligned BLOCKS ChaCha20
randomBufferSize Alignment
randomBufferAlignment

  unsafeToPointer :: RandomBuf -> Pointer
unsafeToPointer = RandomBuf -> Pointer
unBuf

-- | Get the actual location where the data is to be stored. Ensures
-- that the pointer is aligned to the @randomBufferAlignment@
-- restriction.
getBufferPointer :: MT RandomBuf Pointer
getBufferPointer :: MT RandomBuf Pointer
getBufferPointer = RandomBuf -> Pointer
actualPtr (RandomBuf -> Pointer)
-> MT RandomBuf RandomBuf -> MT RandomBuf Pointer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MT RandomBuf RandomBuf
forall (mT :: * -> * -> *) mem. MemoryThread mT => mT mem mem
getMemory
  where actualPtr :: RandomBuf -> Pointer
actualPtr = (Pointer -> Alignment -> Pointer)
-> Alignment -> Pointer -> Pointer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Pointer -> Alignment -> Pointer
forall a. Ptr a -> Alignment -> Ptr a
alignPtr Alignment
randomBufferAlignment (Pointer -> Pointer)
-> (RandomBuf -> Pointer) -> RandomBuf -> Pointer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RandomBuf -> Pointer
unBuf


--------------------- DANGEROUS CODE --------------------------------

-- Things to take care in this module
-- ==================================
--
-- 1. ENSURE randomBufferSize IS THE MAXIMUM FOR ALL IMPLEMENTATIONS of
--    chacha20 random stream. OTHERWISE BUFFER OVERFLOW.
--
-- 2. Ensure that the alignment requirement is the maximum so that any
--    implementation can use the same memory.




-- | The size of the buffer in blocks of ChaCha20. While the
-- implementations should handle any multiple of blocks, often
-- implementations naturally handle some multiple of blocks, for
-- example the Vector256 implementation handles 2-chacha blocks. Set
-- this quantity to the maximum supported by all implementations.
randomBufferSize :: BLOCKS ChaCha20
randomBufferSize :: BLOCKS ChaCha20
randomBufferSize = Int
16  Int -> ChaCha20 -> BLOCKS ChaCha20
forall p. Int -> p -> BLOCKS p
`blocksOf` ChaCha20
ChaCha20

-- | Implementations are also designed to work with a specific
-- alignment boundary. Unaligned access can slow down the primitives
-- quite a bit. Set this to the maximum of alignment supported by all
-- implementations
randomBufferAlignment :: Alignment
randomBufferAlignment :: Alignment
randomBufferAlignment = Alignment
32 -- For 256-bit vector instructions.