{-# LANGUAGE DataKinds                  #-}

-- | The portable C-implementation of Blake2b.
module ChaCha20.CPortable where

import           Foreign.Ptr                ( castPtr )
import qualified Data.Vector.Unboxed as V

import           Raaz.Core
import           Raaz.Core.Types.Internal
import           Raaz.Primitive.ChaCha20.Internal
import           Raaz.Verse.ChaCha20.C.Portable

name :: String
name :: String
name = String
"chacha20-libverse-c"

description :: String
description :: String
description = String
"ChaCha20 Implementation in C exposed by libverse"

type Prim                    = ChaCha20
type Internals               = ChaCha20Mem
type BufferAlignment         = 32
type BufferPtr               = AlignedBlockPtr BufferAlignment Prim

additionalBlocks :: BlockCount ChaCha20
additionalBlocks :: BlockCount ChaCha20
additionalBlocks = Int -> Proxy ChaCha20 -> BlockCount ChaCha20
forall p. Int -> Proxy p -> BlockCount p
blocksOf Int
1 Proxy ChaCha20
forall k (t :: k). Proxy t
Proxy

processBlocks :: BufferPtr
              -> BlockCount Prim
              -> Internals
              -> IO ()

processBlocks :: BufferPtr -> BlockCount ChaCha20 -> Internals -> IO ()
processBlocks = (Ptr (Tuple 16 (LE Word32))
 -> Word64
 -> Ptr (Tuple 8 Word32)
 -> Ptr (Tuple 3 Word32)
 -> Ptr Word32
 -> IO ())
-> BufferPtr -> BlockCount ChaCha20 -> Internals -> IO ()
forall buf a b c.
(Ptr buf -> Word64 -> Ptr a -> Ptr b -> Ptr c -> IO ())
-> BufferPtr -> BlockCount ChaCha20 -> Internals -> IO ()
runBlockProcess Ptr (Tuple 16 (LE Word32))
-> Word64
-> Ptr (Tuple 8 Word32)
-> Ptr (Tuple 3 Word32)
-> Ptr Word32
-> IO ()
verse_chacha20_c_portable


-- | Process the last bytes.
processLast :: BufferPtr
            -> BYTES Int
            -> Internals
            -> IO ()
processLast :: BufferPtr -> BYTES Int -> Internals -> IO ()
processLast BufferPtr
buf = BufferPtr -> BlockCount ChaCha20 -> Internals -> IO ()
processBlocks BufferPtr
buf (BlockCount ChaCha20 -> Internals -> IO ())
-> (BYTES Int -> BlockCount ChaCha20)
-> BYTES Int
-> Internals
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BYTES Int -> BlockCount ChaCha20
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atLeast


-- | The xchacha20Setup  does the following to the internal state
--
-- 1. Replaces the key stored in the keyCell using the hchacah20 hashing function
--
-- 2. Initialises the ivcell with the last two words in the xiv value.
--
-- As a result the internal state is ready to start encrypting using
-- the xchacha20 variant.
--
xchacha20Setup :: Nounce XChaCha20 -> Internals -> IO ()
xchacha20Setup :: Nounce XChaCha20 -> Internals -> IO ()
xchacha20Setup (XNounce tup) Internals
mem = do
  Ptr (Tuple 8 Word32)
-> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
verse_hchacha20_c_portable Ptr (Tuple 8 Word32)
forall b. Ptr b
keyPtr Word32
h0 Word32
h1 Word32
h2 Word32
h3
  -- In the above step, the key gets replaced by the subkey obtained
  -- from the hchacha20 hash. We also set the ivcell appropriately
  Nounce ChaCha20 -> MemoryCell (Nounce ChaCha20) -> IO ()
forall m v. Initialisable m v => v -> m -> IO ()
initialise Nounce ChaCha20
iv (MemoryCell (Nounce ChaCha20) -> IO ())
-> MemoryCell (Nounce ChaCha20) -> IO ()
forall a b. (a -> b) -> a -> b
$ Internals -> MemoryCell (Nounce ChaCha20)
ivCell Internals
mem
  where keyPtr :: Ptr b
keyPtr = Ptr (Key ChaCha20) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr (Key ChaCha20) -> Ptr b) -> Ptr (Key ChaCha20) -> Ptr b
forall a b. (a -> b) -> a -> b
$ Internals -> Ptr (Key ChaCha20)
keyCellPtr Internals
mem
        [LE Word32
h0,LE Word32
h1,LE Word32
h2, LE Word32
h3, LE Word32
h4, LE Word32
h5] = Vector (LE Word32) -> [LE Word32]
forall a. Unbox a => Vector a -> [a]
V.toList (Vector (LE Word32) -> [LE Word32])
-> Vector (LE Word32) -> [LE Word32]
forall a b. (a -> b) -> a -> b
$ Tuple 6 (LE Word32) -> Vector (LE Word32)
forall (dim :: Nat) a. Tuple dim a -> Vector a
unsafeToVector Tuple 6 (LE Word32)
tup
        iv :: Nounce ChaCha20
