git.iko.soy/elk
on 83cd588 help sign in
elk/builder/src/File/Hash.hs
110 lines 2.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module File.Hash
3 ( Hasher
4 , put
5 , Digest
6 , toString
7 , putByteString
8 , putBuilder
9 , putFile
10 )
11 where
14import Prelude hiding (appendFile)
15import Control.Monad (foldM)
16import qualified Control.Monad.State as State
17import qualified Data.Binary.Get as Binary
18import qualified Data.ByteString as BS
19import qualified Data.ByteString.Builder as BS
20import qualified Data.ByteString.Builder.Extra as BS (defaultChunkSize)
21import qualified Data.ByteString.Lazy as LBS
22import qualified Data.Digest.Pure.SHA as SHA
23import qualified System.IO as IO
27-- HASHER
30type Hasher = State.StateT State IO ()
33type Digest = SHA.Digest SHA.SHA1State
36put :: FilePath -> Hasher -> IO Digest
37put 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)
44toString :: Digest -> String
45toString =
46 SHA.showDigest
50-- HASH STATE
53data State =
54 State
55 { _handle :: !IO.Handle
56 , _length :: !Int
57 , _decoder :: !(Binary.Decoder SHA.SHA1State)
58 }
62-- PUBLIC API
65putByteString :: BS.ByteString -> Hasher
66putByteString chunk =
67 do state <- State.get
68 State.put =<< State.liftIO (appendByteString state chunk)
71putBuilder :: BS.Builder -> Hasher
72putBuilder builder =
73 do state <- State.get
74 State.put =<< State.liftIO (appendBuilder builder state)
77putFile :: FilePath -> Hasher
78putFile path =
79 do state <- State.get
80 State.put =<< State.liftIO (appendFile path state)
84-- PRIMITIVES
87appendByteString :: State -> BS.ByteString -> IO State
88appendByteString (State handle len decoder) chunk =
89 do BS.hPut handle chunk
90 return $ State handle (len + BS.length chunk) (Binary.pushChunk decoder chunk)
93appendBuilder :: BS.Builder -> State -> IO State
94appendBuilder builder state =
95 foldM appendByteString state $
96 LBS.toChunks (BS.toLazyByteString builder)
99appendFile :: FilePath -> State -> IO State
100appendFile path state =
101 IO.withBinaryFile path IO.ReadMode $ \handle ->
102 appendHelp handle state
105appendHelp :: IO.Handle -> State -> IO State
106appendHelp 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