{- This file is part of monad-hash.
 -
 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Control.Monad.Trans.Hash
    ( -- * Rationale
      --
      -- If your code reads or writes some data in a streaming fashion, i.e. in
      -- chunks, you can use this library to compute a hash of the data
      -- incrementally.  This is good both for constant-memory stream
      -- processing and for clean readable code using monads. My original use
      -- case is the latter, but possibly the former is significant as well (at
      -- the time of writing, I haven't done any profiling to check).
      --
      -- ** Efficient stream processing
      --
      -- One of the common uses of hashes is ensuring integrity. Some data is
      -- published along with its hash, and you can download the data and use
      -- the hash to verify your copy is valid (not corrupt, not tampered
      -- with).
      --
      -- When the data is small, you can serialize it into a ByteString (if you
      -- are sending it) or read it into a bytestring (if you are receiving),
      -- and then apply a hash function. But there is a common case in which
      -- you send large data in chunks, and you want to send a hash of it
      -- afterwards. If you first compute the data to send and only then send
      -- it and compute the hash, you may end up with the entire data in
      -- memory. Instead, you can hash the data /incrementally/, chunk by chunk
      -- in parallel to sending the chunks, and by the time you finish sending
      -- the data, you have a ready final hash you can now send too.
      --
      -- A similar case exists when receiving data: Sometimes you read data
      -- (e.g.  from the network) in chunks, and process it incrementally. If
      -- you applied the hash at once on the entire data, you'd have to keep it
      -- all in memory, while using an incremental approach, you could process
      -- the chunks instantly and release them, therefore using constant
      -- memory.
      --
      -- This library offers a simple monad transformer which fills this role.
      --
      -- If an all-at-once hash function is applied only after you finish
      -- receiving the data, perhaps a smart compiler can apply it
      -- incrementally, and then explicit incremental hashing won't make a
      -- performance difference. But even then, that will work only in the
      -- trivial case where the data to be hashed is streamed in one go. If you
      -- need to send it in several parts and interleave some other actions in
      -- the middle, for example build one message based on a reply for the
      -- previous one, optimizations won't help you, and you'll need
      -- incremental hashing for constant-memory stream processing.
      --
      -- ** Clean readable code
      --
      -- The 'HashT' monad transformer is useful in the same way @StateT@ is:
      -- Instead of passing around the temporary hash context, it's kept for
      -- you in the monad transformer implicitly. You access it only when you
      -- need to, and otherwise your code doesn't have to carry it around
      -- everywhere.
      --
      -- * Supported Hash Algorithms
      --
      -- This library uses the @cryptonite@ package and supports any hash
      -- algorithm implemented there (see "Crypto.Hash.Algorithms").
      --
      -- * The monad transformer
      HashT ()
    , runHashT
    , updateHash
    , updateHashMulti
    )
where

import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Class (MonadTrans)
import Control.Monad.Trans.State
import Crypto.Hash
import Data.ByteArray (ByteArrayAccess)

newtype HashT h m a = HashT
    { unHT :: StateT (Context h) m a
    }
    deriving
        ( -- Base basics
          Functor
        , Applicative
        , Monad
          -- Extra monads from base
        , MonadFix
          -- Transformer basics
        , MonadIO
        , MonadTrans
          -- Exceptions
        , MonadCatch
        , MonadThrow
        , MonadMask
        )

runHashT :: (Monad m, HashAlgorithm h) => HashT h m a -> m (a, Digest h)
runHashT act = do
    let initialContext = hashInit
    (result, finalContext) <- runStateT (unHT act) initialContext
    return (result, hashFinalize finalContext)

updateHash
    :: (Monad m, HashAlgorithm h, ByteArrayAccess ba) => ba -> HashT h m ()
updateHash ba = HashT $ modify $ \ ctx -> hashUpdate ctx ba

updateHashMulti
    :: (Monad m, HashAlgorithm h, ByteArrayAccess ba) => [ba] -> HashT h m ()
updateHashMulti bas = HashT $ modify $ \ ctx -> hashUpdates ctx bas