content: {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE TypeFamilies               #-}
  {-# LANGUAGE FlexibleInstances          #-}
  {-# LANGUAGE MultiParamTypeClasses      #-}
  {-# LANGUAGE DataKinds                  #-}
  {-# LANGUAGE FlexibleContexts           #-}
  {-# CFILES raaz/hash/sha1/portable.c    #-}
  
  -- |
  --
  -- Module      : Raaz.Primitive.Sha2.Internal
  -- Description : Internal modules for sha2 family of hashes.
  -- Copyright   : (c) Piyush P Kurur, 2019
  -- License     : Apache-2.0 OR BSD-3-Clause
  -- Maintainer  : Piyush P Kurur <ppk@iitpkd.ac.in>
  -- Stability   : experimental
  --
  module Raaz.Primitive.Sha2.Internal
         ( -- * The sha2 types
           Sha512, Sha256
         , Sha512Mem, Sha256Mem
         , process512Last
         , process256Last
         ) where
  
  import           Data.Vector.Unboxed        ( Unbox )
  import           Foreign.Storable           ( Storable(..) )
  import           GHC.TypeLits
  
  
  import           Raaz.Core
  import           Raaz.Core.Transfer.Unsafe
  import           Raaz.Primitive.HashMemory
  
  ----------------------------- The blake2 type ---------------------------------
  
  -- | The Sha2 type.
  newtype Sha2 w = Sha2 (Tuple 8 w)
                 deriving (Eq, Equality, Storable, EndianStore)
  
  instance ( Unbox w
           , EndianStore w
           ) => Primitive (Sha2 w) where
    type WordType      (Sha2 w) = w
    type WordsPerBlock (Sha2 w) = 16
  
  
  instance (Unbox w, EndianStore w) => Encodable (Sha2 w)
  
  instance (EndianStore w, Unbox w) => IsString (Sha2 w) where
    fromString = fromBase16
  
  instance (EndianStore w, Unbox w) => Show (Sha2 w) where
    show =  showBase16
  
  
  -- | The Sha512 cryptographic hash.
  type Sha512 = Sha2 (BE Word64)
  
  -- | The Sha256 cryptographic hash.
  type Sha256 = Sha2 (BE Word32)
  
  -- | The initial value to start the blake2b hashing. This is equal to
  -- the iv `xor` the parameter block.
  sha512Init :: Sha512
  sha512Init = Sha2 $ unsafeFromList [ 0x6a09e667f3bcc908
                                     , 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.
  sha256Init :: Sha256
  sha256Init = Sha2 $ unsafeFromList [ 0x6a09e667
                                     , 0xbb67ae85
                                     , 0x3c6ef372
                                     , 0xa54ff53a
                                     , 0x510e527f
                                     , 0x9b05688c
                                     , 0x1f83d9ab
                                     , 0x5be0cd19
                                     ]
  
  ---------------------------------- Memory element for Sha512 -----------------------
  
  -- | The memory used by sha512 implementations.
  type Sha512Mem = HashMemory128 Sha512
  
  -- | The memory used bha sha256 implementations.
  type Sha256Mem = HashMemory64 Sha256
  
  instance Initialisable Sha256Mem () where
    initialise _ = initialise sha256Init
  
  instance Initialisable Sha512Mem () where
    initialise _ = initialise sha512Init
  
  
  -- | The block compressor for sha256.
  type Compressor256 n =  AlignedBlockPtr n Sha256
                       -> BlockCount Sha256
                       -> Sha256Mem -> IO ()
  -- | The block compressor for sha512
  type Compressor512 n =  AlignedBlockPtr n Sha512
                       -> BlockCount Sha512
                       -> Sha512Mem -> IO ()
  
  -- | Takes a block processing function for sha256 and gives a last
  -- bytes processor.
  process256Last :: KnownNat n
                 => Compressor256 n    -- ^ block compressor
                 -> AlignedBlockPtr n Sha256
                 -> BYTES Int
                 -> Sha256Mem
                 -> IO ()
  process256Last comp buf nbytes sha256mem = do
    updateLength nbytes sha256mem
    totalBytes  <- fmap bigEndian <$> getLength sha256mem
    let pad      = padding256 nbytes totalBytes
        blocks   = atMost $ transferSize pad
      in unsafeTransfer pad buf >> comp buf blocks sha256mem
  
  -- | Takes a block processing function for sha512 and gives a last
  -- bytes processor.
  process512Last :: KnownNat n
                 => Compressor512 n
                 -> AlignedBlockPtr n Sha512
                 -> BYTES Int
                 -> Sha512Mem
                 -> IO ()
  process512Last comp buf nbytes sha512mem = do
    updateLength128 nbytes sha512mem
    uLen  <- fmap bigEndian <$> getULength sha512mem
    lLen  <- fmap bigEndian <$> getLLength sha512mem
    let pad      = padding512 nbytes uLen lLen
        blocks   = atMost $ transferSize pad
        in unsafeTransfer pad buf >> comp buf blocks sha512mem
  
  -- | The padding for sha256 as a writer.
  padding256 :: BYTES Int         -- Data in buffer.
             -> BYTES (BE Word64) -- Message length
             -> WriteTo
  padding256 bufSize msgLen  =
    glueWrites 0 boundary (padBit1 bufSize) lengthWrite
    where boundary    = blocksOf 1 (Proxy :: Proxy Sha256)
          lengthWrite = write $ shiftL msgLen 3
  
  -- | The padding for sha512 as a writer.
  padding512 :: BYTES Int         -- Data in buffer.
             -> BYTES (BE Word64) -- Message length higher
             -> BYTES (BE Word64) -- Message length lower
             -> WriteTo
  padding512 bufSize uLen lLen  = glueWrites 0 boundary (padBit1 bufSize) lengthWrite
    where boundary    = blocksOf 1 (Proxy :: Proxy Sha512)
          lengthWrite = write up `mappend` write lp
          up          = shiftL uLen 3 .|. shiftR lLen 61
          lp          = shiftL lLen 3
  
  
  -- | Pad the message with a 1-bit.
  padBit1 :: BYTES Int -- ^ message length
          -> WriteTo
  padBit1  sz = skip sz <> writeStorable (0x80 :: Word8)
  