@@ -1,110 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module File.Hash
3− ( Hasher
4− , put
5− , Digest
6− , toString
7− , putByteString
8− , putBuilder
9− , putFile
10− )
11− where
12−
13−
14−import Prelude hiding (appendFile)
15−import Control.Monad (foldM)
16−import qualified Control.Monad.State as State
17−import qualified Data.Binary.Get as Binary
18−import qualified Data.ByteString as BS
19−import qualified Data.ByteString.Builder as BS
20−import qualified Data.ByteString.Builder.Extra as BS (defaultChunkSize)
21−import qualified Data.ByteString.Lazy as LBS
22−import qualified Data.Digest.Pure.SHA as SHA
23−import qualified System.IO as IO
24−
25−
26−
27−-- HASHER
28−
29−
30−type Hasher = State.StateT State IO ()
31−
32−
33−type Digest = SHA.Digest SHA.SHA1State
34−
35−
36−put :: FilePath -> Hasher -> IO Digest
37−put path hasher =
38− IO.withBinaryFile path IO.WriteMode $ \handle ->
39− do let state = State handle 0 SHA.sha1Incremental
40− (State _ len decoder) <- State.execStateT hasher state
41− return (SHA.completeSha1Incremental decoder len)
42−
43−
44−toString :: Digest -> String
45−toString =
46− SHA.showDigest
47−
48−
49−
50−-- HASH STATE
51−
52−
53−data State =
54− State
55− { _handle :: !IO.Handle
56− , _length :: !Int
57− , _decoder :: !(Binary.Decoder SHA.SHA1State)
58− }
59−
60−
61−
62−-- PUBLIC API
63−
64−
65−putByteString :: BS.ByteString -> Hasher
66−putByteString chunk =
67− do state <- State.get
68− State.put =<< State.liftIO (appendByteString state chunk)
69−
70−
71−putBuilder :: BS.Builder -> Hasher
72−putBuilder builder =
73− do state <- State.get
74− State.put =<< State.liftIO (appendBuilder builder state)
75−
76−
77−putFile :: FilePath -> Hasher
78−putFile path =
79− do state <- State.get
80− State.put =<< State.liftIO (appendFile path state)
81−
82−
83−
84−-- PRIMITIVES
85−
86−
87−appendByteString :: State -> BS.ByteString -> IO State
88−appendByteString (State handle len decoder) chunk =
89− do BS.hPut handle chunk
90− return $ State handle (len + BS.length chunk) (Binary.pushChunk decoder chunk)
91−
92−
93−appendBuilder :: BS.Builder -> State -> IO State
94−appendBuilder builder state =
95− foldM appendByteString state $
96− LBS.toChunks (BS.toLazyByteString builder)
97−
98−
99−appendFile :: FilePath -> State -> IO State
100−appendFile path state =
101− IO.withBinaryFile path IO.ReadMode $ \handle ->
102− appendHelp handle state
103−
104−
105−appendHelp :: IO.Handle -> State -> IO State
106−appendHelp handle state =
107− do chunk <- BS.hGet handle BS.defaultChunkSize
108− if BS.null chunk
109− then return state
110− else appendHelp handle =<< appendByteString state chunk