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

convert simRepoState to use UUID as key

Browse source
This commit is contained in:
Joey Hess 2024-09-12 10:08:50 -04:00
parent 7b931df475
commit 68e52f6ec0
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 83 additions and 76 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

135
Annex/Sim.hs
View file

@ -52,7 +52,7 @@ import qualified System.FilePath.ByteString as P
data SimState = SimState data SimState = SimState
{ simRepos :: M.Map RepoName UUID { simRepos :: M.Map RepoName UUID
, simRepoList :: [RepoName] , simRepoList :: [RepoName]
, simRepoState :: M.Map RepoName SimRepoState , simRepoState :: M.Map UUID SimRepoState
, simConnections :: M.Map UUID (S.Set RemoteName) , simConnections :: M.Map UUID (S.Set RemoteName)
, simFiles :: M.Map RawFilePath Key , simFiles :: M.Map RawFilePath Key
, simRng :: StdGen , simRng :: StdGen
@ -100,6 +100,7 @@ data SimRepoState = SimRepoState
{ simLocations :: M.Map Key (M.Map UUID LocationState) { simLocations :: M.Map Key (M.Map UUID LocationState)
, simIsSpecialRemote :: Bool , simIsSpecialRemote :: Bool
, simRepo :: Maybe SimRepo , simRepo :: Maybe SimRepo
, simRepoName :: RepoName
} }
deriving (Show) deriving (Show)
@ -114,10 +115,12 @@ newerLocationState l1@(LocationState vc1 _) l2@(LocationState vc2 _)
| vc1 > vc2 = l1 | vc1 > vc2 = l1
| otherwise = l2 | otherwise = l2
setPresentKey :: UUID -> Key -> RepoName -> SimState -> SimState {- Updates the state of repou to indicate that a key is
setPresentKey u k repo st = st - present or not in u. -}
{ simRepoState = case M.lookup repo (simRepoState st) of setPresentKey :: UUID -> Key -> UUID -> SimState -> SimState
Just rst -> M.insert repo setPresentKey u k repou st = st
{ simRepoState = case M.lookup repou (simRepoState st) of
Just rst -> M.insert repou
(setPresentKey' (simVectorClock st) u k rst) (setPresentKey' (simVectorClock st) u k rst)
(simRepoState st) (simRepoState st)
Nothing -> error "no simRepoState in setPresentKey" Nothing -> error "no simRepoState in setPresentKey"
@ -309,7 +312,7 @@ applySimCommand' (CommandAdd file sz repos) st =
where where
go k st' [] = Right $ Right st go k st' [] = Right $ Right st
go k st' (repo:rest) = checkKnownRepo repo st' $ \u -> go k st' (repo:rest) = checkKnownRepo repo st' $ \u ->
let st'' = setPresentKey u k repo $ st' let st'' = setPresentKey u k u $ st'
{ simFiles = M.insert file k (simFiles st') { simFiles = M.insert file k (simFiles st')
} }
in go k st'' rest in go k st'' rest
@ -321,7 +324,7 @@ applySimCommand' (CommandSeed rngseed) st = Right $ Right $ st
{ simRng = mkStdGen rngseed { simRng = mkStdGen rngseed
} }
applySimCommand' (CommandPresent repo file) st = checkKnownRepo repo st $ \u -> applySimCommand' (CommandPresent repo file) st = checkKnownRepo repo st $ \u ->
case (M.lookup file (simFiles st), M.lookup repo (simRepoState st)) of case (M.lookup file (simFiles st), M.lookup u (simRepoState st)) of
(Just k, Just rst) (Just k, Just rst)
| u `S.member` getSimLocations rst k -> | u `S.member` getSimLocations rst k ->
Right $ Right st Right $ Right st
@ -335,7 +338,7 @@ applySimCommand' (CommandPresent repo file) st = checkKnownRepo repo st $ \u ->
++ " to be present in " ++ " to be present in "
++ fromRepoName repo ++ ", but it is not." ++ fromRepoName repo ++ ", but it is not."
applySimCommand' (CommandNotPresent repo file) st = checkKnownRepo repo st $ \u -> applySimCommand' (CommandNotPresent repo file) st = checkKnownRepo repo st $ \u ->
case (M.lookup file (simFiles st), M.lookup repo (simRepoState st)) of case (M.lookup file (simFiles st), M.lookup u (simRepoState st)) of
(Just k, Just rst) (Just k, Just rst)
| u `S.notMember` getSimLocations rst k -> | u `S.notMember` getSimLocations rst k ->
Right $ Right st Right $ Right st
@ -404,16 +407,17 @@ applySimAction r u (ActionGetWanted remote) st =
overFilesRemote r u remote S.member wanted go st overFilesRemote r 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 u _ f k r st' = setPresentKey u k r $ go u _ f k r st' = setPresentKey u k u $
addHistory st' $ CommandPresent r f addHistory st' $ CommandPresent r f
applySimAction r u (ActionSendWanted remote) st = applySimAction r u (ActionSendWanted remote) st =
overFilesRemote r u remote S.notMember wanted go 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' = setPresentKey remoteu k r $ go _ 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 remoteu k (remoteNameToRepoName remote) $ setPresentKey remoteu k remoteu $
setPresentKey remoteu k u $
addHistory st' $ CommandPresent (remoteNameToRepoName remote) f addHistory st' $ CommandPresent (remoteNameToRepoName remote) f
applySimAction r u (ActionDropUnwanted Nothing) st = undefined -- TODO applySimAction r u (ActionDropUnwanted Nothing) st = undefined -- TODO
applySimAction r u (ActionDropUnwanted (Just remote)) st = undefined -- TODO applySimAction r u (ActionDropUnwanted (Just remote)) st = undefined -- TODO
@ -436,7 +440,7 @@ overFilesRemote
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 $ liftIO $
runSimRepo r st $ \rst -> runSimRepo u st $ \rst ->
let l = M.toList $ let l = M.toList $
M.filter (checkremotepred remoteu rst) $ M.filter (checkremotepred remoteu rst) $
simFiles st simFiles st
@ -460,9 +464,10 @@ simulateGitAnnexMerge
-> SimState -> SimState
-> Either String (Either (Annex SimState) SimState) -> Either String (Either (Annex SimState) SimState)
simulateGitAnnexMerge src dest st = simulateGitAnnexMerge src dest st =
case M.lookup dest (simRepoState 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
Nothing -> Left $ "Unable to find simRepoState for " ++ fromRepoName dest Nothing -> Left $ "Unable to find simRepoState for " ++ fromRepoName dest
Just destst -> case M.lookup src (simRepoState st) of Just destst -> case M.lookup srcu (simRepoState st) of
Nothing -> Left $ "Unable to find simRepoState for " ++ fromRepoName src Nothing -> Left $ "Unable to find simRepoState for " ++ fromRepoName src
Just srcst -> Right $ Right $ Just srcst -> Right $ Right $
let locs = M.unionWith let locs = M.unionWith
@ -471,10 +476,11 @@ simulateGitAnnexMerge src dest st =
(simLocations srcst) (simLocations srcst)
destst' = destst { simLocations = locs } destst' = destst { simLocations = locs }
in st in st
{ simRepoState = M.insert dest { simRepoState = M.insert destu
destst' destst'
(simRepoState st) (simRepoState st)
} }
_ -> Left $ "Unable to find " ++ fromRepoName src ++ " or " ++ fromRepoName dest ++ " in simRepos"
checkNonexistantRepo :: RepoName -> SimState -> Either String a -> Either String a checkNonexistantRepo :: RepoName -> SimState -> Either String a -> Either String a
checkNonexistantRepo reponame st a = case M.lookup reponame (simRepos st) of checkNonexistantRepo reponame st a = case M.lookup reponame (simRepos st) of
@ -576,27 +582,27 @@ instance Show GetSimRepoPath where
show _ = "GetSimRepoPath" show _ = "GetSimRepoPath"
data SimRepoConfig = SimRepoConfig data SimRepoConfig = SimRepoConfig
{ simRepoUUID :: UUID { simRepoConfigUUID :: UUID
, simRepoIsSpecialRemote :: Bool , simRepoConfigIsSpecialRemote :: Bool
, simRepoGroups :: S.Set Group , simRepoConfigGroups :: S.Set Group
, simRepoTrustLevel :: TrustLevel , simRepoConfigTrustLevel :: TrustLevel
, simRepoPreferredContent :: Maybe PreferredContentExpression , simRepoConfigPreferredContent :: Maybe PreferredContentExpression
, simRepoRequiredContent :: Maybe PreferredContentExpression , simRepoConfigRequiredContent :: Maybe PreferredContentExpression
, simRepoGroupPreferredContent :: M.Map Group PreferredContentExpression , simRepoConfigGroupPreferredContent :: M.Map Group PreferredContentExpression
, simRepoMaxSize :: Maybe MaxSize , simRepoConfigMaxSize :: Maybe MaxSize
} }
deriving (Show) deriving (Show)
newSimRepoConfig :: UUID -> Bool -> SimRepoConfig newSimRepoConfig :: UUID -> Bool -> SimRepoConfig
newSimRepoConfig u isspecialremote = SimRepoConfig newSimRepoConfig u isspecialremote = SimRepoConfig
{ simRepoUUID = u { simRepoConfigUUID = u
, simRepoIsSpecialRemote = isspecialremote , simRepoConfigIsSpecialRemote = isspecialremote
, simRepoGroups = mempty , simRepoConfigGroups = mempty
, simRepoTrustLevel = def , simRepoConfigTrustLevel = def
, simRepoPreferredContent = Nothing , simRepoConfigPreferredContent = Nothing
, simRepoRequiredContent = Nothing , simRepoConfigRequiredContent = Nothing
, simRepoGroupPreferredContent = mempty , simRepoConfigGroupPreferredContent = mempty
, simRepoMaxSize = Nothing , simRepoConfigMaxSize = Nothing
} }
addRepo :: RepoName -> SimRepoConfig -> SimState -> SimState addRepo :: RepoName -> SimRepoConfig -> SimState -> SimState
@ -605,34 +611,35 @@ addRepo reponame simrepo st = st
, simRepoList = if reponame `elem` simRepoList st , simRepoList = if reponame `elem` simRepoList st
then simRepoList st then simRepoList st
else reponame : simRepoList st else reponame : simRepoList st
, simRepoState = M.insert reponame rst (simRepoState st) , simRepoState = M.insert u rst (simRepoState st)
, simConnections = M.insert u mempty (simConnections st) , simConnections = M.insert u mempty (simConnections st)
, simGroups = M.insert u (simRepoGroups simrepo) (simGroups st) , simGroups = M.insert u (simRepoConfigGroups simrepo) (simGroups st)
, simTrustLevels = M.insert u , simTrustLevels = M.insert u
(simRepoTrustLevel simrepo) (simRepoConfigTrustLevel simrepo)
(simTrustLevels st) (simTrustLevels st)
, simWanted = M.alter , simWanted = M.alter
(const $ simRepoPreferredContent simrepo) (const $ simRepoConfigPreferredContent simrepo)
u u
(simWanted st) (simWanted st)
, simRequired = M.alter , simRequired = M.alter
(const $ simRepoRequiredContent simrepo) (const $ simRepoConfigRequiredContent simrepo)
u u
(simRequired st) (simRequired st)
, simGroupWanted = M.union , simGroupWanted = M.union
(simRepoGroupPreferredContent simrepo) (simRepoConfigGroupPreferredContent simrepo)
(simGroupWanted st) (simGroupWanted st)
, simMaxSize = M.alter , simMaxSize = M.alter
(const $ simRepoMaxSize simrepo) (const $ simRepoConfigMaxSize simrepo)
u u
(simMaxSize st) (simMaxSize st)
} }
where where
u = simRepoUUID simrepo u = simRepoConfigUUID simrepo
rst = SimRepoState rst = SimRepoState
{ simLocations = mempty { simLocations = mempty
, simIsSpecialRemote = simRepoIsSpecialRemote simrepo , simIsSpecialRemote = simRepoConfigIsSpecialRemote simrepo
, simRepo = Nothing , simRepo = Nothing
, simRepoName = reponame
} }
mkGetExistingRepoByName :: Annex GetExistingRepoByName mkGetExistingRepoByName :: Annex GetExistingRepoByName
@ -651,19 +658,19 @@ mkGetExistingRepoByName = do
let gs = fromMaybe S.empty $ let gs = fromMaybe S.empty $
M.lookup u (groupsByUUID groupmap) M.lookup u (groupsByUUID groupmap)
in SimRepoConfig in SimRepoConfig
{ simRepoUUID = u { simRepoConfigUUID = u
, simRepoIsSpecialRemote = , simRepoConfigIsSpecialRemote =
M.member u remoteconfigmap M.member u remoteconfigmap
, simRepoGroups = gs , simRepoConfigGroups = gs
, simRepoTrustLevel = , simRepoConfigTrustLevel =
lookupTrust' u trustmap lookupTrust' u trustmap
, simRepoPreferredContent = , simRepoConfigPreferredContent =
M.lookup u pcmap M.lookup u pcmap
, simRepoRequiredContent = , simRepoConfigRequiredContent =
M.lookup u rcmap M.lookup u rcmap
, simRepoGroupPreferredContent = , simRepoConfigGroupPreferredContent =
M.restrictKeys gpcmap gs M.restrictKeys gpcmap gs
, simRepoMaxSize = , simRepoConfigMaxSize =
M.lookup u maxsizes M.lookup u maxsizes
} }
(_, msg) -> Left msg (_, msg) -> Left msg
@ -674,7 +681,7 @@ data SimRepo = SimRepo
{ simRepoGitRepo :: Repo { simRepoGitRepo :: Repo
, simRepoAnnex :: (Annex.AnnexState, Annex.AnnexRead) , simRepoAnnex :: (Annex.AnnexState, Annex.AnnexRead)
, simRepoCurrState :: SimState , simRepoCurrState :: SimState
, simRepoName :: RepoName , simRepoUUID :: UUID
} }
instance Show SimRepo where instance Show SimRepo where
@ -688,12 +695,12 @@ updateSimRepoStates :: SimState -> IO SimState
updateSimRepoStates st = go st (M.toList $ simRepoState st) updateSimRepoStates st = go st (M.toList $ simRepoState st)
where where
go st' [] = return st' go st' [] = return st'
go st' ((reponame, rst):rest) = case simRepo rst of go st' ((u, rst):rest) = case simRepo rst of
Just sr -> do Just sr -> do
sr' <- updateSimRepoState st sr sr' <- updateSimRepoState st sr
let rst' = rst { simRepo = Just sr' } let rst' = rst { simRepo = Just sr' }
let st'' = st let st'' = st
{ simRepoState = M.insert reponame rst' { simRepoState = M.insert u rst'
(simRepoState st) (simRepoState st)
} }
go st'' rest go st'' rest
@ -703,14 +710,14 @@ initNewSimRepos :: SimState -> IO SimState
initNewSimRepos = \st -> go st (M.toList $ simRepoState st) initNewSimRepos = \st -> go st (M.toList $ simRepoState st)
where where
go st [] = return st go st [] = return st
go st ((reponame, rst):rest) = go st ((u, rst):rest) =
case (simRepo rst, M.lookup reponame (simRepos st)) of case simRepo rst of
(Nothing, Just u) -> do Nothing -> do
let GetSimRepoPath getdest = simGetSimRepoPath st let GetSimRepoPath getdest = simGetSimRepoPath st
sr <- initSimRepo reponame u (getdest u) st sr <- initSimRepo (simRepoName rst) u (getdest u) st
let rst' = rst { simRepo = Just sr } let rst' = rst { simRepo = Just sr }
let st' = st let st' = st
{ simRepoState = M.insert reponame rst' { simRepoState = M.insert u rst'
(simRepoState st) (simRepoState st)
} }
go st' rest go st' rest
@ -741,7 +748,7 @@ initSimRepo simreponame u dest st = do
(simRng st) (simRng st)
(simGetExistingRepoByName st) (simGetExistingRepoByName st)
(simGetSimRepoPath st) (simGetSimRepoPath st)
, simRepoName = simreponame , simRepoUUID = u
} }
simulatedRepositoryDescription :: RepoName -> String simulatedRepositoryDescription :: RepoName -> String
@ -751,10 +758,10 @@ simulatedRepositoryDescription simreponame =
simulationDifferences :: Differences simulationDifferences :: Differences
simulationDifferences = mkDifferences $ S.singleton Simulation simulationDifferences = mkDifferences $ S.singleton Simulation
runSimRepo :: RepoName -> SimState -> (SimRepoState -> Annex SimState) -> IO SimState runSimRepo :: UUID -> SimState -> (SimRepoState -> Annex SimState) -> IO SimState
runSimRepo reponame st a = do runSimRepo u st a = do
st' <- updateSimRepos st st' <- updateSimRepos st
case M.lookup reponame (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'', strd) <- Annex.run (simRepoAnnex sr) $
@ -765,11 +772,11 @@ runSimRepo reponame st a = do
return $ st'' return $ st''
{ simRepoState = M.adjust { simRepoState = M.adjust
(\rst' -> rst' { simRepo = Just sr' }) (\rst' -> rst' { simRepo = Just sr' })
(simRepoName sr) u
(simRepoState st'') (simRepoState st'')
} }
Nothing -> error $ "runSimRepo simRepo not set for " ++ fromRepoName reponame Nothing -> error $ "runSimRepo simRepo not set for " ++ fromUUID u
Nothing -> error $ "runSimRepo simRepoState not found for " ++ fromRepoName reponame Nothing -> error $ "runSimRepo simRepoState not found for " ++ fromUUID u
updateSimRepoState :: SimState -> SimRepo -> IO SimRepo updateSimRepoState :: SimState -> SimRepo -> IO SimRepo
updateSimRepoState newst sr = do updateSimRepoState newst sr = do
@ -850,7 +857,7 @@ updateSimRepoState newst sr = do
annexedfilepath f annexedfilepath f
annexedfilepath f = repoPath (simRepoGitRepo sr) P.</> f annexedfilepath f = repoPath (simRepoGitRepo sr) P.</> f
getlocations = maybe mempty simLocations getlocations = maybe mempty simLocations
. M.lookup (simRepoName sr) . M.lookup (simRepoUUID sr)
. simRepoState . simRepoState
setlocations s k = setlocations s k =
mapM_ (\l -> logChange NoLiveUpdate k l s) mapM_ (\l -> logChange NoLiveUpdate k l s)