From 4254e2297db006b912da22ac9776c41ee06be906 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 22 Dec 2020 16:07:53 -0400
Subject: [PATCH] implement retrieveExportWithContentIdentifier

Moved out an XXX to a todo

This seems about ready to merge..
---
 Remote/Borg.hs                           | 34 ++++++++++++++++++------
 doc/todo/borg_sync_tree_not_grafted.mdwn |  5 ++++
 2 files changed, 31 insertions(+), 8 deletions(-)
 create mode 100644 doc/todo/borg_sync_tree_not_grafted.mdwn

diff --git a/Remote/Borg.hs b/Remote/Borg.hs
index 460be074fe..70a01f8ec1 100644
--- a/Remote/Borg.hs
+++ b/Remote/Borg.hs
@@ -17,6 +17,7 @@ import Git.Types (toTreeItemType, TreeItemType(..))
 import Git.FilePath
 import Config
 import Config.Cost
+import Annex.Tmp
 import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.ExportImport
@@ -131,9 +132,6 @@ borgLocal = notElem ':'
 borgArchive :: BorgRepo -> BorgArchiveName -> String
 borgArchive r n = r ++ "::" ++ decodeBS' n
 
--- XXX the tree generated by using this does not seem to get grafted into
--- the git-annex branch, so would be subject to being lost to GC.
--- Is this a general problem affecting importtree too?
 listImportableContentsM :: UUID -> BorgRepo -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
 listImportableContentsM u borgrepo = prompt $ do
 	imported <- getImported u
@@ -172,7 +170,7 @@ listImportableContentsM u borgrepo = prompt $ do
 			-- importable keys, so avoids needing to buffer all
 			-- the rest of the files in memory.
 			in case ThirdPartyPopulated.importKey' loc sz of
-				Just k -> (loc, (borgContentIdentifier, sz))
+				Just _k -> (loc, (borgContentIdentifier, sz))
 					: parsefilelist archivename rest
 				Nothing -> parsefilelist archivename rest
 	parsefilelist _ _ = []
@@ -249,15 +247,12 @@ getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u)
 				)
 			)
 
-retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key
-retrieveExportWithContentIdentifierM borgrepo loc cid dest k p = error "TODO"
-
 -- Check if the file is still there in the borg archive.
 -- Does not check that the content is unchanged; we assume that 
 -- the content of files in borg archives does not change, which is normally
 -- the case. But archives may be deleted, and files may be deleted.
 checkPresentExportWithContentIdentifierM :: BorgRepo -> Key -> ImportLocation -> [ContentIdentifier] -> Annex Bool
-checkPresentExportWithContentIdentifierM borgrepo k loc cids = prompt $ liftIO $ do
+checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
 	let p = proc "borg"
 		[ "list"
 		, "--format"
@@ -298,3 +293,26 @@ checkPresentExportWithContentIdentifierM borgrepo k loc cids = prompt $ liftIO $
 			( return False -- repo exists, content not in it
 			, giveup $ "Unable to access borg repository " ++ borgrepo
 			)
+
+retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key
+retrieveExportWithContentIdentifierM borgrepo loc _ dest mkk _ = do
+	showOutput
+	prompt $ withOtherTmp $ \othertmp -> liftIO $ do
+		-- borgrepo could be relative, and borg has to be run
+		-- in the temp directory to get it to write there
+		absborgrepo <- fromRawFilePath <$> absPath (toRawFilePath borgrepo)
+		let p = proc "borg"
+			[ "extract"
+			, borgArchive absborgrepo archivename
+			, fromRawFilePath archivefile
+			]
+		(Nothing, Nothing, Nothing, pid) <- createProcess $ p
+			{ cwd = Just (fromRawFilePath othertmp) }
+		forceSuccessProcess p pid
+		-- Filepaths in borg archives are relative, so it's ok to
+		-- combine with </>
+		moveFile (fromRawFilePath othertmp </> fromRawFilePath archivefile) dest
+		removeDirectoryRecursive (fromRawFilePath othertmp)
+	mkk
+  where
+	(archivename, archivefile) = extractImportLocation loc
diff --git a/doc/todo/borg_sync_tree_not_grafted.mdwn b/doc/todo/borg_sync_tree_not_grafted.mdwn
new file mode 100644
index 0000000000..a4423706e1
--- /dev/null
+++ b/doc/todo/borg_sync_tree_not_grafted.mdwn
@@ -0,0 +1,5 @@
+The tree generated by git-annex sync with a borg remote 
+does not seem to get grafted into the git-annex branch, so
+would be subject to being lost to GC. 
+
+Is this a general problem affecting importtree too?
-- 
2.30.2