module Crypto.Hash.BLAKE2.Internal
(
InitFunc,
InitKeyFunc,
UpdateFunc,
FinalFunc,
HashFunc,
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)
type InitFunc a = Ptr a -> CSize -> IO CInt
type InitKeyFunc a = Ptr a -> CSize -> Ptr () -> CSize -> IO CInt
type UpdateFunc a = Ptr a -> Ptr () -> CSize -> IO CInt
type FinalFunc a = Ptr a -> Ptr () -> CSize -> IO CInt
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 #-}