{-# LANGUAGE DataKinds                  #-}

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


import Foreign.Ptr                ( castPtr      )

import Raaz.Core
import Raaz.Core.Transfer.Unsafe
import Raaz.Core.Types.Internal
import Raaz.Primitive.HashMemory
import Raaz.Primitive.Blake2.Internal
import Raaz.Verse.Blake2b.C.Portable

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

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

type Prim                    = Blake2b
type Internals               = Blake2bMem
type BufferAlignment         = 32
type BufferPtr               = AlignedBlockPtr BufferAlignment Prim

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


processBlocks :: BufferPtr
              -> BlockCount Blake2b
              -> Blake2bMem
              -> IO ()

processBlocks :: BufferPtr -> BlockCount Blake2b -> Blake2bMem -> IO ()
processBlocks BufferPtr
buf BlockCount Blake2b
blks Blake2bMem
b2bmem =
  let uPtr :: Ptr b
uPtr   = Ptr (BYTES Word64) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr (BYTES Word64) -> Ptr b) -> Ptr (BYTES Word64) -> Ptr b
forall a b. (a -> b) -> a -> b
$ Blake2bMem -> Ptr (BYTES Word64)
forall h. Storable h => HashMemory128 h -> Ptr (BYTES Word64)
uLengthCellPointer Blake2bMem
b2bmem
      lPtr :: Ptr b
lPtr   = Ptr (BYTES Word64) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr (BYTES Word64) -> Ptr b) -> Ptr (BYTES Word64) -> Ptr b
forall a b. (a -> b) -> a -> b
$ Blake2bMem -> Ptr (BYTES Word64)
forall h. Storable h => HashMemory128 h -> Ptr (BYTES Word64)
lLengthCellPointer Blake2bMem
b2bmem
      hshPtr :: Ptr b
hshPtr = Ptr Blake2b -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Blake2b -> Ptr b) -> Ptr Blake2b -> Ptr b
forall a b. (a -> b) -> a -> b
$ Blake2bMem -> Ptr Blake2b
forall h. Storable h => HashMemory128 h -> Ptr h
hashCell128Pointer Blake2bMem
b2bmem
      --
      -- Type coersions to the appropriate type.
      --
      wblks :: Word64
wblks  = Int -> Word64
forall a. Enum a => Int -> a
toEnum  (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ BlockCount Blake2b -> Int
forall a. Enum a => a -> Int
fromEnum BlockCount Blake2b
blks
      blkPtr :: Ptr b
blkPtr = Ptr (Tuple 16 (LE Word64)) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr (Tuple 16 (LE Word64)) -> Ptr b)
-> Ptr (Tuple 16 (LE Word64)) -> Ptr b
forall a b. (a -> b) -> a -> b
$ AlignedPtr BufferAlignment (Tuple 16 (LE Word64))
-> Ptr (Tuple 16 (LE Word64))
forall (n :: Nat) a. AlignedPtr n a -> Ptr a
forgetAlignment AlignedPtr BufferAlignment (Tuple 16 (LE Word64))
BufferPtr
buf
  in Ptr (Tuple 16 (LE Word64))
-> Word64
-> Ptr Word64
-> Ptr Word64
-> Ptr (Tuple 8 Word64)
-> IO ()
verse_blake2b_c_portable_iter Ptr (Tuple 16 (LE Word64))
forall {b}. Ptr b
blkPtr Word64
wblks Ptr Word64
forall {b}. Ptr b
uPtr Ptr Word64
forall {b}. Ptr b
lPtr Ptr (Tuple 8 Word64)
forall {b}. Ptr b
hshPtr


-- | Process the last bytes. The last block of the message (whether it
-- is padded or not) should necessarily be processed by the
-- processLast function as one needs to set the finalisation flag for
-- it.
--
-- Let us consider two cases.
--
-- 1. The message is empty. In which case the padding is 1-block
--    size. This needs to be processed as the last block
--
-- 2. If the message is non-empty then the padded message is the least
--    multiple @n@ of block size that is greater than or equal to the
--    input and hence is at least 1 block in size. Therefore, we
--    should be compressing a total @n-1@ blocks using the block
--    compression function at the last block using the finalisation
--    flags.
--
processLast :: BufferPtr
            -> BYTES Int
            -> Blake2bMem
            -> IO ()
