1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
{- git-annex export log
-
- Copyright 2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Logs.Export where
import qualified Data.Map as M
import Annex.Common
import qualified Annex.Branch
import qualified Git
import Git.Sha
import Git.FilePath
import Logs
import Logs.MapLog
import Annex.UUID
data Exported = Exported
{ exportedTreeish :: Git.Ref
, incompleteExportedTreeish :: [Git.Ref]
}
deriving (Eq, Show)
data ExportParticipants = ExportParticipants
{ exportFrom :: UUID
, exportTo :: UUID
}
deriving (Eq, Ord)
data ExportChange = ExportChange
{ oldTreeish :: [Git.Ref]
, newTreeish :: Git.Ref
}
-- | Get what's been exported to a special remote.
--
-- If the list contains multiple items, there was an export conflict,
-- and different trees were exported to the same special remote.
getExport :: UUID -> Annex [Exported]
getExport remoteuuid = nub . mapMaybe get . M.toList . simpleMap
. parseExportLog
<$> Annex.Branch.get exportLog
where
get (ep, exported)
| exportTo ep == remoteuuid = Just exported
| otherwise = Nothing
-- | Record a change in what's exported to a special remote.
--
-- This is called before an export begins uploading new files to the
-- remote, but after it's cleaned up any files that need to be deleted
-- from the old treeish.
--
-- Any entries in the log for the oldTreeish will be updated to the
-- newTreeish. This way, when multiple repositories are exporting to
-- the same special remote, there's no conflict as long as they move
-- forward in lock-step.
--
-- Also, the newTreeish is grafted into the git-annex branch. This is done
-- to ensure that it's available later.
recordExport :: UUID -> ExportChange -> Annex ()
recordExport remoteuuid ec = do
c <- liftIO currentVectorClock
u <- getUUID
let ep = ExportParticipants { exportFrom = u, exportTo = remoteuuid }
let exported = Exported (newTreeish ec) []
Annex.Branch.change exportLog $
showExportLog
. changeMapLog c ep exported
. M.mapWithKey (updateothers c u)
. parseExportLog
where
updateothers c u ep le@(LogEntry _ exported@(Exported { exportedTreeish = t }))
| u == exportFrom ep || remoteuuid /= exportTo ep || t `notElem` oldTreeish ec = le
| otherwise = LogEntry c (exported { exportedTreeish = newTreeish ec })
-- | Record the beginning of an export, to allow cleaning up from
-- interrupted exports.
--
-- This is called before any changes are made to the remote.
recordExportBeginning :: UUID -> Git.Ref -> Annex ()
recordExportBeginning remoteuuid newtree = do
c <- liftIO currentVectorClock
u <- getUUID
let ep = ExportParticipants { exportFrom = u, exportTo = remoteuuid }
old <- fromMaybe (Exported emptyTree [])
. M.lookup ep . simpleMap
. parseExportLog
<$> Annex.Branch.get exportLog
let new = old { incompleteExportedTreeish = nub (newtree:incompleteExportedTreeish old) }
Annex.Branch.change exportLog $
showExportLog
. changeMapLog c ep new
. parseExportLog
Annex.Branch.graftTreeish newtree (asTopFilePath "export.tree")
parseExportLog :: String -> MapLog ExportParticipants Exported
parseExportLog = parseMapLog parseExportParticipants parseExported
showExportLog :: MapLog ExportParticipants Exported -> String
showExportLog = showMapLog formatExportParticipants formatExported
formatExportParticipants :: ExportParticipants -> String
formatExportParticipants ep =
fromUUID (exportFrom ep) ++ ':' : fromUUID (exportTo ep)
parseExportParticipants :: String -> Maybe ExportParticipants
parseExportParticipants s = case separate (== ':') s of
("",_) -> Nothing
(_,"") -> Nothing
(f,t) -> Just $ ExportParticipants
{ exportFrom = toUUID f
, exportTo = toUUID t
}
formatExported :: Exported -> String
formatExported exported = unwords $ map Git.fromRef $
exportedTreeish exported : incompleteExportedTreeish exported
parseExported :: String -> Maybe Exported
parseExported s = case words s of
(et:it) -> Just $ Exported (Git.Ref et) (map Git.Ref it)
_ -> Nothing
|
