diff --git a/Annex/Locations.hs b/Annex/Locations.hs index 0b8b34ec38..e28fb7c5ad 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -108,6 +108,7 @@ module Annex.Locations ( gitAnnexSshDir, gitAnnexRemotesDir, gitAnnexAssistantDefaultDir, + gitAnnexSimDir, HashLevels(..), hashDirMixed, hashDirLower, @@ -675,6 +676,9 @@ gitAnnexRemotesDir r = gitAnnexAssistantDefaultDir :: FilePath gitAnnexAssistantDefaultDir = "annex" +gitAnnexSimDir :: Git.Repo -> RawFilePath +gitAnnexSimDir r = P.addTrailingPathSeparator $ gitAnnexDir r P. "sim" + {- Sanitizes a String that will be used as part of a Key's keyName, - dealing with characters that cause problems. - diff --git a/Annex/Sim.hs b/Annex/Sim.hs index 601cb7c9d0..cb3deb311c 100644 --- a/Annex/Sim.hs +++ b/Annex/Sim.hs @@ -40,6 +40,7 @@ import qualified Annex.Queue import System.Random import Data.Word +import Text.Read import qualified Data.Map.Strict as M import qualified Data.Set as S import qualified Data.ByteString as B @@ -49,13 +50,12 @@ import qualified Data.UUID.V5 as U5 import qualified Utility.RawFilePath as R import qualified System.FilePath.ByteString as P -data SimState = SimState +data SimState t = SimState { simRepos :: M.Map RepoName UUID - , simRepoList :: [RepoName] - , simRepoState :: M.Map UUID SimRepoState + , simRepoState :: M.Map UUID (SimRepoState t) , simConnections :: M.Map UUID (S.Set RemoteName) , simFiles :: M.Map RawFilePath Key - , simRng :: StdGen + , simRng :: Int , simTrustLevels :: M.Map UUID TrustLevel , simNumCopies :: NumCopies , simMinCopies :: MinCopies @@ -65,21 +65,20 @@ data SimState = SimState , simGroupWanted :: M.Map Group PreferredContentExpression , simMaxSize :: M.Map UUID MaxSize , simRebalance :: Bool - , simGetExistingRepoByName :: GetExistingRepoByName - , simGetSimRepoPath :: GetSimRepoPath , simHistory :: [SimCommand] , simVectorClock :: VectorClock + , simFile :: Maybe FilePath + , simRootDirectory :: FilePath } - deriving (Show) + deriving (Show, Read) -emptySimState :: StdGen -> GetExistingRepoByName -> GetSimRepoPath -> SimState -emptySimState rng repobyname getpath = SimState +emptySimState :: Int -> FilePath -> SimState t +emptySimState rngseed rootdir = SimState { simRepos = mempty - , simRepoList = mempty , simRepoState = mempty , simConnections = mempty , simFiles = mempty - , simRng = rng + , simRng = rngseed , simTrustLevels = mempty , simNumCopies = configuredNumCopies 1 , simMinCopies = configuredMinCopies 1 @@ -89,26 +88,26 @@ emptySimState rng repobyname getpath = SimState , simGroupWanted = mempty , simMaxSize = mempty , simRebalance = False - , simGetExistingRepoByName = repobyname - , simGetSimRepoPath = getpath , simHistory = [] , simVectorClock = VectorClock 0 + , simFile = Nothing + , simRootDirectory = rootdir } -- State that can vary between different repos in the simulation. -data SimRepoState = SimRepoState +data SimRepoState t = SimRepoState { simLocations :: M.Map Key (M.Map UUID LocationState) , simIsSpecialRemote :: Bool - , simRepo :: Maybe SimRepo + , simRepo :: Maybe t , simRepoName :: RepoName } - deriving (Show) + deriving (Show, Read) data LocationState = LocationState VectorClock Bool - deriving (Eq, Show) + deriving (Eq, Show, Read) newtype VectorClock = VectorClock Int - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Read) newerLocationState :: LocationState -> LocationState -> LocationState newerLocationState l1@(LocationState vc1 _) l2@(LocationState vc2 _) @@ -116,7 +115,7 @@ newerLocationState l1@(LocationState vc1 _) l2@(LocationState vc2 _) | otherwise = l2 {- Updates the state of stu to indicate that a key is present or not in u. -} -setPresentKey :: Bool -> UUID -> Key -> UUID -> SimState -> SimState +setPresentKey :: Bool -> UUID -> Key -> UUID -> SimState SimRepo -> SimState SimRepo setPresentKey present u k stu st = st { simRepoState = case M.lookup stu (simRepoState st) of Just rst -> M.insert stu @@ -125,7 +124,7 @@ setPresentKey present u k stu st = st Nothing -> error "no simRepoState in setPresentKey" } -setPresentKey' :: Bool -> VectorClock -> UUID -> Key -> SimRepoState -> SimRepoState +setPresentKey' :: Bool -> VectorClock -> UUID -> Key -> SimRepoState t -> SimRepoState t setPresentKey' present vc u k rst = rst { simLocations = M.insertWith (M.unionWith newerLocationState) k @@ -133,7 +132,7 @@ setPresentKey' present vc u k rst = rst (simLocations rst) } -getSimLocations :: SimRepoState -> Key -> S.Set UUID +getSimLocations :: SimRepoState t -> Key -> S.Set UUID getSimLocations rst k = maybe mempty getSimLocations' $ M.lookup k (simLocations rst) @@ -143,14 +142,14 @@ getSimLocations' = M.keysSet . M.filter present where present (LocationState _ b) = b -addHistory :: SimState -> SimCommand -> SimState +addHistory :: SimState t -> SimCommand -> SimState t addHistory st c = st { simHistory = c : simHistory st } newtype RepoName = RepoName { fromRepoName :: String } - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) newtype RemoteName = RemoteName { fromRemoteName :: String } - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) remoteNameToRepoName :: RemoteName -> RepoName remoteNameToRepoName (RemoteName n) = RepoName n @@ -165,7 +164,7 @@ data Connections | RepoName :=> Connections | RemoteName :<= Connections | RepoName :<=> Connections - deriving (Show) + deriving (Show, Read) leftSideOfConnection :: Connections -> RepoName leftSideOfConnection (reponame :-> _) = reponame @@ -217,7 +216,7 @@ data SimCommand | CommandRebalance Bool | CommandComment String | CommandBlank - deriving (Show) + deriving (Show, Read) data SimAction = ActionPull RemoteName @@ -227,26 +226,28 @@ data SimAction | ActionSendWanted RemoteName | ActionGitPush RemoteName | ActionGitPull RemoteName - deriving (Show) + deriving (Show, Read) -runSimCommand :: SimCommand -> SimState -> Annex SimState -runSimCommand (CommandStep n) st +runSimCommand :: SimCommand -> GetExistingRepoByName -> SimState SimRepo -> Annex (SimState SimRepo) +runSimCommand (CommandStep n) repobyname st | n > 0 = case randomRepo st of (Just (repo, u), st') -> let (act, st'') = randomAction u st' - in runSimCommand (CommandAction repo act) st'' - >>= runSimCommand (CommandStep (pred n)) + in runSimCommand (CommandAction repo act) repobyname st'' + >>= runSimCommand (CommandStep (pred n)) repobyname (Nothing, st') -> return st' | otherwise = return st -runSimCommand cmd st = case applySimCommand cmd st of - Left err -> giveup err - Right (Right st') -> return st' - Right (Left mkst) -> mkst +runSimCommand cmd repobyname st = + case applySimCommand cmd st repobyname of + Left err -> giveup err + Right (Right st') -> return st' + Right (Left mkst) -> mkst applySimCommand :: SimCommand - -> SimState - -> Either String (Either (Annex SimState) SimState) + -> SimState SimRepo + -> GetExistingRepoByName + -> Either String (Either (Annex (SimState SimRepo)) (SimState SimRepo)) applySimCommand cmd st = applySimCommand' cmd $ flip addHistory cmd $ st { simVectorClock = @@ -256,24 +257,25 @@ applySimCommand cmd st = applySimCommand' :: SimCommand - -> SimState - -> Either String (Either (Annex SimState) SimState) -applySimCommand' (CommandInit reponame) st = + -> SimState SimRepo + -> GetExistingRepoByName + -> Either String (Either (Annex (SimState SimRepo)) (SimState SimRepo)) +applySimCommand' (CommandInit reponame) st _ = checkNonexistantRepo reponame st $ let (u, st') = genSimUUID st reponame in Right $ Right $ addRepo reponame (newSimRepoConfig u False) st' -applySimCommand' (CommandInitRemote reponame) st = +applySimCommand' (CommandInitRemote reponame) st _ = checkNonexistantRepo reponame st $ let (u, st') = genSimUUID st reponame in Right $ Right $ addRepo reponame (newSimRepoConfig u True) st' -applySimCommand' (CommandUse reponame s) st = - case getExistingRepoByName (simGetExistingRepoByName st) s of +applySimCommand' (CommandUse reponame s) st repobyname = + case getExistingRepoByName repobyname s of Right existingrepo -> checkNonexistantRepo reponame st $ Right $ Right $ addRepo reponame existingrepo st Left msg -> Left $ "Unable to use a repository \"" ++ fromRepoName reponame ++ "\" in the simulation because " ++ msg -applySimCommand' (CommandConnect connections) st = +applySimCommand' (CommandConnect connections) st repobyname = let (repo, remote, mconnections) = getConnection connections in checkKnownRepo repo st $ \u -> let st' = st @@ -286,8 +288,8 @@ applySimCommand' (CommandConnect connections) st = in case mconnections of Nothing -> Right $ Right st' Just connections' -> - applySimCommand' (CommandConnect connections') st' -applySimCommand' (CommandDisconnect connections) st = + applySimCommand' (CommandConnect connections') st' repobyname +applySimCommand' (CommandDisconnect connections) st repobyname = let (repo, remote, mconnections) = getConnection connections in checkKnownRepo repo st $ \u -> let st' = st @@ -300,12 +302,12 @@ applySimCommand' (CommandDisconnect connections) st = in case mconnections of Nothing -> Right $ Right $ st Just connections' -> - applySimCommand' (CommandDisconnect connections') st' -applySimCommand' (CommandAddTree repo expr) st = + applySimCommand' (CommandDisconnect connections') st' repobyname +applySimCommand' (CommandAddTree repo expr) st _ = checkKnownRepo repo st $ const $ checkValidPreferredContentExpression expr $ Left $ error "TODO" -- XXX -applySimCommand' (CommandAdd file sz repos) st = +applySimCommand' (CommandAdd file sz repos) st _ = let (k, st') = genSimKey sz st in go k st' repos where @@ -315,14 +317,15 @@ applySimCommand' (CommandAdd file sz repos) st = { simFiles = M.insert file k (simFiles st') } in go k st'' rest -applySimCommand' (CommandStep _) _ = error "applySimCommand' CommandStep" -applySimCommand' (CommandAction repo act) st = +applySimCommand' (CommandStep _) _ _ = error "applySimCommand' CommandStep" +applySimCommand' (CommandAction repo act) st _ = checkKnownRepo repo st $ \u -> applySimAction repo u act st -applySimCommand' (CommandSeed rngseed) st = Right $ Right $ st - { simRng = mkStdGen rngseed - } -applySimCommand' (CommandPresent repo file) st = checkKnownRepo repo st $ \u -> +applySimCommand' (CommandSeed rngseed) st _ = + Right $ Right $ st + { simRng = rngseed + } +applySimCommand' (CommandPresent repo file) st _ = checkKnownRepo repo st $ \u -> case (M.lookup file (simFiles st), M.lookup u (simRepoState st)) of (Just k, Just rst) | u `S.member` getSimLocations rst k -> @@ -336,7 +339,7 @@ applySimCommand' (CommandPresent repo file) st = checkKnownRepo repo st $ \u -> missing = Left $ "Expected " ++ fromRawFilePath file ++ " to be present in " ++ 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 u (simRepoState st)) of (Just k, Just rst) | u `S.notMember` getSimLocations rst k -> @@ -350,56 +353,64 @@ applySimCommand' (CommandNotPresent repo file) st = checkKnownRepo repo st $ \u present = Left $ "Expected " ++ fromRawFilePath file ++ " not to be present in " ++ fromRepoName repo ++ ", but it is present." -applySimCommand' (CommandNumCopies n) st = Right $ Right $ st - { simNumCopies = configuredNumCopies n - } -applySimCommand' (CommandMinCopies n) st = Right $ Right $ st - { simMinCopies = configuredMinCopies n - } -applySimCommand' (CommandTrustLevel repo trustlevel) st = +applySimCommand' (CommandNumCopies n) st _ = + Right $ Right $ st + { simNumCopies = configuredNumCopies n + } +applySimCommand' (CommandMinCopies n) st _ = + Right $ Right $ st + { simMinCopies = configuredMinCopies n + } +applySimCommand' (CommandTrustLevel repo trustlevel) st _ = checkKnownRepo repo st $ \u -> Right $ Right $ st { simTrustLevels = M.insert u trustlevel (simTrustLevels st) } -applySimCommand' (CommandGroup repo groupname) st = checkKnownRepo repo st $ \u -> - Right $ Right $ st - { simGroups = M.insertWith S.union u - (S.singleton groupname) - (simGroups st) - } -applySimCommand' (CommandUngroup repo groupname) st = checkKnownRepo repo st $ \u -> - Right $ Right $ st - { simGroups = M.adjust (S.delete groupname) u (simGroups st) - } -applySimCommand' (CommandWanted repo expr) st = checkKnownRepo repo st $ \u -> - checkValidPreferredContentExpression expr $ Right $ st - { simWanted = M.insert u expr (simWanted st) - } -applySimCommand' (CommandRequired repo expr) st = checkKnownRepo repo st $ \u -> - checkValidPreferredContentExpression expr $ Right $ st - { simRequired = M.insert u expr (simRequired st) - } -applySimCommand' (CommandGroupWanted groupname expr) st = +applySimCommand' (CommandGroup repo groupname) st _ = + checkKnownRepo repo st $ \u -> + Right $ Right $ st + { simGroups = M.insertWith S.union u + (S.singleton groupname) + (simGroups st) + } +applySimCommand' (CommandUngroup repo groupname) st _ = + checkKnownRepo repo st $ \u -> + Right $ Right $ st + { simGroups = M.adjust (S.delete groupname) u (simGroups st) + } +applySimCommand' (CommandWanted repo expr) st _ = + checkKnownRepo repo st $ \u -> + checkValidPreferredContentExpression expr $ Right $ st + { simWanted = M.insert u expr (simWanted st) + } +applySimCommand' (CommandRequired repo expr) st _ = + checkKnownRepo repo st $ \u -> + checkValidPreferredContentExpression expr $ Right $ st + { simRequired = M.insert u expr (simRequired st) + } +applySimCommand' (CommandGroupWanted groupname expr) st _ = checkValidPreferredContentExpression expr $ Right $ st { simGroupWanted = M.insert groupname expr (simGroupWanted st) } -applySimCommand' (CommandMaxSize repo sz) st = checkKnownRepo repo st $ \u -> +applySimCommand' (CommandMaxSize repo sz) st _ = + checkKnownRepo repo st $ \u -> + Right $ Right $ st + { simMaxSize = M.insert u sz (simMaxSize st) + } +applySimCommand' (CommandRebalance b) st _ = Right $ Right $ st - { simMaxSize = M.insert u sz (simMaxSize st) + { simRebalance = b } -applySimCommand' (CommandRebalance b) st = Right $ Right $ st - { simRebalance = b - } -applySimCommand' (CommandComment _) st = Right $ Right st -applySimCommand' CommandBlank st = Right $ Right st +applySimCommand' (CommandComment _) st _ = Right $ Right st +applySimCommand' CommandBlank st _ = Right $ Right st applySimAction :: RepoName -> UUID -> SimAction - -> SimState - -> Either String (Either (Annex SimState) SimState) + -> SimState SimRepo + -> Either String (Either (Annex (SimState SimRepo)) (SimState SimRepo)) applySimAction _r _u (ActionPull _remote) _st = undefined -- TODO applySimAction _r _u (ActionPush _remote) _st = undefined -- TODO applySimAction r u (ActionGetWanted remote) st = @@ -475,17 +486,17 @@ overFilesRemote -> RemoteName -> (UUID -> S.Set UUID -> Bool) -> (Maybe Key -> AssociatedFile -> UUID -> Annex Bool) - -> (UUID -> RawFilePath -> Key -> RepoName -> SimState -> SimState) - -> SimState - -> Either String (Either (Annex SimState) SimState) + -> (UUID -> RawFilePath -> Key -> RepoName -> SimState SimRepo -> SimState SimRepo) + -> SimState SimRepo + -> Either String (Either (Annex (SimState SimRepo)) (SimState SimRepo)) overFilesRemote r u remote remotepred checkwant handlewanted st = checkKnownRemote remote r u st $ \remoteu -> Right $ Left $ liftIO $ - runSimRepo u st $ \rst -> + runSimRepo u st $ \rst -> do let l = M.toList $ M.filter (checkremotepred remoteu rst) $ simFiles st - in go remoteu l st + go remoteu l st where go _ [] st' = return st' go remoteu ((f, k):rest) st' = do @@ -502,8 +513,8 @@ overFilesRemote r u remote remotepred checkwant handlewanted st = simulateGitAnnexMerge :: RepoName -> RepoName - -> SimState - -> Either String (Either (Annex SimState) SimState) + -> SimState SimRepo + -> Either String (Either (Annex (SimState SimRepo)) (SimState SimRepo)) simulateGitAnnexMerge src dest st = case (M.lookup src (simRepos st), M.lookup dest (simRepos st)) of (Just srcu, Just destu) -> case M.lookup destu (simRepoState st) of @@ -523,19 +534,19 @@ simulateGitAnnexMerge src dest st = } _ -> Left $ "Unable to find " ++ fromRepoName src ++ " or " ++ fromRepoName dest ++ " in simRepos" -checkNonexistantRepo :: RepoName -> SimState -> Either String a -> Either String a +checkNonexistantRepo :: RepoName -> SimState SimRepo -> Either String a -> Either String a checkNonexistantRepo reponame st a = case M.lookup reponame (simRepos st) of Nothing -> a Just _ -> Left $ "There is already a repository in the simulation named \"" ++ fromRepoName reponame ++ "\"." -checkKnownRepo :: RepoName -> SimState -> (UUID -> Either String a) -> Either String a +checkKnownRepo :: RepoName -> SimState SimRepo -> (UUID -> Either String a) -> Either String a checkKnownRepo reponame st a = case M.lookup reponame (simRepos st) of Just u -> a u Nothing -> Left $ "No repository in the simulation is named \"" ++ fromRepoName reponame ++ "\"." -checkKnownRemote :: RemoteName -> RepoName -> UUID -> SimState -> (UUID -> Either String a) -> Either String a +checkKnownRemote :: RemoteName -> RepoName -> UUID -> SimState SimRepo -> (UUID -> Either String a) -> Either String a checkKnownRemote remotename reponame u st a = let rs = fromMaybe mempty $ M.lookup u (simConnections st) in if S.member remotename rs @@ -550,21 +561,25 @@ checkValidPreferredContentExpression expr v = Nothing -> Right v Just e -> Left $ "Failed parsing \"" ++ expr ++ "\": " ++ e -simRandom :: SimState -> (StdGen -> (v, StdGen)) -> (v -> r) -> (r, SimState) +simRandom :: SimState t -> (StdGen -> (v, StdGen)) -> (v -> r) -> (r, SimState t) simRandom st mk f = - let (v, rng) = mk (simRng st) - in (f v, st { simRng = rng }) + let rng = mkStdGen (simRng st) + (v, rng') = mk rng + (newseed, _) = random rng' + in (f v, st { simRng = newseed }) -randomRepo :: SimState -> (Maybe (RepoName, UUID), SimState) +randomRepo :: SimState SimRepo -> (Maybe (RepoName, UUID), SimState SimRepo) randomRepo st - | null (simRepoList st) = (Nothing, st) + | null repolist = (Nothing, st) | otherwise = simRandom st - (randomR (0, length (simRepoList st) - 1)) $ \n -> do - let r = simRepoList st !! n + (randomR (0, length repolist - 1)) $ \n -> do + let r = repolist !! n u <- M.lookup r (simRepos st) return (r, u) + where + repolist = M.keys (simRepos st) -randomAction :: UUID -> SimState -> (SimAction, SimState) +randomAction :: UUID -> SimState SimRepo -> (SimAction, SimState SimRepo) randomAction u st = case M.lookup u (simConnections st) of Just cs | not (S.null cs) -> let (mkact, st') = simRandom st (randomR (0, length mkactions - 1)) @@ -595,14 +610,14 @@ randomWords = go [] let (w, g') = random g in go (w:c) (pred n) g' -genSimKey :: ByteSize -> SimState -> (Key, SimState) +genSimKey :: ByteSize -> SimState t -> (Key, SimState t) genSimKey sz st = simRandom st (randomWords 1024) mk where mk b = let tk = genTestKey $ L.pack b in alterKey tk $ \kd -> kd { keySize = Just sz } -genSimUUID :: SimState -> RepoName -> (UUID, SimState) +genSimUUID :: SimState t -> RepoName -> (UUID, SimState t) genSimUUID st (RepoName reponame) = simRandom st (randomWords 1024) (\l -> genUUIDInNameSpace simUUIDNameSpace (encodeBS reponame <> B.pack l)) @@ -617,11 +632,6 @@ newtype GetExistingRepoByName = GetExistingRepoByName instance Show GetExistingRepoByName where show _ = "GetExistingRepoByName" -newtype GetSimRepoPath = GetSimRepoPath (UUID -> FilePath) - -instance Show GetSimRepoPath where - show _ = "GetSimRepoPath" - data SimRepoConfig = SimRepoConfig { simRepoConfigUUID :: UUID , simRepoConfigIsSpecialRemote :: Bool @@ -646,12 +656,9 @@ newSimRepoConfig u isspecialremote = SimRepoConfig , simRepoConfigMaxSize = Nothing } -addRepo :: RepoName -> SimRepoConfig -> SimState -> SimState +addRepo :: RepoName -> SimRepoConfig -> SimState SimRepo -> SimState SimRepo addRepo reponame simrepo st = st { simRepos = M.insert reponame u (simRepos st) - , simRepoList = if reponame `elem` simRepoList st - then simRepoList st - else reponame : simRepoList st , simRepoState = M.insert u rst (simRepoState st) , simConnections = M.insert u mempty (simConnections st) , simGroups = M.insert u (simRepoConfigGroups simrepo) (simGroups st) @@ -721,7 +728,7 @@ mkGetExistingRepoByName = do data SimRepo = SimRepo { simRepoGitRepo :: Repo , simRepoAnnex :: (Annex.AnnexState, Annex.AnnexRead) - , simRepoCurrState :: SimState + , simRepoCurrState :: SimState SimRepo , simRepoUUID :: UUID } @@ -729,10 +736,10 @@ instance Show SimRepo where show _ = "SimRepo" {- Inits and updates SimRepos to reflect the SimState. -} -updateSimRepos :: SimState -> IO SimState +updateSimRepos :: SimState SimRepo -> IO (SimState SimRepo) updateSimRepos st = updateSimRepoStates st >>= initNewSimRepos -updateSimRepoStates :: SimState -> IO SimState +updateSimRepoStates :: SimState SimRepo -> IO (SimState SimRepo) updateSimRepoStates st = go st (M.toList $ simRepoState st) where go st' [] = return st' @@ -747,15 +754,15 @@ updateSimRepoStates st = go st (M.toList $ simRepoState st) go st'' rest Nothing -> go st' rest -initNewSimRepos :: SimState -> IO SimState +initNewSimRepos :: SimState SimRepo -> IO (SimState SimRepo) initNewSimRepos = \st -> go st (M.toList $ simRepoState st) where go st [] = return st go st ((u, rst):rest) = case simRepo rst of Nothing -> do - let GetSimRepoPath getdest = simGetSimRepoPath st - sr <- initSimRepo (simRepoName rst) u (getdest u) st + let d = simRepoDirectory st u + sr <- initSimRepo (simRepoName rst) u d st let rst' = rst { simRepo = Just sr } let st' = st { simRepoState = M.insert u rst' @@ -764,7 +771,10 @@ initNewSimRepos = \st -> go st (M.toList $ simRepoState st) go st' rest _ -> go st rest -initSimRepo :: RepoName -> UUID -> FilePath -> SimState -> IO SimRepo +simRepoDirectory :: SimState t -> UUID -> FilePath +simRepoDirectory st u = simRootDirectory st fromUUID u + +initSimRepo :: RepoName -> UUID -> FilePath -> SimState SimRepo -> IO SimRepo initSimRepo simreponame u dest st = do inited <- boolSystem "git" [ Param "init" @@ -785,10 +795,8 @@ initSimRepo simreponame u dest st = do updateSimRepoState st $ SimRepo { simRepoGitRepo = simrepo , simRepoAnnex = ast' - , simRepoCurrState = emptySimState - (simRng st) - (simGetExistingRepoByName st) - (simGetSimRepoPath st) + , simRepoCurrState = + emptySimState (simRng st) (simRootDirectory st) , simRepoUUID = u } @@ -799,7 +807,7 @@ simulatedRepositoryDescription simreponame = simulationDifferences :: Differences simulationDifferences = mkDifferences $ S.singleton Simulation -runSimRepo :: UUID -> SimState -> (SimRepoState -> Annex SimState) -> IO SimState +runSimRepo :: UUID -> SimState SimRepo -> (SimRepoState SimRepo -> Annex (SimState SimRepo)) -> IO (SimState SimRepo) runSimRepo u st a = do st' <- updateSimRepos st case M.lookup u (simRepoState st') of @@ -819,7 +827,7 @@ runSimRepo u st a = do Nothing -> error $ "runSimRepo simRepo not set for " ++ fromUUID u Nothing -> error $ "runSimRepo simRepoState not found for " ++ fromUUID u -updateSimRepoState :: SimState -> SimRepo -> IO SimRepo +updateSimRepoState :: SimState SimRepo -> SimRepo -> IO SimRepo updateSimRepoState newst sr = do ((), (ast, ard)) <- Annex.run (simRepoAnnex sr) $ doQuietAction $ do let oldst = simRepoCurrState sr @@ -934,3 +942,54 @@ updateField -> DiffUpdate a b m -> m () updateField old new f = updateMap (f old) (f new) + +suspendSim :: SimState SimRepo -> IO () +suspendSim st = do + -- Update the sim repos before suspending, so that at restore time + -- they are up-to-date. + st' <- updateSimRepos st + let st'' = st' + { simRepoState = M.map freeze (simRepoState st) + } + writeFile (simRootDirectory st "state") (show st'') + where + freeze :: SimRepoState SimRepo -> SimRepoState () + freeze rst = rst { simRepo = Nothing } + +restoreSim :: RawFilePath -> IO (Either String (SimState SimRepo)) +restoreSim rootdir = + tryIO (readFile (fromRawFilePath rootdir "state")) >>= \case + Left err -> return (Left (show err)) + Right c -> case readMaybe c :: Maybe (SimState ()) of + Nothing -> return (Left "unable to parse sim state file") + Just st -> do + repostate <- M.fromList + <$> mapM (thaw st) (M.toList (simRepoState st)) + let st' = st + { simRepoState = + M.map (finishthaw st') repostate + } + return (Right st') + where + thaw st (u, rst) = tryNonAsync (thaw' st u) >>= return . \case + Left _ -> (u, rst { simRepo = Nothing }) + Right r -> (u, rst { simRepo = Just r }) + thaw' st u = do + simrepo <- Git.Construct.fromPath $ toRawFilePath $ + simRepoDirectory st u + ast <- Annex.new simrepo + return $ SimRepo + { simRepoGitRepo = simrepo + , simRepoAnnex = ast + , simRepoCurrState = + -- Placeholder, replaced later with current + -- state. + emptySimState (simRng st) + (simRootDirectory st) + , simRepoUUID = u + } + finishthaw st rst = rst + { simRepo = case simRepo rst of + Nothing -> Nothing + Just sr -> Just $ sr { simRepoCurrState = st } + } diff --git a/CHANGELOG b/CHANGELOG index 80f728186f..9c5ec5a91b 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -6,6 +6,9 @@ git-annex (10.20240832) UNRELEASED; urgency=medium "not balanced" and "not sizebalanced". * Fix --explain display of onlyingroup preferred content expression. * Allow maxsize to be set to 0 to stop checking maxsize for a repository. + * sim: New command, can be used to simulate networks of repositories + and see how preferred content and other configuration makes file + content flow through it. -- Joey Hess Tue, 03 Sep 2024 12:38:42 -0400 diff --git a/Command/Sim.hs b/Command/Sim.hs index 9b812ed1d6..76dd88af3b 100644 --- a/Command/Sim.hs +++ b/Command/Sim.hs @@ -12,9 +12,11 @@ module Command.Sim where import Command import Annex.Sim import Annex.Sim.File -import Utility.Tmp.Dir +import Annex.Perms +import Utility.Env import System.Random +import qualified Data.Map as M cmd :: Command cmd = command "sim" SectionTesting @@ -22,19 +24,78 @@ cmd = command "sim" SectionTesting paramCommand (withParams seek) seek :: CmdParams -> CommandSeek -seek _ = do - rng <- initStdGen - repobyname <- mkGetExistingRepoByName - withTmpDir "sim" $ \tmpdir -> do - let getpath = GetSimRepoPath $ \u -> tmpdir fromUUID u - let st = emptySimState rng repobyname getpath - st' <- runSimCommand (CommandInit (RepoName "foo")) st - >>= runSimCommand (CommandUse (RepoName "bar") "here") - >>= runSimCommand (CommandAdd "bigfile" 1000000 [RepoName "foo"]) - >>= runSimCommand (CommandAction (RepoName "bar") (ActionGitPull (RemoteName "foo"))) - >>= runSimCommand (CommandAction (RepoName "bar") (ActionGetWanted (RemoteName "foo"))) - st'' <- liftIO $ updateSimRepos st' - liftIO $ print tmpdir - _ <- liftIO $ getLine - return () +seek ("start":[]) = start Nothing +seek ("start":simfile:[]) = start (Just simfile) +seek ("end":[]) = do + simdir <- fromRepo gitAnnexSimDir + liftIO $ removeDirectoryRecursive $ fromRawFilePath simdir +seek ("visit":reponame:[]) = do + simdir <- fromRepo gitAnnexSimDir + liftIO (restoreSim simdir) >>= \case + Left err -> giveup err + Right st -> case M.lookup (RepoName reponame) (simRepos st) of + Just u -> do + let dir = simRepoDirectory st u + unlessM (liftIO $ doesDirectoryExist dir) $ + giveup "Simulated repository unavailable." + showLongNote "Starting a shell in the simulated repository." + shellcmd <- liftIO $ fromMaybe "sh" <$> getEnv "SHELL" + exitcode <- liftIO $ + safeSystem' shellcmd [] + (\p -> p { cwd = Just dir }) + showLongNote "Finished visit to simulated repository." + liftIO $ exitWith exitcode + Nothing -> giveup $ unwords + [ "There is no simulated repository with that name." + , "Choose from:" + , unwords $ map fromRepoName $ M.keys (simRepos st) + ] +seek ps = case parseSimCommand ps of + Left err -> giveup err + Right simcmd -> do + repobyname <- mkGetExistingRepoByName + simdir <- fromRepo gitAnnexSimDir + liftIO (restoreSim simdir) >>= \case + Left err -> giveup err + Right st -> + runSimCommand simcmd repobyname st + >>= liftIO . saveState +start :: Maybe FilePath -> CommandSeek +start simfile = do + simdir <- fromRawFilePath <$> fromRepo gitAnnexSimDir + whenM (liftIO $ doesDirectoryExist simdir) $ + giveup "A sim was previously started. Use `git-annex sim end` to stop it before starting a new one." + + let simlogfile = case simfile of + Nothing -> simdir "log.sim" + Just f -> simdir takeFileName f + + rng <- fst . random <$> initStdGen + let st = (emptySimState rng simdir) + { simFile = Just simlogfile } + case simfile of + Nothing -> startup simdir st [] + Just f -> case parseSimFile f of + Left err -> giveup err + Right cs -> startup simdir st cs + showLongNote $ UnquotedString "Sim started, logging to sim file " + <> QuotedPath (toRawFilePath simlogfile) + where + startup simdir st cs = do + repobyname <- mkGetExistingRepoByName + createAnnexDirectory (toRawFilePath simdir) + st' <- go st repobyname cs + liftIO $ saveState st' + + go st _ [] = return st + go st repobyname (c:cs) = do + st' <- runSimCommand c repobyname st + go st' repobyname cs + +saveState :: SimState SimRepo -> IO () +saveState st = do + suspendSim st + case simFile st of + Just f -> writeFile f $ generateSimFile $ reverse $ simHistory st + Nothing -> noop diff --git a/Types/Group.hs b/Types/Group.hs index 03c14099c2..d9c4555346 100644 --- a/Types/Group.hs +++ b/Types/Group.hs @@ -22,7 +22,7 @@ import qualified Data.Set as S import qualified Data.ByteString as S newtype Group = Group S.ByteString - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Read) fromGroup :: Group -> String fromGroup (Group g) = decodeBS g diff --git a/Types/Key.hs b/Types/Key.hs index 2d901c0af7..4e357b1eb6 100644 --- a/Types/Key.hs +++ b/Types/Key.hs @@ -68,7 +68,7 @@ instance NFData KeyData data Key = MkKey { keyData :: KeyData , keySerialization :: S.ShortByteString - } deriving (Show, Generic) + } deriving (Show, Read, Generic) instance Eq Key where -- comparing the serialization would be unnecessary work diff --git a/Types/NumCopies.hs b/Types/NumCopies.hs index a7944d404f..c9b0ec05aa 100644 --- a/Types/NumCopies.hs +++ b/Types/NumCopies.hs @@ -44,7 +44,7 @@ import Control.Monad.IO.Class (MonadIO) import Data.Time.Clock.POSIX (POSIXTime) newtype NumCopies = NumCopies Int - deriving (Ord, Eq, Show) + deriving (Ord, Eq, Show, Read) -- Smart constructor; prevent configuring numcopies to 0 which would -- cause data loss. @@ -57,7 +57,7 @@ fromNumCopies :: NumCopies -> Int fromNumCopies (NumCopies n) = n newtype MinCopies = MinCopies Int - deriving (Ord, Eq, Show) + deriving (Ord, Eq, Show, Read) configuredMinCopies :: Int -> MinCopies configuredMinCopies n diff --git a/Types/RepoSize.hs b/Types/RepoSize.hs index a94b7c21d3..81b3169d7d 100644 --- a/Types/RepoSize.hs +++ b/Types/RepoSize.hs @@ -26,7 +26,7 @@ newtype RepoSize = RepoSize { fromRepoSize :: Integer } -- The maximum size of a repo. newtype MaxSize = MaxSize { fromMaxSize :: Integer } - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) -- An offset to the size of a repo. newtype SizeOffset = SizeOffset { fromSizeChange :: Integer } diff --git a/Types/TrustLevel.hs b/Types/TrustLevel.hs index 15487ad729..503314a3db 100644 --- a/Types/TrustLevel.hs +++ b/Types/TrustLevel.hs @@ -22,7 +22,7 @@ import Data.Ord import Types.UUID data TrustLevel = DeadTrusted | UnTrusted | SemiTrusted | Trusted - deriving (Eq, Enum, Ord, Bounded, Show) + deriving (Eq, Enum, Ord, Bounded, Show, Read) instance Default TrustLevel where def = SemiTrusted diff --git a/doc/git-annex-matchexpression.mdwn b/doc/git-annex-matchexpression.mdwn index 0b11bb3fde..514f5e7f9b 100644 --- a/doc/git-annex-matchexpression.mdwn +++ b/doc/git-annex-matchexpression.mdwn @@ -68,6 +68,8 @@ For example, this will exit 0: [[git-annex-matching-expression]](1) +[[git-annex-sim]](1) + # AUTHOR Joey Hess