annex.tune.branchhash1=true bugfix

Fix support for repositories tuned with annex.tune.branchhash1=true,
including --all not working and git-annex log not displaying anything for
annexed files.

Annex/Branch.hs

@@ -577,10 +577,11 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
 	 -}
 	run [] = noop
 	run changers = do
+		config <- Annex.getGitConfig
 		trustmap <- calcTrustMap <$> getStaged trustLog
 		remoteconfigmap <- calcRemoteConfigMap <$> getStaged remoteLog
 		-- partially apply, improves performance
-		let changers' = map (\c -> c trustmap remoteconfigmap) changers
+		let changers' = map (\c -> c config trustmap remoteconfigmap) changers
 		fs <- branchFiles
 		forM_ fs $ \f -> do
 			content <- getStaged f

Annex/Branch/Transitions.hs

@@ -22,6 +22,7 @@ import Types.TrustLevel
 import Types.UUID
 import Types.MetaData
 import Types.Remote
+import Types.GitConfig
 import Types.ProposedAccepted
 import Annex.SpecialRemote.Config
 
@@ -35,7 +36,7 @@ data FileTransition
 	= ChangeFile Builder
 	| PreserveFile
 
-type TransitionCalculator = TrustMap -> M.Map UUID RemoteConfig -> RawFilePath -> L.ByteString -> FileTransition
+type TransitionCalculator = GitConfig -> TrustMap -> M.Map UUID RemoteConfig -> RawFilePath -> L.ByteString -> FileTransition
 
 getTransitionCalculator :: Transition -> Maybe TransitionCalculator
 getTransitionCalculator ForgetGitHistory = Nothing
@@ -54,7 +55,7 @@ getTransitionCalculator ForgetDeadRemotes = Just dropDead
 -- is not removed from the remote log, for the same reason the trust log
 -- is not changed.
 dropDead :: TransitionCalculator
-dropDead trustmap remoteconfigmap f content = case getLogVariety f of
+dropDead config trustmap remoteconfigmap f content = case getLogVariety config f of
 	Just OldUUIDBasedLog
 		| f == trustLog -> PreserveFile
 		| f == remoteLog -> ChangeFile $

CHANGELOG

@@ -9,6 +9,9 @@ git-annex (7.20200205) UNRELEASED; urgency=medium
     be used, to clearly state why.
   * Avoid throwing fatal errors when asked to write to a readonly
     git remote on http.
+  * Fix support for repositories tuned with annex.tune.branchhash1=true,
+    including --all not working and git-annex log not displaying anything
+    for annexed files.
 
  -- Joey Hess <id@joeyh.name>  Fri, 14 Feb 2020 14:12:25 -0400
 

Command/Log.hs

@@ -210,6 +210,7 @@ getAllLog = getGitLog []
 
 getGitLog :: [FilePath] -> [CommandParam] -> Annex ([RefChange], IO Bool)
 getGitLog fs os = do
