    {-# 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 Basement.Block (Block, unsafeFreeze)
    import Basement.Block.Mutable (copyFromPtr, new)
    import Basement.Types.OffsetSize (CountOf (..))
    import Crypto.Hash.Algorithms
    import Crypto.Hash.Types
    import Crypto.Internal.ByteArray (ByteArrayAccess)
    import qualified Crypto.Internal.ByteArray as B
    import Crypto.Internal.Compat (unsafeDoIO)
    import qualified Data.ByteString.Lazy as L
    import Data.Int (Int32)
    import Data.Word (Word8)
    import Foreign.Ptr (Ptr, 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 =
        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
            ((!_) :: 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
            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 =
        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
            ((!_) :: 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
            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
    $ 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
            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
            B.withByteArray ba $ \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
            unsafeFreeze 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)