forget: Preserve currently exported trees

Avoiding problems with exporttree remotes in some unusual circumstances.

This commit was sponsored by Brett Eisenberg on Patreon.
This commit is contained in:
Joey Hess 2021-04-13 15:00:23 -04:00
parent 0bcf155e11
commit 8e7dc958d2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
7 changed files with 36 additions and 8 deletions

View file

@ -43,8 +43,8 @@ import Data.Char
-- | Get what's been exported to a special remote.
getExport :: UUID -> Annex [Exported]
getExport remoteuuid = nub . mapMaybe get . M.toList . simpleMap
. parseExportLog
getExport remoteuuid = nub . mapMaybe get . M.toList
. parseExportLogMap
<$> Annex.Branch.get exportLog
where
get (ep, exported)
@ -61,8 +61,8 @@ recordExportBeginning remoteuuid newtree = do
u <- getUUID
let ep = ExportParticipants { exportFrom = u, exportTo = remoteuuid }
old <- fromMaybe (mkExported emptyTree [])
. M.lookup ep . simpleMap
. parseExportLog
. M.lookup ep
. parseExportLogMap
<$> Annex.Branch.get exportLog
let new = updateIncompleteExportedTreeish old (nub (newtree:incompleteExportedTreeishes [old]))
Annex.Branch.change exportLog $
@ -71,14 +71,14 @@ recordExportBeginning remoteuuid newtree = do
. parseExportLog
recordExportTreeish newtree
-- Grade a tree ref into the git-annex branch. This is done
-- Graft a tree ref into the git-annex branch. This is done
-- to ensure that it's available later, when getting exported files
-- from the remote. Since that could happen in another clone of the
-- repository, the tree has to be kept available, even if it
-- doesn't end up being merged into the master branch.
recordExportTreeish :: Git.Ref -> Annex ()
recordExportTreeish t =
Annex.Branch.rememberTreeish t (asTopFilePath "export.tree")
Annex.Branch.rememberTreeish t (asTopFilePath exportTreeGraftPoint)
-- | Record that an export to a special remote is under way.
--

View file

@ -17,6 +17,7 @@ module Logs.Export.Pure (
exportedTreeishes,
incompleteExportedTreeishes,
parseExportLog,
parseExportLogMap,
buildExportLog,
updateForExportChange,
) where
@ -25,6 +26,7 @@ import Annex.Common
import qualified Git
import Logs.MapLog
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as L
import qualified Data.Attoparsec.ByteString.Lazy as A
import qualified Data.Attoparsec.ByteString.Char8 as A8
@ -72,6 +74,9 @@ data ExportChange = ExportChange
parseExportLog :: L.ByteString -> MapLog ExportParticipants Exported
parseExportLog = parseMapLog exportParticipantsParser exportedParser
parseExportLogMap :: L.ByteString -> M.Map ExportParticipants Exported
parseExportLogMap = simpleMap . parseExportLog
buildExportLog :: MapLog ExportParticipants Exported -> Builder
buildExportLog = buildMapLog buildExportParticipants buildExported