sim: implement dropunwantedfrom

Annex/Sim.hs

@@ -447,49 +447,11 @@ getSimActionComponents (ActionSendWanted repo remote) st =
 		addHistory st' $ CommandPresent (remoteNameToRepoName remote) f
 getSimActionComponents (ActionDropUnwanted repo Nothing) st =
 	checkKnownRepo repo st $ \u ->
-		Right $ Left (st, map (go u) $ M.toList $ simFiles st)
+		simulateDropUnwanted st u repo u
-  where
+getSimActionComponents (ActionDropUnwanted repo (Just remote)) st =
-	go u (f, k) st' = liftIO $ runSimRepo u st' $ \rst ->
+	checkKnownRepo repo st $ \u ->
-		let af = AssociatedFile $ Just f
+		checkKnownRemote remote repo u st $ \ru ->
-		in if present u rst k
+			simulateDropUnwanted st u (remoteNameToRepoName remote) ru
-			then ifM (wantDrop NoLiveUpdate False Nothing (Just k) af Nothing)
-				( return $ checkdrop u rst k st'
-				, return st'
-				)
-			else return st'
-	
-	present u rst k = u `S.member` getSimLocations rst k
-
-	checkdrop u rst k st' =
-		let numcopies = simNumCopies st'
-		    mincopies = simMinCopies st'
-		    verifiedcopies = mapMaybe (verifypresent u k st') $
-		    	filter (/= u) $ S.toList $ getSimLocations rst k
-		in case safeDropAnalysis numcopies mincopies verifiedcopies Nothing of
-			UnsafeDrop -> st'
-			SafeDrop -> dodrop u k st'
-			SafeDropCheckTime -> dodrop u k st'
-
-	dodrop u k = setPresentKey False u k u
-	
-	remotes u = S.fromList $ mapMaybe 
-		(\remote -> M.lookup (remoteNameToRepoName remote) (simRepos st))
-		(maybe mempty S.toList $ M.lookup u $ simConnections st)
-	
-	verifypresent u k st' ru = do
-		rst <- M.lookup ru (simRepoState st')
-		if present ru rst k
-			then if ru `S.member` remotes u
-				then Just $ if simIsSpecialRemote rst
-					then mkVerifiedCopy RecentlyVerifiedCopy ru
-					else mkVerifiedCopy LockedCopy ru
-				else case M.lookup ru (simTrustLevels st') of
-					Just Trusted -> Just $
-						mkVerifiedCopy TrustedCopy ru
-					_ -> Nothing
-			else Nothing
-getSimActionComponents (ActionDropUnwanted _repo (Just _remote)) _st =
-	undefined -- TODO
 getSimActionComponents (ActionGitPush repo remote) st =
 	checkKnownRepo repo st $ \u -> 
 		checkKnownRemote remote repo u st $ \_ ->
@@ -602,6 +564,58 @@ simulateGitAnnexMerge src dest st =
 						}
 		_ -> Left $ "Unable to find " ++ fromRepoName src ++ " or " ++ fromRepoName dest ++ " in simRepos"
 
+simulateDropUnwanted
+	:: SimState SimRepo
+	-> UUID
+	-> RepoName
+	-> UUID
+	-> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo)]) (SimState SimRepo))
+simulateDropUnwanted st u dropfromname dropfrom =
+	Right $ Left (st, map go $ M.toList $ simFiles st)
+  where
+	go (f, k) st' = liftIO $ runSimRepo u st' $ \rst ->
+		let af = AssociatedFile $ Just f
+		in if present dropfrom rst k
+			then ifM (wantDrop NoLiveUpdate False (Just dropfrom) (Just k) af Nothing)
+				( return $ checkdrop rst k f st'
+				, return st'
+				)
+			else return st'
+	
+	present ru rst k = ru `S.member` getSimLocations rst k
+
+	checkdrop rst k f st' =
+		let numcopies = simNumCopies st'
+		    mincopies = simMinCopies st'
+		    verifiedcopies = mapMaybe (verifypresent k st') $
+		    	filter (/= dropfrom) $ S.toList $ getSimLocations rst k
+		in case safeDropAnalysis numcopies mincopies verifiedcopies Nothing of
+			UnsafeDrop -> st'
+			SafeDrop -> dodrop k f st'
+			SafeDropCheckTime -> dodrop k f st'
+
+	dodrop k f st' =
+		setPresentKey False dropfrom k u $
+			setPresentKey False dropfrom k dropfrom $
+				addHistory st' $ CommandNotPresent dropfromname f
+	
+	remotes = S.fromList $ mapMaybe 
+		(\remote -> M.lookup (remoteNameToRepoName remote) (simRepos st))
+		(maybe mempty S.toList $ M.lookup u $ simConnections st)
+	
+	verifypresent k st' ru = do
+		rst <- M.lookup ru (simRepoState st')
+		if present ru rst k
+			then if ru `S.member` remotes || ru == u
+				then Just $ if simIsSpecialRemote rst
+					then mkVerifiedCopy RecentlyVerifiedCopy ru
+					else mkVerifiedCopy LockedCopy ru
+				else case M.lookup ru (simTrustLevels st') of
+					Just Trusted -> Just $
+						mkVerifiedCopy TrustedCopy ru
+					_ -> Nothing
+			else Nothing
+
 checkNonexistantRepo :: RepoName -> SimState SimRepo -> Either String a -> Either String a
 checkNonexistantRepo reponame st a = case M.lookup reponame (simRepos st) of
 	Nothing -> a

Annex/Sim/File.hs

@@ -97,7 +97,7 @@ formatAction (ActionSync (RepoName repo) (RemoteName remote)) =
 formatAction (ActionGetWanted (RepoName repo) (RemoteName remote)) =
 	["action", repo, "getwanted", remote]
 formatAction (ActionDropUnwanted (RepoName repo) (Just (RemoteName remote))) =
-	["action", repo, "dropunwanted", remote]
+	["action", repo, "dropunwantedfrom", remote]
 formatAction (ActionDropUnwanted (RepoName repo) Nothing) =
 	["action", repo, "dropunwanted"]
 formatAction (ActionSendWanted (RepoName repo) (RemoteName remote)) =
@@ -197,11 +197,11 @@ parseSimAction ("action":repo:"getwanted":remote:rest) =
 	mkAction rest $ ActionGetWanted (RepoName repo) (RemoteName remote)
 parseSimAction ("action":repo:"sendwanted":remote:rest) =
 	mkAction rest $ ActionSendWanted (RepoName repo) (RemoteName remote)
-parseSimAction ("action":repo:"dropunwanted":rest) =
+parseSimAction ("action":repo:"dropunwantedfrom":remote:rest) =
-	mkAction rest $ ActionDropUnwanted (RepoName repo) Nothing
-parseSimAction ("action":repo:"dropunwanted":remote:rest) =
 	mkAction rest $ ActionDropUnwanted (RepoName repo)
 		(Just (RemoteName remote))
+parseSimAction ("action":repo:"dropunwanted":rest) =
+	mkAction rest $ ActionDropUnwanted (RepoName repo) Nothing
 parseSimAction ("action":repo:"gitpush":remote:rest) =
 	mkAction rest $ ActionGitPush (RepoName repo) (RemoteName remote)
 parseSimAction ("action":repo:"gitpull":remote:rest) =

doc/git-annex-sim.mdwn

@@ -192,7 +192,7 @@ as passed to "git annex sim" while a simulation is running.
   Simulate the repository dropping files it does not want, 
   when it is able to verify enough copies exist on remotes.
 
-* `action repo dropunwanted remote`
+* `action repo dropunwantedfrom remote`
 
   Simulate the repository dropping files from the remote that the remote
   does not want, when it is able to verify enouh copies exist.
@@ -217,7 +217,7 @@ as passed to "git annex sim" while a simulation is running.
 * `action repo push remote`
 
   Simulate the equivilant of [[git-annex-push]](1) by combining
-  the actions sendwanted, dropunwanted, and gitpush.
+  the actions sendwanted, dropunwantedfrom, and gitpush.
 
 * `action repo sync remote`
 

doc/todo/git-annex_proxies.mdwn

@@ -34,8 +34,6 @@ Planned schedule of work:
 
 * sim: implement addtree
 
-* sim: implement ActionDropUnwanted
-
 ## items deferred until later for balanced preferred content and maxsize tracking
 
 * `git-annex assist --rebalance` of `balanced=foo:2`