1{- git-annex branch transitions
2 -
3 - Copyright 2013-2021 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Annex.Branch.Transitions (
9	FileTransition(..),
10	getTransitionCalculator,
11	filterBranch,
12) where
13
14import Common
15import Logs
16import Logs.Transitions
17import qualified Logs.UUIDBased as UUIDBased
18import qualified Logs.Presence.Pure as Presence
19import qualified Logs.Chunk.Pure as Chunk
20import qualified Logs.MetaData.Pure as MetaData
21import qualified Logs.Remote.Pure as Remote
22import Types.TrustLevel
23import Types.UUID
24import Types.MetaData
25import Types.Remote
26import Types.GitConfig (GitConfig)
27import Types.ProposedAccepted
28import Annex.SpecialRemote.Config
29
30import qualified Data.Map as M
31import qualified Data.Set as S
32import qualified Data.ByteString.Lazy as L
33import qualified Data.Attoparsec.ByteString.Lazy as A
34import Data.ByteString.Builder
35
36data FileTransition
37	= ChangeFile Builder
38	| PreserveFile
39
40type TransitionCalculator = GitConfig -> RawFilePath -> L.ByteString -> FileTransition
41
42getTransitionCalculator :: Transition -> Maybe (TrustMap -> M.Map UUID RemoteConfig -> TransitionCalculator)
43getTransitionCalculator ForgetGitHistory = Nothing
44getTransitionCalculator ForgetDeadRemotes = Just dropDead
45
46-- Removes data about all dead repos.
47--
48-- The trust log is not changed, because other, unmerged clones
49-- may contain other data about the dead repos. So we need to remember
50-- which are dead to later remove that.
51--
52-- When the remote log contains a sameas-uuid pointing to a dead uuid,
53-- the uuid of that remote configuration is also effectively dead,
54-- though not in the trust log. There may be per-remote state stored using
55-- the latter uuid, that also needs to be removed. The sameas-uuid
56-- is not removed from the remote log, for the same reason the trust log
57-- is not changed.
58dropDead :: TrustMap -> M.Map UUID RemoteConfig -> TransitionCalculator
59dropDead trustmap remoteconfigmap gc f content
60	| f == trustLog = PreserveFile
61	| f == remoteLog = ChangeFile $
62		Remote.buildRemoteConfigLog $
63			M.mapWithKey minimizesameasdead $
64				filterMapLog (notdead trustmap) id $
65					Remote.parseRemoteConfigLog content
66	| otherwise = filterBranch (notdead trustmap') gc f content
67  where
68	notdead m u = M.findWithDefault def u m /= DeadTrusted
69	trustmap' = trustmap `M.union`
70		M.map (const DeadTrusted) (M.filter sameasdead remoteconfigmap)
71	sameasdead cm =
72		case toUUID . fromProposedAccepted <$> M.lookup sameasUUIDField cm of
73			Nothing -> False
74			Just u' -> M.lookup u' trustmap == Just DeadTrusted
75	minimizesameasdead u l
76		| M.lookup u trustmap' == Just DeadTrusted =
77			l { UUIDBased.value = minimizesameasdead' (UUIDBased.value l) }
78		| otherwise = l
79	minimizesameasdead' c = M.restrictKeys c (S.singleton sameasUUIDField)
80
81filterBranch :: (UUID -> Bool) -> TransitionCalculator
82filterBranch wantuuid gc f content = case getLogVariety gc f of
83	Just OldUUIDBasedLog -> ChangeFile $
84		UUIDBased.buildLogOld byteString $
85			filterMapLog wantuuid id $
86				UUIDBased.parseLogOld A.takeByteString content
87	Just NewUUIDBasedLog -> ChangeFile $
88		UUIDBased.buildLogNew byteString $
89			filterMapLog wantuuid id $
90				UUIDBased.parseLogNew A.takeByteString content
91	Just (ChunkLog _) -> ChangeFile $
92		Chunk.buildLog $ filterMapLog wantuuid fst $
93			Chunk.parseLog content
94	Just (LocationLog _) -> ChangeFile $ Presence.buildLog $
95		Presence.compactLog $
96			filterLocationLog wantuuid $
97				Presence.parseLog content
98	Just (UrlLog _) -> PreserveFile
99	Just RemoteMetaDataLog -> ChangeFile $ MetaData.buildLog $
100		filterRemoteMetaDataLog wantuuid $
101			MetaData.simplifyLog $ MetaData.parseLog content
102	Just OtherLog -> PreserveFile
103	Nothing -> PreserveFile
104
105filterMapLog :: (UUID -> Bool) -> (k -> UUID) -> M.Map k v -> M.Map k v
106filterMapLog wantuuid getuuid = M.filterWithKey $ \k _v -> wantuuid (getuuid k)
107
108filterLocationLog :: (UUID -> Bool) -> [Presence.LogLine] -> [Presence.LogLine]
109filterLocationLog wantuuid = filter $
110	wantuuid . toUUID . Presence.fromLogInfo . Presence.info
111
112filterRemoteMetaDataLog :: (UUID -> Bool) -> MetaData.Log MetaData -> MetaData.Log MetaData
113filterRemoteMetaDataLog wantuuid =
114	MetaData.filterOutEmpty . MetaData.filterRemoteMetaData wantuuid
115