may have found a way to make a request for a websocket?!
dunno, it compiles anyway
This commit is contained in:
parent
9ee005e49a
commit
392b15d5c3
1 changed files with 8 additions and 4 deletions
12
P2P/Http.hs
12
P2P/Http.hs
|
@ -26,6 +26,7 @@ import Utility.MonotonicClock
|
||||||
import Servant
|
import Servant
|
||||||
import Servant.Client.Streaming
|
import Servant.Client.Streaming
|
||||||
import Servant.Client.Core.RunClient
|
import Servant.Client.Core.RunClient
|
||||||
|
import qualified Servant.Client.Core.Request
|
||||||
import qualified Servant.Types.SourceT as S
|
import qualified Servant.Types.SourceT as S
|
||||||
import Servant.API.WebSocket
|
import Servant.API.WebSocket
|
||||||
import qualified Network.WebSockets as Websocket
|
import qualified Network.WebSockets as Websocket
|
||||||
|
@ -395,14 +396,14 @@ serveLockContent
|
||||||
-> Handler ()
|
-> Handler ()
|
||||||
serveLockContent = undefined
|
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
|
-- XXX this is enough to let servant-client work, but it's not yet
|
||||||
-- possible to run a WebSocketClient.
|
-- possible to run a WebSocketClient.
|
||||||
instance RunClient m => HasClient m WebSocket where
|
instance RunClient m => HasClient m WebSocket where
|
||||||
type Client m WebSocket = WebSocketClient
|
type Client m WebSocket = WebSocketClient
|
||||||
clientWithRoute _pm Proxy _ = WebSocketClient
|
clientWithRoute _pm Proxy req = WebSocketClient req
|
||||||
hoistClientMonad _ _ _ WebSocketClient = WebSocketClient
|
hoistClientMonad _ _ _ w = w
|
||||||
|
|
||||||
clientLockContent
|
clientLockContent
|
||||||
:: B64Key
|
:: B64Key
|
||||||
|
@ -443,7 +444,10 @@ query' = do
|
||||||
run :: IO ()
|
run :: IO ()
|
||||||
run = do
|
run = do
|
||||||
manager' <- newManager defaultManagerSettings
|
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
|
case res of
|
||||||
Left err -> putStrLn $ "Error: " ++ show err
|
Left err -> putStrLn $ "Error: " ++ show err
|
||||||
Right res' -> do
|
Right res' -> do
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue