implemented cloneSimRepo

Started on updateSimRepoState

diff --git a/Annex/Difference.hs b/Annex/Difference.hs
index fa874476fdc0033b00450c15f9c564c68ed1526c..6c5d8bdada968660a226e5083472a473ed20aa45 100644 (file)
--- 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 8d9eaf9c6df465b591bc46ea02fb34c5485b46a9..8fc4b8ba4f04ed7331023655e767d4a6a3d28e0c 100644 (file)
--- 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 e4075ed851e4411157a2ba19666d97d6a6481cda..167963a3cda49be7a72bc0067d3b8ece39d5fb11 100644 (file)
--- a/Types/Difference.hs
+++ b/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