1{- git-annex export log (also used to log imports), pure operations
2 -
3 - Copyright 2017-2020 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE OverloadedStrings #-}
9
10module Logs.Export.Pure (
11	Exported,
12	mkExported,
13	updateExportedTreeish,
14	updateIncompleteExportedTreeish,
15	ExportParticipants(..),
16	ExportChange(..),
17	exportedTreeishes,
18	incompleteExportedTreeishes,
19	parseExportLog,
20	parseExportLogMap,
21	buildExportLog,
22	updateForExportChange,
23) where
24
25import Annex.Common
26import Annex.VectorClock
27import qualified Git
28import Logs.MapLog
29
30import qualified Data.Map as M
31import qualified Data.ByteString.Lazy as L
32import qualified Data.Attoparsec.ByteString.Lazy as A
33import qualified Data.Attoparsec.ByteString.Char8 as A8
34import Data.ByteString.Builder
35
36-- This constuctor is not itself exported to other modules, to enforce
37-- consistent use of exportedTreeishes.
38data Exported = Exported
39	{ exportedTreeish :: Git.Ref
40	, incompleteExportedTreeish :: [Git.Ref]
41	}
42	deriving (Eq, Show)
43
44mkExported :: Git.Ref -> [Git.Ref] -> Exported
45mkExported = Exported
46
47updateExportedTreeish :: Exported -> Git.Ref -> Exported
48updateExportedTreeish ex t = ex { exportedTreeish = t }
49
50updateIncompleteExportedTreeish :: Exported -> [Git.Ref] -> Exported
51updateIncompleteExportedTreeish ex t = ex { incompleteExportedTreeish = t }
52
53-- | Get the list of exported treeishes.
54--
55-- If the list contains multiple items, there was an export conflict,
56-- and different trees were exported to the same special remote.
57exportedTreeishes :: [Exported] -> [Git.Ref]
58exportedTreeishes = nub . map exportedTreeish
59
60-- | Treeishes that started to be exported, but were not finished.
61incompleteExportedTreeishes :: [Exported] -> [Git.Ref]
62incompleteExportedTreeishes = concatMap incompleteExportedTreeish
63
64data ExportParticipants = ExportParticipants
65	{ exportFrom :: UUID
66	, exportTo :: UUID
67	}
68	deriving (Eq, Ord, Show)
69
70data ExportChange = ExportChange
71	{ oldTreeish :: [Git.Ref]
72	, newTreeish :: Git.Ref
73	}
74
75parseExportLog :: L.ByteString -> MapLog ExportParticipants Exported
76parseExportLog = parseMapLog exportParticipantsParser exportedParser
77
78parseExportLogMap :: L.ByteString -> M.Map ExportParticipants Exported
79parseExportLogMap = simpleMap . parseExportLog
80
81buildExportLog :: MapLog ExportParticipants Exported -> Builder
82buildExportLog = buildMapLog buildExportParticipants buildExported
83
84buildExportParticipants :: ExportParticipants -> Builder
85buildExportParticipants ep =
86	buildUUID (exportFrom ep) <> sep <> buildUUID (exportTo ep)
87  where
88	sep = charUtf8 ':'
89
90exportParticipantsParser :: A.Parser ExportParticipants
91exportParticipantsParser = ExportParticipants
92	<$> (toUUID <$> A8.takeWhile1 (/= ':'))
93	<* A8.char ':'
94	<*> (toUUID <$> A8.takeWhile1 (const True))
95
96buildExported :: Exported -> Builder
97buildExported exported = go (exportedTreeish exported : incompleteExportedTreeish exported)
98  where
99	go [] = mempty
100	go (r:rs) = rref r <> mconcat [ charUtf8 ' ' <> rref r' | r' <- rs ]
101	rref = byteString . Git.fromRef'
102
103exportedParser :: A.Parser Exported
104exportedParser = Exported <$> refparser <*> many refparser
105  where
106	refparser = (Git.Ref <$> A8.takeWhile1 (/= ' ') )
107		<* ((const () <$> A8.char ' ') <|> A.endOfInput)
108
109-- Used when recording that an export is under way.
110-- Any LogEntry for the oldTreeish will be updated to the newTreeish.
111-- This way, when multiple repositories are exporting to
112-- the same special remote, there's no conflict as long as they move
113-- forward in lock-step.
114updateForExportChange :: UUID -> ExportChange -> CandidateVectorClock -> UUID -> ExportParticipants -> LogEntry Exported -> LogEntry Exported
115updateForExportChange remoteuuid ec c hereuuid ep le@(LogEntry lc exported@(Exported { exportedTreeish = t }))
116	| hereuuid == exportFrom ep || remoteuuid /= exportTo ep || t `notElem` oldTreeish ec = le
117	| otherwise = LogEntry c' (exported { exportedTreeish = newTreeish ec })
118  where
119	c' = advanceVectorClock c [lc]
120