1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module : Crypto.Hash.IO
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- Generalized impure cryptographic hash interface
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 (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 = doInit undefined B.alloc
where
doInit
:: HashAlgorithm a
=> a -> (Int -> (Ptr (Context a) -> IO ()) -> IO B.Bytes) -> IO (MutableContext a)
doInit alg alloc = MutableContext `fmap` alloc (hashInternalContextSize alg) hashInternalInit
-- | Create a new mutable hash context.
--
-- The algorithm is explicitely passed as parameter
hashMutableInitWith :: HashAlgorithm alg => alg -> IO (MutableContext alg)
hashMutableInitWith _ = hashMutableInit
-- | Update a mutable hash context in place
hashMutableUpdate
:: (B.ByteArrayAccess ba, HashAlgorithm a) => MutableContext a -> ba -> IO ()
hashMutableUpdate mc dat = doUpdate mc (B.withByteArray mc)
where
doUpdate
:: HashAlgorithm a
=> MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
doUpdate _ withCtx =
withCtx $ \ctx ->
B.withByteArray dat $ \d ->
hashInternalUpdate ctx d (fromIntegral $ B.length dat)
-- | Finalize a mutable hash context and compute a digest
hashMutableFinalize
:: forall a. HashAlgorithm a => MutableContext a -> IO (Digest a)
hashMutableFinalize mc = do
b <- B.alloc (hashDigestSize (undefined :: a)) $ \dig -> B.withByteArray mc $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
return $ Digest b
-- | Reset the mutable context to the initial state of the hash
hashMutableReset :: HashAlgorithm a => MutableContext a -> IO ()
hashMutableReset mc = doReset mc (B.withByteArray mc)
where
doReset
:: HashAlgorithm a
=> MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO ()
doReset _ withCtx = withCtx hashInternalInit
|
