db7c3bbb4f
use the typeclass for the lowest IO impure C bindings definitions, and define the pure interface as generic on top of this. At the same time define an Hash.IO interface to allow mutable manipulations of hash contextes when necessary. Use HashAlgorithm instead of HashFunction in the [PubKey] sections Tweak the HMAC, PBKDF2 functions to be more efficient and use the new interface
63 lines
2.3 KiB
Haskell
63 lines
2.3 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
|
|
, hashMutableScrub
|
|
) where
|
|
|
|
import Crypto.Hash.Types
|
|
import qualified Crypto.Internal.ByteArray as B
|
|
import Data.ByteString (ByteString)
|
|
import Foreign.Ptr
|
|
|
|
newtype MutableContext a = MutableContext B.Bytes
|
|
deriving (B.ByteArrayAccess)
|
|
|
|
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
|
|
|
|
hashMutableInitWith :: HashAlgorithm alg => alg -> IO (MutableContext alg)
|
|
hashMutableInitWith _ = hashMutableInit
|
|
|
|
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)
|
|
|
|
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
|
|
|
|
-- FIXME not implemented just yet.
|
|
hashMutableScrub :: HashAlgorithm a => MutableContext a -> IO ()
|
|
hashMutableScrub (MutableContext _) = return ()
|