From 9a72785307fa830e48b0a3b0db241b33576a98d3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 7 Mar 2019 14:10:56 -0400
Subject: [PATCH] fixes to export db lookup when accessing importtree=yes

Now in a fresh clone with a importtree=yes remote enabled,
git annex fsck --from the remote works.
---
 Database/Export.hs            | 30 +++++++++++++++---------------
 Remote/Helper/ExportImport.hs | 33 +++++++++++++++++++--------------
 doc/todo/import_tree.mdwn     |  8 +++-----
 3 files changed, 37 insertions(+), 34 deletions(-)

diff --git a/Database/Export.hs b/Database/Export.hs
index cdf384ba39..2905935bff 100644
--- a/Database/Export.hs
+++ b/Database/Export.hs
@@ -19,11 +19,11 @@ module Database.Export (
 	addExportedLocation,
 	removeExportedLocation,
 	getExportedLocation,
-	getExportedKey,
 	isExportDirectoryEmpty,
 	getExportTreeCurrent,
 	recordExportTreeCurrent,
 	getExportTree,
+	getExportTreeKey,
 	addExportTree,
 	removeExportTree,
 	updateExportTree,
@@ -155,20 +155,6 @@ getExportedLocation (ExportHandle h _) k = H.queryDbQueue h $ do
   where
 	ik = toIKey k
 
-{- Get the key that was exported to a location.
- -
- - Note that the database does not currently have an index to make this
- - fast.
- -
- - Note that this does not see recently queued changes.
- -}
-getExportedKey :: ExportHandle -> ExportLocation -> IO [Key]
-getExportedKey (ExportHandle h _) el = H.queryDbQueue h $ do
-	l <- selectList [ExportedFile ==. ef] []
-	return $ map (fromIKey . exportedKey . entityVal) l
-  where
-	ef = toSFilePath (fromExportLocation el)
-
 {- Note that this does not see recently queued changes. -}
 isExportDirectoryEmpty :: ExportHandle -> ExportDirectory -> IO Bool
 isExportDirectoryEmpty (ExportHandle h _) d = H.queryDbQueue h $ do
@@ -185,6 +171,20 @@ getExportTree (ExportHandle h _) k = H.queryDbQueue h $ do
   where
 	ik = toIKey k
 
+{- Get keys that might be currently exported to a location.
+ -
+ - Note that the database does not currently have an index to make this
+ - fast.
+ -
+ - Note that this does not see recently queued changes.
+ -}
+getExportTreeKey :: ExportHandle -> ExportLocation -> IO [Key]
+getExportTreeKey (ExportHandle h _) el = H.queryDbQueue h $ do
+	map (fromIKey . exportTreeKey . entityVal) 
+		<$> selectList [ExportTreeFile ==. ef] []
+  where
+	ef = toSFilePath (fromExportLocation el)
+
 addExportTree :: ExportHandle -> Key -> ExportLocation -> IO ()
 addExportTree h k loc = queueDb h $
 	void $ insertUnique $ ExportTree ik ef
diff --git a/Remote/Helper/ExportImport.hs b/Remote/Helper/ExportImport.hs
index f7faa2c513..5c55f9a1cb 100644
--- a/Remote/Helper/ExportImport.hs
+++ b/Remote/Helper/ExportImport.hs
@@ -135,25 +135,27 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
 	isimport r' exportdbv = do
 		ciddbv <- prepciddb
 
-		let getknowncids db loc = do
-			exportdb <- getexportdb exportdbv
-			ks <- liftIO $ Export.getExportedKey exportdb loc
-			liftIO $ concat
-				<$> mapM (ContentIdentifier.getContentIdentifiers db (uuid r')) ks
-
-		let checkpresent k loc = do
+		let keycids k = do
 			db <- getciddb ciddbv
+			liftIO $ ContentIdentifier.getContentIdentifiers db (uuid r') k
+
+		let checkpresent k loc = 
 			checkPresentExportWithContentIdentifier
 				(importActions r')
-				k loc
-				=<< getknowncids db loc
+				k loc 
+				=<< keycids k
 
 		return $ r'
 			{ exportActions = (exportActions r')
 				{ storeExport = \f k loc p -> do
 					db <- getciddb ciddbv
-					knowncids <- getknowncids db loc
-					storeExportWithContentIdentifier (importActions r') f k loc knowncids p >>= \case
+					exportdb <- getexportdb exportdbv
+					updateexportdb exportdb exportdbv
+					oldks <- liftIO $ Export.getExportTreeKey exportdb loc
+					oldcids <- liftIO $ concat
+						<$> mapM (ContentIdentifier.getContentIdentifiers db (uuid r')) oldks
+					liftIO $ print ("cids", oldcids)
+					storeExportWithContentIdentifier (importActions r') f k loc oldcids p >>= \case
 						Nothing -> return False
 						Just newcid -> do
 							withExclusiveLock gitAnnexContentIdentifierLock $ do
@@ -161,10 +163,9 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
 								liftIO $ ContentIdentifier.flushDbQueue db
 							recordContentIdentifier (uuid r') newcid k
 							return True
-				, removeExport = \k loc -> do
-					db <- getciddb ciddbv
+				, removeExport = \k loc ->
 					removeExportWithContentIdentifier (importActions r') k loc
-						=<< getknowncids db loc
+						=<< keycids k
 				, removeExportDirectory = removeExportDirectoryWhenEmpty (importActions r')
 				-- renameExport is optional, and the
 				-- remote's implementation may
@@ -273,6 +274,10 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
 			Nothing -> ifM (liftIO $ atomically $ tryPutTMVar lcklckv ())
 				( do
 					db <- ContentIdentifier.openDb
+					ContentIdentifier.needsUpdateFromLog db >>= \case
+						Just v -> withExclusiveLock gitAnnexContentIdentifierLock $
+							ContentIdentifier.updateFromLog db v
+						Nothing -> noop
 					liftIO $ atomically $ putTMVar dbtv db
 					return db
 				-- loser waits for winner to open the db and
diff --git a/doc/todo/import_tree.mdwn b/doc/todo/import_tree.mdwn
index 03aaaedf1a..32b2f91dc5 100644
--- a/doc/todo/import_tree.mdwn
+++ b/doc/todo/import_tree.mdwn
@@ -10,14 +10,12 @@ this.
 
 ## implementation notes
 
-* getknowncids needs to update the export db when the git-annex branch is
-  newer, otherwise it can miss the most recent information
-
-  Note that updating the db needs to write lock it.
-
 * Need to support annex-tracking-branch configuration, which documentation
   says makes git-annex sync and assistant do imports.
 
+* git-annex import needs to say when it's downloading files, display
+  progress bars, and support concurrent downloads.
+
 * When on an adjusted unlocked branch, need to import the files unlocked.
   Also, the tracking branch code needs to know about such branches,
   currently it will generate the wrong tracking branch.