    {-# LANGUAGE ForeignFunctionInterface #-}

    -- |
    -- Module      : Crypto.Hash.Skein512
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- A module containing Skein512 bindings
    --
    module Crypto.Hash.Skein512
        ( Ctx(..)

        -- * Incremental hashing Functions
        , init     -- :: Int -> Ctx
        , update   -- :: Ctx -> ByteString -> Ctx
        , updates  -- :: Ctx -> [ByteString] -> Ctx
        , finalize -- :: Ctx -> ByteString

        -- * Single Pass hashing
        , hash     -- :: Int -> ByteString -> ByteString
        , hashlazy -- :: Int -> ByteString -> ByteString
        ) where

    import Prelude hiding (init)
    import Foreign.Ptr
    import Foreign.ForeignPtr (withForeignPtr)
    import Foreign.Storable
    import Foreign.Marshal.Alloc
    import qualified Data.ByteString.Lazy as L
    import Data.ByteString (ByteString)
    import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
    import Data.ByteString.Internal (create, toForeignPtr)
    import Data.Word
    import Crypto.Hash.Internal (unsafeDoIO)

    -- | Skein512 Context
    newtype Ctx = Ctx ByteString

    {-# INLINE sizeCtx #-}
    sizeCtx :: Int
    sizeCtx :: Int
    sizeCtx = Int
    160

    {- return the number of bytes of output for the digest -}
    peekHashlen :: Ptr Ctx -> IO Int
    peekHashlen :: Ptr Ctx -> IO Int
    peekHashlen Ptr Ctx
    ptr = Ptr Word32 -> IO Word32
    forall a. Storable a => Ptr a -> IO a
    peek Ptr Word32
    iptr IO Word32 -> (Word32 -> IO Int) -> IO Int
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Word32
    v -> Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $! Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    v
        where iptr :: Ptr Word32
              iptr :: Ptr Word32
    iptr = Ptr Ctx -> Ptr Word32
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Ctx
    ptr

    {-# RULES "hash" forall b i. finalize (update (init i) b) = hash i b #-}
    {-# RULES "hash.list1" forall b i. finalize (updates (init i) [b]) = hash i b #-}
    {-# RULES "hashmany" forall b i. finalize (foldl update (init i) b) = hashlazy i (L.fromChunks b) #-}
    {-# RULES "hashlazy" forall b i. finalize (foldl update (init i) $ L.toChunks b) = hashlazy i b #-}

    {-# INLINE withByteStringPtr #-}
    withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
    withByteStringPtr :: forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
    withByteStringPtr ByteString
    b Ptr Word8 -> IO a
    f =
        ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    fptr ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr -> Ptr Word8 -> IO a
    f (Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off)
        where (ForeignPtr Word8
    fptr, Int
    off, Int
    _) = ByteString -> (ForeignPtr Word8, Int, Int)
    toForeignPtr ByteString
    b

    {-# INLINE memcopy64 #-}
    memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
    memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
    memcopy64 Ptr Word64
    dst Ptr Word64
    src = (Int -> IO ()) -> [Int] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Int -> IO ()
    peekAndPoke [Int
    0..(Int
    20Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)]
        where peekAndPoke :: Int -> IO ()
    peekAndPoke Int
    i = Ptr Word64 -> Int -> IO Word64
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word64
    src Int
    i IO Word64 -> (Word64 -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Ptr Word64 -> Int -> Word64 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word64
    dst Int
    i

    withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
    withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
    withCtxCopy (Ctx ByteString
    ctxB) Ptr Ctx -> IO ()
    f = ByteString -> Ctx
    Ctx (ByteString -> Ctx) -> IO ByteString -> IO Ctx
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` IO ByteString
    createCtx
        where createCtx :: IO ByteString
    createCtx = Int -> (Ptr Word8 -> IO ()) -> IO ByteString
    create Int
    sizeCtx ((Ptr Word8 -> IO ()) -> IO ByteString)
    -> (Ptr Word8 -> IO ()) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    dstPtr ->
                          ByteString -> (Ptr Word8 -> IO ()) -> IO ()
    forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
    withByteStringPtr ByteString
    ctxB ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    srcPtr -> do
                              Ptr Word64 -> Ptr Word64 -> IO ()
    memcopy64 (Ptr Word8 -> Ptr Word64
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    dstPtr) (Ptr Word8 -> Ptr Word64
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    srcPtr)
                              Ptr Ctx -> IO ()
    f (Ptr Word8 -> Ptr Ctx
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    dstPtr)

    withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
    withCtxThrow :: forall a. Ctx -> (Ptr Ctx -> IO a) -> IO a
    withCtxThrow (Ctx ByteString
    ctxB) Ptr Ctx -> IO a
    f =
        Int -> (Ptr Any -> IO a) -> IO a
    forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes Int
    sizeCtx ((Ptr Any -> IO a) -> IO a) -> (Ptr Any -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \Ptr Any
    dstPtr ->
        ByteString -> (Ptr Word8 -> IO a) -> IO a
    forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
    withByteStringPtr ByteString
    ctxB ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    srcPtr -> do
            Ptr Word64 -> Ptr Word64 -> IO ()
    memcopy64 (Ptr Any -> Ptr Word64
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Any
    dstPtr) (Ptr Word8 -> Ptr Word64
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    srcPtr)
            Ptr Ctx -> IO a
    f (Ptr Any -> Ptr Ctx
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Any
    dstPtr)

    withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
    withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
    withCtxNew Ptr Ctx -> IO ()
    f = ByteString -> Ctx
    Ctx (ByteString -> Ctx) -> IO ByteString -> IO Ctx
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Int -> (Ptr Word8 -> IO ()) -> IO ByteString
    create Int
    sizeCtx (Ptr Ctx -> IO ()
    f (Ptr Ctx -> IO ()) -> (Ptr Word8 -> Ptr Ctx) -> Ptr Word8 -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ptr Word8 -> Ptr Ctx
    forall a b. Ptr a -> Ptr b
    castPtr)

    withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
    withCtxNewThrow :: forall a. (Ptr Ctx -> IO a) -> IO a
    withCtxNewThrow Ptr Ctx -> IO a
    f = Int -> (Ptr Any -> IO a) -> IO a
    forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes Int
    sizeCtx (Ptr Ctx -> IO a
    f (Ptr Ctx -> IO a) -> (Ptr Any -> Ptr Ctx) -> Ptr Any -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ptr Any -> Ptr Ctx
    forall a b. Ptr a -> Ptr b
    castPtr)

    foreign import ccall unsafe "skein512.h cryptohash_skein512_init"
        c_skein512_init :: Ptr Ctx -> Word32 -> IO ()

    foreign import ccall "skein512.h cryptohash_skein512_update"
        c_skein512_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()

    foreign import ccall unsafe "skein512.h cryptohash_skein512_finalize"
        c_skein512_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()

    updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
    updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
    updateInternalIO Ptr Ctx
    ptr ByteString
    d =
        ByteString -> (CStringLen -> IO ()) -> IO ()
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    unsafeUseAsCStringLen ByteString
    d (\(Ptr CChar
    cs, Int
    len) -> Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()
    c_skein512_update Ptr Ctx
    ptr (Ptr CChar -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CChar
    cs) (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len))

    finalizeInternalIO :: Ptr Ctx -> IO ByteString
    finalizeInternalIO :: Ptr Ctx -> IO ByteString
    finalizeInternalIO Ptr Ctx
    ptr =
        Ptr Ctx -> IO Int
    peekHashlen Ptr Ctx
    ptr IO Int -> (Int -> IO ByteString) -> IO ByteString
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Int
    digestSize -> Int -> (Ptr Word8 -> IO ()) -> IO ByteString
    create Int
    digestSize (Ptr Ctx -> Ptr Word8 -> IO ()
    c_skein512_finalize Ptr Ctx
    ptr)

    {-# NOINLINE init #-}
    -- | init a context
    init :: Int -> Ctx
    init :: Int -> Ctx
    init Int
    hashlen = IO Ctx -> Ctx
    forall a. IO a -> a
    unsafeDoIO (IO Ctx -> Ctx) -> IO Ctx -> Ctx
    forall a b. (a -> b) -> a -> b
    $ (Ptr Ctx -> IO ()) -> IO Ctx
    withCtxNew ((Ptr Ctx -> IO ()) -> IO Ctx) -> (Ptr Ctx -> IO ()) -> IO Ctx
    forall a b. (a -> b) -> a -> b
    $ \Ptr Ctx
    ptr -> Ptr Ctx -> Word32 -> IO ()
    c_skein512_init Ptr Ctx
    ptr (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    hashlen)

    {-# NOINLINE update #-}
    -- | update a context with a bytestring
    update :: Ctx -> ByteString -> Ctx
    update :: Ctx -> ByteString -> Ctx
    update Ctx
    ctx ByteString
    d = IO Ctx -> Ctx
    forall a. IO a -> a
    unsafeDoIO (IO Ctx -> Ctx) -> IO Ctx -> Ctx
    forall a b. (a -> b) -> a -> b
    $ Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
    withCtxCopy Ctx
    ctx ((Ptr Ctx -> IO ()) -> IO Ctx) -> (Ptr Ctx -> IO ()) -> IO Ctx
    forall a b. (a -> b) -> a -> b
    $ \Ptr Ctx
    ptr -> Ptr Ctx -> ByteString -> IO ()
    updateInternalIO Ptr Ctx
    ptr ByteString
    d

    {-# NOINLINE updates #-}
    -- | updates a context with multiples bytestring
    updates :: Ctx -> [ByteString] -> Ctx
    updates :: Ctx -> [ByteString] -> Ctx
    updates Ctx
    ctx [ByteString]
    d = IO Ctx -> Ctx
    forall a. IO a -> a
    unsafeDoIO (IO Ctx -> Ctx) -> IO Ctx -> Ctx
    forall a b. (a -> b) -> a -> b
    $ Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
    withCtxCopy Ctx
    ctx ((Ptr Ctx -> IO ()) -> IO Ctx) -> (Ptr Ctx -> IO ()) -> IO Ctx
    forall a b. (a -> b) -> a -> b
    $ \Ptr Ctx
    ptr -> (ByteString -> IO ()) -> [ByteString] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Ptr Ctx -> ByteString -> IO ()
    updateInternalIO Ptr Ctx
    ptr) [ByteString]
    d

    {-# NOINLINE finalize #-}
    -- | finalize the context into a digest bytestring
    finalize :: Ctx -> ByteString
    finalize :: Ctx -> ByteString
    finalize Ctx
    ctx = IO ByteString -> ByteString
    forall a. IO a -> a
    unsafeDoIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Ctx -> (Ptr Ctx -> IO ByteString) -> IO ByteString
    forall a. Ctx -> (Ptr Ctx -> IO a) -> IO a
    withCtxThrow Ctx
    ctx Ptr Ctx -> IO ByteString
    finalizeInternalIO

    {-# NOINLINE hash #-}
    -- | hash a strict bytestring into a digest bytestring
    hash :: Int -> ByteString -> ByteString
    hash :: Int -> ByteString -> ByteString
    hash Int
    hashlen ByteString
    d = IO ByteString -> ByteString
    forall a. IO a -> a
    unsafeDoIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Ptr Ctx -> IO ByteString) -> IO ByteString
    forall a. (Ptr Ctx -> IO a) -> IO a
    withCtxNewThrow ((Ptr Ctx -> IO ByteString) -> IO ByteString)
    -> (Ptr Ctx -> IO ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \Ptr Ctx
    ptr -> do
        Ptr Ctx -> Word32 -> IO ()
    c_skein512_init Ptr Ctx
    ptr (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    hashlen) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Ptr Ctx -> ByteString -> IO ()
    updateInternalIO Ptr Ctx
    ptr ByteString
    d IO () -> IO ByteString -> IO ByteString
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Ptr Ctx -> IO ByteString
    finalizeInternalIO Ptr Ctx
    ptr

    {-# NOINLINE hashlazy #-}
    -- | hash a lazy bytestring into a digest bytestring
    hashlazy :: Int -> L.ByteString -> ByteString
    hashlazy :: Int -> ByteString -> ByteString
    hashlazy Int
    hashlen ByteString
    l = IO ByteString -> ByteString
    forall a. IO a -> a
    unsafeDoIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Ptr Ctx -> IO ByteString) -> IO ByteString
    forall a. (Ptr Ctx -> IO a) -> IO a
    withCtxNewThrow ((Ptr Ctx -> IO ByteString) -> IO ByteString)
    -> (Ptr Ctx -> IO ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \Ptr Ctx
    ptr -> do
        Ptr Ctx -> Word32 -> IO ()
    c_skein512_init Ptr Ctx
    ptr (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    hashlen) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (ByteString -> IO ()) -> [ByteString] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Ptr Ctx -> ByteString -> IO ()
    updateInternalIO Ptr Ctx
    ptr) (ByteString -> [ByteString]
    L.toChunks ByteString
    l) IO () -> IO ByteString -> IO ByteString
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Ptr Ctx -> IO ByteString
    finalizeInternalIO Ptr Ctx
    ptr