+	config <- Annex.getGitConfig
 	(ls, cleanup) <- inRepo $ pipeNullSplit $
 		[ Param "log"
 		, Param "-z"
@@ -220,7 +221,7 @@ getGitLog fs os = do
 		[ Param $ Git.fromRef Annex.Branch.fullname
 		, Param "--"
 		] ++ map Param fs
-	return (parseGitRawLog (map decodeBL' ls), cleanup)
+	return (parseGitRawLog config (map decodeBL' ls), cleanup)
 
 -- Parses chunked git log --raw output, which looks something like:
 --
@@ -236,8 +237,8 @@ getGitLog fs os = do
 --
 -- The timestamp is not included before all changelines, so
 -- keep track of the most recently seen timestamp.
-parseGitRawLog :: [String] -> [RefChange]
-parseGitRawLog = parse epoch
+parseGitRawLog :: GitConfig -> [String] -> [RefChange]
+parseGitRawLog config = parse epoch
   where
 	epoch = toEnum 0 :: POSIXTime
 	parse oldts ([]:rest) = parse oldts rest
@@ -250,7 +251,7 @@ parseGitRawLog = parse epoch
 			(tss, cl') -> (parseTimeStamp tss, cl')
 	  	mrc = do
 			(old, new) <- parseRawChangeLine cl
-			key <- locationLogFileKey (toRawFilePath c2)
+			key <- locationLogFileKey config (toRawFilePath c2)
 			return $ RefChange
 				{ changetime = ts
 				, oldref = old

Logs.hs

@@ -1,6 +1,6 @@
 {- git-annex log file names
  -
- - Copyright 2013-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -27,8 +27,8 @@ data LogVariety
 
 {- Converts a path from the git-annex branch into one of the varieties
  - of logs used by git-annex, if it's a known path. -}
-getLogVariety :: RawFilePath -> Maybe LogVariety
-getLogVariety f
+getLogVariety :: GitConfig -> RawFilePath -> Maybe LogVariety
+getLogVariety config f
 	| f `elem` topLevelOldUUIDBasedLogs = Just OldUUIDBasedLog
 	| f `elem` topLevelNewUUIDBasedLogs = Just NewUUIDBasedLog
 	| isRemoteStateLog f = Just NewUUIDBasedLog
@@ -36,7 +36,7 @@ getLogVariety f
 	| isChunkLog f = ChunkLog <$> extLogFileKey chunkLogExt f
 	| isRemoteMetaDataLog f = Just RemoteMetaDataLog
 	| isMetaDataLog f || f `elem` otherLogs = Just OtherLog
-	| otherwise = PresenceLog <$> firstJust (presenceLogs f)
+	| otherwise = PresenceLog <$> firstJust (presenceLogs config f)
 
 {- All the old-format uuid-based logs stored in the top of the git-annex branch. -}
 topLevelOldUUIDBasedLogs :: [RawFilePath]
@@ -61,10 +61,10 @@ topLevelNewUUIDBasedLogs =
 
 
 {- All the ways to get a key from a presence log file -}
-presenceLogs :: RawFilePath -> [Maybe Key]
-presenceLogs f =
+presenceLogs :: GitConfig -> RawFilePath -> [Maybe Key]
+presenceLogs config f =
 	[ urlLogFileKey f
-	, locationLogFileKey f
+	, locationLogFileKey config f
 	]
 
 {- Top-level logs that are neither UUID based nor presence logs. -}
@@ -218,8 +218,17 @@ urlLogFileKey :: RawFilePath -> Maybe Key
 urlLogFileKey = extLogFileKey urlLogExt
 
 {- Converts a pathname into a key if it's a location log. -}
-locationLogFileKey :: RawFilePath -> Maybe Key
-locationLogFileKey path
-	-- Want only xx/yy/foo.log, not .log files in other places.
-	| length (splitDirectories (fromRawFilePath path)) /= 3 = Nothing
+locationLogFileKey :: GitConfig -> RawFilePath -> Maybe Key
+locationLogFileKey config path
+	| length (splitDirectories (fromRawFilePath path)) /= locationLogFileDepth config = Nothing
 	| otherwise = extLogFileKey ".log" path
+
+{- Depth of location log files within the git-annex branch.
+ -
+ - Normally they are xx/yy/key.log so depth 3. 
+ - The same extension is also used for other logs that
+ - are not location logs. -}
+locationLogFileDepth :: GitConfig -> Int
+locationLogFileDepth config = hashlevels + 1
+  where
+        HashLevels hashlevels = branchHashLevels config

Logs/Location.hs

@@ -130,7 +130,9 @@ loggedKeys :: Annex [Unchecked Key]
 loggedKeys = loggedKeys' (not <$$> checkDead)
 
 loggedKeys' :: (Key -> Annex Bool) -> Annex [Unchecked Key]
-loggedKeys' check = mapMaybe (defercheck <$$> locationLogFileKey)
+loggedKeys' check = do
+	config <- Annex.getGitConfig
+	mapMaybe (defercheck <$$> locationLogFileKey config)
 		<$> Annex.Branch.files
   where
 	defercheck k = Unchecked $ ifM (check k)

Upgrade/V2.hs

@@ -67,16 +67,17 @@ upgrade = do
 
 locationLogs :: Annex [(Key, FilePath)]
 locationLogs = do
+	config <- Annex.getGitConfig
 	dir <- fromRepo gitStateDir
 	liftIO $ do
 		levela <- dirContents dir
 		levelb <- mapM tryDirContents levela
 		files <- mapM tryDirContents (concat levelb)
-		return $ mapMaybe islogfile (concat files)
+		return $ mapMaybe (islogfile config) (concat files)
   where
 	tryDirContents d = catchDefaultIO [] $ dirContents d
-	islogfile f = maybe Nothing (\k -> Just (k, f)) $
-			locationLogFileKey (toRawFilePath f)
+	islogfile config f = maybe Nothing (\k -> Just (k, f)) $
+			locationLogFileKey config (toRawFilePath f)
 
 inject :: FilePath -> FilePath -> Annex ()
 inject source dest = do

doc/bugs/git-annex_does_not_operate_on_all_keys_in_tuned_repository_with_annex.tune.branchhash1__61__true.mdwn

@@ -87,3 +87,5 @@ Repository status:
 Of course, I love it! Great project, thanks, Joey!
 
 However, /me always wants more features from it. It's great that git-annex continues to develop.
+
+> [[fixed|done]] --[[Joey]] 

doc/bugs/git-annex_does_not_operate_on_all_keys_in_tuned_repository_with_annex.tune.branchhash1__61__true/comment_1_0e3da1c92dd46e4fc7facd10050fb590._comment

@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2020-02-14T19:01:50Z"
+ content="""
+Indeed this is a bug.  Easy to see why, note that "3":
+
+	locationLogFileKey path
+	        -- Want only xx/yy/foo.log, not .log files in other places.
+	        | length (splitDirectories (fromRawFilePath path)) /= 3 = Nothing
+
+So this also affected some other things that use that. Including `git-annex log`,
+potentially something to do with v2 upgrade (if a v2 repo could be tuned this way?),
+and handling transitions set up by `git annex forget`.
+
+(I also checked if annex.tune.objecthash1 similarly broke stuff that
+enumerated .git/annex/objects, but that was handled ok already.)
+"""]]