From 392b15d5c3b80942c2b6c9ca9f207882410c9526 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 7 Jul 2024 21:51:30 -0400 Subject: [PATCH] may have found a way to make a request for a websocket?! dunno, it compiles anyway --- P2P/Http.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/P2P/Http.hs b/P2P/Http.hs index 2e6c291de3..9aba55a1e7 100644 --- a/P2P/Http.hs +++ b/P2P/Http.hs @@ -26,6 +26,7 @@ import Utility.MonotonicClock import Servant import Servant.Client.Streaming import Servant.Client.Core.RunClient +import qualified Servant.Client.Core.Request import qualified Servant.Types.SourceT as S import Servant.API.WebSocket import qualified Network.WebSockets as Websocket @@ -395,14 +396,14 @@ serveLockContent -> Handler () serveLockContent = undefined -data WebSocketClient = WebSocketClient deriving (Eq, Show, Bounded, Enum) +data WebSocketClient = WebSocketClient Servant.Client.Core.Request.Request -- XXX this is enough to let servant-client work, but it's not yet -- possible to run a WebSocketClient. instance RunClient m => HasClient m WebSocket where type Client m WebSocket = WebSocketClient - clientWithRoute _pm Proxy _ = WebSocketClient - hoistClientMonad _ _ _ WebSocketClient = WebSocketClient + clientWithRoute _pm Proxy req = WebSocketClient req + hoistClientMonad _ _ _ w = w clientLockContent :: B64Key @@ -443,7 +444,10 @@ query' = do run :: IO () run = do manager' <- newManager defaultManagerSettings - res <- runClientM query (mkClientEnv manager' (BaseUrl Http "localhost" 8081 "")) + let WebSocketClient wscreq = query' + res <- runClientM (runRequestAcceptStatus Nothing wscreq) + (mkClientEnv manager' (BaseUrl Http "localhost" 8081 "")) + -- res <- runClientM query (mkClientEnv manager' (BaseUrl Http "localhost" 8081 "")) case res of Left err -> putStrLn $ "Error: " ++ show err Right res' -> do