{-# LANGUAGE ForeignFunctionInterface   #-}
{-# LANGUAGE DataKinds                  #-}


-- | The portable C-implementation of Blake2s.
module Blake2s.CHandWritten where

import Raaz.Core
import Raaz.Core.Transfer.Unsafe
import Raaz.Core.Types.Internal
import Raaz.Primitive.HashMemory
import Raaz.Primitive.Blake2.Internal


name :: String
name :: String
name = String
"blake2s-c-handwritten"

description :: String
description :: String
description = String
"Hand written Blake2s Implementation using portable C and Haskell FFI"

type Prim                    = Blake2s
type Internals               = Blake2sMem
type BufferAlignment         = 32
type BufferPtr               = AlignedBlockPtr BufferAlignment Prim

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

------------------------- FFI For Blake2s -------------------------------------


foreign import ccall unsafe
  "raaz/hash/blake2/common.h raazHashBlake2sPortableBlockCompress"
  c_blake2s_compress  :: BufferPtr
                      -> BlockCount Blake2s
                      -> BYTES Word64
                      -> Ptr Prim
                      -> IO ()

foreign import ccall unsafe
  "raaz/hash/blake2/common.h raazHashBlake2sPortableLastBlock"
  c_blake2s_last   :: BlockPtr Prim
                   -> BYTES Int
                   -> BYTES Word64
                   -> Word32
                   -> Word32
                   -> Ptr Prim
                   -> IO ()
--
processBlocks :: BufferPtr
              -> BlockCount Prim
              -> Internals
              -> IO ()

processBlocks :: BufferPtr -> BlockCount Prim -> Internals -> IO ()
processBlocks BufferPtr
buf BlockCount Prim
blks Internals
b2smem =
  let hshPtr :: Ptr Prim
hshPtr = Internals -> Ptr Prim
forall h. Storable h => HashMemory64 h -> Ptr h
hashCellPointer Internals
b2smem
  in do BYTES Word64
l      <- Internals -> IO (BYTES Word64)
forall h. HashMemory64 h -> IO (BYTES Word64)
getLength Internals
b2smem
        BufferPtr -> BlockCount Prim -> BYTES Word64 -> Ptr Prim -> IO ()
c_blake2s_compress BufferPtr
buf BlockCount Prim
blks BYTES Word64
l Ptr Prim
hshPtr
        BlockCount Prim -> Internals -> IO ()
forall len h. LengthUnit len => len -> HashMemory64 h -> IO ()
updateLength BlockCount Prim
blks Internals
b2smem

-- | Process the last bytes.
processLast :: BufferPtr
            -> BYTES Int
            -> Internals
            -> IO ()
processLast :: BufferPtr -> BYTES Int -> Internals -> IO ()
processLast BufferPtr
buf BYTES Int
nbytes  Internals
b2smem = do
  Transfer 'WriteToBuffer -> Ptr (Tuple 16 (LE Word32)) -> IO ()
forall (ptr :: * -> *) (t :: Mode) a.
Pointer ptr =>
Transfer t -> ptr a -> IO ()
unsafeTransfer Transfer 'WriteToBuffer
padding (Ptr (Tuple 16 (LE Word32)) -> IO ())
-> Ptr (Tuple 16 (LE Word32)) -> IO ()
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  -- pad the message
  BufferPtr -> BlockCount Prim -> Internals -> IO ()
processBlocks BufferPtr
buf BlockCount Prim
nBlocks Internals
b2smem              -- process all but the last block
  --
  -- Handle the last block
  --
  BYTES Word64
l      <- Internals -> IO (BYTES Word64)
forall h. HashMemory64 h -> IO (BYTES Word64)
getLength Internals
b2smem
  BlockPtr Prim
-> BYTES Int
-> BYTES Word64
-> Word32
-> Word32
-> Ptr Prim
-> IO ()
c_blake2s_last Ptr (Tuple 16 (LE Word32))
BlockPtr Prim
lastBlockPtr BYTES Int
remBytes BYTES Word64
l Word32
f0 Word32
f1 Ptr Prim
hshPtr
  where hshPtr :: Ptr Prim
hshPtr = Internals -> Ptr Prim
forall h. Storable h => HashMemory64 h -> Ptr h
hashCellPointer Internals
b2smem
        padding :: Transfer 'WriteToBuffer
padding      = Proxy Prim -> BYTES Int -> Transfer 'WriteToBuffer
forall prim.
Primitive prim =>
Proxy prim -> BYTES Int -> Transfer 'WriteToBuffer
blake2Pad (Proxy Prim
forall k (t :: k). Proxy t
Proxy :: Proxy Prim) BYTES Int
nbytes
        nBlocks :: BlockCount Prim
nBlocks      = BYTES Int -> BlockCount Prim
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atMost (Transfer 'WriteToBuffer -> BYTES Int
forall (t :: Mode). Transfer t -> BYTES Int
transferSize Transfer 'WriteToBuffer
padding) BlockCount Prim -> BlockCount Prim -> BlockCount Prim
forall a. Monoid a => a -> a -> a
`mappend` Int -> BlockCount Prim
forall a. Enum a => Int -> a
toEnum (-Int
1)
                       -- all but the last block
        remBytes :: BYTES Int
remBytes     = BYTES Int
nbytes BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
- BlockCount Prim -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes BlockCount Prim
nBlocks
                       -- Actual bytes in the last block.
        lastBlockPtr :: Ptr (Tuple 16 (LE Word32))
lastBlockPtr = 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 Ptr (Tuple 16 (LE Word32))
-> BlockCount Prim -> Ptr (Tuple 16 (LE Word32))
forall l a. LengthUnit l => Ptr a -> l -> Ptr a
`movePtr` BlockCount Prim
nBlocks
        --
        -- Finalisation FLAGS
        --
        f0 :: Word32
f0 = Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
0
        f1 :: Word32
f1 = Word32
0