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.

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index 5393d65b0d6388d353457473327ad925db058543..b9596c14e7a9d50677faf5f92b949b270d8fc898 100644 (file)
--- 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 a6ab76f1fb39b68cb1a3603b9d79cc00e59ed0c0..f11ef112c2ef33c5248a8bd1bce15dd1faa6bc1c 100644 (file)
--- 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