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