sim: better step

On each step, find all the actions that could be done, and pick one of them
to do.

Should detect stability, but that is broken.
This commit is contained in:
Joey Hess 2024-09-20 15:21:18 -04:00
parent 31679e3e9f
commit 19b966f0fd
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 74 additions and 59 deletions

View file

@ -237,14 +237,6 @@ data SimAction
deriving (Show, Read) deriving (Show, Read)
runSimCommand :: SimCommand -> GetExistingRepoByName -> SimState SimRepo -> Annex (SimState SimRepo) runSimCommand :: SimCommand -> GetExistingRepoByName -> SimState SimRepo -> Annex (SimState SimRepo)
runSimCommand (CommandStep n) repobyname st
| n > 0 = case randomRepo st of
(Just (repo, u), st') ->
let (act, st'') = randomAction repo u st'
in runSimCommand (CommandAction act) repobyname st''
>>= runSimCommand (CommandStep (pred n)) repobyname
(Nothing, st') -> return st'
| otherwise = return st
runSimCommand cmd repobyname st = runSimCommand cmd repobyname st =
case applySimCommand cmd st repobyname of case applySimCommand cmd st repobyname of
Left err -> giveup err Left err -> giveup err
@ -360,12 +352,13 @@ applySimCommand' (CommandAddMulti n suffix minsz maxsz repos) st repobyname =
file = toRawFilePath (show n ++ suffix) file = toRawFilePath (show n ++ suffix)
in case applySimCommand' (CommandAdd file sz repos) st' repobyname of in case applySimCommand' (CommandAdd file sz repos) st' repobyname of
Left err -> Left err Left err -> Left err
Right (Right st'') -> Right (Right st'') ->
case pred n of case pred n of
0 -> Right (Right st'') 0 -> Right (Right st'')
n' -> applySimCommand' (CommandAddMulti n' suffix minsz maxsz repos) st'' repobyname n' -> applySimCommand' (CommandAddMulti n' suffix minsz maxsz repos) st'' repobyname
Right (Left _) -> error "applySimCommand' CommandAddMulti" Right (Left _) -> error "applySimCommand' CommandAddMulti"
applySimCommand' (CommandStep _) _ _ = error "applySimCommand' CommandStep" applySimCommand' (CommandStep n) st _ =
Right $ Left $ handleStep n n st
applySimCommand' (CommandAction act) st _ = applySimCommand' (CommandAction act) st _ =
case getSimActionComponents act st of case getSimActionComponents act st of
Left err -> Left err Left err -> Left err
@ -373,7 +366,9 @@ applySimCommand' (CommandAction act) st _ =
Right (Left (st', l)) -> Right $ Left $ go l st' Right (Left (st', l)) -> Right $ Left $ go l st'
where where
go [] st' = return st' go [] st' = return st'
go (a:as) st' = a st' >>= go as go (a:as) st' = do
(st'', _) <- a st'
go as st''
applySimCommand' (CommandSeed rngseed) st _ = applySimCommand' (CommandSeed rngseed) st _ =
Right $ Right $ st Right $ Right $ st
{ simRng = rngseed { simRng = rngseed
@ -457,11 +452,51 @@ applySimCommand' (CommandRebalance b) st _ =
} }
applySimCommand' (CommandComment _) st _ = Right $ Right st applySimCommand' (CommandComment _) st _ = Right $ Right st
applySimCommand' CommandBlank st _ = Right $ Right st applySimCommand' CommandBlank st _ = Right $ Right st
handleStep :: Int -> Int -> SimState SimRepo -> Annex (SimState SimRepo)
handleStep startn n st
| n > 0 = do
let (st', actions) = getcomponents [] st $
getactions [] (M.toList (simRepos st))
st'' <- runoneaction actions st'
handleStep startn (pred n) st''
| otherwise = return st
where
getactions c [] = c
getactions c ((repo, u):repos) =
case M.lookup u (simConnections st) of
Nothing -> getactions c repos
Just remotes ->
let c' = map (ActionSync repo)
(S.toList remotes)
in getactions (c'++c) repos
getcomponents c st' [] = (st', concat c)
getcomponents c st' (a:as) = case getSimActionComponents a st' of
Left _ -> getcomponents c st' as
Right (Right st'') -> getcomponents c st'' as
Right (Left (st'', cs)) -> getcomponents (cs:c) st'' as
runoneaction [] st' = do
showLongNote $ UnquotedString $
"Simulation has stabilized after "
++ show (n - startn)
++ " steps."
return st'
runoneaction actions st' = do
let (idx, st'') = simRandom st'
(randomR (0, length actions - 1))
id
let action = actions !! idx
let restactions = take idx actions ++ drop (idx+1) actions
action st'' >>= \case
(st''', False) -> runoneaction restactions st'''
(st''', True) -> return st'''
getSimActionComponents getSimActionComponents
:: SimAction :: SimAction
-> SimState SimRepo -> SimState SimRepo
-> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo)]) (SimState SimRepo)) -> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo, Bool)]) (SimState SimRepo))
getSimActionComponents (ActionGetWanted repo remote) st = getSimActionComponents (ActionGetWanted repo remote) st =
checkKnownRepo repo st $ \u -> checkKnownRepo repo st $ \u ->
let go _remoteu f k _r st' = setPresentKey True u k u $ let go _remoteu f k _r st' = setPresentKey True u k u $
@ -537,7 +572,7 @@ getSimActionComponents (ActionSync repo remote) st =
simActionSequence simActionSequence
:: [SimAction] :: [SimAction]
-> SimState SimRepo -> SimState SimRepo
-> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo)]) (SimState SimRepo)) -> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo, Bool)]) (SimState SimRepo))
simActionSequence [] st = Right (Right st) simActionSequence [] st = Right (Right st)
simActionSequence (a:as) st = case getSimActionComponents a st of simActionSequence (a:as) st = case getSimActionComponents a st of
Left err -> Left err Left err -> Left err
@ -558,7 +593,7 @@ overFilesRemote
-> (Maybe Key -> AssociatedFile -> UUID -> Annex Bool) -> (Maybe Key -> AssociatedFile -> UUID -> Annex Bool)
-> (UUID -> RawFilePath -> Key -> RepoName -> SimState SimRepo -> SimState SimRepo) -> (UUID -> RawFilePath -> Key -> RepoName -> SimState SimRepo -> SimState SimRepo)
-> SimState SimRepo -> SimState SimRepo
-> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo)]) (SimState SimRepo)) -> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo, Bool)]) (SimState SimRepo))
overFilesRemote r u remote remotepred checkwant handlewanted st = overFilesRemote r u remote remotepred checkwant handlewanted st =
checkKnownRemote remote r u st $ \remoteu -> checkKnownRemote remote r u st $ \remoteu ->
Right (Left (st, map (go remoteu) $ M.toList $ simFiles st)) Right (Left (st, map (go remoteu) $ M.toList $ simFiles st))
@ -567,13 +602,13 @@ overFilesRemote r u remote remotepred checkwant handlewanted st =
let af = AssociatedFile $ Just f let af = AssociatedFile $ Just f
in liftIO $ runSimRepo u st' $ \rst -> in liftIO $ runSimRepo u st' $ \rst ->
case M.lookup remoteu (simRepoState st') of case M.lookup remoteu (simRepoState st') of
Nothing -> return st' Nothing -> return (st', False)
Just rmtst Just rmtst
| not (checkremotepred remoteu rst k) -> return st' | not (checkremotepred remoteu rst k) -> return (st', False)
| not (checkremotepred remoteu rmtst k) -> return st' | not (checkremotepred remoteu rmtst k) -> return (st', False)
| otherwise -> ifM (checkwant (Just k) af remoteu) | otherwise -> ifM (checkwant (Just k) af remoteu)
( return $ handlewanted remoteu f k r st' ( return (handlewanted remoteu f k r st', True)
, return st' , return (st', False)
) )
checkremotepred remoteu rst k = checkremotepred remoteu rst k =
remotepred remoteu (getSimLocations rst k) remotepred remoteu (getSimLocations rst k)
@ -607,7 +642,7 @@ simulateDropUnwanted
-> UUID -> UUID
-> RepoName -> RepoName
-> UUID -> UUID
-> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo)]) (SimState SimRepo)) -> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo, Bool)]) (SimState SimRepo))
simulateDropUnwanted st u dropfromname dropfrom = simulateDropUnwanted st u dropfromname dropfrom =
Right $ Left (st, map go $ M.toList $ simFiles st) Right $ Left (st, map go $ M.toList $ simFiles st)
where where
@ -616,10 +651,10 @@ simulateDropUnwanted st u dropfromname dropfrom =
in if present dropfrom rst k in if present dropfrom rst k
then ifM (wantDrop NoLiveUpdate False (Just dropfrom) (Just k) af Nothing) then ifM (wantDrop NoLiveUpdate False (Just dropfrom) (Just k) af Nothing)
( return $ checkdrop rst k f st' ( return $ checkdrop rst k f st'
, return st' , return (st', False)
) )
else return st' else return (st', False)
present ru rst k = ru `S.member` getSimLocations rst k present ru rst k = ru `S.member` getSimLocations rst k
checkdrop rst k f st' = checkdrop rst k f st' =
@ -628,9 +663,9 @@ simulateDropUnwanted st u dropfromname dropfrom =
verifiedcopies = mapMaybe (verifypresent k st') $ verifiedcopies = mapMaybe (verifypresent k st') $
filter (/= dropfrom) $ S.toList $ getSimLocations rst k filter (/= dropfrom) $ S.toList $ getSimLocations rst k
in case safeDropAnalysis numcopies mincopies verifiedcopies Nothing of in case safeDropAnalysis numcopies mincopies verifiedcopies Nothing of
UnsafeDrop -> st' UnsafeDrop -> (st', False)
SafeDrop -> dodrop k f st' SafeDrop -> (dodrop k f st', True)
SafeDropCheckTime -> dodrop k f st' SafeDropCheckTime -> (dodrop k f st', True)
dodrop k f st' = dodrop k f st' =
setPresentKey False dropfrom k u $ setPresentKey False dropfrom k u $
@ -699,29 +734,6 @@ randomRepo st
where where
repolist = M.keys (simRepos st) repolist = M.keys (simRepos st)
randomAction :: RepoName -> UUID -> SimState SimRepo -> (SimAction, SimState SimRepo)
randomAction repo u st = case M.lookup u (simConnections st) of
Just cs | not (S.null cs) ->
let (mkact, st') = simRandom st (randomR (0, length mkactions - 1))
(mkactions !!)
(remote, st'') = simRandom st' (randomR (0, S.size cs - 1))
(`S.elemAt` cs)
in (mkact repo remote, st'')
-- When there are no remotes, this is the only possible action.
_ -> (ActionDropUnwanted repo Nothing, st)
where
mkactions =
[ ActionPull
, ActionPush
, ActionSync
, ActionGetWanted
, \repo' remote -> ActionDropUnwanted repo' (Just remote)
, \repo' _remote -> ActionDropUnwanted repo' Nothing
, ActionSendWanted
, ActionGitPush
, ActionGitPull
]
randomWords :: Int -> StdGen -> ([Word8], StdGen) randomWords :: Int -> StdGen -> ([Word8], StdGen)
randomWords = go [] randomWords = go []
where where
@ -928,23 +940,24 @@ simulatedRepositoryDescription simreponame =
simulationDifferences :: Differences simulationDifferences :: Differences
simulationDifferences = mkDifferences $ S.singleton Simulation simulationDifferences = mkDifferences $ S.singleton Simulation
runSimRepo :: UUID -> SimState SimRepo -> (SimRepoState SimRepo -> Annex (SimState SimRepo)) -> IO (SimState SimRepo) runSimRepo :: UUID -> SimState SimRepo -> (SimRepoState SimRepo -> Annex (SimState SimRepo, t)) -> IO (SimState SimRepo, t)
runSimRepo u st a = do runSimRepo u st a = do
st' <- updateSimRepos st st' <- updateSimRepos st
case M.lookup u (simRepoState st') of case M.lookup u (simRepoState st') of
Just rst -> case simRepo rst of Just rst -> case simRepo rst of
Just sr -> do Just sr -> do
(st'', strd) <- Annex.run (simRepoAnnex sr) $ ((st'', t), strd) <- Annex.run (simRepoAnnex sr) $
doQuietAction (a rst) doQuietAction (a rst)
let sr' = sr let sr' = sr
{ simRepoAnnex = strd { simRepoAnnex = strd
} }
return $ st'' let st''' = st''
{ simRepoState = M.adjust { simRepoState = M.adjust
(\rst' -> rst' { simRepo = Just sr' }) (\rst' -> rst' { simRepo = Just sr' })
u u
(simRepoState st'') (simRepoState st'')
} }
return (st''', t)
Nothing -> error $ "runSimRepo simRepo not set for " ++ fromUUID u Nothing -> error $ "runSimRepo simRepo not set for " ++ fromUUID u
Nothing -> error $ "runSimRepo simRepoState not found for " ++ fromUUID u Nothing -> error $ "runSimRepo simRepoState not found for " ++ fromUUID u

