{- git-annex export log (also used to log imports), pure operations - - Copyright 2017-2020 Joey Hess - - 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 constructor 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]