iv  = Tuple 3 (LE Word32) -> Nounce ChaCha20
Nounce (Tuple 3 (LE Word32) -> Nounce ChaCha20)
-> Tuple 3 (LE Word32) -> Nounce ChaCha20
forall a b. (a -> b) -> a -> b
$ [LE Word32] -> Tuple 3 (LE Word32)
forall a (dim :: Nat).
(Unbox a, Dimension dim) =>
[a] -> Tuple dim a
unsafeFromList [LE Word32
0, LE Word32
h4, LE Word32
h5] :: Nounce ChaCha20


-- | Copy the key from the memory cell chacha20Mem.
copyKey :: Dest ChaCha20Mem -> Src (MemoryCell (Key ChaCha20)) -> IO ()
copyKey :: Dest Internals -> Src (MemoryCell (Key ChaCha20)) -> IO ()
copyKey = Dest (MemoryCell (Key ChaCha20))
-> Src (MemoryCell (Key ChaCha20)) -> IO ()
forall a.
Storable a =>
Dest (MemoryCell a) -> Src (MemoryCell a) -> IO ()
copyCell (Dest (MemoryCell (Key ChaCha20))
 -> Src (MemoryCell (Key ChaCha20)) -> IO ())
-> (Dest Internals -> Dest (MemoryCell (Key ChaCha20)))
-> Dest Internals
-> Src (MemoryCell (Key ChaCha20))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Internals -> MemoryCell (Key ChaCha20))
-> Dest Internals -> Dest (MemoryCell (Key ChaCha20))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Internals -> MemoryCell (Key ChaCha20)
keyCell

-------------- Helper function for running an iterator -----------
runBlockProcess :: ( Ptr buf ->
                     Word64  ->
                     Ptr a   ->
                     Ptr b   ->
                     Ptr c   ->
                     IO ()
                   )
                -> BufferPtr
                -> BlockCount Prim
                -> Internals
                -> IO ()
runBlockProcess :: (Ptr buf -> Word64 -> Ptr a -> Ptr b -> Ptr c -> IO ())
-> BufferPtr -> BlockCount ChaCha20 -> Internals -> IO ()
runBlockProcess Ptr buf -> Word64 -> Ptr a -> Ptr b -> Ptr c -> IO ()
func BufferPtr
buf BlockCount ChaCha20
blks Internals
mem =
  let keyPtr :: Ptr b
keyPtr     = Ptr (Key ChaCha20) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr (Key ChaCha20) -> Ptr b) -> Ptr (Key ChaCha20) -> Ptr b
forall a b. (a -> b) -> a -> b
$ Internals -> Ptr (Key ChaCha20)
keyCellPtr Internals
mem
      ivPtr :: Ptr b
ivPtr      = Ptr (Nounce ChaCha20) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr (Nounce ChaCha20) -> Ptr b) -> Ptr (Nounce ChaCha20) -> Ptr b
forall a b. (a -> b) -> a -> b
$ Internals -> Ptr (Nounce ChaCha20)
ivCellPtr Internals
mem
      counterPtr :: Ptr b
counterPtr = Ptr (LE Word32) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr (LE Word32) -> Ptr b) -> Ptr (LE Word32) -> Ptr b
forall a b. (a -> b) -> a -> b
$ Internals -> Ptr (LE Word32)
counterCellPtr Internals
mem
      blkPtr :: Ptr b
blkPtr     = Ptr (Tuple 16 (LE Word32)) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr (Tuple 16 (LE Word32)) -> Ptr b)
-> Ptr (Tuple 16 (LE Word32)) -> Ptr b
forall a b. (a -> b) -> a -> b
$ AlignedPtr BufferAlignment (Tuple 16 (LE Word32))
-> Ptr (Tuple 16 (LE Word32))
forall (n :: Nat) a. AlignedPtr n a -> Ptr a
forgetAlignment AlignedPtr BufferAlignment (Tuple 16 (LE Word32))
BufferPtr
buf
      wBlks :: Word64
wBlks      = Int -> Word64
forall a. Enum a => Int -> a
toEnum  (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ BlockCount ChaCha20 -> Int
forall a. Enum a => a -> Int
fromEnum BlockCount ChaCha20
blks
  in Ptr buf -> Word64 -> Ptr a -> Ptr b -> Ptr c -> IO ()
func Ptr buf
forall b. Ptr b
blkPtr Word64
wBlks Ptr a
forall b. Ptr b
keyPtr Ptr b
forall b. Ptr b
ivPtr Ptr c
forall b. Ptr b
counterPtr