{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
module Crypto.Hash
(
Context
, Digest
, digestFromByteString
, hashInitWith
, hashWith
, hashPrefixWith
, hashInit
, hashUpdates
, hashUpdate
, hashFinalize
, hashFinalizePrefix
, hashBlockSize
, hashDigestSize
, hash
, hashPrefix
, 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, plusPtr)
import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import qualified Data.ByteString.Lazy as L
import Data.Word (Word8)
import Data.Int (Int32)
hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a
hash :: forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ba
bs = forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize forall a b. (a -> b) -> a -> b
$ forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate forall a. HashAlgorithm a => Context a
hashInit ba
bs
hashPrefix :: (ByteArrayAccess ba, HashAlgorithmPrefix a) => ba -> Int -> Digest a
hashPrefix :: forall ba a.
(ByteArrayAccess ba, HashAlgorithmPrefix a) =>
ba -> Int -> Digest a
hashPrefix = forall a ba.
(HashAlgorithmPrefix a, ByteArrayAccess ba) =>
Context a -> ba -> Int -> Digest a
hashFinalizePrefix forall a. HashAlgorithm a => Context a
hashInit
hashlazy :: HashAlgorithm a => L.ByteString -> Digest a
hashlazy :: forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy ByteString
lbs = forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize forall a b. (a -> b) -> a -> b
$ forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
hashUpdates forall a. HashAlgorithm a => Context a
hashInit (ByteString -> [ByteString]
L.toChunks ByteString
lbs)
hashInit :: forall a . HashAlgorithm a => Context a
hashInit :: forall a. HashAlgorithm a => Context a
hashInit = forall a. Bytes -> Context a
Context forall a b. (a -> b) -> a -> b
$ forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze (forall a. HashAlgorithm a => a -> Int
hashInternalContextSize (forall a. HasCallStack => a
undefined :: a)) forall a b. (a -> b) -> a -> b
$ \(Ptr (Context a)
ptr :: Ptr (Context a)) ->
forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
hashInternalInit Ptr (Context a)
ptr
hashUpdate :: (ByteArrayAccess ba, HashAlgorithm a) => Context a -> ba -> Context a
hashUpdate :: forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context a
ctx ba
b
| forall a. ByteArrayAccess a => a -> Bool
B.null ba
b = Context a
ctx
| Bool
otherwise = forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
hashUpdates Context a
ctx [ba
b]
hashUpdates :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba)
=> Context a
-> [ba]
-> Context a
hashUpdates :: forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
hashUpdates Context a
c [ba]
l
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ba]
ls = Context a
c
| Bool
otherwise = forall a. Bytes -> Context a
Context forall a b. (a -> b) -> a -> b
$ forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze Context a
c forall a b. (a -> b) -> a -> b
$ \(Ptr (Context a)
ctx :: Ptr (Context a)) ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ba
b -> forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
b (forall {a}.
HashAlgorithm a =>
Ptr (Context a) -> Int -> Ptr Word8 -> IO ()
processBlocks Ptr (Context a)
ctx (forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
b))) [ba]
ls
where
ls :: [ba]
ls = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteArrayAccess a => a -> Bool
B.null) [ba]
l
processBlocks :: Ptr (Context a) -> Int -> Ptr Word8 -> IO ()
processBlocks Ptr (Context a)
ctx Int
bytesLeft Ptr Word8
dataPtr
| Int
bytesLeft forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate Ptr (Context a)
ctx Ptr Word8
dataPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
actuallyProcessed)
Ptr (Context a) -> Int -> Ptr Word8 -> IO ()
processBlocks Ptr (Context a)
ctx (Int
bytesLeft forall a. Num a => a -> a -> a
- Int
actuallyProcessed) (Ptr Word8
dataPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
actuallyProcessed)
where
actuallyProcessed :: Int
actuallyProcessed = forall a. Ord a => a -> a -> a
min Int
bytesLeft (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int32))
hashFinalize :: forall a . HashAlgorithm a
=> Context a
-> Digest a
hashFinalize :: forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize !Context a
c =
forall a. Block Word8 -> Digest a
Digest forall a b. (a -> b) -> a -> b
$ forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze (forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall a. HasCallStack => a
undefined :: a)) forall a b. (a -> b) -> a -> b
$ \(Ptr (Digest a)
dig :: Ptr (Digest a)) -> do
((!Bytes
_) :: B.Bytes) <- forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> IO bs2
B.copy Context a
c forall a b. (a -> b) -> a -> b
$ \(Ptr (Context a)
ctx :: Ptr (Context a)) -> forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr (Digest a) -> IO ()
hashInternalFinalize Ptr (Context a)
ctx Ptr (Digest a)
dig
forall (m :: * -> *) a. Monad m => a -> m a
return ()
hashFinalizePrefix :: forall a ba . (HashAlgorithmPrefix a, ByteArrayAccess ba)
=> Context a
-> ba
-> Int
-> Digest a
hashFinalizePrefix :: forall a ba.
(HashAlgorithmPrefix a, ByteArrayAccess ba) =>
Context a -> ba -> Int -> Digest a
hashFinalizePrefix !Context a
c ba
b Int
len =
forall a. Block Word8 -> Digest a
Digest forall a b. (a -> b) -> a -> b
$ forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze (forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall a. HasCallStack => a
undefined :: a)) forall a b. (a -> b) -> a -> b
$ \(Ptr (Digest a)
dig :: Ptr (Digest a)) -> do
((!Bytes
_) :: B.Bytes) <- forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> IO bs2
B.copy Context a
c forall a b. (a -> b) -> a -> b
$ \(Ptr (Context a)
ctx :: Ptr (Context a)) ->
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
b forall a b. (a -> b) -> a -> b
$ \Ptr Word8
d ->
forall a.
HashAlgorithmPrefix a =>
Ptr (Context a)
-> Ptr Word8 -> Word32 -> Word32 -> Ptr (Digest a) -> IO ()
hashInternalFinalizePrefix Ptr (Context a)
ctx Ptr Word8
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
b) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr (Digest a)
dig
forall (m :: * -> *) a. Monad m => a -> m a
return ()
hashInitWith :: HashAlgorithm alg => alg -> Context alg
hashInitWith :: forall alg. HashAlgorithm alg => alg -> Context alg
hashInitWith alg
_ = forall a. HashAlgorithm a => Context a
hashInit
hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg
hashWith :: forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith alg
_ = forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash
hashPrefixWith :: (ByteArrayAccess ba, HashAlgorithmPrefix alg) => alg -> ba -> Int -> Digest alg
hashPrefixWith :: forall ba alg.
(ByteArrayAccess ba, HashAlgorithmPrefix alg) =>
alg -> ba -> Int -> Digest alg
hashPrefixWith alg
_ = forall ba a.
(ByteArrayAccess ba, HashAlgorithmPrefix a) =>
ba -> Int -> Digest a
hashPrefix
digestFromByteString :: forall a ba . (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a)
digestFromByteString :: forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString = a -> ba -> Maybe (Digest a)
from forall a. HasCallStack => a
undefined
where
from :: a -> ba -> Maybe (Digest a)
from :: a -> ba -> Maybe (Digest a)
from a
alg ba
bs
| forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs forall a. Eq a => a -> a -> Bool
== (forall a. HashAlgorithm a => a -> Int
hashDigestSize a
alg) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Block Word8 -> Digest a
Digest forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ ba -> IO (Block Word8)
copyBytes ba
bs
| Bool
otherwise = forall a. Maybe a
Nothing
copyBytes :: ba -> IO (Block Word8)
copyBytes :: ba -> IO (Block Word8)
copyBytes ba
ba = do
MutableBlock Word8 RealWorld
muArray <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new forall {ty}. CountOf ty
count
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
ba forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
Ptr ty
-> MutableBlock ty (PrimState prim)
-> Offset ty
-> CountOf ty
-> prim ()
copyFromPtr Ptr Word8
ptr MutableBlock Word8 RealWorld
muArray Offset Word8
0 forall {ty}. CountOf ty
count
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock Word8 RealWorld
muArray
where
count :: CountOf ty
count = forall ty. Int -> CountOf ty
CountOf (forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
ba)