support sha256 git repos

Git will eventually switch to sha2 and there will not be one single
shaSize anymore, but two (40 and 64).

Changed all parsers for git plumbing output to support both sizes of
shas.

One potential problem this does not deal with is, if somewhere in
git-annex it reads two shas from different sources, and compares them
to see if they're the same sha, it would fail if they're sha1 and sha256
of the same value. I don't know if that will really be a concern.

Annex/AdjustedBranch.hs

@@ -558,8 +558,8 @@ reverseAdjustedCommit commitparent adj (csha, basiscommit) origbranch
 reverseAdjustedTree :: Sha -> Adjustment -> Sha -> Annex Sha
 reverseAdjustedTree basis adj csha = do
 	(diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha)
-	let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff
-	let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others
+	let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti `elem` nullShas) diff
+	let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti `elem` nullShas) others
 	adds' <- catMaybes <$>
 		mapM (adjustTreeItem reverseadj) (map diffTreeToTreeItem adds)
 	treesha <- Git.Tree.adjustTree

Annex/View.hs

@@ -396,12 +396,12 @@ withViewChanges addmeta removemeta = do
 	void $ liftIO cleanup
   where
 	handleremovals item
-		| DiffTree.srcsha item /= nullSha =
+		| DiffTree.srcsha item `notElem` nullShas =
 			handlechange item removemeta
 				=<< catKey (DiffTree.srcsha item)
 		| otherwise = noop
 	handleadds item
-		| DiffTree.dstsha item /= nullSha = 
+		| DiffTree.dstsha item `notElem` nullShas = 
 			handlechange item addmeta
 				=<< catKey (DiffTree.dstsha item)
 		| otherwise = noop

CHANGELOG

@@ -4,6 +4,7 @@ git-annex (7.20191231) UNRELEASED; urgency=medium
     annex.largefiles configuration (and potentially safer as it avoids
     bugs like the smudge bug fixed in the last release).
   * reinject --known: Fix bug that prevented it from working in a bare repo.
+  * Support being used in a git repository that uses sha256 rather than sha1.
 
  -- Joey Hess <id@joeyh.name>  Wed, 01 Jan 2020 12:51:40 -0400
 

Command/Export.hs

@@ -216,7 +216,7 @@ mkDiffMap old new db = do
 			, (, (Nothing, Just (Git.DiffTree.file i))) <$> dstek
 			]
 	getek sha
-		| sha == nullSha = return Nothing
+		| sha `elem` nullShas = return Nothing
 		| otherwise = Just <$> exportKey sha
 
 newtype FileUploaded = FileUploaded { fromFileUploaded :: Bool }
@@ -310,7 +310,7 @@ cleanupExport r db ek loc sent = do
 
 startUnexport :: Remote -> ExportHandle -> TopFilePath -> [Git.Sha] -> CommandStart
 startUnexport r db f shas = do
