    -- |
    -- Module      : Crypto.Hash.IO
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- Generalized impure cryptographic hash interface
    --
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE ScopedTypeVariables        #-}
    module Crypto.Hash.IO
        ( HashAlgorithm(..)
        , MutableContext
        , hashMutableInit
        , hashMutableInitWith
        , hashMutableUpdate
        , hashMutableFinalize
        , hashMutableReset
        ) where

    import           Crypto.Hash.Types
    import qualified Crypto.Internal.ByteArray as B
    import           Foreign.Ptr

    -- | A Mutable hash context
    newtype MutableContext a = MutableContext B.Bytes
        deriving (MutableContext a -> Int
    MutableContext a -> Ptr p -> IO ()
    MutableContext a -> (Ptr p -> IO a) -> IO a
    (MutableContext a -> Int)
    -> (forall p a. MutableContext a -> (Ptr p -> IO a) -> IO a)
    -> (forall p. MutableContext a -> Ptr p -> IO ())
    -> ByteArrayAccess (MutableContext a)
    forall a. MutableContext a -> Int
    forall p. MutableContext a -> Ptr p -> IO ()
    forall ba.
    (ba -> Int)
    -> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
    -> (forall p. ba -> Ptr p -> IO ())
    -> ByteArrayAccess ba
    forall a p. MutableContext a -> Ptr p -> IO ()
    forall p a. MutableContext a -> (Ptr p -> IO a) -> IO a
    forall a p a. MutableContext a -> (Ptr p -> IO a) -> IO a
    copyByteArrayToPtr :: MutableContext a -> Ptr p -> IO ()
    $ccopyByteArrayToPtr :: forall a p. MutableContext a -> Ptr p -> IO ()
    withByteArray :: MutableContext a -> (Ptr p -> IO a) -> IO a
    $cwithByteArray :: forall a p a. MutableContext a -> (Ptr p -> IO a) -> IO a
    length :: MutableContext a -> Int
    $clength :: forall a. MutableContext a -> Int
    B.ByteArrayAccess)

    -- | Create a new mutable hash context.
    --
    -- the algorithm used is automatically determined from the return constraint.
    hashMutableInit :: HashAlgorithm alg => IO (MutableContext alg)
    hashMutableInit :: IO (MutableContext alg)
    hashMutableInit = alg
    -> (Int -> (Ptr (Context alg) -> IO ()) -> IO Bytes)
    -> IO (MutableContext alg)
    forall a.
    HashAlgorithm a =>
    a
    -> (Int -> (Ptr (Context a) -> IO ()) -> IO Bytes)
    -> IO (MutableContext a)
    doInit alg
    forall a. HasCallStack => a
    undefined Int -> (Ptr (Context alg) -> IO ()) -> IO Bytes
    forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
    B.alloc
      where
            doInit :: HashAlgorithm a => a -> (Int -> (Ptr (Context a) -> IO ()) -> IO B.Bytes) -> IO (MutableContext a)
            doInit :: a
    -> (Int -> (Ptr (Context a) -> IO ()) -> IO Bytes)
    -> IO (MutableContext a)
    doInit alg :: a
    alg alloc :: Int -> (Ptr (Context a) -> IO ()) -> IO Bytes
    alloc = Bytes -> MutableContext a
    forall a. Bytes -> MutableContext a
    MutableContext (Bytes -> MutableContext a) -> IO Bytes -> IO (MutableContext a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Int -> (Ptr (Context a) -> IO ()) -> IO Bytes
    alloc (a -> Int
    forall a. HashAlgorithm a => a -> Int
    hashInternalContextSize a
    alg) Ptr (Context a) -> IO ()
    forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
    hashInternalInit

    -- | Create a new mutable hash context.
    --
    -- The algorithm is explicitely passed as parameter
    hashMutableInitWith :: HashAlgorithm alg => alg -> IO (MutableContext alg)
    hashMutableInitWith :: alg -> IO (MutableContext alg)
    hashMutableInitWith _ = IO (MutableContext alg)
    forall alg. HashAlgorithm alg => IO (MutableContext alg)
    hashMutableInit

    -- | Update a mutable hash context in place
    hashMutableUpdate :: (B.ByteArrayAccess ba, HashAlgorithm a) => MutableContext a -> ba -> IO ()
    hashMutableUpdate :: MutableContext a -> ba -> IO ()
    hashMutableUpdate mc :: MutableContext a
    mc dat :: ba
    dat = MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
    forall a.
    HashAlgorithm a =>
    MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
    doUpdate MutableContext a
    mc (MutableContext a -> (Ptr (Context a) -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    B.withByteArray MutableContext a
    mc)
      where doUpdate :: HashAlgorithm a => MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
            doUpdate :: MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
    doUpdate _ withCtx :: (Ptr (Context a) -> IO ()) -> IO ()
    withCtx =
                (Ptr (Context a) -> IO ()) -> IO ()
    withCtx             ((Ptr (Context a) -> IO ()) -> IO ())
    -> (Ptr (Context a) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ctx :: Ptr (Context a)
    ctx ->
                ba -> (Ptr Word8 -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    B.withByteArray ba
    dat ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \d :: Ptr Word8
    d   ->
                    Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
    forall a.
    HashAlgorithm a =>
    Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
    hashInternalUpdate Ptr (Context a)
    ctx Ptr Word8
    d (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ ba -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ba
    dat)

    -- | Finalize a mutable hash context and compute a digest
    hashMutableFinalize :: forall a . HashAlgorithm a => MutableContext a -> IO (Digest a)
    hashMutableFinalize :: MutableContext a -> IO (Digest a)
    hashMutableFinalize mc :: MutableContext a
    mc = do
        Block Word8
    b <- Int -> (Ptr (Digest a) -> IO ()) -> IO (Block Word8)
    forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
    B.alloc (a -> Int
    forall a. HashAlgorithm a => a -> Int
    hashDigestSize (a
    forall a. HasCallStack => a
    undefined :: a)) ((Ptr (Digest a) -> IO ()) -> IO (Block Word8))
    -> (Ptr (Digest a) -> IO ()) -> IO (Block Word8)
    forall a b. (a -> b) -> a -> b
    $ \dig :: Ptr (Digest a)
    dig -> MutableContext a -> (Ptr (Context a) -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    B.withByteArray MutableContext a
    mc ((Ptr (Context a) -> IO ()) -> IO ())
    -> (Ptr (Context a) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Ptr (Context a)
    ctx :: Ptr (Context a)) -> Ptr (Context a) -> Ptr (Digest a) -> IO ()
    forall a.
    HashAlgorithm a =>
    Ptr (Context a) -> Ptr (Digest a) -> IO ()
    hashInternalFinalize Ptr (Context a)
    ctx Ptr (Digest a)
    dig
        Digest a -> IO (Digest a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Digest a -> IO (Digest a)) -> Digest a -> IO (Digest a)
    forall a b. (a -> b) -> a -> b
    $ Block Word8 -> Digest a
    forall a. Block Word8 -> Digest a
    Digest Block Word8
    b

    -- | Reset the mutable context to the initial state of the hash
    hashMutableReset :: HashAlgorithm a => MutableContext a -> IO ()
    hashMutableReset :: MutableContext a -> IO ()
    hashMutableReset mc :: MutableContext a
    mc = MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
    forall a.
    HashAlgorithm a =>
    MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
    doReset MutableContext a
    mc (MutableContext a -> (Ptr (Context a) -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    B.withByteArray MutableContext a
    mc)
      where
        doReset :: HashAlgorithm a => MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
        doReset :: MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
    doReset _ withCtx :: (Ptr (Context a) -> IO ()) -> IO ()
    withCtx = (Ptr (Context a) -> IO ()) -> IO ()
    withCtx Ptr (Context a) -> IO ()
    forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
    hashInternalInit