1{- git hash-object interface 2 - 3 - Copyright 2011-2019 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8{-# LANGUAGE CPP #-} 9 10module Git.HashObject where 11 12import Common 13import Git 14import Git.Sha 15import Git.Command 16import Git.Types 17import qualified Utility.CoProcess as CoProcess 18import Utility.Tmp 19 20import qualified Data.ByteString as S 21import qualified Data.ByteString.Char8 as S8 22import qualified Data.ByteString.Lazy as L 23import Data.ByteString.Builder 24 25type HashObjectHandle = CoProcess.CoProcessHandle 26 27hashObjectStart :: Bool -> Repo -> IO HashObjectHandle 28hashObjectStart writeobject = gitCoProcessStart True $ catMaybes 29 [ Just (Param "hash-object") 30 , if writeobject then Just (Param "-w") else Nothing 31 , Just (Param "--stdin-paths") 32 , Just (Param "--no-filters") 33 ] 34 35hashObjectStop :: HashObjectHandle -> IO () 36hashObjectStop = CoProcess.stop 37 38{- Injects a file into git, returning the Sha of the object. -} 39hashFile :: HashObjectHandle -> RawFilePath -> IO Sha 40hashFile h file = CoProcess.query h send receive 41 where 42 send to = S8.hPutStrLn to =<< absPath file 43 receive from = getSha "hash-object" $ S8.hGetLine from 44 45class HashableBlob t where 46 hashableBlobToHandle :: Handle -> t -> IO () 47 48instance HashableBlob L.ByteString where 49 hashableBlobToHandle = L.hPut 50 51instance HashableBlob S.ByteString where 52 hashableBlobToHandle = S.hPut 53 54instance HashableBlob Builder where 55 hashableBlobToHandle = hPutBuilder 56 57{- Injects a blob into git. Unfortunately, the current git-hash-object 58 - interface does not allow batch hashing without using temp files. -} 59hashBlob :: HashableBlob b => HashObjectHandle -> b -> IO Sha 60hashBlob h b = withTmpFile "hash" $ \tmp tmph -> do 61 hashableBlobToHandle tmph b 62 hClose tmph 63 hashFile h (toRawFilePath tmp) 64 65{- Injects some content into git, returning its Sha. 66 - 67 - Avoids using a tmp file, but runs a new hash-object command each 68 - time called. -} 69hashObject :: ObjectType -> String -> Repo -> IO Sha 70hashObject objtype content = hashObject' objtype (flip hPutStr content) 71 72hashObject' :: ObjectType -> (Handle -> IO ()) -> Repo -> IO Sha 73hashObject' objtype writer repo = getSha subcmd $ 74 pipeWriteRead (map Param params) (Just writer) repo 75 where 76 subcmd = "hash-object" 77 params = [subcmd, "-t", decodeBS (fmtObjectType objtype), "-w", "--stdin", "--no-filters"] 78