-	eks <- forM (filter (/= nullSha) shas) exportKey
+	eks <- forM (filter (`notElem` nullShas) shas) exportKey
 	if null eks
 		then stop
 		else starting ("unexport " ++ name r) (ActionItemOther (Just (fromRawFilePath f'))) $
@@ -359,7 +359,7 @@ cleanupUnexport r db eks loc = do
 
 startRecoverIncomplete :: Remote -> ExportHandle -> Git.Sha -> TopFilePath -> CommandStart
 startRecoverIncomplete r db sha oldf
-	| sha == nullSha = stop
+	| sha `elem` nullShas = stop
 	| otherwise = do
 		ek <- exportKey sha
 		let loc = exportTempName ek

Command/Undo.hs

@@ -58,7 +58,7 @@ perform p = do
 	-- Take two passes through the diff, first doing any removals,
 	-- and then any adds. This order is necessary to handle eg, removing
 	-- a directory and replacing it with a file.
-	let (removals, adds) = partition (\di -> dstsha di == nullSha) diff'
+	let (removals, adds) = partition (\di -> dstsha di `elem` nullShas) diff'
 	let mkrel di = liftIO $ relPathCwdToFile $ fromRawFilePath $
 		fromTopFilePath (file di) g
 

Command/Unused.hs

@@ -267,7 +267,7 @@ withKeysReferencedDiff a getdiff extractsha = do
   where
   	go d = do
 		let sha = extractsha d
-		unless (sha == nullSha) $
+		unless (sha `elem` nullShas) $
 			catKey sha >>= maybe noop a
 
 {- Filters out keys that have an associated file that's not modified. -}

Database/Export.hs

@@ -233,7 +233,7 @@ runExportDiffUpdater updater h old new = do
 	void $ liftIO cleanup
   where
 	getek sha
-		| sha == nullSha = return Nothing
+		| sha `elem` nullShas = return Nothing
 		| otherwise = Just <$> exportKey sha
 
 {- Diff from the old to the new tree and update the ExportTree table. -}

Git/CatFile.hs

@@ -148,13 +148,12 @@ parseResp object l
 	| " missing" `isSuffixOf` l -- less expensive than full check
 		&& l == fromRef object ++ " missing" = Just DNE
 	| otherwise = case words l of
-		[sha, objtype, size]
-			| length sha == shaSize ->
-				case (readObjectType (encodeBS objtype), reads size) of
-					(Just t, [(bytes, "")]) -> 
-						Just $ ParsedResp (Ref sha) bytes t
-					_ -> Nothing
-			| otherwise -> Nothing
+		[sha, objtype, size] -> case extractSha sha of
+			Just sha' -> case (readObjectType (encodeBS objtype), reads size) of
+				(Just t, [(bytes, "")]) -> 
+					Just $ ParsedResp sha' bytes t
+				_ -> Nothing
+			Nothing -> Nothing
 		_ -> Nothing
 
 querySingle :: CommandParam -> Ref -> Repo -> (Handle -> IO a) -> IO (Maybe a)

Git/DiffTree.hs

@@ -119,10 +119,7 @@ parseDiffRaw l = go l
 		readmode = fst . Prelude.head . readOct
 
 		-- info = :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status>
-		-- All fields are fixed, so we can pull them out of
-		-- specific positions in the line.
 		(srcm, past_srcm) = splitAt 7 $ drop 1 info
 		(dstm, past_dstm) = splitAt 7 past_srcm
-		(ssha, past_ssha) = splitAt shaSize past_dstm
-		(dsha, past_dsha) = splitAt shaSize $ drop 1 past_ssha
-		s = drop 1 past_dsha
+		(ssha, past_ssha) = separate (== ' ') past_dstm
+		(dsha, s) = separate (== ' ') past_ssha

Git/DiffTreeItem.hs

@@ -17,8 +17,8 @@ import Git.Types
 data DiffTreeItem = DiffTreeItem
 	{ srcmode :: FileMode
 	, dstmode :: FileMode
-	, srcsha :: Sha -- nullSha if file was added
-	, dstsha :: Sha -- nullSha if file was deleted
+	, srcsha :: Sha -- null sha if file was added
+	, dstsha :: Sha -- null sha if file was deleted
 	, status :: String
 	, file :: TopFilePath
 	} deriving Show

Git/LsFiles.hs

@@ -158,17 +158,20 @@ stagedDetails = stagedDetails' []
 stagedDetails' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedDetails' ps l repo = do
 	(ls, cleanup) <- pipeNullSplit params repo
-	return (map parse ls, cleanup)
+	return (map parseStagedDetails ls, cleanup)
   where
 	params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ 
 		Param "--" : map (File . fromRawFilePath) l
-	parse s
-		| null file = (L.toStrict s, Nothing, Nothing)
-		| otherwise = (toRawFilePath file, extractSha $ take shaSize rest, readmode mode)
-	  where
-		(metadata, file) = separate (== '\t') (decodeBL' s)
-		(mode, rest) = separate (== ' ') metadata
-		readmode = fst <$$> headMaybe . readOct
+
+parseStagedDetails :: L.ByteString -> StagedDetails
+parseStagedDetails s
+	| null file = (L.toStrict s, Nothing, Nothing)
+	| otherwise = (toRawFilePath file, extractSha sha, readmode mode)
+  where
+	(metadata, file) = separate (== '\t') (decodeBL' s)
+	(mode, metadata') = separate (== ' ') metadata
+	(sha, _) = separate (== ' ') metadata'
+	readmode = fst <$$> headMaybe . readOct
 
 {- Returns a list of the files in the specified locations that are staged
  - for commit, and whose type has changed. -}

Git/LsTree.hs

@@ -94,10 +94,10 @@ parserLsTree = TreeItem
 	<$> octal
 	<* A8.char ' '
 	-- type
-	<*> A.takeTill (== 32)
+	<*> A8.takeTill (== ' ')
 	<* A8.char ' '
 	-- sha
-	<*> (Ref . decodeBS' <$> A.take shaSize)
+	<*> (Ref . decodeBS' <$> A8.takeTill (== '\t'))
 	<* A8.char '\t'
 	-- file
 	<*> (asTopFilePath . Git.Filename.decode <$> A.takeByteString)

Git/Sha.hs

@@ -1,6 +1,6 @@
 {- git SHA stuff
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011,2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -21,8 +21,8 @@ getSha subcommand a = maybe bad return =<< extractSha <$> a
  - it, but nothing else. -}
 extractSha :: String -> Maybe Sha
 extractSha s
-	| len == shaSize = val s
-	| len == shaSize + 1 && length s' == shaSize = val s'
+	| len `elem` shaSizes = val s
+	| len - 1 `elem` shaSizes && length s' == len - 1 = val s'
 	| otherwise = Nothing
   where
 	len = length s
@@ -31,13 +31,30 @@ extractSha s
 		| all (`elem` "1234567890ABCDEFabcdef") v = Just $ Ref v
 		| otherwise = Nothing
 
-{- Size of a git sha. -}
-shaSize :: Int
-shaSize = 40
+{- Sizes of git shas. -}
+shaSizes :: [Int]
+shaSizes = 
+	[ 40 -- sha1 (must come first)
+	, 64 -- sha256
+	]
 
-nullSha :: Ref		
-nullSha = Ref $ replicate shaSize '0'
+{- Git plumbing often uses a all 0 sha to represent things like a
+ - deleted file. -}
+nullShas :: [Sha]
+nullShas = map (\n -> Ref (replicate n '0')) shaSizes
 
-{- Git's magic empty tree. -}
+{- Sha to provide to git plumbing when deleting a file.
+ -
+ - It's ok to provide a sha1; git versions that use sha256 will map the
+ - sha1 to the sha256, or probably just treat all null sha1 specially
+ - the same as all null sha256. -}
+deleteSha :: Sha
+deleteSha = Prelude.head nullShas
+
+{- Git's magic empty tree.
+ -
+ - It's ok to provide the sha1 of this to git to refer to an empty tree;
+ - git versions that use sha256 will map the sha1 to the sha256.
+ -}
 emptyTree :: Ref
 emptyTree = Ref "4b825dc642cb6eb9a060e54bf8d69288fbee4904"

Git/UnionMerge.hs

@@ -82,7 +82,7 @@ doMerge hashhandle ch differ repo streamer = do
  - a line suitable for update-index that union merges the two sides of the
  - diff. -}
 mergeFile :: String -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString)
-mergeFile info file hashhandle h = case filter (/= nullSha) [Ref asha, Ref bsha] of
+mergeFile info file hashhandle h = case filter (`notElem` nullShas) [Ref asha, Ref bsha] of
 	[] -> return Nothing
 	(sha:[]) -> use sha
 	shas -> use

Git/UpdateIndex.hs

@@ -108,7 +108,7 @@ unstageFile file repo = do
 unstageFile' :: TopFilePath -> Streamer
 unstageFile' p = pureStreamer $ L.fromStrict $
 	"0 "
-	<> encodeBS' (fromRef nullSha)
+	<> encodeBS' (fromRef deleteSha)
 	<> "\t"
 	<> indexPath p