From 4e11cb19ef2640a1664236e3ca3b84bc6d711e82 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 6 Sep 2024 14:23:29 -0400 Subject: [PATCH] implemented cloneSimRepo Started on updateSimRepoState --- Annex/Difference.hs | 4 ++- Annex/Sim.hs | 73 ++++++++++++++++++++++++++++++++++++++++----- Types/Difference.hs | 20 +++++++++---- 3 files changed, 82 insertions(+), 15 deletions(-) diff --git a/Annex/Difference.hs b/Annex/Difference.hs index fa874476fd..6c5d8bdada 100644 --- a/Annex/Difference.hs +++ b/Annex/Difference.hs @@ -56,5 +56,7 @@ setDifferences = do else return ds ) forM_ (listDifferences ds') $ \d -> - setConfig (differenceConfigKey d) (differenceConfigVal d) + case differenceConfigKey d of + Nothing -> noop + Just ck -> setConfig ck (differenceConfigVal d) recordDifferences ds' u diff --git a/Annex/Sim.hs b/Annex/Sim.hs index 8d9eaf9c6d..8fc4b8ba4f 100644 --- a/Annex/Sim.hs +++ b/Annex/Sim.hs @@ -15,17 +15,24 @@ import Types.NumCopies import Types.Group import Types.StandardGroups import Types.TrustLevel +import Types.Difference import Git.Types import Git import Backend.Hash (genTestKey) import Annex.UUID import Annex.FileMatcher +import Annex.Init +import Annex.Startup import Logs.Group import Logs.Trust import Logs.PreferredContent import Logs.Remote import Logs.MaxSize +import Logs.Difference +import qualified Annex import qualified Remote +import qualified Git.Construct +import qualified Git.Remote.Remove import System.Random import Data.Word @@ -61,13 +68,13 @@ data SimState = SimState } deriving (Show) -emptySimState :: Int -> GetExistingRepoByName -> SimState -emptySimState rngseed repobyname = SimState +emptySimState :: StdGen -> GetExistingRepoByName -> SimState +emptySimState rng repobyname = SimState { simRepos = mempty , simRepoState = mempty , simConnections = mempty , simFiles = mempty - , simRng = mkStdGen rngseed + , simRng = rng , simTrustLevels = mempty , simNumCopies = configuredNumCopies 1 , simGroups = mempty @@ -83,8 +90,11 @@ emptySimState rngseed repobyname = SimState data SimRepoState = SimRepoState { simLocations :: M.Map Key (S.Set RepoName) , simIsSpecialRemote :: Bool + , simRepo :: Maybe SimRepo } - deriving (Show, Eq) + +instance Show SimRepoState where + show _ = "SimRepoState" setPresentKey :: RepoName -> Key -> SimRepoState -> SimRepoState setPresentKey repo k rst = rst @@ -346,6 +356,7 @@ addRepo reponame simrepo st = st rst = SimRepoState { simLocations = mempty , simIsSpecialRemote = simRepoIsSpecialRemote simrepo + , simRepo = Nothing } mkGetExistingRepoByName :: Annex GetExistingRepoByName @@ -381,8 +392,16 @@ mkGetExistingRepoByName = do } (_, msg) -> Left msg -cloneSimRepo :: RepoName -> UUID -> Repo -> FilePath -> IO () -cloneSimRepo simreponame u parent dest = do +-- Information about a git repository that is cloned and used to represent +-- a repository in the simulation +data SimRepo = SimRepo + { simRepoGitRepo :: Repo + , simRepoAnnex :: (Annex.AnnexState, Annex.AnnexRead) + , simRepoCurrState :: SimState + } + +cloneSimRepo :: RepoName -> UUID -> Repo -> FilePath -> SimState -> IO SimRepo +cloneSimRepo simreponame u parent dest st = do cloned <- boolSystem "git" [ Param "clone" , Param "--shared" @@ -391,8 +410,46 @@ cloneSimRepo simreponame u parent dest = do -- Note that, on visiting the simulated repo, -- the working tree needs to be reset. , Param "--no-checkout" + -- Make sure the origin gets that name. + , Param "--origin", Param "origin" , File (fromRawFilePath (repoPath parent)) , File dest ] - unless cloned $ giveup "git clone failed" - -- TODO delete origin remote from clone, to avoid foot-shooting + unless cloned $ + giveup "git clone failed" + simrepo <- Git.Construct.fromPath (toRawFilePath dest) + ast <- Annex.new simrepo + ((), ast') <- Annex.run ast $ doQuietAction $ do + -- Disconnect simulated repository from origin, so its + -- git-annex branch is not used, and also to prevent any + -- accidental foot shooting pushes to it. + inRepo $ Git.Remote.Remove.remove "origin" + storeUUID u + -- Prevent merging this simulated git-annex branch with + -- any real one. Writing to the git-annex branch here also + -- avoids checkSharedClone enabling the shared clone + -- setting, which is not wanted here. + recordDifferences simulationDifferences u + let desc = "simulated repository " ++ fromRepoName simreponame + initialize startupAnnex (Just desc) Nothing + updateSimRepoState st $ SimRepo + { simRepoGitRepo = simrepo + , simRepoAnnex = ast' + , simRepoCurrState = emptySimState + (simRng st) + (simGetExistingRepoByName st) + } + +updateSimRepoState :: SimState -> SimRepo -> IO SimRepo +updateSimRepoState st sr = do + ((), ast) <- Annex.run (simRepoAnnex sr) $ doQuietAction $ do + let oldst = simRepoCurrState sr + -- simTrustLevels st + error "TODO diff and update everything" -- XXX + return $ sr + { simRepoAnnex = ast + , simRepoCurrState = st + } + +simulationDifferences :: Differences +simulationDifferences = mkDifferences $ S.singleton Simulation diff --git a/Types/Difference.hs b/Types/Difference.hs index e4075ed851..167963a3cd 100644 --- a/Types/Difference.hs +++ b/Types/Difference.hs @@ -1,6 +1,6 @@ {- git-annex repository differences - - - Copyright 2015 Joey Hess + - Copyright 2015-2024 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -51,6 +51,7 @@ data Difference = ObjectHashLower | OneLevelObjectHash | OneLevelBranchHash + | Simulation deriving (Show, Read, Eq, Ord, Enum, Bounded) -- This type is used internally for efficient checking for differences, @@ -60,6 +61,7 @@ data Differences { objectHashLower :: Bool , oneLevelObjectHash :: Bool , oneLevelBranchHash :: Bool + , simulation :: Bool } | UnknownDifferences @@ -71,6 +73,7 @@ instance Eq Differences where [ objectHashLower , oneLevelObjectHash , oneLevelBranchHash + , simulation ] appendDifferences :: Differences -> Differences -> Differences @@ -78,6 +81,7 @@ appendDifferences a@(Differences {}) b@(Differences {}) = a { objectHashLower = objectHashLower a || objectHashLower b , oneLevelObjectHash = oneLevelObjectHash a || oneLevelObjectHash b , oneLevelBranchHash = oneLevelBranchHash a || oneLevelBranchHash b + , simulation = simulation a || simulation b } appendDifferences _ _ = UnknownDifferences @@ -85,7 +89,7 @@ instance Sem.Semigroup Differences where (<>) = appendDifferences instance Monoid Differences where - mempty = Differences False False False + mempty = Differences False False False False readDifferences :: String -> Differences readDifferences = maybe UnknownDifferences mkDifferences . readish @@ -97,26 +101,28 @@ getDifferences :: Git.Repo -> Differences getDifferences r = mkDifferences $ S.fromList $ mapMaybe getmaybe [minBound .. maxBound] where - getmaybe d = case Git.Config.isTrueFalse' =<< Git.Config.getMaybe (differenceConfigKey d) r of + getmaybe d = case Git.Config.isTrueFalse' =<< flip Git.Config.getMaybe r =<< differenceConfigKey d of Just True -> Just d _ -> Nothing -differenceConfigKey :: Difference -> ConfigKey +differenceConfigKey :: Difference -> Maybe ConfigKey differenceConfigKey ObjectHashLower = tunable "objecthashlower" differenceConfigKey OneLevelObjectHash = tunable "objecthash1" differenceConfigKey OneLevelBranchHash = tunable "branchhash1" +differenceConfigKey Simulation = Nothing differenceConfigVal :: Difference -> String differenceConfigVal _ = Git.Config.boolConfig True -tunable :: B.ByteString -> ConfigKey -tunable k = ConfigKey ("annex.tune." <> k) +tunable :: B.ByteString -> Maybe ConfigKey +tunable k = Just $ ConfigKey ("annex.tune." <> k) hasDifference :: Difference -> Differences -> Bool hasDifference _ UnknownDifferences = False hasDifference ObjectHashLower ds = objectHashLower ds hasDifference OneLevelObjectHash ds = oneLevelObjectHash ds hasDifference OneLevelBranchHash ds = oneLevelBranchHash ds +hasDifference Simulation ds = simulation ds listDifferences :: Differences -> [Difference] listDifferences d@(Differences {}) = map snd $ @@ -124,6 +130,7 @@ listDifferences d@(Differences {}) = map snd $ [ (objectHashLower, ObjectHashLower) , (oneLevelObjectHash, OneLevelObjectHash) , (oneLevelBranchHash, OneLevelBranchHash) + , (simulation, Simulation) ] listDifferences UnknownDifferences = [] @@ -132,6 +139,7 @@ mkDifferences s = Differences { objectHashLower = check ObjectHashLower , oneLevelObjectHash = check OneLevelObjectHash , oneLevelBranchHash = check OneLevelBranchHash + , simulation = check Simulation } where check f = f `S.member` s