----------------------------------------------------------------
-- |
-- Module      : Crypto.Hash.BLAKE2.Internal
-- Maintainer  : John Galt <jgalt@centromere.net>
-- Stability   : experimental
-- Portability : POSIX

module Crypto.Hash.BLAKE2.Internal
  ( -- * Types
    InitFunc,
    InitKeyFunc,
    UpdateFunc,
    FinalFunc,
    HashFunc,
    -- * Functions
    initializer,
    initializer',
    updater,
    finalizer,
    hasher
  ) where

import Control.Monad            (void)
import Data.ByteString          (ByteString)
import Data.ByteString.Internal (create, toForeignPtr)
import Data.ByteString.Unsafe   (unsafeUseAsCStringLen)
import Foreign.C.Types          (CInt, CSize)
import Foreign.ForeignPtr       (ForeignPtr, mallocForeignPtr, withForeignPtr)
import Foreign.Marshal.Array    (copyArray)
import Foreign.Ptr              (Ptr, castPtr)
import Foreign.Storable         (Storable)
import System.IO.Unsafe         (unsafePerformIO)

-- int blake2X_init( blake2X_state *S, size_t outlen );
type InitFunc a = Ptr a -> CSize -> IO CInt

-- int blake2X_init_key( blake2X_state *S, size_t outlen, const void *key, size_t keylen );
type InitKeyFunc a = Ptr a -> CSize -> Ptr () -> CSize -> IO CInt

-- int blake2X_update( blake2X_state *S, const void *in, size_t inlen );
type UpdateFunc a = Ptr a -> Ptr () -> CSize -> IO CInt

-- int blake2X_final( blake2X_state *S, void *out, size_t outlen );
type FinalFunc a = Ptr a -> Ptr () -> CSize -> IO CInt

-- int blake2s( void *out, size_t outlen, const void *in, size_t inlen, const void *key, size_t keylen );
type HashFunc = Ptr ()
             -> CSize
             -> Ptr ()
             -> CSize
             -> Ptr ()
             -> CSize
             -> IO CInt

initializer :: Storable a
            => InitFunc a
            -> Int
            -> ForeignPtr a
initializer :: forall a. Storable a => InitFunc a -> Int -> ForeignPtr a
initializer InitFunc a
f Int
outlen = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr a
fptr <- forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
    CInt
ret <- InitFunc a
f (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outlen)
    if CInt
ret forall a. Eq a => a -> a -> Bool
== CInt
0
    then forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr a
fptr
    else forall a. HasCallStack => [Char] -> a
error [Char]
"initialization failure"

initializer' :: Storable a
             => InitKeyFunc a
             -> Int
             -> ByteString
             -> ForeignPtr a
initializer' :: forall a.
Storable a =>
InitKeyFunc a -> Int -> ByteString -> ForeignPtr a
initializer' InitKeyFunc a
f Int
outlen ByteString
key = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr a
fptr <- forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr ->
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
key forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
kptr, Int
klen) -> do
      let klen' :: CSize
klen'   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
klen
          outlen' :: CSize
outlen' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outlen
      CInt
ret <- InitKeyFunc a
f Ptr a
ptr CSize
outlen' (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
kptr) CSize
klen'
      if CInt
ret forall a. Eq a => a -> a -> Bool
== CInt
0
      then forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr a
fptr
      else forall a. HasCallStack => [Char] -> a
error [Char]
"initialization failure"

updater :: Storable a
        => UpdateFunc a
        -> ByteString
        -> ForeignPtr a
        -> ForeignPtr a
updater :: forall a.
Storable a =>
UpdateFunc a -> ByteString -> ForeignPtr a -> ForeignPtr a
updater UpdateFunc a
f ByteString
d ForeignPtr a
state = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr a
newState <- forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
newState forall a b. (a -> b) -> a -> b
$ \Ptr a
nsptr -> do
    let (ForeignPtr Word8
dfp, Int
_, Int
dlen) = ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr ByteString
d
        dlen' :: CSize
dlen' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dlen
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
state forall a b. (a -> b) -> a -> b
$ \Ptr a
sptr -> do
        forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
nsptr Ptr a
sptr Int
1
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ UpdateFunc a
f (forall a b. Ptr a -> Ptr b
castPtr Ptr a
nsptr) (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dptr) CSize
dlen'
  forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr a
newState

finalizer :: Storable a
          => FinalFunc a
          -> Int
          -> ForeignPtr a
          -> ByteString
finalizer :: forall a.
Storable a =>
FinalFunc a -> Int -> ForeignPtr a -> ByteString
finalizer FinalFunc a
f Int
outlen ForeignPtr a
state = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr a
newState <- forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
newState forall a b. (a -> b) -> a -> b
$ \Ptr a
nsptr ->
    Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
outlen forall a b. (a -> b) -> a -> b
$ \Ptr Word8
optr ->
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
state forall a b. (a -> b) -> a -> b
$ \Ptr a
sptr -> do
        let outlen' :: CSize
outlen' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outlen
        forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
nsptr Ptr a
sptr Int
1
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ FinalFunc a
f (forall a b. Ptr a -> Ptr b
castPtr Ptr a
nsptr) (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
optr) CSize
outlen'

hasher :: HashFunc
       -> Int
       -> ByteString
       -> ByteString
       -> ByteString
hasher :: HashFunc -> Int -> ByteString -> ByteString -> ByteString
hasher HashFunc
h Int
olen ByteString
key ByteString
input =
  forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
olen forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ostr ->
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
key forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
kstr, Int
klen) ->
      forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
input forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
istr, Int
ilen) ->
        let olen' :: CSize
olen' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
olen
            ilen' :: CSize
ilen' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ilen
            klen' :: CSize
klen' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
klen
        in forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ HashFunc
h (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ostr) CSize
olen'
                    (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
istr) CSize
ilen'
                    (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
kstr) CSize
klen'
{-# INLINE hasher #-}