merge from git-annex and relicense accordingly

Merge git library and utility from git-annex. The former is now relicensed
AGPL, so git-repair as a whole becomes AGPL.

For simplicity, I am relicensing the remainder of the code in git-repair
AGPL as well, per the header changes in this commit. While that code is
also technically available under the GPL license, as it's been released
under that license before, changes going forward will be only released by
me under the AGPL.

1 files changed, 76 insertions, 0 deletions

diff --git a/Git/HashObject.hs b/Git/HashObject.hs
new file mode 100644
index 0000000..3787c9c
--- /dev/null
+++ b/Git/HashObject.hs
@@ -0,0 +1,76 @@
+{- git hash-object interface
+ -
+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Git.HashObject where
+
+import Common
+import Git
+import Git.Sha
+import Git.Command
+import Git.Types
+import qualified Utility.CoProcess as CoProcess
+import Utility.Tmp
+
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import Data.ByteString.Builder
+
+type HashObjectHandle = CoProcess.CoProcessHandle
+
+hashObjectStart :: Bool -> Repo -> IO HashObjectHandle
+hashObjectStart writeobject = gitCoProcessStart True $ catMaybes
+	[ Just (Param "hash-object")
+	, if writeobject then Just (Param "-w") else Nothing
+	, Just (Param "--stdin-paths")
+	, Just (Param "--no-filters")
+	]
+
+hashObjectStop :: HashObjectHandle -> IO ()
+hashObjectStop = CoProcess.stop
+
+{- Injects a file into git, returning the Sha of the object. -}
+hashFile :: HashObjectHandle -> FilePath -> IO Sha
+hashFile h file = CoProcess.query h send receive
+  where
+	send to = hPutStrLn to =<< absPath file
+	receive from = getSha "hash-object" $ hGetLine from
+
+class HashableBlob t where
+	hashableBlobToHandle :: Handle -> t -> IO ()
+
+instance HashableBlob L.ByteString where
+	hashableBlobToHandle = L.hPut
+
+instance HashableBlob S.ByteString where
+	hashableBlobToHandle = S.hPut
+
+instance HashableBlob Builder where
+	hashableBlobToHandle = hPutBuilder
+
+{- Injects a blob into git. Unfortunately, the current git-hash-object
+ - interface does not allow batch hashing without using temp files. -}
+hashBlob :: HashableBlob b => HashObjectHandle -> b -> IO Sha
+hashBlob h b = withTmpFile "hash" $ \tmp tmph -> do
+	hashableBlobToHandle tmph b
+	hClose tmph
+	hashFile h tmp
+
+{- Injects some content into git, returning its Sha.
+ - 
+ - Avoids using a tmp file, but runs a new hash-object command each
+ - time called. -}
+hashObject :: ObjectType -> String -> Repo -> IO Sha
+hashObject objtype content = hashObject' objtype (flip hPutStr content)
+
+hashObject' :: ObjectType -> (Handle -> IO ()) -> Repo -> IO Sha
+hashObject' objtype writer repo = getSha subcmd $
+	pipeWriteRead (map Param params) (Just writer) repo
+  where
+	subcmd = "hash-object"
+	params = [subcmd, "-t", decodeBS (fmtObjectType objtype), "-w", "--stdin", "--no-filters"]