sim: Fix size tracking for balanced preferred content

diff --git a/Annex/Sim.hs b/Annex/Sim.hs
index 0f76559ba297c31138f469f3a557537af19c606f..988fc2a8258f52b6557f516e16872148d900cd30 100644 (file)
--- a/Annex/Sim.hs
+++ b/Annex/Sim.hs
@@ -40,6 +40,7 @@ import qualified Remote
 import qualified Git.Construct
 import qualified Git.LsFiles
 import qualified Annex.Queue
+import qualified Database.RepoSize
 
 import System.Random
 import Data.Word
@@ -98,6 +99,7 @@ emptySimState rngseed rootdir = SimState
 -- State that can vary between different repos in the simulation.
 data SimRepoState t = SimRepoState
        { simLocations :: M.Map Key (M.Map UUID LocationState)
+       , simLiveSizeChanges :: M.Map UUID SizeOffset
        , simIsSpecialRemote :: Bool
        , simRepo :: Maybe t
        , simRepoName :: RepoName
@@ -126,7 +128,7 @@ setPresentKey present u k stu st = st
        }
 
 setPresentKey' :: Bool -> VectorClock -> UUID -> Key -> SimRepoState t -> SimRepoState t
-setPresentKey' present vc u k rst = rst
+setPresentKey' present vc u k rst = rememberLiveSizeChanges present u k rst $ rst
        { simLocations = 
                M.insertWith (M.unionWith newerLocationState) k
                        (M.singleton u (LocationState vc present))
@@ -613,10 +615,11 @@ overFilesRemote r u remote remotepred localpred checkwant handlewanted st =
                                        | not (checkremotepred remoteu rst k) -> return (st'', False)
                                        | not (checkremotepred remoteu rmtst k) -> return (st'', False)
                                        | not (checklocalpred rst k) -> return (st'', False)
-                                       | otherwise -> ifM (checkwant (Just k) af remoteu)
-                                               ( return (handlewanted remoteu f k r st'', True)
-                                               , return (st'', False)
-                                               )
+                                       | otherwise -> updateLiveSizeChanges rst $
+                                               ifM (checkwant (Just k) af remoteu)
+                                                       ( return (handlewanted remoteu f k r st'', True)
+                                                       , return (st'', False)
+                                                       )
        checkremotepred remoteu rst k =
                remotepred remoteu (getSimLocations rst k)
        checklocalpred rst k =
@@ -634,18 +637,22 @@ simulateGitAnnexMerge src dest st =
                        Just destst -> case M.lookup srcu (simRepoState st) of
                                Nothing -> Left $ "Unable to find simRepoState for " ++ fromRepoName src
                                Just srcst -> Right $ Right $
-                                       let locs = M.unionWith
-                                               (M.unionWith newerLocationState)
-                                               (simLocations destst)
-                                               (simLocations srcst)
-                                           destst' = destst { simLocations = locs }
-                                       in st
-                                               { simRepoState = M.insert destu
-                                                       destst'
-                                                       (simRepoState st)
-                                               }
+                                       simulateGitAnnexMerge' srcst destst destu st
                _ -> Left $ "Unable to find " ++ fromRepoName src ++ " or " ++ fromRepoName dest ++ " in simRepos"
 
+simulateGitAnnexMerge' :: SimRepoState SimRepo -> SimRepoState SimRepo -> UUID -> SimState SimRepo -> SimState SimRepo
+simulateGitAnnexMerge' srcst destst destu st = 
+       let locs = M.unionWith
+               (M.unionWith newerLocationState)
+               (simLocations destst)
+               (simLocations srcst)
+           destst' = calcLiveSizeChanges $ destst
+               { simLocations = locs
+               }
+       in st
+               { simRepoState = M.insert destu destst' (simRepoState st)
+               }
+
 simulateDropUnwanted
        :: SimState SimRepo
        -> UUID
@@ -658,10 +665,11 @@ simulateDropUnwanted st u dropfromname dropfrom =
        go (f, k) st' = liftIO $ runSimRepo u st' $ \st'' rst ->
                let af = AssociatedFile $ Just f
                in if present dropfrom rst k
-                       then ifM (wantDrop NoLiveUpdate False (Just dropfrom) (Just k) af Nothing)
-                               ( return $ checkdrop rst k f st''
-                               , return (st'', False)
-                               )
+                       then updateLiveSizeChanges rst $
+                               ifM (wantDrop NoLiveUpdate False (Just dropfrom) (Just k) af Nothing)
+                                       ( return $ checkdrop rst k f st''
+                                       , return (st'', False)
+                                       )
                        else return (st'', False)
 
        present ru rst k = ru `S.member` getSimLocations rst k
@@ -827,6 +835,7 @@ addRepo reponame simrepo st = st
        u = simRepoConfigUUID simrepo
        rst = SimRepoState
                { simLocations = mempty
+               , simLiveSizeChanges = mempty
                , simIsSpecialRemote = simRepoConfigIsSpecialRemote simrepo
                , simRepo = Nothing
                , simRepoName = reponame
@@ -970,6 +979,59 @@ runSimRepo u st a = do
                        Nothing -> error $ "runSimRepo simRepo not set for " ++ fromUUID u
                Nothing -> error $ "runSimRepo simRepoState not found for " ++ fromUUID u
 
+rememberLiveSizeChanges :: Bool -> UUID -> Key -> SimRepoState t -> SimRepoState t -> SimRepoState t
+rememberLiveSizeChanges present u k oldrst newrst
+       | u `S.member` getSimLocations oldrst k == present = newrst
+       | otherwise = 
+               let m = M.alter go u (simLiveSizeChanges newrst)
+               in newrst { simLiveSizeChanges = m }
+  where
+       ksz = fromMaybe 0 $ fromKey keySize k
+       change
+               | present = SizeOffset ksz
+               | otherwise = SizeOffset (negate ksz)
+
+       go Nothing = Just change
+       go (Just oldoffset) = Just (oldoffset + change)
+
+calcLiveSizeChanges :: SimRepoState t -> SimRepoState t
+calcLiveSizeChanges rst = rst
+       { simLiveSizeChanges = go mempty $ M.toList $ simLocations rst
+       }
+  where
+       go m [] = m
+       go m ((k, locm):rest) = go (go' k m (M.toList locm)) rest
+
+       go' _ m [] = m
+       go' k m ((u, locst):rest) = go' k (M.alter (calc k locst) u m) rest
+
+       calc k (LocationState _ present) msz
+               | not present = msz
+               | otherwise = Just $ fromMaybe (SizeOffset 0) msz + 
+                       SizeOffset (fromMaybe 0 $ fromKey keySize k)
+
+{- Update the RepoSize database in a simulated repository as if LiveUpdate
+ - were done for the simulated changes in keys locations that have occurred
+ - in the simulation up to this point.
+ - 
+ - This relies on the SizeChanges table being a rolling total. When the
+ - simulation is suspended, the location logs get updated with changes
+ - corresponding to the size changes recorded here. When the simulation is
+ - later resumed, the values written here are taken as the start values
+ - for the rolling total, and so getLiveRepoSizes will only see the
+ - difference between that start value and whatever new value is written
+ - here.
+ -
+ - This assumes that the simulation is not interrupted after calling
+ - this, but before it can update the location logs.
+ -}
+updateLiveSizeChanges :: SimRepoState t -> Annex a -> Annex a
+updateLiveSizeChanges rst a = do
+       h <- Database.RepoSize.getRepoSizeHandle
+       liftIO $ Database.RepoSize.setSizeChanges h $
+               M.map fromSizeOffset $ simLiveSizeChanges rst
+       a
+
 updateSimRepoState :: SimState SimRepo -> SimRepo -> IO SimRepo
 updateSimRepoState newst sr = do
        ((), (ast, ard)) <- Annex.run (simRepoAnnex sr) $ doQuietAction $ do

diff --git a/Database/RepoSize.hs b/Database/RepoSize.hs
index 20de270442236d1f74fc7dee1a7012efb5d76e35..25a2aca44a3eeca83ba98460eab98570cbed0f5a 100644 (file)
--- a/Database/RepoSize.hs
+++ b/Database/RepoSize.hs
@@ -33,6 +33,7 @@ module Database.RepoSize (
        removeStaleLiveSizeChanges,
        recordedRepoOffsets,
        liveRepoOffsets,
+       setSizeChanges,
 ) where
 
 import Annex.Common
@@ -311,6 +312,11 @@ setSizeChangeFor u sz =
                (SizeChanges u sz)
                [SizeChangesRollingtotal =. sz]
 
+setSizeChanges :: RepoSizeHandle -> M.Map UUID FileSize -> IO ()
+setSizeChanges (RepoSizeHandle (Just h) _) sizemap = 
+       H.commitDb h $ forM_ (M.toList sizemap) $ uncurry setSizeChangeFor
+setSizeChanges (RepoSizeHandle Nothing _) _ = noop
+
 addRecentChange :: UUID -> Key -> SizeChange -> SqlPersistM ()
 addRecentChange u k sc =
        void $ upsertBy

diff --git a/Types/RepoSize.hs b/Types/RepoSize.hs
index 81b3169d7d6717876410b72a9e5cbe9781b4cdad..35fb3844907637a62bef8f752f2068a9f38aec25 100644 (file)
--- a/Types/RepoSize.hs
+++ b/Types/RepoSize.hs
@@ -29,8 +29,8 @@ newtype MaxSize = MaxSize { fromMaxSize :: Integer }
        deriving (Show, Read, Eq, Ord)
 
 -- An offset to the size of a repo.
-newtype SizeOffset = SizeOffset { fromSizeChange :: Integer }
-       deriving (Show, Eq, Ord, Num)
+newtype SizeOffset = SizeOffset { fromSizeOffset :: Integer }
+       deriving (Show, Read, Eq, Ord, Num)
 
 -- Used when an action is in progress that will change the current size of
 -- a repository.

diff --git a/doc/git-annex-sim.mdwn b/doc/git-annex-sim.mdwn
index 7618bae0139d15c17723998374f03cbae5688643..602a9ff0aaed9e0933c69368bda70d470ed58fcb 100644 (file)
--- a/doc/git-annex-sim.mdwn
+++ b/doc/git-annex-sim.mdwn
@@ -185,11 +185,14 @@ as passed to "git annex sim" while a simulation is running.
 
   On each step of the simulation, one file is either transferred
   or dropped, according to the preferred content and other configuration.
-  
+
   If there are no more files that can be either transferred or dropped
   according to the current configuration, a message will be displayed
   to indicate that the simulation has stabilized.
 
+  (A step also simulates git pull and git push being run in each repository,
+  to all of its remotes. That happens before the file transfer or drop.)
+
 * `action repo getwanted remote`
 
   Simulate the repository getting files it wants from the remote.

diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index 6a53c7c909995deaae86556f19bfce7940086575..7799c01ee4272dca9a167c2909a7d76fedb6aac1 100644 (file)
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -82,16 +82,6 @@ notpresent bar 9testfile
 step 1
 present bar 9testfile
 
-* sim: For size balanced preferred content to work, getLiveRepoSizes
-  needs to reflect keys that were added/dropped from the repository by
-  earlier stages of the sim. That is not currently done, because
-  NoLiveUpdate is used, and the structure of the sim prevents using the
-  usual live update machinery. And live updates are not needed because the
-  sim only ever actually runs one action at a time.
-
-  What could be done is, at each simulated get/drop of a key in a simulated
-  repo, update the SizeChanges table in its database accordingly.
-
 * sim: Can a cluster using size balanced preferred content be simulated?
   May need the sim to get the concept of a cluster gateway, since the
   gateway is what picks amoung the nodes on the basis of size. On the other
@@ -143,6 +133,11 @@ present bar 9testfile
 * sim: Add support for metadata, so preferred content that matches on it
   will work
 
+* The sim cannot be safely interrupted, or two processes be run
+  concurrently. Both unlike other git-annex commands. Either document these
+  limitations, or add locking and make it detect when it was interrupted
+  and re-run the sim from the start to resume.
+
 ## items deferred until later for balanced preferred content and maxsize tracking
 
 * `git-annex assist --rebalance` of `balanced=foo:2`