Remote.Git removeKey works with annex+http urls

Does not yet handle drop proof lock timestamp checking.

P2P/Http/Client.hs

@@ -210,29 +210,26 @@ clientCheckPresent _ = ()
 
 #ifdef WITH_SERVANT
 clientRemove
-	:: ClientEnv
-	-> ProtocolVersion
-	-> B64Key
-	-> B64UUID ServerSide
-	-> B64UUID ClientSide
-	-> [B64UUID Bypass]
-	-> Maybe Auth
-	-> IO RemoveResultPlus
-clientRemove clientenv (ProtocolVersion ver) key su cu bypass auth =
-	withClientM cli clientenv $ \case
-		Left err -> throwM err
-		Right res -> return res
+	:: Maybe SafeDropProof
+	-> Key
+	-> ClientAction RemoveResultPlus
+clientRemove proof k clientenv (ProtocolVersion ver) su cu bypass auth =
+	liftIO $ withClientM cli clientenv return
   where
+	bk = B64Key k
+
 	cli = case ver of
-		3 -> v3 su V3 key cu bypass auth
-		2 -> v2 su V2 key cu bypass auth
-		1 -> plus <$> v1 su V1 key cu bypass auth
-		0 -> plus <$> v0 su V0 key cu bypass auth
+		3 -> v3 su V3 bk cu bypass auth
+		2 -> v2 su V2 bk cu bypass auth
+		1 -> plus <$> v1 su V1 bk cu bypass auth
+		0 -> plus <$> v0 su V0 bk cu bypass auth
 		_ -> error "unsupported protocol version"
 	
 	_ :<|> _ :<|> _ :<|> _ :<|>
 		_ :<|> _ :<|> _ :<|> _ :<|>
 		v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
+#else
+clientRemove _ _ = ()
 #endif
 
 #ifdef WITH_SERVANT

Remote/Git.hs

@@ -475,11 +475,17 @@ dropKey r st proof key = do
 
 dropKey' :: Git.Repo -> Remote -> State -> Maybe SafeDropProof -> Key -> Annex ()
 dropKey' repo r st@(State connpool duc _ _ _) proof key
+	| isP2PHttp r = p2pHttpClient r giveup (clientRemove proof key) >>= \case
+		RemoveResultPlus True fanoutuuids ->
+			storefanout fanoutuuids
+		RemoveResultPlus False fanoutuuids -> do
+			storefanout fanoutuuids
+			giveup "removing content from remote failed"
 	| not $ Git.repoIsUrl repo = ifM duc
 		( guardUsable repo (giveup "cannot access remote") removelocal
 		, giveup "remote does not have expected annex.uuid value"
 		)
-	| Git.repoIsHttp repo = giveup "dropping from http remote not supported"
+	| Git.repoIsHttp repo = giveup "dropping from this remote is not supported"
 	| otherwise = P2PHelper.remove (uuid r) p2prunner proof key
   where
 	p2prunner = Ssh.runProto r connpool (return (Right False, Nothing))
@@ -506,6 +512,8 @@ dropKey' repo r st@(State connpool duc _ _ _) proof key
 		unless proofunexpired
 			safeDropProofExpired
 			
+	storefanout = P2PHelper.storeFanout key InfoMissing (uuid r) . map fromB64UUID
+
 lockKey :: Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r
 lockKey r st key callback = do
 	repo <- getRepo r
@@ -570,7 +578,7 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key af dest meterupdate vc
 			(gitconfig r)
 			(Ssh.runProto r connpool (return (False, UnVerified)))
 			key af dest meterupdate vc
-	| otherwise = giveup "copying from non-ssh, non-http remote not supported"
+	| otherwise = giveup "copying from this remote is not supported"
   where
 	bwlimit = remoteAnnexBwLimitDownload (gitconfig r)
 		<|> remoteAnnexBwLimit (gitconfig r)
@@ -674,14 +682,15 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key af o meterupdate
 					res <- p2pHttpClient r giveup $
 						clientPut p' key (Just offset) af object sz check'
 					case res of
-						PutResultPlus False _ ->
+						PutResultPlus False fanoutuuids -> do
+							storefanout fanoutuuids
 							failedsend
 						PutResultPlus True fanoutuuids ->
 							storefanout fanoutuuids
 			PutOffsetResultAlreadyHavePlus fanoutuuids ->
 				storefanout fanoutuuids
 	
-	storefanout = P2PHelper.storeFanout key (uuid r) . map fromB64UUID
+	storefanout = P2PHelper.storeFanout key InfoPresent (uuid r) . map fromB64UUID
 
 fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)
 fsckOnRemote r params

Remote/Helper/P2P.hs

@@ -43,17 +43,15 @@ store remoteuuid gc runner k af o p = do
 	metered (Just p) sizer bwlimit $ \_ p' ->
 		runner (P2P.put k af p') >>= \case
 			Just (Just fanoutuuids) -> 
-				storeFanout k remoteuuid fanoutuuids
+				storeFanout k InfoPresent remoteuuid fanoutuuids
 			Just Nothing -> giveup "Transfer failed"
 			Nothing -> remoteUnavail
 
-storeFanout :: Key -> UUID -> [UUID] -> Annex ()
-storeFanout k remoteuuid us = 
-	-- Storing on the remote can cause it to be stored on additional UUIDs, 
-	-- so record those.
+storeFanout :: Key -> LogStatus -> UUID -> [UUID] -> Annex ()
+storeFanout k logstatus remoteuuid us = 
 	forM_ us $ \u ->
 		when (u /= remoteuuid) $
-			logChange k u InfoPresent
+			logChange k u logstatus
 
 retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
 retrieve gc runner k af dest p verifyconfig = do
@@ -67,20 +65,16 @@ retrieve gc runner k af dest p verifyconfig = do
 
 remove :: UUID -> ProtoRunner (Either String Bool, Maybe [UUID]) -> Maybe SafeDropProof -> Key -> Annex ()
 remove remoteuuid runner proof k = runner (P2P.remove proof k) >>= \case
-	Just (Right True, alsoremoveduuids) -> note alsoremoveduuids
+	Just (Right True, alsoremoveduuids) -> 
+		storeFanout k InfoMissing remoteuuid
+			(fromMaybe [] alsoremoveduuids)
 	Just (Right False, alsoremoveduuids) -> do
-		note alsoremoveduuids
+		storeFanout k InfoMissing remoteuuid
+			(fromMaybe [] alsoremoveduuids)
 		giveup "removing content from remote failed"
 	Just (Left err, _) -> do
 		giveup (safeOutput err)
 	Nothing -> remoteUnavail
-  where
-	-- The remote reports removal from other UUIDs than its own,
-	-- so record those.
-	note alsoremoveduuids = 
-		forM_ (fromMaybe [] alsoremoveduuids) $ \u ->
-			when (u /= remoteuuid) $
-				logChange k u InfoMissing
 
 checkpresent :: ProtoRunner (Either String Bool) -> Key -> Annex Bool
 checkpresent runner k =

doc/todo/git-annex_proxies.mdwn

@@ -28,7 +28,9 @@ Planned schedule of work:
 
 ## work notes
 
-* Rest of Remote.Git needs implementing: drop, lock
+* Drop needs to check the proof and use timestamps.
+
+* Rest of Remote.Git needs implementing: lock
 
 * A Locker should expire the lock on its own after 10 minutes,
   initially. Once keeplocked is called, the lock will expire at the end