{-# 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 (Sha2 w -> Sha2 w -> Bool
(Sha2 w -> Sha2 w -> Bool)
-> (Sha2 w -> Sha2 w -> Bool) -> Eq (Sha2 w)
forall w. (Unbox w, Equality w) => Sha2 w -> Sha2 w -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sha2 w -> Sha2 w -> Bool
$c/= :: forall w. (Unbox w, Equality w) => Sha2 w -> Sha2 w -> Bool
== :: Sha2 w -> Sha2 w -> Bool
$c== :: forall w. (Unbox w, Equality w) => Sha2 w -> Sha2 w -> Bool
Eq, Sha2 w -> Sha2 w -> Result
(Sha2 w -> Sha2 w -> Result) -> Equality (Sha2 w)
forall w. (Unbox w, Equality w) => Sha2 w -> Sha2 w -> Result
forall a. (a -> a -> Result) -> Equality a
eq :: Sha2 w -> Sha2 w -> Result
$ceq :: forall w. (Unbox w, Equality w) => Sha2 w -> Sha2 w -> Result
Equality, Ptr b -> Int -> IO (Sha2 w)
Ptr b -> Int -> Sha2 w -> IO ()
Ptr (Sha2 w) -> IO (Sha2 w)
Ptr (Sha2 w) -> Int -> IO (Sha2 w)
Ptr (Sha2 w) -> Int -> Sha2 w -> IO ()
Ptr (Sha2 w) -> Sha2 w -> IO ()
Sha2 w -> Int
(Sha2 w -> Int)
-> (Sha2 w -> Int)
-> (Ptr (Sha2 w) -> Int -> IO (Sha2 w))
-> (Ptr (Sha2 w) -> Int -> Sha2 w -> IO ())
-> (forall b. Ptr b -> Int -> IO (Sha2 w))
-> (forall b. Ptr b -> Int -> Sha2 w -> IO ())
-> (Ptr (Sha2 w) -> IO (Sha2 w))
-> (Ptr (Sha2 w) -> Sha2 w -> IO ())
-> Storable (Sha2 w)
forall b. Ptr b -> Int -> IO (Sha2 w)
forall b. Ptr b -> Int -> Sha2 w -> IO ()
forall w. (Unbox w, Storable w) => Ptr (Sha2 w) -> IO (Sha2 w)
forall w.
(Unbox w, Storable w) =>
Ptr (Sha2 w) -> Int -> IO (Sha2 w)
forall w.
(Unbox w, Storable w) =>
Ptr (Sha2 w) -> Int -> Sha2 w -> IO ()
forall w. (Unbox w, Storable w) => Ptr (Sha2 w) -> Sha2 w -> IO ()
forall w. (Unbox w, Storable w) => Sha2 w -> Int
forall w b. (Unbox w, Storable w) => Ptr b -> Int -> IO (Sha2 w)
forall w b.
(Unbox w, Storable w) =>
Ptr b -> Int -> Sha2 w -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (Sha2 w) -> Sha2 w -> IO ()
$cpoke :: forall w. (Unbox w, Storable w) => Ptr (Sha2 w) -> Sha2 w -> IO ()
peek :: Ptr (Sha2 w) -> IO (Sha2 w)
$cpeek :: forall w. (Unbox w, Storable w) => Ptr (Sha2 w) -> IO (Sha2 w)
pokeByteOff :: Ptr b -> Int -> Sha2 w -> IO ()
$cpokeByteOff :: forall w b.
(Unbox w, Storable w) =>
Ptr b -> Int -> Sha2 w -> IO ()
peekByteOff :: Ptr b -> Int -> IO (Sha2 w)
$cpeekByteOff :: forall w b. (Unbox w, Storable w) => Ptr b -> Int -> IO (Sha2 w)
pokeElemOff :: Ptr (Sha2 w) -> Int -> Sha2 w -> IO ()
$cpokeElemOff :: forall w.
(Unbox w, Storable w) =>
Ptr (Sha2 w) -> Int -> Sha2 w -> IO ()
peekElemOff :: Ptr (Sha2 w) -> Int -> IO (Sha2 w)
$cpeekElemOff :: forall w.
(Unbox w, Storable w) =>
Ptr (Sha2 w) -> Int -> IO (Sha2 w)
alignment :: Sha2 w -> Int
$calignment :: forall w. (Unbox w, Storable w) => Sha2 w -> Int
sizeOf :: Sha2 w -> Int
$csizeOf :: forall w. (Unbox w, Storable w) => Sha2 w -> Int
Storable, Storable (Sha2 w)
Ptr (Sha2 w) -> IO (Sha2 w)
Ptr (Sha2 w) -> Int -> IO ()
Ptr (Sha2 w) -> Sha2 w -> IO ()
Storable (Sha2 w)
-> (Ptr (Sha2 w) -> Sha2 w -> IO ())
-> (Ptr (Sha2 w) -> IO (Sha2 w))
-> (Ptr (Sha2 w) -> Int -> IO ())
-> EndianStore (Sha2 w)
forall w.
Storable w
-> (Ptr w -> w -> IO ())
-> (Ptr w -> IO w)
-> (Ptr w -> Int -> IO ())
-> EndianStore w
forall w. (Unbox w, EndianStore w) => Storable (Sha2 w)
forall w. (Unbox w, EndianStore w) => Ptr (Sha2 w) -> IO (Sha2 w)
forall w. (Unbox w, EndianStore w) => Ptr (Sha2 w) -> Int -> IO ()
forall w.
(Unbox w, EndianStore w) =>
Ptr (Sha2 w) -> Sha2 w -> IO ()
adjustEndian :: Ptr (Sha2 w) -> Int -> IO ()
$cadjustEndian :: forall w. (Unbox w, EndianStore w) => Ptr (Sha2 w) -> Int -> IO ()
load :: Ptr (Sha2 w) -> IO (Sha2 w)
$cload :: forall w. (Unbox w, EndianStore w) => Ptr (Sha2 w) -> IO (Sha2 w)
store :: Ptr (Sha2 w) -> Sha2 w -> IO ()
$cstore :: forall w.
(Unbox w, EndianStore w) =>
Ptr (Sha2 w) -> Sha2 w -> IO ()
$cp1EndianStore :: forall w. (Unbox w, EndianStore w) => Storable (Sha2 w)
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 :: String -> Sha2 w
fromString = String -> Sha2 w
forall a. Encodable a => String -> a
fromBase16

instance (EndianStore w, Unbox w) => Show (Sha2 w) where
  show :: Sha2 w -> String
show =  Sha2 w -> String
forall a. Encodable a => a -> String
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 :: Sha512
sha512Init = Tuple 8 (BE Word64) -> Sha512
forall w. Tuple 8 w -> Sha2 w
Sha2 (Tuple 8 (BE Word64) -> Sha512) -> Tuple 8 (BE Word64) -> Sha512
forall a b. (a -> b) -> a -> b
$ [BE Word64] -> Tuple 8 (BE Word64)
forall a (dim :: Nat).
(Unbox a, Dimension dim) =>
[a] -> Tuple dim a
unsafeFromList [ BE Word64
0x6a09e667f3bcc908
                                   , BE Word64
0xbb67ae8584caa73b
                                   , BE Word64
0x3c6ef372fe94f82b
                                   , BE Word64
0xa54ff53a5f1d36f1
                                   , BE Word64
0x510e527fade682d1
                                   , BE Word64
0x9b05688c2b3e6c1f
                                   , BE Word64
0x1f83d9abfb41bd6b
                                   , BE Word64
0x5be0cd19137e2179
                                   ]

-- | The initial value to start the blake2b hashing. This is equal to
-- the iv `xor` the parameter block.
sha256Init :: Sha256
sha256Init :: Sha256
sha256Init = Tuple 8 (BE Word32) -> Sha256
forall w. Tuple 8 w -> Sha2 w
Sha2 (Tuple 8 (BE Word32) -> Sha256) -> Tuple 8 (BE Word32) -> Sha256
forall a b. (a -> b) -> a -> b
$ [BE Word32] -> Tuple 8 (BE Word32)
forall a (dim :: Nat).
(Unbox a, Dimension dim) =>
[a] -> Tuple dim a
unsafeFromList [ BE Word32
0x6a09e667
                                   , BE Word32
0xbb67ae85
                                   , BE Word32
0x3c6ef372
                                   , BE Word32
0xa54ff53a
                                   , BE Word32
0x510e527f
                                   , BE Word32
0x9b05688c
                                   , BE Word32
0x1f83d9ab
                                   , BE Word32
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 :: () -> Sha256Mem -> IO ()
initialise ()
_ = Sha256 -> Sha256Mem -> IO ()
forall m v. Initialisable m v => v -> m -> IO ()
initialise Sha256
sha256Init

instance Initialisable Sha512Mem () where
  initialise :: () -> Sha512Mem -> IO ()
initialise ()
_ = Sha512 -> Sha512Mem -> IO ()
forall m v. Initialisable m v => v -> m -> IO ()
initialise Sha512
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 :: Compressor256 n
-> AlignedBlockPtr n Sha256 -> BYTES Int -> Sha256Mem -> IO ()
process256Last Compressor256 n
comp AlignedBlockPtr n Sha256
buf BYTES Int
nbytes Sha256Mem
sha256mem = do
  BYTES Int -> Sha256Mem -> IO ()
forall len h. LengthUnit len => len -> HashMemory64 h -> IO ()
updateLength BYTES Int
nbytes Sha256Mem
sha256mem
  BYTES (BE Word64)
totalBytes  <- (Word64 -> BE Word64) -> BYTES Word64 -> BYTES (BE Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> BE Word64
forall w. w -> BE w
bigEndian (BYTES Word64 -> BYTES (BE Word64))
-> IO (BYTES Word64) -> IO (BYTES (BE Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sha256Mem -> IO (BYTES Word64)
forall h. HashMemory64 h -> IO (BYTES Word64)
getLength Sha256Mem
sha256mem
  let pad :: WriteTo
pad      = BYTES Int -> BYTES (BE Word64) -> WriteTo
padding256 BYTES Int
nbytes BYTES (BE Word64)
totalBytes
      blocks :: BlockCount Sha256
blocks   = BYTES Int -> BlockCount Sha256
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atMost (BYTES Int -> BlockCount Sha256) -> BYTES Int -> BlockCount Sha256
forall a b. (a -> b) -> a -> b
$ WriteTo -> BYTES Int
forall (t :: Mode). Transfer t -> BYTES Int
transferSize WriteTo
pad
    in WriteTo -> AlignedPtr n (Tuple 16 (BE Word32)) -> IO ()
forall (ptr :: * -> *) (t :: Mode) a.
Pointer ptr =>
Transfer t -> ptr a -> IO ()
unsafeTransfer WriteTo
pad AlignedPtr n (Tuple 16 (BE Word32))
AlignedBlockPtr n Sha256
buf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Compressor256 n
comp AlignedBlockPtr n Sha256
buf BlockCount Sha256
blocks Sha256Mem
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 :: Compressor512 n
-> AlignedBlockPtr n Sha512 -> BYTES Int -> Sha512Mem -> IO ()
process512Last Compressor512 n
comp AlignedBlockPtr n Sha512
buf BYTES Int
nbytes Sha512Mem
sha512mem = do
  BYTES Int -> Sha512Mem -> IO ()
forall len h. LengthUnit len => len -> HashMemory128 h -> IO ()
updateLength128 BYTES Int
nbytes Sha512Mem
sha512mem
  BYTES (BE Word64)
uLen  <- (Word64 -> BE Word64) -> BYTES Word64 -> BYTES (BE Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> BE Word64
forall w. w -> BE w
bigEndian (BYTES Word64 -> BYTES (BE Word64))
-> IO (BYTES Word64) -> IO (BYTES (BE Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sha512Mem -> IO (BYTES Word64)
forall h. HashMemory128 h -> IO (BYTES Word64)
getULength Sha512Mem
sha512mem
  BYTES (BE Word64)
lLen  <- (Word64 -> BE Word64) -> BYTES Word64 -> BYTES (BE Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> BE Word64
forall w. w -> BE w
bigEndian (BYTES Word64 -> BYTES (BE Word64))
-> IO (BYTES Word64) -> IO (BYTES (BE Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sha512Mem -> IO (BYTES Word64)
forall h. HashMemory128 h -> IO (BYTES Word64)
getLLength Sha512Mem
sha512mem
  let pad :: WriteTo
pad      = BYTES Int -> BYTES (BE Word64) -> BYTES (BE Word64) -> WriteTo
padding512 BYTES Int
nbytes BYTES (BE Word64)
uLen BYTES (BE Word64)
lLen
      blocks :: BlockCount Sha512
blocks   = BYTES Int -> BlockCount Sha512
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atMost (BYTES Int -> BlockCount Sha512) -> BYTES Int -> BlockCount Sha512
forall a b. (a -> b) -> a -> b
$ WriteTo -> BYTES Int
forall (t :: Mode). Transfer t -> BYTES Int
transferSize WriteTo
pad
      in WriteTo -> AlignedPtr n (Tuple 16 (BE Word64)) -> IO ()
forall (ptr :: * -> *) (t :: Mode) a.
Pointer ptr =>
Transfer t -> ptr a -> IO ()
unsafeTransfer WriteTo
pad AlignedPtr n (Tuple 16 (BE Word64))
AlignedBlockPtr n Sha512
buf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Compressor512 n
comp AlignedBlockPtr n Sha512
buf BlockCount Sha512
blocks Sha512Mem
sha512mem

-- | The padding for sha256 as a writer.
padding256 :: BYTES Int         -- Data in buffer.
           -> BYTES (BE Word64) -- Message length
           -> WriteTo
padding256 :: BYTES Int -> BYTES (BE Word64) -> WriteTo
padding256 BYTES Int
bufSize BYTES (BE Word64)
msgLen  =
  Word8 -> BlockCount Sha256 -> WriteTo -> WriteTo -> WriteTo
forall n.
LengthUnit n =>
Word8 -> n -> WriteTo -> WriteTo -> WriteTo
glueWrites Word8
0 BlockCount Sha256
boundary (BYTES Int -> WriteTo
padBit1 BYTES Int
bufSize) WriteTo
lengthWrite
  where boundary :: BlockCount Sha256
boundary    = Int -> Proxy Sha256 -> BlockCount Sha256
forall p. Int -> Proxy p -> BlockCount p
blocksOf Int
1 (Proxy Sha256
forall k (t :: k). Proxy t
Proxy :: Proxy Sha256)
        lengthWrite :: WriteTo
lengthWrite = BYTES (BE Word64) -> WriteTo
forall a. EndianStore a => a -> WriteTo
write (BYTES (BE Word64) -> WriteTo) -> BYTES (BE Word64) -> WriteTo
forall a b. (a -> b) -> a -> b
$ BYTES (BE Word64) -> Int -> BYTES (BE Word64)
forall a. Bits a => a -> Int -> a
shiftL BYTES (BE Word64)
msgLen Int
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 :: BYTES Int -> BYTES (BE Word64) -> BYTES (BE Word64) -> WriteTo
padding512 BYTES Int
bufSize BYTES (BE Word64)
uLen BYTES (BE Word64)
lLen  = Word8 -> BlockCount Sha512 -> WriteTo -> WriteTo -> WriteTo
forall n.
LengthUnit n =>
Word8 -> n -> WriteTo -> WriteTo -> WriteTo
glueWrites Word8
0 BlockCount Sha512
boundary (BYTES Int -> WriteTo
padBit1 BYTES Int
bufSize) WriteTo
lengthWrite
  where boundary :: BlockCount Sha512
boundary    = Int -> Proxy Sha512 -> BlockCount Sha512
forall p. Int -> Proxy p -> BlockCount p
blocksOf Int
1 (Proxy Sha512
forall k (t :: k). Proxy t
Proxy :: Proxy Sha512)
        lengthWrite :: WriteTo
lengthWrite = BYTES (BE Word64) -> WriteTo
forall a. EndianStore a => a -> WriteTo
write BYTES (BE Word64)
up WriteTo -> WriteTo -> WriteTo
forall a. Monoid a => a -> a -> a
`mappend` BYTES (BE Word64) -> WriteTo
forall a. EndianStore a => a -> WriteTo
write BYTES (BE Word64)
lp
        up :: BYTES (BE Word64)
up          = BYTES (BE Word64) -> Int -> BYTES (BE Word64)
forall a. Bits a => a -> Int -> a
shiftL BYTES (BE Word64)
uLen Int
3 BYTES (BE Word64) -> BYTES (BE Word64) -> BYTES (BE Word64)
forall a. Bits a => a -> a -> a
.|. BYTES (BE Word64) -> Int -> BYTES (BE Word64)
forall a. Bits a => a -> Int -> a
shiftR BYTES (BE Word64)
lLen Int
61
        lp :: BYTES (BE Word64)
lp          = BYTES (BE Word64) -> Int -> BYTES (BE Word64)
forall a. Bits a => a -> Int -> a
shiftL BYTES (BE Word64)
lLen Int
3


-- | Pad the message with a 1-bit.
padBit1 :: BYTES Int -- ^ message length
        -> WriteTo
padBit1 :: BYTES Int -> WriteTo
padBit1  BYTES Int
sz = BYTES Int -> WriteTo
forall l (t :: Mode). LengthUnit l => l -> Transfer t
skip BYTES Int
sz WriteTo -> WriteTo -> WriteTo
forall a. Semigroup a => a -> a -> a
<> Word8 -> WriteTo
forall a. Storable a => a -> WriteTo
writeStorable (Word8
0x80 :: Word8)