{- This file is part of monad-hash. - - Written in 2016 by fr33domlover . - - ♡ 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 - . -} {-# 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