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

dunno, it compiles anyway
This commit is contained in:
Joey Hess 2024-07-07 21:51:30 -04:00
parent 9ee005e49a
commit 392b15d5c3
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -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