From ce48eb797c81638fa73e14e26114cd38d8e8998b Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 15 Oct 2019 11:33:33 -0400
Subject: [PATCH] make DropDead transition minimize remote.log for dead sameas
 remotes

All that needs to be retained in remote.log is the sameas-uuid.
The rest of the config is eliminated. This doesn't save enough space to
bother with, but it prevents anything sensitive in the config of the
dead sameas remote from lingering around.

Note that minimizesameasdead does not update the VectorClock when
changing the log line. That's normally a no-no, but in this case,
it makes each DropDead result in the exact same file contents,
and vector clocks are not needed because the transition breaks
the history chain.
---
 Annex/Branch/Transitions.hs | 26 +++++++++++++++++---------
 Logs/Remote.hs              |  5 ++---
 Logs/Remote/Pure.hs         | 12 ++++++++++--
 3 files changed, 29 insertions(+), 14 deletions(-)

diff --git a/Annex/Branch/Transitions.hs b/Annex/Branch/Transitions.hs
index 5e57f999d5..1ed2e4d505 100644
--- a/Annex/Branch/Transitions.hs
+++ b/Annex/Branch/Transitions.hs
@@ -17,6 +17,7 @@ import qualified Logs.UUIDBased as UUIDBased
 import qualified Logs.Presence.Pure as Presence
 import qualified Logs.Chunk.Pure as Chunk
 import qualified Logs.MetaData.Pure as MetaData
+import qualified Logs.Remote.Pure as Remote
 import Types.TrustLevel
 import Types.UUID
 import Types.MetaData
@@ -24,6 +25,7 @@ import Types.Remote
 import Annex.SpecialRemote.Config
 
 import qualified Data.Map as M
+import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Attoparsec.ByteString.Lazy as A
 import Data.ByteString.Builder
@@ -47,21 +49,22 @@ getTransitionCalculator ForgetDeadRemotes = Just dropDead
 -- When the remote log contains a sameas-uuid pointing to a dead uuid,
 -- the uuid of that remote configuration is also effectively dead,
 -- though not in the trust log. There may be per-remote state stored using
--- the latter uuid, that also needs to be removed. That configuration
+-- the latter uuid, that also needs to be removed. The sameas-uuid
 -- is not removed from the remote log, for the same reason the trust log
 -- is not changed.
 dropDead :: TransitionCalculator
 dropDead trustmap remoteconfigmap f content = case getLogVariety f of
 	Just OldUUIDBasedLog
 		| f == trustLog -> PreserveFile
-		| otherwise ->
-			let go tm = ChangeFile $
-				UUIDBased.buildLogOld byteString $
-					dropDeadFromMapLog tm id $
-						UUIDBased.parseLogOld A.takeByteString content
-			in if f == remoteLog
-				then go trustmap
-				else go trustmap'
+		| f == remoteLog -> ChangeFile $
+			Remote.buildRemoteConfigLog $
+				M.mapWithKey minimizesameasdead $
+					dropDeadFromMapLog trustmap id $
+						Remote.parseRemoteConfigLog content
+		| otherwise -> ChangeFile $
+			UUIDBased.buildLogOld byteString $
+				dropDeadFromMapLog trustmap' id $
+					UUIDBased.parseLogOld A.takeByteString content
 	Just NewUUIDBasedLog -> ChangeFile $
 		UUIDBased.buildLogNew byteString $
 			dropDeadFromMapLog trustmap' id $
@@ -85,6 +88,11 @@ dropDead trustmap remoteconfigmap f content = case getLogVariety f of
 		case toUUID <$> M.lookup sameasUUIDField cm of
 			Nothing -> False
 			Just u' -> M.lookup u' trustmap == Just DeadTrusted
+	minimizesameasdead u l
+		| M.lookup u trustmap' == Just DeadTrusted =
+			l { UUIDBased.value = minimizesameasdead' (UUIDBased.value l) }
+		| otherwise = l
+	minimizesameasdead' c = M.restrictKeys c (S.singleton sameasUUIDField)
 
 dropDeadFromMapLog :: TrustMap -> (k -> UUID) -> M.Map k v -> M.Map k v
 dropDeadFromMapLog trustmap getuuid =
diff --git a/Logs/Remote.hs b/Logs/Remote.hs
index 02350dbb83..f747b51469 100644
--- a/Logs/Remote.hs
+++ b/Logs/Remote.hs
@@ -26,16 +26,15 @@ import Logs.Remote.Pure
 import Annex.SpecialRemote.Config
 
 import qualified Data.Map as M
-import Data.ByteString.Builder
 
 {- Adds or updates a remote's config in the log. -}
 configSet :: UUID -> RemoteConfig -> Annex ()
 configSet u cfg = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change remoteLog $
-		buildLogOld (byteString . encodeBS . showConfig)
+		buildRemoteConfigLog
 			. changeLog c u (removeSameasInherited cfg)
-			. parseLogOld remoteConfigParser
+			. parseRemoteConfigLog
 
 {- Map of remotes by uuid containing key/value config maps. -}
 readRemoteLog :: Annex (M.Map UUID RemoteConfig)
diff --git a/Logs/Remote/Pure.hs b/Logs/Remote/Pure.hs
index 0c405b9795..e855d87200 100644
--- a/Logs/Remote/Pure.hs
+++ b/Logs/Remote/Pure.hs
@@ -7,10 +7,11 @@
 
 module Logs.Remote.Pure (
 	calcRemoteConfigMap,
+	parseRemoteConfigLog,
+	buildRemoteConfigLog,
         keyValToConfig,
         configToKeyVal,
         showConfig,
-	remoteConfigParser,
 
         prop_isomorphic_configEscape,
         prop_parse_show_Config,
@@ -25,11 +26,18 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 import Data.Char
 import qualified Data.Attoparsec.ByteString.Lazy as A
+import Data.ByteString.Builder
 
 calcRemoteConfigMap :: L.ByteString -> M.Map UUID RemoteConfig
 calcRemoteConfigMap = (\m -> M.map (addSameasInherited m) m)
 	. simpleMap
-	. parseLogOld remoteConfigParser
+	. parseRemoteConfigLog
+
+parseRemoteConfigLog :: L.ByteString -> Log RemoteConfig
+parseRemoteConfigLog = parseLogOld remoteConfigParser
+
+buildRemoteConfigLog :: Log RemoteConfig -> Builder
+buildRemoteConfigLog = buildLogOld (byteString . encodeBS . showConfig)
 
 remoteConfigParser :: A.Parser RemoteConfig
 remoteConfigParser = keyValToConfig . words . decodeBS <$> A.takeByteString