From 3d13521479d8126cb23c3dd17e4841a9878ae5d5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 9 Jul 2024 13:50:42 -0400
Subject: [PATCH] set up handles for p2phttp

Now it fully works.. for the first request. But then it gets stuck
waiting for the P2P protocol runner to shut down.
---
 Command/P2PHttp.hs |  2 +-
 P2P/Http/State.hs  | 18 ++++++++++++++----
 2 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index 5393d65b0d..b9596c14e7 100644
--- a/Command/P2PHttp.hs
+++ b/Command/P2PHttp.hs
@@ -54,7 +54,7 @@ testCheckPresent = do
 	burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
 	res <- liftIO $ clientCheckPresent (mkClientEnv mgr burl)
 		(P2P.ProtocolVersion 3)
-		(B64Key (fromJust $ deserializeKey ("WORM--foo" :: String)))
+		(B64Key (fromJust $ deserializeKey ("WORM-s30-m1720547401--foo" :: String)))
 		(B64UUID (toUUID ("cu" :: String)))
 		(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
 		[]
diff --git a/P2P/Http/State.hs b/P2P/Http/State.hs
index a6ab76f1fb..f11ef112c2 100644
--- a/P2P/Http/State.hs
+++ b/P2P/Http/State.hs
@@ -118,21 +118,31 @@ withLocalP2PConnections a = do
 		resp <- if connectionServerUUID connparams /= myuuid
 			then return $ Left $ ConnectionFailed "unknown uuid"
 			else do
+				hdl1 <- liftIO newEmptyTMVarIO
+				hdl2 <- liftIO newEmptyTMVarIO
+				waitv1 <- liftIO newEmptyTMVarIO
+				waitv2 <- liftIO newEmptyTMVarIO
+				let h1 = P2PHandleTMVar hdl1 waitv1
+				let h2 = P2PHandleTMVar hdl2 waitv2 
+				let serverconn = P2PConnection Nothing
+					(const True) h1 h2
+					(ConnIdent (Just "http server"))
+				let clientconn = P2PConnection Nothing
+					(const True) h2 h1
+					(ConnIdent (Just "http client"))
 				runst <- liftIO $ mkrunst connparams
-				-- TODO not this, need one with MVars.
-				let conn = stdioP2PConnection Nothing
 				-- TODO is this right? It needs to exit
 				-- when the client stops sending messages.
 				let server = P2P.serveAuthed
 					(connectionServerMode connparams)
 					(connectionServerUUID connparams)
 				let protorunner = void $
-					runFullProto runst conn server
+					runFullProto runst serverconn server
 				asyncworker <- liftIO . async 
 					=<< forkState protorunner
 				let releaseconn = atomically $ putTMVar relv $
 					join (liftIO (wait asyncworker))
-				return $ Right (runst, conn, releaseconn)
+				return $ Right (runst, clientconn, releaseconn)
 		liftIO $ atomically $ putTMVar respvar resp
 
 	mkrunst connparams = do