consistently omit clusters when calculating RepoSizes
authorJoey Hess <joeyh@joeyh.name>
Sat, 17 Aug 2024 15:16:21 +0000 (11:16 -0400)
committerJoey Hess <joeyh@joeyh.name>
Sat, 17 Aug 2024 15:24:14 +0000 (11:24 -0400)
updateRepoSize is only called on the UUID of a repository, not any
cluster it might be a node of. But overLocationLogs and overLocationLogsJournal
were inclusing cluster UUIDs. So it was inconsistent.

Currently I don't see any reason to calculate RepoSize for a cluster.
It's not even clear what it should mean, the total size of all nodes, or
the amount of information stored in the cluster in total?

Annex/RepoSize.hs
CmdLine/Seek.hs
Command/Info.hs
Logs/Location.hs

index 5a30321db426ba7443cdcb96f745c620f81c3df9..a75e0440ba086ae572b34762385959cf6ef6fd72 100644 (file)
@@ -85,7 +85,7 @@ calcBranchRepoSizes :: Annex (M.Map UUID RepoSize, Sha)
 calcBranchRepoSizes = do
        knownuuids <- M.keys <$> uuidDescMap
        let startmap = M.fromList $ map (\u -> (u, RepoSize 0)) knownuuids
-       overLocationLogs True startmap accumsizes >>= \case
+       overLocationLogs True True startmap accumsizes >>= \case
                UnmergedBranches v -> return v
                NoUnmergedBranches v -> return v
   where
@@ -100,7 +100,7 @@ calcJournalledRepoSizes
        -> Sha 
        -> Annex (M.Map UUID RepoSize)
 calcJournalledRepoSizes startmap branchsha =
-       overLocationLogsJournal startmap branchsha accumsizes
+       overLocationLogsJournal startmap branchsha accumsizes Nothing
   where
        accumsizes k (newlocs, removedlocs) m = return $
                let m' = foldl' (flip $ M.alter $ addKeyRepoSize k) m newlocs
index f84669501656f5c50961b041a7558369b6b36098..07818dcda5f8d7a9d74376c54eded268a22ec057 100644 (file)
@@ -284,7 +284,7 @@ withKeyOptions' ko auto mkkeyaction fallbackaction worktreeitems = do
                let discard reader = reader >>= \case
                        Nothing -> noop
                        Just _ -> discard reader
-               overLocationLogs' False ()
+               overLocationLogs' False False ()
                        (\reader cont -> checktimelimit (discard reader) cont) 
                        (\k _ () -> keyaction Nothing (SeekInput [], k, mkActionItem k))
                        >>= \case
index 5906fe3b438afc734639d34293d7a7a4ed537f04..1161bec93978dce1e1ab6741d702165c4a0dac02 100644 (file)
@@ -641,7 +641,7 @@ cachedAllRepoData = do
                Just _ -> return s
                Nothing -> do
                        matcher <- lift getKeyOnlyMatcher
-                       r <- lift $ overLocationLogs False (emptyKeyInfo, mempty) $ \k locs (d, rd) -> do
+                       r <- lift $ overLocationLogs False False (emptyKeyInfo, mempty) $ \k locs (d, rd) -> do
                                ifM (matchOnKey matcher k)
                                        ( do
                                                alivelocs <- snd
index 78ad36d60a196d512ed1c581cbea103f9c40f2bb..dad2ddc8082cf83e3d1504e6d32ee8465d49c43d 100644 (file)
@@ -112,7 +112,11 @@ loggedLocationsRef ref = map (toUUID . fromLogInfo) . getLog <$> catObject ref
 
 {- Parses the content of a log file and gets the locations in it. -}
 parseLoggedLocations :: Clusters -> L.ByteString -> [UUID]
-parseLoggedLocations clusters l = addClusterUUIDs clusters $
+parseLoggedLocations clusters =
+       addClusterUUIDs clusters . parseLoggedLocationsWithoutClusters
+
+parseLoggedLocationsWithoutClusters :: L.ByteString -> [UUID]
+parseLoggedLocationsWithoutClusters l =
        map (toUUID . fromLogInfo . info)
                (filterPresent (parseLog l))
 
@@ -226,23 +230,30 @@ loggedKeysFor' u = loggedKeys' isthere
 {- This is much faster than loggedKeys. -}
 overLocationLogs
        :: Bool
+       -> Bool
        -> v
        -> (Key -> [UUID] -> v -> Annex v)
        -> Annex (Annex.Branch.UnmergedBranches (v, Sha))
-overLocationLogs ignorejournal v =
-       overLocationLogs' ignorejournal v (flip const)
+overLocationLogs ignorejournal noclusters v =
+       overLocationLogs' ignorejournal noclusters v (flip const)
 
 overLocationLogs'
        :: Bool
+       -> Bool
        -> v
        -> (Annex (FileContents Key Bool) -> Annex v -> Annex v)
         -> (Key -> [UUID] -> v -> Annex v)
         -> Annex (Annex.Branch.UnmergedBranches (v, Sha))
-overLocationLogs' ignorejournal =
+overLocationLogs' ignorejournal noclusters iv discarder keyaction = do
+       mclusters <- if noclusters then pure Nothing else Just <$> getClusters
        overLocationLogsHelper
                (Annex.Branch.overBranchFileContents ignorejournal)
                (\locparser _ _ content -> pure (locparser (fst <$> content)))
                True
+               iv
+               discarder
+               keyaction
+               mclusters
 
 type LocChanges = 
        ( S.Set UUID
@@ -260,14 +271,16 @@ overLocationLogsJournal
        :: v
        -> Sha
        -> (Key -> LocChanges -> v -> Annex v)
+       -> Maybe Clusters
        -> Annex v
-overLocationLogsJournal v branchsha keyaction = 
+overLocationLogsJournal v branchsha keyaction mclusters 
        overLocationLogsHelper
                (Annex.Branch.overJournalFileContents handlestale)
                changedlocs
                False
                -- ^ do not precache journalled content, which may be stale
                v (flip const) keyaction 
+               mclusters
   where
        handlestale _ journalcontent = return (journalcontent, Just True)
 
@@ -291,12 +304,16 @@ overLocationLogsHelper
        -> v
        -> (Annex (FileContents Key b) -> Annex v -> Annex v)
         -> (Key -> u -> v -> Annex v)
+       -> (Maybe Clusters)
         -> Annex a
-overLocationLogsHelper runner locparserrunner canprecache iv discarder keyaction = do
+overLocationLogsHelper runner locparserrunner canprecache iv discarder keyaction mclusters = do
        config <- Annex.getGitConfig
-       clusters <- getClusters
 
-       let locparser = maybe [] (parseLoggedLocations clusters)
+       let locparser = maybe
+               parseLoggedLocationsWithoutClusters
+               parseLoggedLocations
+               mclusters
+       let locparser' = maybe [] locparser
        let getk = locationLogFileKey config
        let go v reader = reader >>= \case
                Just (k, f, content) -> discarder reader $ do
@@ -307,7 +324,7 @@ overLocationLogsHelper runner locparserrunner canprecache iv discarder keyaction
                        ifM (checkDead k)
                                ( go v reader
                                , do
-                                       !locs <- locparserrunner locparser k f content
+                                       !locs <- locparserrunner locparser' k f content
                                        !v' <- keyaction k locs v
                                        go v' reader
                                )