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

-- |
--
-- Module      : Raaz.Primitive.Blake2.Internal
-- Description : Internal modules for Blake2 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.Blake2.Internal
       ( -- * The blake2 types
         Blake2b, Blake2s
       , Blake2bMem, Blake2sMem
       , blake2Pad
       ) where

import           Data.Vector.Unboxed        ( Unbox )
import           Foreign.Storable           ( Storable       )

import           Raaz.Core
import           Raaz.Primitive.HashMemory
import           Raaz.Primitive.Keyed.Internal

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

-- | The Blake2 type.
newtype Blake2 w = Blake2 (Tuple 8 w)
               deriving (Blake2 w -> Blake2 w -> Bool
(Blake2 w -> Blake2 w -> Bool)
-> (Blake2 w -> Blake2 w -> Bool) -> Eq (Blake2 w)
forall w. (Unbox w, Equality w) => Blake2 w -> Blake2 w -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Blake2 w -> Blake2 w -> Bool
$c/= :: forall w. (Unbox w, Equality w) => Blake2 w -> Blake2 w -> Bool
== :: Blake2 w -> Blake2 w -> Bool
$c== :: forall w. (Unbox w, Equality w) => Blake2 w -> Blake2 w -> Bool
Eq, Blake2 w -> Blake2 w -> Result
(Blake2 w -> Blake2 w -> Result) -> Equality (Blake2 w)
forall w. (Unbox w, Equality w) => Blake2 w -> Blake2 w -> Result
forall a. (a -> a -> Result) -> Equality a
eq :: Blake2 w -> Blake2 w -> Result
$ceq :: forall w. (Unbox w, Equality w) => Blake2 w -> Blake2 w -> Result
Equality, Ptr b -> Int -> IO (Blake2 w)
Ptr b -> Int -> Blake2 w -> IO ()
Ptr (Blake2 w) -> IO (Blake2 w)
Ptr (Blake2 w) -> Int -> IO (Blake2 w)
Ptr (Blake2 w) -> Int -> Blake2 w -> IO ()
Ptr (Blake2 w) -> Blake2 w -> IO ()
Blake2 w -> Int
(Blake2 w -> Int)
-> (Blake2 w -> Int)
-> (Ptr (Blake2 w) -> Int -> IO (Blake2 w))
-> (Ptr (Blake2 w) -> Int -> Blake2 w -> IO ())
-> (forall b. Ptr b -> Int -> IO (Blake2 w))
-> (forall b. Ptr b -> Int -> Blake2 w -> IO ())
-> (Ptr (Blake2 w) -> IO (Blake2 w))
-> (Ptr (Blake2 w) -> Blake2 w -> IO ())
-> Storable (Blake2 w)
forall b. Ptr b -> Int -> IO (Blake2 w)
forall b. Ptr b -> Int -> Blake2 w -> IO ()
forall w. (Unbox w, Storable w) => Ptr (Blake2 w) -> IO (Blake2 w)
forall w.
(Unbox w, Storable w) =>
Ptr (Blake2 w) -> Int -> IO (Blake2 w)
forall w.
(Unbox w, Storable w) =>
Ptr (Blake2 w) -> Int -> Blake2 w -> IO ()
forall w.
(Unbox w, Storable w) =>
Ptr (Blake2 w) -> Blake2 w -> IO ()
forall w. (Unbox w, Storable w) => Blake2 w -> Int
forall w b. (Unbox w, Storable w) => Ptr b -> Int -> IO (Blake2 w)
forall w b.
(Unbox w, Storable w) =>
Ptr b -> Int -> Blake2 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 (Blake2 w) -> Blake2 w -> IO ()
$cpoke :: forall w.
(Unbox w, Storable w) =>
Ptr (Blake2 w) -> Blake2 w -> IO ()
peek :: Ptr (Blake2 w) -> IO (Blake2 w)
$cpeek :: forall w. (Unbox w, Storable w) => Ptr (Blake2 w) -> IO (Blake2 w)
pokeByteOff :: Ptr b -> Int -> Blake2 w -> IO ()
$cpokeByteOff :: forall w b.
(Unbox w, Storable w) =>
Ptr b -> Int -> Blake2 w -> IO ()
peekByteOff :: Ptr b -> Int -> IO (Blake2 w)
$cpeekByteOff :: forall w b. (Unbox w, Storable w) => Ptr b -> Int -> IO (Blake2 w)
pokeElemOff :: Ptr (Blake2 w) -> Int -> Blake2 w -> IO ()
$cpokeElemOff :: forall w.
(Unbox w, Storable w) =>
Ptr (Blake2 w) -> Int -> Blake2 w -> IO ()
peekElemOff :: Ptr (Blake2 w) -> Int -> IO (Blake2 w)
$cpeekElemOff :: forall w.
(Unbox w, Storable w) =>
Ptr (Blake2 w) -> Int -> IO (Blake2 w)
alignment :: Blake2 w -> Int
$calignment :: forall w. (Unbox w, Storable w) => Blake2 w -> Int
sizeOf :: Blake2 w -> Int
$csizeOf :: forall w. (Unbox w, Storable w) => Blake2 w -> Int
Storable, Storable (Blake2 w)
Ptr (Blake2 w) -> IO (Blake2 w)
Ptr (Blake2 w) -> Int -> IO ()
Ptr (Blake2 w) -> Blake2 w -> IO ()
Storable (Blake2 w)
-> (Ptr (Blake2 w) -> Blake2 w -> IO ())
-> (Ptr (Blake2 w) -> IO (Blake2 w))
-> (Ptr (Blake2 w) -> Int -> IO ())
-> EndianStore (Blake2 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 (Blake2 w)
forall w.
(Unbox w, EndianStore w) =>
Ptr (Blake2 w) -> IO (Blake2 w)
forall w.
(Unbox w, EndianStore w) =>
Ptr (Blake2 w) -> Int -> IO ()
forall w.
(Unbox w, EndianStore w) =>
Ptr (Blake2 w) -> Blake2 w -> IO ()
adjustEndian :: Ptr (Blake2 w) -> Int -> IO ()
$cadjustEndian :: forall w.
(Unbox w, EndianStore w) =>
Ptr (Blake2 w) -> Int -> IO ()
load :: Ptr (Blake2 w) -> IO (Blake2 w)
$cload :: forall w.
(Unbox w, EndianStore w) =>
Ptr (Blake2 w) -> IO (Blake2 w)
store :: Ptr (Blake2 w) -> Blake2 w -> IO ()
$cstore :: forall w.
(Unbox w, EndianStore w) =>
Ptr (Blake2 w) -> Blake2 w -> IO ()
$cp1EndianStore :: forall w. (Unbox w, EndianStore w) => Storable (Blake2 w)
EndianStore)

instance ( Unbox w
         , EndianStore w
         ) => Primitive (Blake2 w) where
  type WordType      (Blake2 w) = w
  type WordsPerBlock (Blake2 w) = 16

instance (Unbox w, EndianStore w) => Encodable (Blake2 w)

instance (EndianStore w, Unbox w) => IsString (Blake2 w) where
  fromString :: String -> Blake2 w
fromString = String -> Blake2 w
forall a. Encodable a => String -> a
fromBase16

instance (EndianStore w, Unbox w) => Show (Blake2 w) where
  show :: Blake2 w -> String
show =  Blake2 w -> String
forall a. Encodable a => a -> String
showBase16

-- | The Blake2b hash type.
type Blake2b = Blake2 (LE Word64)

-- | The Blake2s hash type.
type Blake2s = Blake2 (LE Word32)

keyLength :: (Storable prim, Num b) => Proxy prim -> BYTES Int -> b
keyLength :: Proxy prim -> BYTES Int -> b
keyLength Proxy prim
proxy BYTES Int
len
  | BYTES Int
len BYTES Int -> BYTES Int -> Bool
forall a. Ord a => a -> a -> Bool
> BYTES Int
tLen = BYTES Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral BYTES Int
tLen
  | Bool
otherwise  = BYTES Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral BYTES Int
len
  where tLen :: BYTES Int
tLen = Proxy prim -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf Proxy prim
proxy

instance KeyedHash Blake2b where
  hashInit :: BYTES Int -> Blake2b
hashInit BYTES Int
len = Tuple 8 (LE Word64) -> Blake2b
forall w. Tuple 8 w -> Blake2 w
Blake2 (Tuple 8 (LE Word64) -> Blake2b) -> Tuple 8 (LE Word64) -> Blake2b
forall a b. (a -> b) -> a -> b
$ [LE Word64] -> Tuple 8 (LE Word64)
forall a (dim :: Nat).
(Unbox a, Dimension dim) =>
[a] -> Tuple dim a
unsafeFromList [ LE Word64
0x6a09e667f3bcc908 LE Word64 -> LE Word64 -> LE Word64
forall a. Bits a => a -> a -> a
`xor` LE Word64
iv0
                                         , LE Word64
0xbb67ae8584caa73b
                                         , LE Word64
0x3c6ef372fe94f82b
                                         , LE Word64
0xa54ff53a5f1d36f1
                                         , LE Word64
0x510e527fade682d1
                                         , LE Word64
0x9b05688c2b3e6c1f
                                         , LE Word64
0x1f83d9abfb41bd6b
                                         , LE Word64
0x5be0cd19137e2179
                                         ]
    where len8 :: LE Word64
len8 = Proxy Blake2b -> BYTES Int -> LE Word64
forall prim b.
(Storable prim, Num b) =>
Proxy prim -> BYTES Int -> b
keyLength (Proxy Blake2b
forall k (t :: k). Proxy t
Proxy :: Proxy Blake2b) BYTES Int
len
          iv0 :: LE Word64
iv0  = LE Word64
0x01010040 LE Word64 -> LE Word64 -> LE Word64
forall a. Bits a => a -> a -> a
.|. LE Word64 -> Int -> LE Word64
forall a. Bits a => a -> Int -> a
shiftL LE Word64
len8 Int
8

instance KeyedHash Blake2s where
  hashInit :: BYTES Int -> Blake2s
hashInit BYTES Int
len =  Tuple 8 (LE Word32) -> Blake2s
forall w. Tuple 8 w -> Blake2 w
Blake2 (Tuple 8 (LE Word32) -> Blake2s) -> Tuple 8 (LE Word32) -> Blake2s
forall a b. (a -> b) -> a -> b
$ [LE Word32] -> Tuple 8 (LE Word32)
forall a (dim :: Nat).
(Unbox a, Dimension dim) =>
[a] -> Tuple dim a
unsafeFromList [ LE Word32
0x6a09e667 LE Word32 -> LE Word32 -> LE Word32
forall a. Bits a => a -> a -> a
`xor` LE Word32
iv0
                                          , LE Word32
0xbb67ae85
                                          , LE Word32
0x3c6ef372
                                          , LE Word32
0xa54ff53a
                                          , LE Word32
0x510e527f
                                          , LE Word32
0x9b05688c
                                          , LE Word32
0x1f83d9ab
                                          , LE Word32
0x5be0cd19
                                          ]
    where len8 :: LE Word32
len8 = Proxy Blake2s -> BYTES Int -> LE Word32
forall prim b.
(Storable prim, Num b) =>
Proxy prim -> BYTES Int -> b
keyLength (Proxy Blake2s
forall k (t :: k). Proxy t
Proxy :: Proxy Blake2s) BYTES Int
len
          iv0 :: LE Word32
iv0  = LE Word32
0x01010020  LE Word32 -> LE Word32 -> LE Word32
forall a. Bits a => a -> a -> a
.|. LE Word32 -> Int -> LE Word32
forall a. Bits a => a -> Int -> a
shiftL LE Word32
len8 Int
8


---------------------------------- Memory element for Blake2b -----------------------
-- | The memory element for blake2b hash.
type Blake2bMem = HashMemory128 Blake2b

-- | The memory element for blake2s hash.
type Blake2sMem = HashMemory64 Blake2s

instance Initialisable Blake2bMem () where
  initialise :: () -> Blake2bMem -> IO ()
initialise ()
_ = Blake2b -> Blake2bMem -> IO ()
forall m v. Initialisable m v => v -> m -> IO ()
initialise (BYTES Int -> Blake2b
forall prim. KeyedHash prim => BYTES Int -> prim
hashInit BYTES Int
0 :: Blake2b)

instance Initialisable Blake2sMem () where
  initialise :: () -> Blake2sMem -> IO ()
initialise ()
_ = Blake2s -> Blake2sMem -> IO ()
forall m v. Initialisable m v => v -> m -> IO ()
initialise (BYTES Int -> Blake2s
forall prim. KeyedHash prim => BYTES Int -> prim
hashInit BYTES Int
0 :: Blake2s)

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

-- | The generic blake2 padding algorithm. We pad the message with
-- just enough zero's to make it a multiple of the block size. The
-- exception is the empty message which should generate a single block
-- of zeros.
--
blake2Pad :: Primitive prim
          => Proxy prim  -- ^ the primitive (Blake2b or Blake2s).
          -> BYTES Int   -- ^ length of the message
          -> WriteTo
blake2Pad :: Proxy prim -> BYTES Int -> WriteTo
blake2Pad Proxy prim
primProxy BYTES Int
m
  | BYTES Int
m BYTES Int -> BYTES Int -> Bool
forall a. Eq a => a -> a -> Bool
== BYTES Int
0    = Word8 -> BlockCount prim -> WriteTo
forall n. LengthUnit n => Word8 -> n -> WriteTo
writeBytes Word8
0 (BlockCount prim -> WriteTo) -> BlockCount prim -> WriteTo
forall a b. (a -> b) -> a -> b
$ Int -> Proxy prim -> BlockCount prim
forall p. Int -> Proxy p -> BlockCount p
blocksOf Int
1 Proxy prim
primProxy -- empty message
  | Bool
otherwise = Word8 -> BlockCount prim -> WriteTo -> WriteTo
forall n. LengthUnit n => Word8 -> n -> WriteTo -> WriteTo
padWrite Word8
0 (Int -> Proxy prim -> BlockCount prim
forall p. Int -> Proxy p -> BlockCount p
blocksOf Int
1 Proxy prim
primProxy) (WriteTo -> WriteTo) -> WriteTo -> WriteTo
forall a b. (a -> b) -> a -> b
$ BYTES Int -> WriteTo
forall l (t :: Mode). LengthUnit l => l -> Transfer t
skip BYTES Int
m