    -- |
    -- 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)
    --
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE BangPatterns        #-}
    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.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 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 -> [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)

    -- | 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
            ((!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 =
        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
    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
    $ 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
    forall p a. 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)