mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

sim concurrency

Browse source
This commit is contained in:
Joey Hess 2024-09-17 09:33:55 -04:00
parent 3b7e3cb2f4
commit 7d27a8ea1a
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 191 additions and 140 deletions
Download patch file Download diff file Expand all files Collapse all files

213
Annex/Sim.hs
View file

@ -200,7 +200,7 @@ data SimCommand
| CommandAddTree RepoName PreferredContentExpression | CommandAddTree RepoName PreferredContentExpression
| CommandAdd RawFilePath ByteSize [RepoName] | CommandAdd RawFilePath ByteSize [RepoName]
| CommandStep Int | CommandStep Int
| CommandAction RepoName SimAction | CommandAction SimAction
| CommandSeed Int | CommandSeed Int
| CommandPresent RepoName RawFilePath | CommandPresent RepoName RawFilePath
| CommandNotPresent RepoName RawFilePath | CommandNotPresent RepoName RawFilePath
@ -219,44 +219,45 @@ data SimCommand
deriving (Show, Read) deriving (Show, Read)
data SimAction data SimAction
= ActionPull RemoteName = ActionPull RepoName RemoteName
| ActionPush RemoteName | ActionPush RepoName RemoteName
| ActionSync RemoteName | ActionSync RepoName RemoteName
| ActionGetWanted RemoteName | ActionGetWanted RepoName RemoteName
| ActionDropUnwanted (Maybe RemoteName) | ActionDropUnwanted RepoName (Maybe RemoteName)
| ActionSendWanted RemoteName | ActionSendWanted RepoName RemoteName
| ActionGitPush RemoteName | ActionGitPush RepoName RemoteName
| ActionGitPull RemoteName | ActionGitPull RepoName RemoteName
| ActionWhile SimAction 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 runSimCommand (CommandStep n) repobyname st
| n > 0 = case randomRepo st of | n > 0 = case randomRepo st of
(Just (repo, u), st') -> (Just (repo, u), st') ->
let (act, st'') = randomAction u st' let (act, st'') = randomAction repo u st'
in runSimCommand (CommandAction repo act) repobyname st'' in runSimCommand (CommandAction act) repobyname st''
>>= runSimCommand (CommandStep (pred n)) repobyname >>= runSimCommand (CommandStep (pred n)) repobyname
(Nothing, st') -> return st' (Nothing, st') -> return st'
| otherwise = return st | otherwise = return st
runSimCommand (CommandAction reponame (ActionPull remote)) repobyname st = runSimCommand (CommandAction (ActionPull repo remote)) repobyname st =
runCompoundSimAction repobyname runCompoundSimAction repobyname
[ CommandAction reponame (ActionGitPull remote) [ CommandAction (ActionGitPull repo remote)
, CommandAction reponame (ActionGetWanted remote) , CommandAction (ActionGetWanted repo remote)
, CommandAction reponame (ActionDropUnwanted Nothing) , CommandAction (ActionDropUnwanted repo Nothing)
] st ] st
runSimCommand (CommandAction reponame (ActionPush remote)) repobyname st = runSimCommand (CommandAction (ActionPush repo remote)) repobyname st =
runCompoundSimAction repobyname runCompoundSimAction repobyname
[ CommandAction reponame (ActionSendWanted remote) [ CommandAction (ActionSendWanted repo remote)
, CommandAction reponame (ActionDropUnwanted (Just remote)) , CommandAction (ActionDropUnwanted repo (Just remote))
, CommandAction reponame (ActionGitPush remote) , CommandAction (ActionGitPush repo remote)
] st ] st
runSimCommand (CommandAction reponame (ActionSync remote)) repobyname st = runSimCommand (CommandAction (ActionSync repo remote)) repobyname st =
runCompoundSimAction repobyname runCompoundSimAction repobyname
[ CommandAction reponame (ActionGitPull remote) [ CommandAction (ActionGitPull repo remote)
, CommandAction reponame (ActionGetWanted remote) , CommandAction (ActionGetWanted repo remote)
, CommandAction reponame (ActionSendWanted remote) , CommandAction (ActionSendWanted repo remote)
, CommandAction reponame (ActionDropUnwanted (Just remote)) , CommandAction (ActionDropUnwanted repo (Just remote))
, CommandAction reponame (ActionGitPush remote) , CommandAction (ActionGitPush repo remote)
] st ] st
runSimCommand cmd repobyname st = runSimCommand cmd repobyname st =
case applySimCommand cmd st repobyname of case applySimCommand cmd st repobyname of
@ -344,9 +345,14 @@ applySimCommand' (CommandAdd file sz repos) st _ =
} }
in go k st'' rest in go k st'' rest
applySimCommand' (CommandStep _) _ _ = error "applySimCommand' CommandStep" applySimCommand' (CommandStep _) _ _ = error "applySimCommand' CommandStep"
applySimCommand' (CommandAction repo act) st _ = applySimCommand' (CommandAction act) st _ =
checkKnownRepo repo st $ \u -> case getSimActionComponents act st of
applySimAction repo u act st Left err -> Left err
Right (Right st') -> Right (Right st')
Right (Left (st', l)) -> Right $ Left $ go l st'
where
go [] st' = return st'
go (a:as) st' = a st' >>= go as
applySimCommand' (CommandSeed rngseed) st _ = applySimCommand' (CommandSeed rngseed) st _ =
Right $ Right $ st Right $ Right $ st
{ simRng = rngseed { simRng = rngseed
@ -431,63 +437,63 @@ 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
applySimAction getSimActionComponents
:: RepoName :: SimAction
-> UUID
-> SimAction
-> SimState SimRepo -> SimState SimRepo
-> Either String (Either (Annex (SimState SimRepo)) (SimState SimRepo)) -> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo)]) (SimState SimRepo))
applySimAction r u (ActionGetWanted remote) st = getSimActionComponents (ActionGetWanted repo remote) st =
overFilesRemote r u remote S.member wanted go st checkKnownRepo repo st $ \u ->
let go _remoteu f k _r st' = setPresentKey True u k u $
addHistory st' $ CommandPresent repo f
in overFilesRemote repo u remote S.member wanted go st
where where
wanted k f _ = wantGet NoLiveUpdate False k f wanted k f _ = wantGet NoLiveUpdate False k f
go _remoteu f k _r st' = setPresentKey True u k u $ getSimActionComponents (ActionSendWanted repo remote) st =
addHistory st' $ CommandPresent r f checkKnownRepo repo st $ \u ->
applySimAction r u (ActionSendWanted remote) st = overFilesRemote repo u remote S.notMember wanted (go u) st
overFilesRemote r u remote S.notMember wanted go st
where where
wanted = wantGetBy NoLiveUpdate False wanted = wantGetBy NoLiveUpdate False
go remoteu f k _r st' = go u remoteu f k _r st' =
-- Sending to a remote updates the location log -- Sending to a remote updates the location log
-- of both the repository sending and the remote. -- of both the repository sending and the remote.
setPresentKey True remoteu k remoteu $ setPresentKey True remoteu k remoteu $
setPresentKey True remoteu k u $ setPresentKey True remoteu k u $
addHistory st' $ CommandPresent (remoteNameToRepoName remote) f addHistory st' $ CommandPresent (remoteNameToRepoName remote) f
applySimAction _r u (ActionDropUnwanted Nothing) st = getSimActionComponents (ActionDropUnwanted repo Nothing) st =
Right $ Left $ liftIO $ runSimRepo u st $ \rst -> checkKnownRepo repo st $ \u ->
go rst (M.toList $ M.filter (present rst) $ simFiles st) st Right $ Left (st, map (go u) $ M.toList $ simFiles st)
where where
present rst k = u `S.member` getSimLocations rst k go u (f, k) st' = liftIO $ runSimRepo u st' $ \rst ->
let af = AssociatedFile $ Just f
in if present u rst k
then ifM (wantDrop NoLiveUpdate False Nothing (Just k) af Nothing)
( return $ checkdrop u rst k st'
, return st'
)
else return st'
present u rst k = u `S.member` getSimLocations rst k
go _ [] st' = return st' checkdrop u rst k st' =
go rst ((f, k):rest) st' = do
ifM (wantDrop NoLiveUpdate False Nothing (Just k) af Nothing)
( go rst rest $ checkdrop rst k st'
, go rst rest st'
)
where
af = AssociatedFile $ Just f
checkdrop rst k st' =
let numcopies = simNumCopies st' let numcopies = simNumCopies st'
mincopies = simMinCopies st' mincopies = simMinCopies st'
verifiedcopies = mapMaybe (verifypresent k st') $ verifiedcopies = mapMaybe (verifypresent u k st') $
filter (/= u) $ S.toList $ getSimLocations rst k filter (/= u) $ 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'
SafeDrop -> dodrop k st' SafeDrop -> dodrop u k st'
SafeDropCheckTime -> dodrop k st' SafeDropCheckTime -> dodrop u k st'
dodrop k = setPresentKey False u k u dodrop u k = setPresentKey False u k u
remotes = S.fromList $ mapMaybe remotes u = S.fromList $ mapMaybe
(\remote -> M.lookup (remoteNameToRepoName remote) (simRepos st)) (\remote -> M.lookup (remoteNameToRepoName remote) (simRepos st))
(maybe mempty S.toList $ M.lookup u $ simConnections st) (maybe mempty S.toList $ M.lookup u $ simConnections st)
verifypresent k st' ru = do verifypresent u k st' ru = do
rst <- M.lookup ru (simRepoState st') rst <- M.lookup ru (simRepoState st')
if present rst k if present u rst k
then if ru `S.member` remotes then if ru `S.member` remotes u
then Just $ if simIsSpecialRemote rst then Just $ if simIsSpecialRemote rst
then mkVerifiedCopy RecentlyVerifiedCopy ru then mkVerifiedCopy RecentlyVerifiedCopy ru
else mkVerifiedCopy LockedCopy ru else mkVerifiedCopy LockedCopy ru
@ -496,17 +502,39 @@ applySimAction _r u (ActionDropUnwanted Nothing) st =
mkVerifiedCopy TrustedCopy ru mkVerifiedCopy TrustedCopy ru
_ -> Nothing _ -> Nothing
else Nothing else Nothing
applySimAction _r _u (ActionDropUnwanted (Just _remote)) _st = undefined -- TODO getSimActionComponents (ActionDropUnwanted _repo (Just _remote)) _st =
applySimAction r u (ActionGitPush remote) st = undefined -- TODO
checkKnownRemote remote r u st $ \_ -> getSimActionComponents (ActionGitPush repo remote) st =
simulateGitAnnexMerge r (remoteNameToRepoName remote) st checkKnownRepo repo st $ \u ->
applySimAction r u (ActionGitPull remote) st = checkKnownRemote remote repo u st $ \_ ->
checkKnownRemote remote r u st $ \_ -> simulateGitAnnexMerge repo (remoteNameToRepoName remote) st
simulateGitAnnexMerge (remoteNameToRepoName remote) r st getSimActionComponents (ActionGitPull repo remote) st =
checkKnownRepo repo st $ \u ->
checkKnownRemote remote repo u st $ \_ ->
simulateGitAnnexMerge (remoteNameToRepoName remote) repo st
getSimActionComponents (ActionWhile a b) st =
case getSimActionComponents a st of
Left err -> Left err
Right (Right st') -> getSimActionComponents b st'
Right (Left (st', as)) ->
case getSimActionComponents b st' of
Left err -> Left err
Right (Right st'') -> Right $ Left (st'', as)
Right (Left (st'', bs)) ->
Right $ Left $ mingle as bs st'' []
where
mingle [] subbs st' c = (st', reverse c ++ subbs)
mingle subas [] st' c = (st', reverse c ++ subas)
mingle (suba:subas) (subb:subbs) st' c =
let (coinflip, st'') = simRandom st' random id
in if coinflip
then mingle subas (subb:subbs) st'' (suba:c)
else mingle (suba:subas) subbs st'' (subb:c)
-- These are handled by runSimCommand -- These are handled by runSimCommand
applySimAction _r _u (ActionPull _remote) _st = error "applySimAction ActionPull" -- XXX move to here
applySimAction _r _u (ActionPush _remote) _st = error "applySimAction ActionPush" getSimActionComponents (ActionPull _ _) _st = error "applySimAction ActionPull"
applySimAction _r _u (ActionSync _remote) _st = error "applySimAction ActionSync" getSimActionComponents (ActionPush _ _) _st = error "applySimAction ActionPush"
getSimActionComponents (ActionSync _ _) _st = error "applySimAction ActionSync"
overFilesRemote overFilesRemote
:: RepoName :: RepoName
@ -516,25 +544,20 @@ 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 (Annex (SimState SimRepo)) (SimState SimRepo)) -> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo)]) (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 $ liftIO $ Right (Left (st, map (go remoteu) $ M.toList $ simFiles st))
runSimRepo u st $ \rst -> do
let l = M.toList $
M.filter (checkremotepred remoteu rst) $
simFiles st
go remoteu l st
where where
go _ [] st' = return st' go remoteu (f, k) st' =
go remoteu ((f, k):rest) st' = do let af = AssociatedFile $ Just f
ifM (checkwant (Just k) af remoteu) in liftIO $ runSimRepo u st' $ \rst ->
( go remoteu rest $ handlewanted remoteu f k r st' if checkremotepred remoteu rst k
, go remoteu rest st' then ifM (checkwant (Just k) af remoteu)
) ( return $ handlewanted remoteu f k r st'
where , return st'
af = AssociatedFile $ Just f )
else return st'
checkremotepred remoteu rst k = checkremotepred remoteu rst k =
remotepred remoteu (getSimLocations rst k) remotepred remoteu (getSimLocations rst k)
@ -542,7 +565,7 @@ simulateGitAnnexMerge
:: RepoName :: RepoName
-> RepoName -> RepoName
-> SimState SimRepo -> SimState SimRepo
-> Either String (Either (Annex (SimState SimRepo)) (SimState SimRepo)) -> Either String (Either a (SimState SimRepo))
simulateGitAnnexMerge src dest st = simulateGitAnnexMerge src dest st =
case (M.lookup src (simRepos st), M.lookup dest (simRepos st)) of case (M.lookup src (simRepos st), M.lookup dest (simRepos st)) of
(Just srcu, Just destu) -> case M.lookup destu (simRepoState st) of (Just srcu, Just destu) -> case M.lookup destu (simRepoState st) of
@ -607,24 +630,24 @@ randomRepo st
where where
repolist = M.keys (simRepos st) repolist = M.keys (simRepos st)
randomAction :: UUID -> SimState SimRepo -> (SimAction, SimState SimRepo) randomAction :: RepoName -> UUID -> SimState SimRepo -> (SimAction, SimState SimRepo)
randomAction u st = case M.lookup u (simConnections st) of randomAction repo u st = case M.lookup u (simConnections st) of
Just cs | not (S.null cs) -> Just cs | not (S.null cs) ->
let (mkact, st') = simRandom st (randomR (0, length mkactions - 1)) let (mkact, st') = simRandom st (randomR (0, length mkactions - 1))
(mkactions !!) (mkactions !!)
(remote, st'') = simRandom st' (randomR (0, S.size cs - 1)) (remote, st'') = simRandom st' (randomR (0, S.size cs - 1))
(`S.elemAt` cs) (`S.elemAt` cs)
in (mkact remote, st'') in (mkact repo remote, st'')
-- When there are no remotes, this is the only possible action. -- When there are no remotes, this is the only possible action.
_ -> (ActionDropUnwanted Nothing, st) _ -> (ActionDropUnwanted repo Nothing, st)
where where
mkactions = mkactions =
[ ActionPull [ ActionPull
, ActionPush , ActionPush
, ActionSync , ActionSync
, ActionGetWanted , ActionGetWanted
, ActionDropUnwanted . Just , \repo' remote -> ActionDropUnwanted repo' (Just remote)
, const (ActionDropUnwanted Nothing) , \repo' _remote -> ActionDropUnwanted repo' Nothing
, ActionSendWanted , ActionSendWanted
, ActionGitPush , ActionGitPush
, ActionGitPull , ActionGitPull

100
Annex/Sim/File.hs
View file

@ -51,24 +51,7 @@ generateSimFile = unlines . map unwords . go
(["add", fromRawFilePath f, showsize sz] ++ map fromRepoName repos) : go rest (["add", fromRawFilePath f, showsize sz] ++ map fromRepoName repos) : go rest
go (CommandStep n : rest) = go (CommandStep n : rest) =
["step", show n] : go rest ["step", show n] : go rest
go (CommandAction (RepoName repo) (ActionPull (RemoteName remote)) : rest) = go (CommandAction act : rest) = formatAction act : go rest
["action", repo, "pull", remote] : go rest
go (CommandAction (RepoName repo) (ActionPush (RemoteName remote)) : rest) =
["action", repo, "push", remote] : go rest
go (CommandAction (RepoName repo) (ActionSync (RemoteName remote)) : rest) =
["action", repo, "sync", remote] : go rest
go (CommandAction (RepoName repo) (ActionGetWanted (RemoteName remote)) : rest) =
["action", repo, "getwanted", remote] : go rest
go (CommandAction (RepoName repo) (ActionDropUnwanted (Just (RemoteName remote))) : rest) =
["action", repo, "dropunwanted", remote] : go rest
go (CommandAction (RepoName repo) (ActionDropUnwanted Nothing) : rest) =
["action", repo, "dropunwanted"] : go rest
go (CommandAction (RepoName repo) (ActionSendWanted (RemoteName remote)) : rest) =
["action", repo, "sendwanted", remote] : go rest
go (CommandAction (RepoName repo) (ActionGitPush (RemoteName remote)) : rest) =
["action", repo, "gitpush", remote] : go rest
go (CommandAction (RepoName repo) (ActionGitPull (RemoteName remote)) : rest) =
["action", repo, "gitpull", remote] : go rest
go (CommandSeed n : rest) = go (CommandSeed n : rest) =
["seed", show n] : go rest ["seed", show n] : go rest
go (CommandPresent (RepoName repo) f : rest) = go (CommandPresent (RepoName repo) f : rest) =
@ -102,6 +85,28 @@ generateSimFile = unlines . map unwords . go
showsize = filter (not . isSpace) . preciseSize storageUnits True showsize = filter (not . isSpace) . preciseSize storageUnits True
formatAction :: SimAction -> [String]
formatAction (ActionPull (RepoName repo) (RemoteName remote)) =
["action", repo, "pull", remote]
formatAction (ActionPush (RepoName repo) (RemoteName remote)) =
["action", repo, "push", remote]
formatAction (ActionSync (RepoName repo) (RemoteName remote)) =
["action", repo, "sync", remote]
formatAction (ActionGetWanted (RepoName repo) (RemoteName remote)) =
["action", repo, "getwanted", remote]
formatAction (ActionDropUnwanted (RepoName repo) (Just (RemoteName remote))) =
["action", repo, "dropunwanted", remote]
formatAction (ActionDropUnwanted (RepoName repo) Nothing) =
["action", repo, "dropunwanted"]
formatAction (ActionSendWanted (RepoName repo) (RemoteName remote)) =
["action", repo, "sendwanted", remote]
formatAction (ActionGitPush (RepoName repo) (RemoteName remote)) =
["action", repo, "gitpush", remote]
formatAction (ActionGitPull (RepoName repo) (RemoteName remote)) =
["action", repo, "gitpull", remote]
formatAction (ActionWhile a b) =
formatAction a ++ ["while"] ++ formatAction b
parseSimCommand :: [String] -> Either String SimCommand parseSimCommand :: [String] -> Either String SimCommand
parseSimCommand ("init":name:[]) = parseSimCommand ("init":name:[]) =
Right $ CommandInit (RepoName name) Right $ CommandInit (RepoName name)
@ -126,30 +131,9 @@ parseSimCommand ("step":n:[]) =
case readMaybe n of case readMaybe n of
Just n' -> Right $ CommandStep n' Just n' -> Right $ CommandStep n'
Nothing -> Left $ "Unable to parse step value \"" ++ n ++ "\"" Nothing -> Left $ "Unable to parse step value \"" ++ n ++ "\""
parseSimCommand ("action":repo:"pull":remote:[]) = parseSimCommand l@("action":_) = case parseSimAction l of
Right $ CommandAction (RepoName repo) Right act -> Right $ CommandAction act
(ActionPull (RemoteName remote)) Left err -> Left err
parseSimCommand ("action":repo:"push":remote:[]) =
Right $ CommandAction (RepoName repo)
(ActionPush (RemoteName remote))
parseSimCommand ("action":repo:"sync":remote:[]) =
Right $ CommandAction (RepoName repo)
(ActionSync (RemoteName remote))
parseSimCommand ("action":repo:"getwanted":remote:[]) =
Right $ CommandAction (RepoName repo)
(ActionGetWanted (RemoteName remote))
parseSimCommand ("action":repo:"dropunwanted":[]) =
Right $ CommandAction (RepoName repo)
(ActionDropUnwanted Nothing)
parseSimCommand ("action":repo:"dropunwanted":remote:[]) =
Right $ CommandAction (RepoName repo)
(ActionDropUnwanted (Just (RemoteName remote)))
parseSimCommand ("action":repo:"gitpush":remote:[]) =
Right $ CommandAction (RepoName repo)
(ActionGitPush (RemoteName remote))
parseSimCommand ("action":repo:"gitpull":remote:[]) =
Right $ CommandAction (RepoName repo)
(ActionGitPull (RemoteName remote))
parseSimCommand ("seed":n:[]) = parseSimCommand ("seed":n:[]) =
case readMaybe n of case readMaybe n of
Just n' -> Right $ CommandSeed n' Just n' -> Right $ CommandSeed n'
@ -188,7 +172,37 @@ parseSimCommand ("maxsize":repo:size:[]) =
parseSimCommand ("rebalance":onoff:[]) = case isTrueFalse onoff of parseSimCommand ("rebalance":onoff:[]) = case isTrueFalse onoff of
Just b -> Right $ CommandRebalance b Just b -> Right $ CommandRebalance b
Nothing -> Left $ "Unable to parse rebalance value \"" ++ onoff ++ "\"" Nothing -> Left $ "Unable to parse rebalance value \"" ++ onoff ++ "\""
parseSimCommand ws = Left $ "Unable to parse sim command: \"" ++ unwords ws ++ "\"" parseSimCommand ws = parseError ws
parseSimAction :: [String] -> Either String SimAction
parseSimAction ("action":repo:"pull":remote:rest) =
mkAction rest $ ActionPull (RepoName repo) (RemoteName remote)
parseSimAction ("action":repo:"push":remote:rest) =
mkAction rest $ ActionPush (RepoName repo) (RemoteName remote)
parseSimAction ("action":repo:"sync":remote:rest) =
mkAction rest $ ActionSync (RepoName repo) (RemoteName remote)
parseSimAction ("action":repo:"getwanted":remote:rest) =
mkAction rest $ ActionGetWanted (RepoName repo) (RemoteName remote)
parseSimAction ("action":repo:"dropunwanted":rest) =
mkAction rest $ ActionDropUnwanted (RepoName repo) Nothing
parseSimAction ("action":repo:"dropunwanted":remote:rest) =
mkAction rest $ ActionDropUnwanted (RepoName repo)
(Just (RemoteName remote))
parseSimAction ("action":repo:"gitpush":remote:rest) =
mkAction rest $ ActionGitPush (RepoName repo) (RemoteName remote)
parseSimAction ("action":repo:"gitpull":remote:rest) =
mkAction rest $ ActionGitPull (RepoName repo) (RemoteName remote)
parseSimAction ws = parseError ws
mkAction :: [String] -> SimAction -> Either String SimAction
mkAction [] a = Right a
mkAction ("while":rest) a = case parseSimAction rest of
Right b -> Right (ActionWhile a b)
Left err -> Left err
mkAction ws _ = parseError ws
parseError :: [String] -> Either String a
parseError ws = Left $ "Unable to parse sim command: \"" ++ unwords ws ++ "\""
parseConnections :: [String] -> Either String Connections parseConnections :: [String] -> Either String Connections
parseConnections = go . reverse parseConnections = go . reverse

18
doc/git-annex-sim.mdwn
View file

@ -204,12 +204,26 @@ as passed to "git annex sim" while a simulation is running.
Simulate the equivilant of [[git-annex-sync]](1) by combining Simulate the equivilant of [[git-annex-sync]](1) by combining
the actions gitpull, getwanted, sendwanted, dropunwanted, and gitpush. the actions gitpull, getwanted, sendwanted, dropunwanted, and gitpush.
* `action [...] while action [...]`
Simulate running the two actions concurrently. While the simulation only
actually simulates one thing happening at a time, when the actions each
operate on multiple files, they will be interleaved randomly.
Any number of actions can be combined this way.
For example:
action foo dropunwanted while action bar getwanted foo
In this example, bar may or may not get a file before foo drops it.
* `seed N` * `seed N`
Sets the random seed to a given number. Using this should make the Sets the random seed to a given number. Using this should make the
results of the simulation deterministic. The output sim file results of the simulation deterministic. The output sim file
always has the random seed included in it, so usually you don't need to always has the random seed included in it, so it can be used to replay
specify this. the simulation.
* `present repo file` * `present repo file`