    -- |
    -- Module      : Crypto.Hash.SHA1
    -- License     : BSD-style
    -- Maintainer  : Herbert Valerio Riedel <hvr@gnu.org>
    -- Stability   : stable
    -- Portability : unknown
    --
    -- A module containing <https://en.wikipedia.org/wiki/SHA-1 SHA-1> bindings
    --
    module Crypto.Hash.SHA1
        (

        -- * Incremental API
        --
        -- | This API is based on 4 different functions, similar to the
        -- lowlevel operations of a typical hash:
        --
        --  - 'init': create a new hash context
        --  - 'update': update non-destructively a new hash context with a strict bytestring
        --  - 'updates': same as update, except that it takes a list of strict bytestrings
        --  - 'finalize': finalize the context and returns a digest bytestring.
        --
        -- all those operations are completely pure, and instead of
        -- changing the context as usual in others language, it
        -- re-allocates a new context each time.
        --
        -- Example:
        --
        -- > import qualified Data.ByteString
        -- > import qualified Crypto.Hash.SHA1 as SHA1
        -- >
        -- > main = print digest
        -- >   where
        -- >     digest = SHA1.finalize ctx
        -- >     ctx    = foldl SHA1.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ])
        -- >     ctx0   = SHA1.init

          Ctx(..)
        , init     -- :: Ctx
        , update   -- :: Ctx -> ByteString -> Ctx
        , updates  -- :: Ctx -> [ByteString] -> Ctx
        , finalize -- :: Ctx -> ByteString

        -- * Single Pass API
        --
        -- | This API use the incremental API under the hood to provide
        -- the common all-in-one operations to create digests out of a
        -- 'ByteString' and lazy 'L.ByteString'.
        --
        --  - 'hash': create a digest ('init' + 'update' + 'finalize') from a strict 'ByteString'
        --  - 'hashlazy': create a digest ('init' + 'update' + 'finalize') from a lazy 'L.ByteString'
        --
        -- Example:
        --
        -- > import qualified Data.ByteString
        -- > import qualified Crypto.Hash.SHA1 as SHA1
        -- >
        -- > main = print $ SHA1.hash (Data.ByteString.pack [0..255])
        --
        -- __NOTE__: The returned digest is a binary 'ByteString'. For
        -- converting to a base16/hex encoded digest the
        -- <https://hackage.haskell.org/package/base16-bytestring base16-bytestring>
        -- package is recommended.

        , hash     -- :: ByteString -> ByteString
        , hashlazy -- :: L.ByteString -> ByteString

        -- ** HMAC-SHA1
        --
        -- | <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible
        -- <https://en.wikipedia.org/wiki/HMAC HMAC>-SHA1 digests

        , hmac     -- :: ByteString -> ByteString -> ByteString
        , hmaclazy -- :: ByteString -> L.ByteString -> ByteString
        ) where

    import Prelude hiding (init)
    import Foreign.C.Types
    import Foreign.Ptr
    import Foreign.ForeignPtr (withForeignPtr)
    import Foreign.Marshal.Alloc
    import qualified Data.ByteString.Lazy as L
    import qualified Data.ByteString as B
    import Data.ByteString (ByteString)
    import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
    import Data.ByteString.Internal (create, toForeignPtr, memcpy)
    import Data.Bits (xor)
    import Data.Word
    import System.IO.Unsafe (unsafeDupablePerformIO)

    -- | perform IO for hashes that do allocation and ffi.
    -- unsafeDupablePerformIO is used when possible as the
    -- computation is pure and the output is directly linked
    -- to the input. we also do not modify anything after it has
    -- been returned to the user.
    unsafeDoIO :: IO a -> a
    unsafeDoIO = unsafeDupablePerformIO

    -- | SHA-1 Context
    --
    -- The context data is exactly 92 bytes long, however
    -- the data in the context is stored in host-endianness.
    --
    -- The context data is made up of
    --
    --  * a 'Word64' representing the number of bytes already feed to hash algorithm so far,
    --
    --  * a 64-element 'Word8' buffer holding partial input-chunks, and finally
    --
    --  * a 5-element 'Word32' array holding the current work-in-progress digest-value.
    --
    -- Consequently, a SHA-1 digest as produced by 'hash', 'hashlazy', or 'finalize' is 20 bytes long.
    newtype Ctx = Ctx ByteString

    -- keep this synchronised with cbits/sha1.h
    {-# INLINE digestSize #-}
    digestSize :: Int
    digestSize = 20

    {-# INLINE sizeCtx #-}
    sizeCtx :: Int
    sizeCtx = 92

    {-# RULES "digestSize" B.length (finalize init) = digestSize #-}
    {-# RULES "hash" forall b. finalize (update init b) = hash b #-}
    {-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}
    {-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}
    {-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}

    {-# INLINE withByteStringPtr #-}
    withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
    withByteStringPtr b f =
        withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
        where (fptr, off, _) = toForeignPtr b

    copyCtx :: Ptr Ctx -> Ptr Ctx -> IO ()
    copyCtx dst src = memcpy (castPtr dst) (castPtr src) (fromIntegral sizeCtx)

    withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
    withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
      where
        createCtx = create sizeCtx $ \dstPtr ->
                    withByteStringPtr ctxB $ \srcPtr -> do
                        copyCtx (castPtr dstPtr) (castPtr srcPtr)
                        f (castPtr dstPtr)

    withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
    withCtxThrow (Ctx ctxB) f =
        allocaBytes sizeCtx $ \dstPtr ->
        withByteStringPtr ctxB $ \srcPtr -> do
            copyCtx (castPtr dstPtr) (castPtr srcPtr)
            f (castPtr dstPtr)

    withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
    withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)

    withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
    withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)

    foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_init"
        c_sha1_init :: Ptr Ctx -> IO ()

    foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_update"
        c_sha1_update_unsafe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()

    foreign import ccall safe "sha1.h hs_cryptohash_sha1_update"
        c_sha1_update_safe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()

    -- 'safe' call overhead neglible for 8KiB and more
    c_sha1_update :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()
    c_sha1_update pctx pbuf sz
      | sz < 8192 = c_sha1_update_unsafe pctx pbuf sz
      | otherwise  = c_sha1_update_safe   pctx pbuf sz

    foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_finalize"
        c_sha1_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()

    updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
    updateInternalIO ptr d =
        unsafeUseAsCStringLen d (\(cs, len) -> c_sha1_update ptr (castPtr cs) (fromIntegral len))

    finalizeInternalIO :: Ptr Ctx -> IO ByteString
    finalizeInternalIO ptr = create digestSize (c_sha1_finalize ptr)

    {-# NOINLINE init #-}
    -- | create a new hash context
    init :: Ctx
    init = unsafeDoIO $ withCtxNew $ c_sha1_init

    validCtx :: Ctx -> Bool
    validCtx (Ctx b) = B.length b == sizeCtx

    {-# NOINLINE update #-}
    -- | update a context with a bytestring
    update :: Ctx -> ByteString -> Ctx
    update ctx d
      | validCtx ctx = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d
      | otherwise    = error "SHA1.update: invalid Ctx"

    {-# NOINLINE updates #-}
    -- | updates a context with multiple bytestrings
    updates :: Ctx -> [ByteString] -> Ctx
    updates ctx d
      | validCtx ctx = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d
      | otherwise    = error "SHA1.updates: invalid Ctx"

    {-# NOINLINE finalize #-}
    -- | finalize the context into a digest bytestring (20 bytes)
    finalize :: Ctx -> ByteString
    finalize ctx
      | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO
      | otherwise    = error "SHA1.finalize: invalid Ctx"

    {-# NOINLINE hash #-}
    -- | hash a strict bytestring into a digest bytestring (20 bytes)
    hash :: ByteString -> ByteString
    hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do
        c_sha1_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr

    {-# NOINLINE hashlazy #-}
    -- | hash a lazy bytestring into a digest bytestring (20 bytes)
    hashlazy :: L.ByteString -> ByteString
    hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do
        c_sha1_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

    {-# NOINLINE hmac #-}
    -- | Compute 20-byte <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible
    -- HMAC-SHA1 digest for a strict bytestring message
    --
    -- @since 0.11.100.0
    hmac :: ByteString -- ^ secret
         -> ByteString -- ^ message
         -> ByteString
    hmac secret msg = hash $ B.append opad (hash $ B.append ipad msg)
      where
        opad = B.map (xor 0x5c) k'
        ipad = B.map (xor 0x36) k'

        k'  = B.append kt pad
        kt  = if B.length secret > 64 then hash secret else secret
        pad = B.replicate (64 - B.length kt) 0

    {-# NOINLINE hmaclazy #-}
    -- | Compute 20-byte <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible
    -- HMAC-SHA1 digest for a lazy bytestring message
    --
    -- @since 0.11.100.0
    hmaclazy :: ByteString   -- ^ secret
             -> L.ByteString -- ^ message
             -> ByteString
    hmaclazy secret msg = hash $ B.append opad (hashlazy $ L.append ipad msg)
      where
        opad = B.map (xor 0x5c) k'
        ipad = L.fromChunks [B.map (xor 0x36) k']

        k'  = B.append kt pad
        kt  = if B.length secret > 64 then hash secret else secret
        pad = B.replicate (64 - B.length kt) 0