74 lines
2.8 KiB
Haskell
74 lines
2.8 KiB
Haskell
-- |
|
|
-- Module : Crypto.Hash.IO
|
|
-- License : BSD-style
|
|
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
|
-- Stability : experimental
|
|
-- Portability : unknown
|
|
--
|
|
-- Generalized impure cryptographic hash interface
|
|
--
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
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 (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 :: HashAlgorithm a => MutableContext a -> IO (Digest a)
|
|
hashMutableFinalize mc = doFinalize undefined (B.withByteArray mc) B.alloc
|
|
where doFinalize :: HashAlgorithm alg
|
|
=> alg
|
|
-> ((Ptr (Context alg) -> IO ()) -> IO ())
|
|
-> (Int -> (Ptr (Digest alg) -> IO ()) -> IO B.Bytes)
|
|
-> IO (Digest alg)
|
|
doFinalize alg withCtx allocDigest = do
|
|
b <- allocDigest (hashDigestSize alg) $ \dig ->
|
|
withCtx $ \ctx ->
|
|
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
|