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
|
{- git-annex export log (also used to log imports), pure operations
-
- Copyright 2017-2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Logs.Export.Pure (
Exported,
mkExported,
updateExportedTreeish,
updateIncompleteExportedTreeish,
ExportParticipants(..),
ExportChange(..),
exportedTreeishes,
incompleteExportedTreeishes,
parseExportLog,
parseExportLogMap,
buildExportLog,
updateForExportChange,
) where
import Annex.Common
import Annex.VectorClock
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
import Data.ByteString.Builder
-- This constuctor is not itself exported to other modules, to enforce
-- consistent use of exportedTreeishes.
data Exported = Exported
{ exportedTreeish :: Git.Ref
, incompleteExportedTreeish :: [Git.Ref]
}
deriving (Eq, Show)
mkExported :: Git.Ref -> [Git.Ref] -> Exported
mkExported = Exported
updateExportedTreeish :: Exported -> Git.Ref -> Exported
updateExportedTreeish ex t = ex { exportedTreeish = t }
updateIncompleteExportedTreeish :: Exported -> [Git.Ref] -> Exported
updateIncompleteExportedTreeish ex t = ex { incompleteExportedTreeish = t }
-- | Get the list of exported treeishes.
--
-- If the list contains multiple items, there was an export conflict,
-- and different trees were exported to the same special remote.
exportedTreeishes :: [Exported] -> [Git.Ref]
exportedTreeishes = nub . map exportedTreeish
-- | Treeishes that started to be exported, but were not finished.
incompleteExportedTreeishes :: [Exported] -> [Git.Ref]
incompleteExportedTreeishes = concatMap incompleteExportedTreeish
data ExportParticipants = ExportParticipants
{ exportFrom :: UUID
, exportTo :: UUID
}
deriving (Eq, Ord, Show)
data ExportChange = ExportChange
{ oldTreeish :: [Git.Ref]
, newTreeish :: Git.Ref
}
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
buildExportParticipants :: ExportParticipants -> Builder
buildExportParticipants ep =
buildUUID (exportFrom ep) <> sep <> buildUUID (exportTo ep)
where
sep = charUtf8 ':'
exportParticipantsParser :: A.Parser ExportParticipants
exportParticipantsParser = ExportParticipants
<$> (toUUID <$> A8.takeWhile1 (/= ':'))
<* A8.char ':'
<*> (toUUID <$> A8.takeWhile1 (const True))
buildExported :: Exported -> Builder
buildExported exported = go (exportedTreeish exported : incompleteExportedTreeish exported)
where
go [] = mempty
go (r:rs) = rref r <> mconcat [ charUtf8 ' ' <> rref r' | r' <- rs ]
rref = byteString . Git.fromRef'
exportedParser :: A.Parser Exported
exportedParser = Exported <$> refparser <*> many refparser
where
refparser = (Git.Ref <$> A8.takeWhile1 (/= ' ') )
<* ((const () <$> A8.char ' ') <|> A.endOfInput)
-- Used when recording that an export is under way.
-- Any LogEntry 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.
updateForExportChange :: UUID -> ExportChange -> CandidateVectorClock -> UUID -> ExportParticipants -> LogEntry Exported -> LogEntry Exported
updateForExportChange remoteuuid ec c hereuuid ep le@(LogEntry lc exported@(Exported { exportedTreeish = t }))
| hereuuid == exportFrom ep || remoteuuid /= exportTo ep || t `notElem` oldTreeish ec = le
| otherwise = LogEntry c' (exported { exportedTreeish = newTreeish ec })
where
c' = advanceVectorClock c [lc]
|
