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
|
{- git-annex transitions log
-
- This is used to record transitions that have been performed on the
- git-annex branch, and when the transition was first started.
-
- We can quickly detect when the local branch has already had an transition
- done that is listed in the remote branch by checking that the local
- branch contains the same transition, with the same or newer start time.
-
- Copyright 2013-2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Logs.Transitions where
import Annex.Common
import Annex.VectorClock
import Logs.Line
import qualified Git
import Git.Types (fromRef)
import Annex.CatFile
import qualified Data.Set as S
import Data.Either
import Data.Char
import Data.ByteString (ByteString)
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy as L
import qualified Data.Attoparsec.ByteString.Lazy as A
import qualified Data.Attoparsec.ByteString.Char8 as A8
transitionsLog :: OsPath
transitionsLog = literalOsPath "transitions.log"
data Transition
= ForgetGitHistory
| ForgetDeadRemotes
deriving (Show, Ord, Eq, Read)
data TransitionLine = TransitionLine
{ transitionStarted :: VectorClock
-- New transitions that we don't know about yet are preserved.
, transition :: Either ByteString Transition
} deriving (Ord, Eq)
type Transitions = S.Set TransitionLine
describeTransition :: Transition -> String
describeTransition ForgetGitHistory = "forget git history"
describeTransition ForgetDeadRemotes = "forget dead remotes"
noTransitions :: Transitions
noTransitions = S.empty
addTransition :: CandidateVectorClock -> Transition -> Transitions -> Transitions
addTransition c t s = S.insert (TransitionLine c' (Right t)) s
where
oldcs = map transitionStarted $
filter (\l -> transition l == Right t) (S.toList s)
c' = advanceVectorClock c oldcs
buildTransitions :: Transitions -> Builder
buildTransitions = mconcat . map genline . S.elems
where
genline tl = buildt (transition tl) <> charUtf8 ' '
<> buildVectorClock (transitionStarted tl) <> charUtf8 '\n'
buildt (Left b) = byteString b
buildt (Right t) = byteString (encodeBS (show t))
parseTransitions :: L.ByteString -> Transitions
parseTransitions = fromMaybe S.empty . A.maybeResult . A.parse
(S.fromList <$> parseLogLines transitionLineParser)
parseTransitionsStrictly :: String -> L.ByteString -> Transitions
parseTransitionsStrictly source b =
let ts = parseTransitions b
in if S.null $ S.filter (isLeft . transition) ts
then ts
else giveup $ "unknown transitions listed in " ++ source ++ "; upgrade git-annex!"
transitionLineParser :: A.Parser TransitionLine
transitionLineParser = do
t <- parsetransition <$> A.takeTill (== sp)
_ <- A8.char ' '
c <- vectorClockParser
return $ TransitionLine c t
where
parsetransition b = case readish (decodeBS b) of
Just t -> Right t
Nothing -> Left b
sp = fromIntegral (ord ' ')
combineTransitions :: [Transitions] -> Transitions
combineTransitions = S.unions
{- Unknown types of transitions are omitted. -}
knownTransitionList :: Transitions -> [Transition]
knownTransitionList = nub . rights . map transition . S.elems
{- Typically ran with Annex.Branch.change, but we can't import Annex.Branch
- here since it depends on this module. -}
recordTransitions :: (OsPath -> (L.ByteString -> Builder) -> Annex ()) -> Transitions -> Annex ()
recordTransitions changer t = changer transitionsLog $
buildTransitions . S.union t . parseTransitionsStrictly "local"
getRefTransitions :: Git.Ref -> Annex Transitions
getRefTransitions ref =
parseTransitionsStrictly (fromRef ref)
<$> catFile ref transitionsLog
|