processLast :: BufferPtr -> BYTES Int -> Blake2bMem -> IO ()
processLast BufferPtr
buf BYTES Int
nbytes Blake2bMem
b2bmem = do
  Transfer 'WriteToBuffer -> Ptr (Tuple 16 (LE Word64)) -> IO ()
forall (ptr :: * -> *) (t :: Mode) a.
Pointer ptr =>
Transfer t -> ptr a -> IO ()
unsafeTransfer Transfer 'WriteToBuffer
padding (Ptr (Tuple 16 (LE Word64)) -> IO ())
-> Ptr (Tuple 16 (LE Word64)) -> IO ()
forall a b. (a -> b) -> a -> b
$ AlignedPtr BufferAlignment (Tuple 16 (LE Word64))
-> Ptr (Tuple 16 (LE Word64))
forall (n :: Nat) a. AlignedPtr n a -> Ptr a
forgetAlignment AlignedPtr BufferAlignment (Tuple 16 (LE Word64))
BufferPtr
buf  -- pad the message
  BufferPtr -> BlockCount Blake2b -> Blake2bMem -> IO ()
processBlocks BufferPtr
buf BlockCount Blake2b
nBlocks Blake2bMem
b2bmem              -- process all but the last block
  --
  -- Handle the last block
  --
  BYTES Word64
u  <- Blake2bMem -> IO (BYTES Word64)
forall h. HashMemory128 h -> IO (BYTES Word64)
getULength Blake2bMem
b2bmem
  BYTES Word64
l  <- Blake2bMem -> IO (BYTES Word64)
forall h. HashMemory128 h -> IO (BYTES Word64)
getLLength Blake2bMem
b2bmem
  let hshPtr :: Ptr b
hshPtr = Ptr Blake2b -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Blake2b -> Ptr b) -> Ptr Blake2b -> Ptr b
forall a b. (a -> b) -> a -> b
$ Blake2bMem -> Ptr Blake2b
forall h. Storable h => HashMemory128 h -> Ptr h
hashCell128Pointer Blake2bMem
b2bmem
    in Ptr (Tuple 16 (LE Word64))
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Ptr (Tuple 8 Word64)
-> IO ()
verse_blake2b_c_portable_last Ptr (Tuple 16 (LE Word64))
forall {b}. Ptr b
lastBlockPtr Word64
remBytes Word64
u Word64
l Word64
f0 Word64
f1 Ptr (Tuple 8 Word64)
forall {b}. Ptr b
hshPtr

  where padding :: Transfer 'WriteToBuffer
padding      = Proxy Blake2b -> BYTES Int -> Transfer 'WriteToBuffer
forall prim.
Primitive prim =>
Proxy prim -> BYTES Int -> Transfer 'WriteToBuffer
blake2Pad (Proxy Blake2b
forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b) BYTES Int
nbytes
        nBlocks :: BlockCount Blake2b
nBlocks      = BYTES Int -> BlockCount Blake2b
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 Blake2b -> BlockCount Blake2b -> BlockCount Blake2b
forall a. Monoid a => a -> a -> a
`mappend` Int -> BlockCount Blake2b
forall a. Enum a => Int -> a
toEnum (-Int
1)
                                           -- all but the last block
        remBytes :: Word64
remBytes     = Int -> Word64
forall a. Enum a => Int -> a
toEnum (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ BYTES Int -> Int
forall a. Enum a => a -> Int
fromEnum (BYTES Int -> Int) -> BYTES Int -> Int
forall a b. (a -> b) -> a -> b
$ BYTES Int
nbytes BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
- BlockCount Blake2b -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes BlockCount Blake2b
nBlocks
                                           -- Actual bytes in the last block.
        lastBlockPtr :: Ptr b
lastBlockPtr = Ptr (Tuple 16 (LE Word64)) -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (AlignedPtr BufferAlignment (Tuple 16 (LE Word64))
-> Ptr (Tuple 16 (LE Word64))
forall (n :: Nat) a. AlignedPtr n a -> Ptr a
forgetAlignment AlignedPtr BufferAlignment (Tuple 16 (LE Word64))
BufferPtr
buf Ptr (Tuple 16 (LE Word64))
-> BlockCount Blake2b -> Ptr (Tuple 16 (LE Word64))
forall l a. LengthUnit l => Ptr a -> l -> Ptr a
`movePtr` BlockCount Blake2b
nBlocks)
        --
        -- Finalisation FLAGS
        --
        f0 :: Word64
f0 = Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
0
        f1 :: Word64
f1 = Word64
0