    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE TypeFamilies               #-}
    {-# LANGUAGE RecordWildCards            #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE ForeignFunctionInterface   #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE DataKinds                  #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# CFILES raaz/hash/sha1/portable.c    #-}

    -- | Internal types and function for blake2 hashes.
    module Raaz.Hash.Blake2.Internal
           ( -- * The blake2 types
             BLAKE2, BLAKE2b, BLAKE2s
           , Blake2bMem, Blake2sMem
           , blake2Pad, blake2bImplementation
           , blake2sImplementation
           ) where

    import           Control.Applicative
    import           Control.Monad.IO.Class
    import           Data.Bits           ( xor, complement )
    import           Data.Monoid
    import           Data.String
    import           Data.Word
    import           Foreign.Ptr         ( Ptr          )
    import           Foreign.Storable    ( Storable(..) )
    import           Prelude      hiding ( zipWith      )

    import           Raaz.Core
    import           Raaz.Core.Transfer
    import           Raaz.Hash.Internal

    ----------------------------- The blake2 type ---------------------------------

    -- | The BLAKE2 type.
    newtype BLAKE2 w = BLAKE2 (Tuple 8 w)
                   deriving (Eq, Equality, Storable, EndianStore)

    -- | Word type for Blake2b
    type Word2b = LE Word64

    -- | Word type for Blake2s
    type Word2s = LE Word32

    -- | The BLAKE2b hash type.
    type BLAKE2b = BLAKE2 Word2b

    -- | The BLAKE2s hash type.
    type BLAKE2s = BLAKE2 Word2s

    instance Encodable BLAKE2b
    instance Encodable BLAKE2s

    instance IsString BLAKE2b where
      fromString = fromBase16

    instance IsString BLAKE2s where
      fromString = fromBase16

    instance Show BLAKE2b where
      show =  showBase16

    instance Show BLAKE2s where
      show =  showBase16

    instance Primitive BLAKE2b where
      blockSize _ = BYTES 128
      type Implementation BLAKE2b = SomeHashI BLAKE2b

    instance Hash BLAKE2b where
      additionalPadBlocks _ = toEnum 1

    instance Primitive BLAKE2s where
      blockSize _ = BYTES 64
      type Implementation BLAKE2s = SomeHashI BLAKE2s

    instance Hash BLAKE2s where
      additionalPadBlocks _ = toEnum 1

    -- | The initial value to start the blake2b hashing. This is equal to
    -- the iv `xor` the parameter block.
    hash2b0 :: BLAKE2b
    hash2b0 = BLAKE2 $ unsafeFromList [ 0x6a09e667f3bcc908 `xor` 0x01010040
                                      , 0xbb67ae8584caa73b
                                      , 0x3c6ef372fe94f82b
                                      , 0xa54ff53a5f1d36f1
                                      , 0x510e527fade682d1
                                      , 0x9b05688c2b3e6c1f
                                      , 0x1f83d9abfb41bd6b
                                      , 0x5be0cd19137e2179
                                      ]

    -- | The initial value to start the blake2b hashing. This is equal to
    -- the iv `xor` the parameter block.
    hash2s0 :: BLAKE2s
    hash2s0 = BLAKE2 $ unsafeFromList [ 0x6a09e667 `xor` 0x01010020
                                      , 0xbb67ae85
                                      , 0x3c6ef372
                                      , 0xa54ff53a
                                      , 0x510e527f
                                      , 0x9b05688c
                                      , 0x1f83d9ab
                                      , 0x5be0cd19
                                      ]

    ---------------------------------- Memory element for BLAKE2b -----------------------

    -- | Memory element for BLAKE2b implementations.
    data Blake2bMem = Blake2bMem { blake2bCell :: MemoryCell BLAKE2b
                                 , uLengthCell :: MemoryCell (BYTES Word64)
                                 , lLengthCell :: MemoryCell (BYTES Word64)
                                 }

    instance Memory Blake2bMem where
      memoryAlloc     = Blake2bMem <$> memoryAlloc <*> memoryAlloc <*> memoryAlloc
      unsafeToPointer = unsafeToPointer . blake2bCell

    instance Initialisable Blake2bMem () where
      initialise _ = do onSubMemory blake2bCell  $ initialise hash2b0
                        onSubMemory uLengthCell  $ initialise (0 :: BYTES Word64)
                        onSubMemory lLengthCell  $ initialise (0 :: BYTES Word64)

    instance Extractable Blake2bMem BLAKE2b where
      extract = onSubMemory blake2bCell extract

    ---------------------------------- Memory element for BLAKE2b -----------------------

    -- | Memory element for BLAKE2s implementations.
    data Blake2sMem = Blake2sMem { blake2sCell :: MemoryCell BLAKE2s
                                 , lengthCell  :: MemoryCell (BYTES Word64)
                                 }

    instance Memory Blake2sMem where
      memoryAlloc     = Blake2sMem <$> memoryAlloc <*> memoryAlloc
      unsafeToPointer = unsafeToPointer . blake2sCell

    instance Initialisable Blake2sMem () where
      initialise _ = do onSubMemory blake2sCell $ initialise hash2s0
                        onSubMemory lengthCell  $ initialise (0 :: BYTES Word64)

    instance Extractable Blake2sMem BLAKE2s where
      extract = onSubMemory blake2sCell extract

    ----------------------- Padding for Blake code ------------------------------

    -- | The generic blake2 padding algorithm.
    blake2Pad :: (Primitive prim, MonadIO m)
              => prim      -- ^ the primitive (BLAKE2b or BLAKE2s).
              -> BYTES Int -- ^ length of the message
              -> WriteM m
    blake2Pad prim = padWrite 0 (blocksOf 1 prim) . skipWrite

    ----------------------- Create a blake2b implementation ---------------------
    type Compress2b =  Pointer            -- ^ Buffer
                    -> BLOCKS BLAKE2b     -- ^ number of blocks
                    -> Ptr (BYTES Word64) -- ^ Upper count
                    -> Ptr (BYTES Word64) -- ^ Lower
                    -> Ptr BLAKE2b
                    -> IO ()

    type Last2b =  Pointer
                -> BYTES Int
                -> BYTES Word64 -- Upper
                -> BYTES Word64 -- Lower
                -> Word64       -- f0
                -> Word64       -- f1
                -> Ptr BLAKE2b
                -> IO ()

    -- | Create a hash implementation form BLAKE2b given a compression
    -- function and the last block function.
    blake2bImplementation :: String  -- ^ Name
                          -> String  -- ^ Description
                          -> Compress2b
                          -> Last2b
                          -> HashI BLAKE2b Blake2bMem
    blake2bImplementation nm descr compress2b last2b
      = HashI { hashIName              = nm
              , hashIDescription       = descr
              , compress               = comp
              , compressFinal          = final
              , compressStartAlignment = 32  --  Allow gcc to use vector instructions
              }
      where comp buf blks = do uPtr   <- onSubMemory uLengthCell getCellPointer
                               lPtr   <- onSubMemory lLengthCell getCellPointer
                               hshPtr <- onSubMemory blake2bCell getCellPointer
                               liftIO $ compress2b buf blks uPtr lPtr hshPtr

            lastBlock buf r = do u      <- onSubMemory uLengthCell extract
                                 l      <- onSubMemory lLengthCell extract
                                 hshPtr <- onSubMemory blake2bCell getCellPointer
                                 let f0 = complement 0
                                     f1 = 0
                                   in  liftIO $ last2b buf r u l f0 f1 hshPtr

            final buf nbytes = unsafeWrite blake2bPad buf >> finalPadded buf nbytes
              where blake2bPad = blake2Pad (undefined :: BLAKE2b) nbytes

            finalPadded buf nbytes
              | nbytes == 0 = lastBlock buf 0  -- only when actual input is empty.
              | otherwise   = let
                  (blks,r)       =  bytesQuotRem nbytes
                  blksToCompress = if r == 0 then blks <> toEnum (-1) else blks
                  remBytes       = if r > 0 then r else inBytes $ blocksOf 1 (undefined :: BLAKE2b)
                  lastBlockPtr   = buf `movePtr` blksToCompress
                  in do comp buf blksToCompress
                        lastBlock lastBlockPtr remBytes

    ------------------------- Implementations of blake2s ---------------------------------------------

    type Compress2s =  Pointer            -- ^ Buffer
                    -> BLOCKS BLAKE2s     -- ^ number of blocks
                    -> BYTES Word64       -- ^ length of the message so far
                    -> Ptr BLAKE2s        -- ^ Hash pointer
                    -> IO ()

    type Last2s =  Pointer
                -> BYTES Int
                -> BYTES Word64
                -> Word32       -- f0
                -> Word32       -- f1
                -> Ptr BLAKE2s
                -> IO ()

    -- | Create a hash implementation form BLAKE2s given a compression
    -- function and the last block function.
    blake2sImplementation :: String  -- ^ Name
                          -> String  -- ^ Description
                          -> Compress2s
                          -> Last2s
                          -> HashI BLAKE2s Blake2sMem
    blake2sImplementation nm descr compress2s last2s
      = HashI { hashIName              = nm
              , hashIDescription       = descr
              , compress               = comp
              , compressFinal          = final
              , compressStartAlignment = 32  --  Allow gcc to use vector instructions
              }
      where comp buf blks = do len    <- onSubMemory lengthCell  extract    -- extract current length

                               hshPtr <- onSubMemory blake2sCell getCellPointer
                               liftIO $ compress2s buf blks len hshPtr

                               let increment :: BYTES Word64
                                   increment = fromIntegral $ inBytes blks -- update the length by blks
                                   in onSubMemory lengthCell $ modify (+increment)

            lastBlock buf r = do len    <- onSubMemory lengthCell extract
                                 hshPtr <- onSubMemory blake2sCell getCellPointer
                                 let f0 = complement 0
                                     f1 = 0
                                   in liftIO $ last2s buf r len f0 f1 hshPtr

            final buf nbytes = unsafeWrite blake2sPad buf >> finalPadded buf nbytes
              where blake2sPad = blake2Pad (undefined :: BLAKE2s) nbytes

            finalPadded buf nbytes
              | nbytes == 0 = lastBlock buf 0  -- only when actual input is empty.
              | otherwise   = let
                  (blks,r)       =  bytesQuotRem nbytes
                  blksToCompress = if r == 0 then blks <> toEnum (-1) else blks
                  remBytes       = if r > 0 then r else inBytes $ blocksOf 1 (undefined :: BLAKE2s)
                  lastBlockPtr   = buf `movePtr` blksToCompress
                  in do comp buf blksToCompress
                        lastBlock lastBlockPtr remBytes