-- |
-- 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
--
-- This type is an instance of 'B.ByteArrayAccess' for debugging purpose.
-- Internal layout is architecture dependent, may contain uninitialized data
-- fragments, and change in future versions.  The bytearray should not be used
-- as input to cryptographic algorithms.
newtype MutableContext a = MutableContext B.Bytes
    deriving (MutableContext a -> Int
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 :: forall p. MutableContext a -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall a p. MutableContext a -> Ptr p -> IO ()
withByteArray :: forall p a. 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 :: forall alg. HashAlgorithm alg => IO (MutableContext alg)
hashMutableInit = forall a.
HashAlgorithm a =>
a
-> (Int -> (Ptr (Context a) -> IO ()) -> IO Bytes)
-> IO (MutableContext a)
doInit forall a. HasCallStack => a
undefined 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 :: forall a.
HashAlgorithm a =>
a
-> (Int -> (Ptr (Context a) -> IO ()) -> IO Bytes)
-> IO (MutableContext a)
doInit a
alg Int -> (Ptr (Context a) -> IO ()) -> IO Bytes
alloc = forall a. Bytes -> MutableContext a
MutableContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> (Ptr (Context a) -> IO ()) -> IO Bytes
alloc (forall a. HashAlgorithm a => a -> Int
hashInternalContextSize a
alg) 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 :: forall alg. HashAlgorithm alg => alg -> IO (MutableContext alg)
hashMutableInitWith 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 :: forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
MutableContext a -> ba -> IO ()
hashMutableUpdate MutableContext a
mc ba
dat = forall a.
HashAlgorithm a =>
MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
doUpdate MutableContext a
mc (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 :: forall a.
HashAlgorithm a =>
MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
doUpdate MutableContext a
_ (Ptr (Context a) -> IO ()) -> IO ()
withCtx =
            (Ptr (Context a) -> IO ()) -> IO ()
withCtx             forall a b. (a -> b) -> a -> b
$ \Ptr (Context a)
ctx ->
            forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
dat forall a b. (a -> b) -> a -> b
$ \Ptr Word8
d   ->
                forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate Ptr (Context a)
ctx Ptr Word8
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 :: forall a. HashAlgorithm a => MutableContext a -> IO (Digest a)
hashMutableFinalize MutableContext a
mc = do
    Block Word8
b <- forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc (forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall a. HasCallStack => a
undefined :: a)) forall a b. (a -> b) -> a -> b
$ \Ptr (Digest a)
dig -> forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray MutableContext a
mc forall a b. (a -> b) -> a -> b
$ \(Ptr (Context a)
ctx :: Ptr (Context a)) -> forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr (Digest a) -> IO ()
hashInternalFinalize Ptr (Context a)
ctx Ptr (Digest a)
dig
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall a. HashAlgorithm a => MutableContext a -> IO ()
hashMutableReset MutableContext a
mc = forall a.
HashAlgorithm a =>
MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
doReset MutableContext a
mc (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 :: forall a.
HashAlgorithm a =>
MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
doReset MutableContext a
_ (Ptr (Context a) -> IO ()) -> IO ()
withCtx = (Ptr (Context a) -> IO ()) -> IO ()
withCtx forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
hashInternalInit