1{-# LANGUAGE RankNTypes, BangPatterns #-}
2-- |
3-- Module      : Crypto.Hash.Conduit
4-- License     : BSD-style
5-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
6-- Stability   : experimental
7-- Portability : unknown
8--
9-- A module containing Conduit facilities for hash based functions.
10--
11-- this module is vaguely similar to the crypto-conduit part related to hash
12-- on purpose, as to provide an upgrade path. The api documentation is pulled
13-- directly from this package and adapted, and thus are originally
14-- copyright Felipe Lessa.
15--
16module Crypto.Hash.Conduit
17    ( -- * Cryptographic hash functions
18      sinkHash
19    , hashFile
20    ) where
21
22import Crypto.Hash
23import qualified Data.ByteString as B
24
25import Data.Conduit
26import Data.Conduit.Binary (sourceFile)
27
28import Control.Monad.IO.Class (MonadIO, liftIO)
29import Control.Monad.Trans.Resource (runResourceT)
30
31-- | A 'Sink' that hashes a stream of 'B.ByteString'@s@ and
32-- creates a digest @d@.
33sinkHash :: (Monad m, HashAlgorithm hash) => Consumer B.ByteString m (Digest hash)
34sinkHash = sink hashInit
35  where sink ctx = do
36            b <- await
37            case b of
38                Nothing -> return $! hashFinalize ctx
39                Just bs -> sink $! hashUpdate ctx bs
40
41-- | Hashes the whole contents of the given file in constant
42-- memory.  This function is just a convenient wrapper around
43-- 'sinkHash' defined as:
44--
45-- @
46-- hashFile fp = 'liftIO' $ 'runResourceT' ('sourceFile' fp '$$' 'sinkHash')
47-- @
48hashFile :: (MonadIO m, HashAlgorithm hash) => FilePath -> m (Digest hash)
49hashFile fp = liftIO $ runResourceT (sourceFile fp $$ sinkHash)
50