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

@@ -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

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
+				=<< 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

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.