implemented cloneSimRepo
Started on updateSimRepoState
This commit is contained in:
parent
8d707c4821
commit
4e11cb19ef
3 changed files with 82 additions and 15 deletions
|
@ -56,5 +56,7 @@ setDifferences = do
|
||||||
else return ds
|
else return ds
|
||||||
)
|
)
|
||||||
forM_ (listDifferences ds') $ \d ->
|
forM_ (listDifferences ds') $ \d ->
|
||||||
setConfig (differenceConfigKey d) (differenceConfigVal d)
|
case differenceConfigKey d of
|
||||||
|
Nothing -> noop
|
||||||
|
Just ck -> setConfig ck (differenceConfigVal d)
|
||||||
recordDifferences ds' u
|
recordDifferences ds' u
|
||||||
|
|
73
Annex/Sim.hs
73
Annex/Sim.hs
|
@ -15,17 +15,24 @@ import Types.NumCopies
|
||||||
import Types.Group
|
import Types.Group
|
||||||
import Types.StandardGroups
|
import Types.StandardGroups
|
||||||
import Types.TrustLevel
|
import Types.TrustLevel
|
||||||
|
import Types.Difference
|
||||||
import Git.Types
|
import Git.Types
|
||||||
import Git
|
import Git
|
||||||
import Backend.Hash (genTestKey)
|
import Backend.Hash (genTestKey)
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Annex.FileMatcher
|
import Annex.FileMatcher
|
||||||
|
import Annex.Init
|
||||||
|
import Annex.Startup
|
||||||
import Logs.Group
|
import Logs.Group
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
import Logs.PreferredContent
|
import Logs.PreferredContent
|
||||||
import Logs.Remote
|
import Logs.Remote
|
||||||
import Logs.MaxSize
|
import Logs.MaxSize
|
||||||
|
import Logs.Difference
|
||||||
|
import qualified Annex
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
|
import qualified Git.Construct
|
||||||
|
import qualified Git.Remote.Remove
|
||||||
|
|
||||||
import System.Random
|
import System.Random
|
||||||
import Data.Word
|
import Data.Word
|
||||||
|
@ -61,13 +68,13 @@ data SimState = SimState
|
||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
emptySimState :: Int -> GetExistingRepoByName -> SimState
|
emptySimState :: StdGen -> GetExistingRepoByName -> SimState
|
||||||
emptySimState rngseed repobyname = SimState
|
emptySimState rng repobyname = SimState
|
||||||
{ simRepos = mempty
|
{ simRepos = mempty
|
||||||
, simRepoState = mempty
|
, simRepoState = mempty
|
||||||
, simConnections = mempty
|
, simConnections = mempty
|
||||||
, simFiles = mempty
|
, simFiles = mempty
|
||||||
, simRng = mkStdGen rngseed
|
, simRng = rng
|
||||||
, simTrustLevels = mempty
|
, simTrustLevels = mempty
|
||||||
, simNumCopies = configuredNumCopies 1
|
, simNumCopies = configuredNumCopies 1
|
||||||
, simGroups = mempty
|
, simGroups = mempty
|
||||||
|
@ -83,8 +90,11 @@ emptySimState rngseed repobyname = SimState
|
||||||
data SimRepoState = SimRepoState
|
data SimRepoState = SimRepoState
|
||||||
{ simLocations :: M.Map Key (S.Set RepoName)
|
{ simLocations :: M.Map Key (S.Set RepoName)
|
||||||
, simIsSpecialRemote :: Bool
|
, simIsSpecialRemote :: Bool
|
||||||
|
, simRepo :: Maybe SimRepo
|
||||||
}
|
}
|
||||||
deriving (Show, Eq)
|
|
||||||
|
instance Show SimRepoState where
|
||||||
|
show _ = "SimRepoState"
|
||||||
|
|
||||||
setPresentKey :: RepoName -> Key -> SimRepoState -> SimRepoState
|
setPresentKey :: RepoName -> Key -> SimRepoState -> SimRepoState
|
||||||
setPresentKey repo k rst = rst
|
setPresentKey repo k rst = rst
|
||||||
|
@ -346,6 +356,7 @@ addRepo reponame simrepo st = st
|
||||||
rst = SimRepoState
|
rst = SimRepoState
|
||||||
{ simLocations = mempty
|
{ simLocations = mempty
|
||||||
, simIsSpecialRemote = simRepoIsSpecialRemote simrepo
|
, simIsSpecialRemote = simRepoIsSpecialRemote simrepo
|
||||||
|
, simRepo = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
mkGetExistingRepoByName :: Annex GetExistingRepoByName
|
mkGetExistingRepoByName :: Annex GetExistingRepoByName
|
||||||
|
@ -381,8 +392,16 @@ mkGetExistingRepoByName = do
|
||||||
}
|
}
|
||||||
(_, msg) -> Left msg
|
(_, msg) -> Left msg
|
||||||
|
|
||||||
cloneSimRepo :: RepoName -> UUID -> Repo -> FilePath -> IO ()
|
-- Information about a git repository that is cloned and used to represent
|
||||||
cloneSimRepo simreponame u parent dest = do
|
-- 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"
|
cloned <- boolSystem "git"
|
||||||
[ Param "clone"
|
[ Param "clone"
|
||||||
, Param "--shared"
|
, Param "--shared"
|
||||||
|
@ -391,8 +410,46 @@ cloneSimRepo simreponame u parent dest = do
|
||||||
-- Note that, on visiting the simulated repo,
|
-- Note that, on visiting the simulated repo,
|
||||||
-- the working tree needs to be reset.
|
-- the working tree needs to be reset.
|
||||||
, Param "--no-checkout"
|
, Param "--no-checkout"
|
||||||
|
-- Make sure the origin gets that name.
|
||||||
|
, Param "--origin", Param "origin"
|
||||||
, File (fromRawFilePath (repoPath parent))
|
, File (fromRawFilePath (repoPath parent))
|
||||||
, File dest
|
, File dest
|
||||||
]
|
]
|
||||||
unless cloned $ giveup "git clone failed"
|
unless cloned $
|
||||||
-- TODO delete origin remote from clone, to avoid foot-shooting
|
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
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- git-annex repository differences
|
{- 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.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -51,6 +51,7 @@ data Difference
|
||||||
= ObjectHashLower
|
= ObjectHashLower
|
||||||
| OneLevelObjectHash
|
| OneLevelObjectHash
|
||||||
| OneLevelBranchHash
|
| OneLevelBranchHash
|
||||||
|
| Simulation
|
||||||
deriving (Show, Read, Eq, Ord, Enum, Bounded)
|
deriving (Show, Read, Eq, Ord, Enum, Bounded)
|
||||||
|
|
||||||
-- This type is used internally for efficient checking for differences,
|
-- This type is used internally for efficient checking for differences,
|
||||||
|
@ -60,6 +61,7 @@ data Differences
|
||||||
{ objectHashLower :: Bool
|
{ objectHashLower :: Bool
|
||||||
, oneLevelObjectHash :: Bool
|
, oneLevelObjectHash :: Bool
|
||||||
, oneLevelBranchHash :: Bool
|
, oneLevelBranchHash :: Bool
|
||||||
|
, simulation :: Bool
|
||||||
}
|
}
|
||||||
| UnknownDifferences
|
| UnknownDifferences
|
||||||
|
|
||||||
|
@ -71,6 +73,7 @@ instance Eq Differences where
|
||||||
[ objectHashLower
|
[ objectHashLower
|
||||||
, oneLevelObjectHash
|
, oneLevelObjectHash
|
||||||
, oneLevelBranchHash
|
, oneLevelBranchHash
|
||||||
|
, simulation
|
||||||
]
|
]
|
||||||
|
|
||||||
appendDifferences :: Differences -> Differences -> Differences
|
appendDifferences :: Differences -> Differences -> Differences
|
||||||
|
@ -78,6 +81,7 @@ appendDifferences a@(Differences {}) b@(Differences {}) = a
|
||||||
{ objectHashLower = objectHashLower a || objectHashLower b
|
{ objectHashLower = objectHashLower a || objectHashLower b
|
||||||
, oneLevelObjectHash = oneLevelObjectHash a || oneLevelObjectHash b
|
, oneLevelObjectHash = oneLevelObjectHash a || oneLevelObjectHash b
|
||||||
, oneLevelBranchHash = oneLevelBranchHash a || oneLevelBranchHash b
|
, oneLevelBranchHash = oneLevelBranchHash a || oneLevelBranchHash b
|
||||||
|
, simulation = simulation a || simulation b
|
||||||
}
|
}
|
||||||
appendDifferences _ _ = UnknownDifferences
|
appendDifferences _ _ = UnknownDifferences
|
||||||
|
|
||||||
|
@ -85,7 +89,7 @@ instance Sem.Semigroup Differences where
|
||||||
(<>) = appendDifferences
|
(<>) = appendDifferences
|
||||||
|
|
||||||
instance Monoid Differences where
|
instance Monoid Differences where
|
||||||
mempty = Differences False False False
|
mempty = Differences False False False False
|
||||||
|
|
||||||
readDifferences :: String -> Differences
|
readDifferences :: String -> Differences
|
||||||
readDifferences = maybe UnknownDifferences mkDifferences . readish
|
readDifferences = maybe UnknownDifferences mkDifferences . readish
|
||||||
|
@ -97,26 +101,28 @@ getDifferences :: Git.Repo -> Differences
|
||||||
getDifferences r = mkDifferences $ S.fromList $
|
getDifferences r = mkDifferences $ S.fromList $
|
||||||
mapMaybe getmaybe [minBound .. maxBound]
|
mapMaybe getmaybe [minBound .. maxBound]
|
||||||
where
|
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
|
Just True -> Just d
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
differenceConfigKey :: Difference -> ConfigKey
|
differenceConfigKey :: Difference -> Maybe ConfigKey
|
||||||
differenceConfigKey ObjectHashLower = tunable "objecthashlower"
|
differenceConfigKey ObjectHashLower = tunable "objecthashlower"
|
||||||
differenceConfigKey OneLevelObjectHash = tunable "objecthash1"
|
differenceConfigKey OneLevelObjectHash = tunable "objecthash1"
|
||||||
differenceConfigKey OneLevelBranchHash = tunable "branchhash1"
|
differenceConfigKey OneLevelBranchHash = tunable "branchhash1"
|
||||||
|
differenceConfigKey Simulation = Nothing
|
||||||
|
|
||||||
differenceConfigVal :: Difference -> String
|
differenceConfigVal :: Difference -> String
|
||||||
differenceConfigVal _ = Git.Config.boolConfig True
|
differenceConfigVal _ = Git.Config.boolConfig True
|
||||||
|
|
||||||
tunable :: B.ByteString -> ConfigKey
|
tunable :: B.ByteString -> Maybe ConfigKey
|
||||||
tunable k = ConfigKey ("annex.tune." <> k)
|
tunable k = Just $ ConfigKey ("annex.tune." <> k)
|
||||||
|
|
||||||
hasDifference :: Difference -> Differences -> Bool
|
hasDifference :: Difference -> Differences -> Bool
|
||||||
hasDifference _ UnknownDifferences = False
|
hasDifference _ UnknownDifferences = False
|
||||||
hasDifference ObjectHashLower ds = objectHashLower ds
|
hasDifference ObjectHashLower ds = objectHashLower ds
|
||||||
hasDifference OneLevelObjectHash ds = oneLevelObjectHash ds
|
hasDifference OneLevelObjectHash ds = oneLevelObjectHash ds
|
||||||
hasDifference OneLevelBranchHash ds = oneLevelBranchHash ds
|
hasDifference OneLevelBranchHash ds = oneLevelBranchHash ds
|
||||||
|
hasDifference Simulation ds = simulation ds
|
||||||
|
|
||||||
listDifferences :: Differences -> [Difference]
|
listDifferences :: Differences -> [Difference]
|
||||||
listDifferences d@(Differences {}) = map snd $
|
listDifferences d@(Differences {}) = map snd $
|
||||||
|
@ -124,6 +130,7 @@ listDifferences d@(Differences {}) = map snd $
|
||||||
[ (objectHashLower, ObjectHashLower)
|
[ (objectHashLower, ObjectHashLower)
|
||||||
, (oneLevelObjectHash, OneLevelObjectHash)
|
, (oneLevelObjectHash, OneLevelObjectHash)
|
||||||
, (oneLevelBranchHash, OneLevelBranchHash)
|
, (oneLevelBranchHash, OneLevelBranchHash)
|
||||||
|
, (simulation, Simulation)
|
||||||
]
|
]
|
||||||
listDifferences UnknownDifferences = []
|
listDifferences UnknownDifferences = []
|
||||||
|
|
||||||
|
@ -132,6 +139,7 @@ mkDifferences s = Differences
|
||||||
{ objectHashLower = check ObjectHashLower
|
{ objectHashLower = check ObjectHashLower
|
||||||
, oneLevelObjectHash = check OneLevelObjectHash
|
, oneLevelObjectHash = check OneLevelObjectHash
|
||||||
, oneLevelBranchHash = check OneLevelBranchHash
|
, oneLevelBranchHash = check OneLevelBranchHash
|
||||||
|
, simulation = check Simulation
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
check f = f `S.member` s
|
check f = f `S.member` s
|
||||||
|
|
Loading…
Reference in a new issue