{-# LANGUAGE RankNTypes, BangPatterns #-}
-- |
-- Module      : Crypto.Hash.Conduit
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- A module containing Conduit facilities for hash based functions.
--
-- this module is vaguely similar to the crypto-conduit part related to hash
-- on purpose, as to provide an upgrade path. The api documentation is pulled
-- directly from this package and adapted, and thus are originally
-- copyright Felipe Lessa.
--
module Crypto.Hash.Conduit
    ( -- * Cryptographic hash functions
      sinkHash
    , hashFile
    ) where

import Crypto.Hash
import qualified Data.ByteString as B

import Data.Conduit
import Data.Conduit.Binary (sourceFile)

import Control.Monad.IO.Class (MonadIO, liftIO)

-- | A 'Sink' that hashes a stream of 'B.ByteString'@s@ and
-- creates a digest @d@.
sinkHash :: (Monad m, HashAlgorithm hash) => ConduitT B.ByteString o m (Digest hash)
sinkHash :: forall (m :: * -> *) hash o.
(Monad m, HashAlgorithm hash) =>
ConduitT ByteString o m (Digest hash)
sinkHash = Context hash -> ConduitT ByteString o m (Digest hash)
forall {m :: * -> *} {a} {ba} {o}.
(Monad m, HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> ConduitT ba o m (Digest a)
sink Context hash
forall a. HashAlgorithm a => Context a
hashInit
  where sink :: Context a -> ConduitT ba o m (Digest a)
sink Context a
ctx = do
            Maybe ba
b <- ConduitT ba o m (Maybe ba)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
            case Maybe ba
b of
                Maybe ba
Nothing -> Digest a -> ConduitT ba o m (Digest a)
forall a. a -> ConduitT ba o m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Digest a -> ConduitT ba o m (Digest a))
-> Digest a -> ConduitT ba o m (Digest a)
forall a b. (a -> b) -> a -> b
$! Context a -> Digest a
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize Context a
ctx
                Just ba
bs -> Context a -> ConduitT ba o m (Digest a)
sink (Context a -> ConduitT ba o m (Digest a))
-> Context a -> ConduitT ba o m (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
ctx ba
bs

-- | Hashes the whole contents of the given file in constant
-- memory.  This function is just a convenient wrapper around
-- 'sinkHash' defined as:
--
-- @
-- hashFile fp = 'liftIO' $ 'runConduitRes' ('sourceFile' fp '.|' 'sinkHash')
-- @
hashFile :: (MonadIO m, HashAlgorithm hash) => FilePath -> m (Digest hash)
hashFile :: forall (m :: * -> *) hash.
(MonadIO m, HashAlgorithm hash) =>
FilePath -> m (Digest hash)
hashFile FilePath
fp = IO (Digest hash) -> m (Digest hash)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Digest hash) -> m (Digest hash))
-> IO (Digest hash) -> m (Digest hash)
forall a b. (a -> b) -> a -> b
$ ConduitT () Void (ResourceT IO) (Digest hash) -> IO (Digest hash)
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (FilePath -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFile FilePath
fp ConduitT () ByteString (ResourceT IO) ()
-> ConduitT ByteString Void (ResourceT IO) (Digest hash)
-> ConduitT () Void (ResourceT IO) (Digest hash)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT ByteString Void (ResourceT IO) (Digest hash)
forall (m :: * -> *) hash o.
(Monad m, HashAlgorithm hash) =>
ConduitT ByteString o m (Digest hash)
sinkHash)