use P2P protocol for drop

Not yet used for everything else, but this is enough to
verify that it works, and do some benchmarking.

Some bugfixes included, which got it working. Also fallback to old
actions has been verified to work correctly.

Benchmarked dropping one thousand files from a ssh remote on localhost.
Using the old git-annex	40.867 seconds.
With the P2P protocol	9.905 seconds!

This commit was sponsored by Jochen Bartl on Patreon.

Remote/Git.hs

@@ -54,10 +54,11 @@ import Remote.Helper.Export
 import qualified Remote.Helper.Ssh as Ssh
 import qualified Remote.GCrypt
 import qualified Remote.P2P
-import P2P.Address
+import qualified Remote.Helper.P2P as P2PHelper
 import qualified P2P.Protocol as P2P
 import qualified P2P.Annex as P2P
 import qualified P2P.IO as P2P
+import P2P.Address
 import Annex.Path
 import Creds
 import Messages.Progress
@@ -150,11 +151,12 @@ gen r u c gc
 	| otherwise = case repoP2PAddress r of
 		Nothing -> do
 			duc <- mkDeferredUUIDCheck r u gc
-			go duc <$> remoteCost gc defcst
+			connpool <- Ssh.mkP2PSshConnectionPool
+			go duc connpool <$> remoteCost gc defcst
 		Just addr -> Remote.P2P.chainGen addr r u c gc
   where
 	defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
-	go duc cst = Just new
+	go duc connpool cst = Just new
 	  where
 		new = Remote 
 			{ uuid = u
@@ -163,7 +165,7 @@ gen r u c gc
 			, storeKey = copyToRemote new duc
 			, retrieveKeyFile = copyFromRemote new
 			, retrieveKeyFileCheap = copyFromRemoteCheap new
-			, removeKey = dropKey new duc
+			, removeKey = dropKey new duc connpool
 			, lockContent = Just (lockKey new duc)
 			, checkPresent = inAnnex new duc
 			, checkPresentCheap = repoCheap r
@@ -368,8 +370,8 @@ keyUrls r key = map tourl locs'
 	remoteconfig = gitconfig r
 	cfg = remoteGitConfig remoteconfig
 
-dropKey :: Remote -> DeferredUUIDCheck -> Key -> Annex Bool
-dropKey r duc key
+dropKey :: Remote -> DeferredUUIDCheck -> Ssh.P2PSshConnectionPool -> Key -> Annex Bool
+dropKey r duc connpool key
 	| not $ Git.repoIsUrl (repo r) = ifM duc
 		( guardUsable (repo r) (return False) $
 			commitOnCleanup r $ onLocalFast r $ do
@@ -383,7 +385,9 @@ dropKey r duc key
 		, return False
 		)
 	| Git.repoIsHttp (repo r) = giveup "dropping from http remote not supported"
-	| otherwise = commitOnCleanup r $ Ssh.dropKey (repo r) key
+	| otherwise = commitOnCleanup r $ do
+		let fallback = Ssh.dropKey (repo r) key
+		P2PHelper.remove (runProto r connpool fallback) key
 
 lockKey :: Remote -> DeferredUUIDCheck -> Key -> (VerifiedCopy -> Annex r) -> Annex r
 lockKey r duc key callback
@@ -758,12 +762,12 @@ mkDeferredUUIDCheck r u gc
 
 -- Runs a P2P Proto action on a remote when it supports that,
 -- otherwise the fallback action.
-runSsh :: Remote -> Ssh.P2PSshConnectionPool -> Annex a -> P2P.Proto a -> Annex a
-runSsh r connpool fallback proto =
-	Ssh.getP2PSshConnection r connpool >>= maybe fallback go
+runProto :: Remote -> Ssh.P2PSshConnectionPool -> Annex a -> P2P.Proto a -> Annex (Maybe a)
+runProto r connpool fallback proto = Just <$>
+	(Ssh.getP2PSshConnection r connpool >>= maybe fallback go)
   where
 	go c = do
-		(c', v) <- runSsh' proto c
+		(c', v) <- runProtoConn proto c
 		case v of
 			Just res -> do
 				liftIO $ Ssh.storeP2PSshConnection connpool c'
@@ -773,9 +777,9 @@ runSsh r connpool fallback proto =
 			-- connection, and run the fallback.
 			Nothing -> fallback
 
-runSsh' :: P2P.Proto a -> Ssh.P2PSshConnection -> Annex (Ssh.P2PSshConnection, Maybe a)
-runSsh' _ P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing)
-runSsh' a conn@(P2P.OpenConnection (c, _pid)) =
+runProtoConn :: P2P.Proto a -> Ssh.P2PSshConnection -> Annex (Ssh.P2PSshConnection, Maybe a)
+runProtoConn _ P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing)
+runProtoConn a conn@(P2P.OpenConnection (c, _pid)) =
 	P2P.runFullProto P2P.Client c a >>= \case
 		Right r -> return (conn, Just r)
 		-- When runFullProto fails, the connection is no longer

Remote/Helper/Ssh.hs

@@ -26,7 +26,6 @@ import Config
 import qualified P2P.Protocol as P2P
 import qualified P2P.IO as P2P
 
-import Control.Concurrent.Async
 import Control.Concurrent.STM
 
 toRepo :: ConsumeStdin -> Git.Repo -> RemoteGitConfig -> SshCommand -> Annex (FilePath, [CommandParam])
@@ -192,7 +191,7 @@ closeP2PSshConnection :: P2PSshConnection -> IO P2PSshConnection
 closeP2PSshConnection P2P.ClosedConnection = return P2P.ClosedConnection
 closeP2PSshConnection (P2P.OpenConnection (conn, pid)) = do
 	P2P.closeConnection conn
-	void $ async $ waitForProcess pid
+	void $ waitForProcess pid
 	return P2P.ClosedConnection
 
 -- Pool of connections over ssh to git-annex-shell p2pstdio.
@@ -235,8 +234,10 @@ storeP2PSshConnection connpool conn = atomically $ modifyTVar' connpool $ \case
 -- If the remote does not support the P2P protocol, that's remembered in 
 -- the connection pool.
 openP2PSshConnection :: Remote -> P2PSshConnectionPool -> Annex (Maybe P2PSshConnection)
-openP2PSshConnection r connpool = 
-	git_annex_shell ConsumeStdin (repo r) "p2pstdio" [] [] >>= \case
+openP2PSshConnection r connpool = do
+	u <- getUUID
+	let ps = [Param (fromUUID u)]
+	git_annex_shell ConsumeStdin (repo r) "p2pstdio" ps [] >>= \case
 		Nothing -> do
 			liftIO $ rememberunsupported
 			return Nothing
@@ -254,11 +255,11 @@ openP2PSshConnection r connpool =
 		let conn = P2P.P2PConnection
 			{ P2P.connRepo = repo r
 			, P2P.connCheckAuth = const False
-			, P2P.connIhdl = from
-			, P2P.connOhdl = to
+			, P2P.connIhdl = to
+			, P2P.connOhdl = from
 			}
 		let c = P2P.OpenConnection (conn, pid)
-		-- When the connection is successful, the peer
+		-- When the connection is successful, the remote
 		-- will send an AUTH_SUCCESS with its uuid.
 		tryNonAsync (P2P.runNetProto conn $ P2P.postAuth) >>= \case
 			Right (Right (Just theiruuid)) | theiruuid == uuid r ->