{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
module Crypto.Hash
(
Context
, Digest
, digestFromByteString
, hashInitWith
, hashWith
, hashInit
, hashUpdates
, hashUpdate
, hashFinalize
, hashBlockSize
, hashDigestSize
, hash
, hashlazy
, module Crypto.Hash.Algorithms
) where
import Basement.Types.OffsetSize (CountOf (..))
import Basement.Block (Block, unsafeFreeze)
import Basement.Block.Mutable (copyFromPtr, new)
import Crypto.Internal.Compat (unsafeDoIO)
import Crypto.Hash.Types
import Crypto.Hash.Algorithms
import Foreign.Ptr (Ptr)
import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import qualified Data.ByteString.Lazy as L
import Data.Word (Word8)
hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a
hash bs = hashFinalize $ hashUpdate hashInit bs
hashlazy :: HashAlgorithm a => L.ByteString -> Digest a
hashlazy lbs = hashFinalize $ hashUpdates hashInit (L.toChunks lbs)
hashInit :: forall a . HashAlgorithm a => Context a
hashInit = Context $ B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr (Context a)) ->
hashInternalInit ptr
hashUpdate :: (ByteArrayAccess ba, HashAlgorithm a) => Context a -> ba -> Context a
hashUpdate ctx b
| B.null b = ctx
| otherwise = hashUpdates ctx [b]
hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba)
=> Context a
-> [ba]
-> Context a
hashUpdates c l
| null ls = c
| otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) ->
mapM_ (\b -> B.withByteArray b $ \d -> hashInternalUpdate ctx d (fromIntegral $ B.length b)) ls
where
ls = filter (not . B.null) l
hashFinalize :: forall a . HashAlgorithm a
=> Context a
-> Digest a
hashFinalize !c =
Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do
((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (Context a)) -> hashInternalFinalize ctx dig
return ()
hashInitWith :: HashAlgorithm alg => alg -> Context alg
hashInitWith _ = hashInit
hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg
hashWith _ = hash
digestFromByteString :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a)
digestFromByteString = from undefined
where
from :: a -> ba -> Maybe (Digest a)
from alg bs
| B.length bs == (hashDigestSize alg) = Just $ Digest $ unsafeDoIO $ copyBytes bs
| otherwise = Nothing
copyBytes :: ba -> IO (Block Word8)
copyBytes ba = do
muArray <- new count
B.withByteArray ba $ \ptr -> copyFromPtr ptr muArray 0 count
unsafeFreeze muArray
where
count = CountOf (B.length ba)