View file

@ -183,8 +183,12 @@ as passed to "git annex sim" while a simulation is running.
Run the simulation forward by this many steps. Run the simulation forward by this many steps.
On each step of the simulation, a simulated repository is selected On each step of the simulation, one file is either transferred
at random, and a random action is performed in it. 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.
* `action repo getwanted remote` * `action repo getwanted remote`

View file

@ -30,6 +30,9 @@ Planned schedule of work:
* Currently working in [[todo/proving_preferred_content_behavior]] * Currently working in [[todo/proving_preferred_content_behavior]]
* bug sim step does not detect stabalization. Seems to keep getting files
that are already in a repo.
* sim: For size balanced preferred content to work, getLiveRepoSizes * sim: For size balanced preferred content to work, getLiveRepoSizes
needs to reflect keys that were added/dropped from the repository by needs to reflect keys that were added/dropped from the repository by
earlier stages of the sim. That is not currently done, because earlier stages of the sim. That is not currently done, because
@ -78,11 +81,6 @@ Planned schedule of work:
clients having direct connections to the nodes, but not the same when clients having direct connections to the nodes, but not the same when
there are more than 2 clients connected to the 2 gateways. there are more than 2 clients connected to the 2 gateways.
* sim: Make an action that considers every action that preferred content
allows to happen, and picks random actions to perform. When there are no
more actions that preferred content allows, the simulation has reached a
stable point and it can stop.
* sim: Detect instability. This can be done by examining the history, * sim: Detect instability. This can be done by examining the history,
if a file is added or removed from the same repository repeatedly, if a file is added or removed from the same repository repeatedly,
there is probably instability, although it may be an instability that there is probably instability, although it may be an instability that