{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Crypto.Hash
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Generalized cryptographic hash interface, that you can use with cryptographic hash
-- algorithm that belong to the HashAlgorithm type class.
--
-- > import Crypto.Hash
-- >
-- > sha1 :: ByteString -> Digest SHA1
-- > sha1 = hash
-- >
-- > hexSha3_512 :: ByteString -> String
-- > hexSha3_512 bs = show (hash bs :: Digest SHA3_512)
module Crypto.Hash (
    -- * Types
    Context,
    Digest,

    -- * Functions
    digestFromByteString,

    -- * Hash methods parametrized by algorithm
    hashInitWith,
    hashWith,
    hashPrefixWith,

    -- * Hash methods
    hashInit,
    hashUpdates,
    hashUpdate,
    hashFinalize,
    hashFinalizePrefix,
    hashBlockSize,
    hashDigestSize,
    hash,
    hashPrefix,
    hashlazy,

    -- * Hash algorithms
    module Crypto.Hash.Algorithms,
) where

import Crypto.Hash.Algorithms
import Crypto.Hash.Types
import Crypto.Internal.ByteArray (ByteArrayAccess, allocAndFreezePrim)
import qualified Crypto.Internal.ByteArray as B
import qualified Data.ByteString.Lazy as L
import Data.Int (Int32)
import qualified Foreign.Marshal.Utils as FMU
import Foreign.Ptr (Ptr, castPtr, plusPtr)

-- | Hash a strict bytestring into a digest.
hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a
hash :: forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
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

-- | Hash the first N bytes of a bytestring, with code path independent from N.
hashPrefix
    :: (ByteArrayAccess ba, HashAlgorithmPrefix a) => ba -> Int -> Digest a
hashPrefix :: forall ba a.
(ByteArrayAccess ba, HashAlgorithmPrefix a) =>
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

-- | Hash a lazy bytestring into a digest.
hashlazy :: HashAlgorithm a => L.ByteString -> Digest a
hashlazy :: forall a. HashAlgorithm a => 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 -> [StrictByteString] -> 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 -> [StrictByteString]
L.toChunks ByteString
lbs)

-- | Initialize a new context for this hash algorithm
hashInit :: forall a. HashAlgorithm a => Context a
hashInit :: forall a. HashAlgorithm a => 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

-- | run hashUpdates on one single bytestring and return the updated context.
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
    | 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]

-- | Update the context with a list of strict bytestring,
-- and return a new context with the updates.
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
    | [ba] -> Bool
forall a. [a] -> 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
forall p a. 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
    -- process the data in 2GB chunks to fit in uint32_t and Int on 32 bit systems
    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 a. a -> IO a
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))

-- | Finalize a context and return a digest.
hashFinalize
    :: forall a
     . HashAlgorithm a
    => Context a
    -> Digest a
hashFinalize :: forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize !Context a
c = ByteArray -> Digest a
forall a. ByteArray -> Digest a
Digest (ByteArray -> Digest a) -> ByteArray -> Digest a
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (Digest a) -> IO ()) -> ByteArray
forall p. Int -> (Ptr p -> IO ()) -> ByteArray
allocAndFreezePrim (a -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize (a
forall a. HasCallStack => a
undefined :: a)) ((Ptr (Digest a) -> IO ()) -> ByteArray)
-> (Ptr (Digest a) -> IO ()) -> ByteArray
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Update the context with the first N bytes of a bytestring and return the
-- digest.  The code path is independent from N but much slower than a normal
-- 'hashUpdate'.  The function can be called for the last bytes of a message, in
-- order to exclude a variable padding, without leaking the padding length.  The
-- begining of the message, never impacted by the padding, should preferably go
-- through 'hashUpdate' for better performance.
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 = ByteArray -> Digest a
forall a. ByteArray -> Digest a
Digest (ByteArray -> Digest a) -> ByteArray -> Digest a
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (Digest a) -> IO ()) -> ByteArray
forall p. Int -> (Ptr p -> IO ()) -> ByteArray
allocAndFreezePrim (a -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize (a
forall a. HasCallStack => a
undefined :: a)) ((Ptr (Digest a) -> IO ()) -> ByteArray)
-> (Ptr (Digest a) -> IO ()) -> ByteArray
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
forall p a. 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Initialize a new context for a specified hash algorithm
hashInitWith :: HashAlgorithm alg => alg -> Context alg
hashInitWith :: forall alg. HashAlgorithm alg => alg -> Context alg
hashInitWith alg
_ = Context alg
forall a. HashAlgorithm a => Context a
hashInit

-- | Run the 'hash' function but takes an explicit hash algorithm parameter
hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg
hashWith :: forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith alg
_ = ba -> Digest alg
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash

-- | Run the 'hashPrefix' function but takes an explicit hash algorithm parameter
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
_ = ba -> Int -> Digest alg
forall ba a.
(ByteArrayAccess ba, HashAlgorithmPrefix a) =>
ba -> Int -> Digest a
hashPrefix

-- | Try to transform a bytearray into a Digest of specific algorithm.
--
-- If the digest is not the right size for the algorithm specified, then
-- Nothing is returned.
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 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
$ ByteArray -> Digest a
forall a. ByteArray -> Digest a
Digest (ByteArray -> Digest a) -> ByteArray -> Digest a
forall a b. (a -> b) -> a -> b
$ ba -> ByteArray
forall {ba}. ByteArrayAccess ba => ba -> ByteArray
copyByteArray ba
bs
        | Bool
otherwise = Maybe (Digest a)
forall a. Maybe a
Nothing

    copyByteArray :: ba -> ByteArray
copyByteArray ba
ba = Int -> (Ptr Any -> IO ()) -> ByteArray
forall p. Int -> (Ptr p -> IO ()) -> ByteArray
allocAndFreezePrim (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
ba) ((Ptr Any -> IO ()) -> ByteArray)
-> (Ptr Any -> IO ()) -> ByteArray
forall a b. (a -> b) -> a -> b
$ \Ptr Any
dst ->
        ba -> (Ptr Any -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
ba ((Ptr Any -> IO ()) -> IO ()) -> (Ptr Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Any
src ->
            Ptr Any -> Ptr Any -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
FMU.copyBytes Ptr Any
dst (Ptr Any -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
src) (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
ba)