From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 8 Jul 2024 01:51:30 +0000 (-0400)
Subject: may have found a way to make a request for a websocket?!
X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~1^2~21^2~228^2~151
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=392b15d5c3b80942c2b6c9ca9f207882410c9526;p=git-annex.git

may have found a way to make a request for a websocket?!

dunno, it compiles anyway
---

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