implemented cloneSimRepo

Started on updateSimRepoState

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

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

Types/Difference.hs

@@ -1,6 +1,6 @@
 {- git-annex repository differences
  -
- - Copyright 2015 Joey Hess <id@joeyh.name>
+ - Copyright 2015-2024 Joey Hess <id@joeyh.name>
  -
  - 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