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