1-- |
2-- Module      : Crypto.Hash.IO
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Generalized impure cryptographic hash interface
9--
10{-# LANGUAGE GeneralizedNewtypeDeriving #-}
11{-# LANGUAGE ScopedTypeVariables        #-}
12module Crypto.Hash.IO
13    ( HashAlgorithm(..)
14    , MutableContext
15    , hashMutableInit
16    , hashMutableInitWith
17    , hashMutableUpdate
18    , hashMutableFinalize
19    , hashMutableReset
20    ) where
21
22import           Crypto.Hash.Types
23import qualified Crypto.Internal.ByteArray as B
24import           Foreign.Ptr
25
26-- | A Mutable hash context
27--
28-- This type is an instance of 'B.ByteArrayAccess' for debugging purpose.
29-- Internal layout is architecture dependent, may contain uninitialized data
30-- fragments, and change in future versions.  The bytearray should not be used
31-- as input to cryptographic algorithms.
32newtype MutableContext a = MutableContext B.Bytes
33    deriving (B.ByteArrayAccess)
34
35-- | Create a new mutable hash context.
36--
37-- the algorithm used is automatically determined from the return constraint.
38hashMutableInit :: HashAlgorithm alg => IO (MutableContext alg)
39hashMutableInit = doInit undefined B.alloc
40  where
41        doInit :: HashAlgorithm a => a -> (Int -> (Ptr (Context a) -> IO ()) -> IO B.Bytes) -> IO (MutableContext a)
42        doInit alg alloc = MutableContext `fmap` alloc (hashInternalContextSize alg) hashInternalInit
43
44-- | Create a new mutable hash context.
45--
46-- The algorithm is explicitely passed as parameter
47hashMutableInitWith :: HashAlgorithm alg => alg -> IO (MutableContext alg)
48hashMutableInitWith _ = hashMutableInit
49
50-- | Update a mutable hash context in place
51hashMutableUpdate :: (B.ByteArrayAccess ba, HashAlgorithm a) => MutableContext a -> ba -> IO ()
52hashMutableUpdate mc dat = doUpdate mc (B.withByteArray mc)
53  where doUpdate :: HashAlgorithm a => MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
54        doUpdate _ withCtx =
55            withCtx             $ \ctx ->
56            B.withByteArray dat $ \d   ->
57                hashInternalUpdate ctx d (fromIntegral $ B.length dat)
58
59-- | Finalize a mutable hash context and compute a digest
60hashMutableFinalize :: forall a . HashAlgorithm a => MutableContext a -> IO (Digest a)
61hashMutableFinalize mc = do
62    b <- B.alloc (hashDigestSize (undefined :: a)) $ \dig -> B.withByteArray mc $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
63    return $ Digest b
64
65-- | Reset the mutable context to the initial state of the hash
66hashMutableReset :: HashAlgorithm a => MutableContext a -> IO ()
67hashMutableReset mc = doReset mc (B.withByteArray mc)
68  where
69    doReset :: HashAlgorithm a => MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
70    doReset _ withCtx = withCtx hashInternalInit
71