The WebSockets library contains an open issue about sending messages from multiple threads.
As an example I took a look at websocket-shootout, and noticed a forked thread for receiveData.
void $ fork $ silentLoop (Unagi.readChan readEnd >>= Ws.sendTextData conn)
silentLoop $ do
msg <- Ws.receiveData conn
case parseMsg msg of
Nothing -> Ws.sendClose conn ("Invalid message" :: LByteString)
Just Echo -> Ws.sendTextData conn msg
Just (Broadcast res) -> do
Unagi.writeChan writeEnd msg
Ws.sendTextData conn res
I was under the impression from the open issue that this would cause issues.
Would it be safe to assume that it's only unsafe to use sendTextData from more than one thread?
In my actual backend server, I'm creating 3 threads per connection:
Ping thread via withPingThread
"Consumer" thread, where it polls with receiveData like the above example
"Producer" thread, where it polls from a TQueue of messages for a given connection, and sends the message via sendTextData.
This thread is to allow multiple threads to queue up messages for a single connection, while only a single thread (this thread) sends text data to the client (except for the fact that receiveData can send text data as well, from the consumer thread).
Is there any obvious mistakes with my approach?
Note that the reported issue is only a problem if compression is used. The websocket-shootout example uses Ws.defaultConnectionOptions which means compression is disabled. As long as you also leave compression disabled, you shouldn't run into any problems with this issue.
Related
I am trying to test my game server with websockets, but i am having problems using multiple clients.
Connecting every single one of them works fine, but when i start the game and send the first messages over the sockets they throw an "ConnectionClosed" error.
The server code looks like this:
main :: IO ()
main = do
state <- newMVar []
putStrLn "listening"
WS.runServer "127.0.0.1" 9000 $ \pen -> do
c <- WS.acceptRequest pen
putStrLn "user connected"
cs <- takeMVar state
let cs' = c : cs
case Vector.fromList cs' :: Maybe (Vector.Vector 4 WS.Connection) of
Just v -> do
let
us = Vector.imap
(\i x -> websocketUser x ("websocket user " ++ show i))
v
putMVar state []
g <- exampleGame us
_ <- playGame g
return ()
Nothing -> putMVar state cs'
To test this I opened 4 chrome tabs and connected each one of them to the server. For every tab i connect the server prints the "user connected" line and after 4 connections the game should start but all sockets get disconnected. It does work fine if I only connect one client. So I think the problem is that I am connection all clients from the same machine. However I don't know how I can test this without using multiple devices. I already tried using different browsers and ports for each client.
My question:
Is this caused by connecting all clients from the same machine and chrome or the server reuses the existing connections or something similar, if yes how can I solve this so I can test my game localy?
Or is there something wrong with my Haskell code?
websocket library
vector-sized
See the documentation for the ServerApp type. Once the IO action finishes, the underlying socket is closed. So, each of your first three clients accepts a connection, stores the connection in the state, and then finishes, closing the connection. Only the fourth client keeps its connection open, and it can't do anything useful with the other three connections, which have now been closed.
If you replace the last line with:
Nothing -> do
putMVar state cs'
threadDelay (10^9) -- wait a while
then that will probably get all four clients connected.
To fix this "for real", you could have the first three connections wait forever and then arrange for the fourth thread to kill them when the game is over.
However, I'm not sure this is the right architecture. Instead of having the only the fourth connection thread running and polling all four connections, you probably want each connection thread to enter a loop to process incoming messages from its client. These threads can modify a shared game state and/or directly broadcast messages to the other client (like the sample "chat" program in the websockets documentation) or else queue up incoming messages for a separate game thread to process.
I'm trying to do communication between Haskell lightweight threads. Threads want to send each other messages for communication and synchronisation.
I was originally using TMVar for this, but I've just realised that the semantics are wrong: a TMVar will store one message in it internally, so positing a message to an empty TMVar won't block. It'll only block if you post a message to a full TMVar.
Can anyone suggest a similar STM IPC construct which:
will cause all writes to block until the message is consumed;
will cause all reads to block until a message is provided?
i.e. a zero-length pipe would be ideal; but I don't think BoundedChan would be happy if I gave it a capacity of 0. (Also, it's not STM.)
If I understand your problem correctly, I don't think you can, since the transactional guarantees mean that transaction A can't read from transaction B's write until transaction B is committed, at which point it can no longer block.
TMVar is the closest you're going to get if you're using STM. With IO, you may be able to build a structure which only completes a write when a reader is available (this structure may already exist, but I'm not aware of it).
I'd suggest to reformulate the two requirements:
will cause all writes to block until the message is consumed;
will cause all reads to block until a message is provided.
The problem is with terms block and consumed/provided. With STM there is no notion of block, there is just retry, which has a different semantics: It restarts the current transaction - it doesn't wait until something happens (this could cause deadlocks). So we can't say "block until ...", we can only say something like "the transaction succeeds only when ...".
Similarly, what does "until a message is consumed/provided" mean? Since transactions are atomic, it can only be "until the transaction that consumed/provided a message succeeded".
So let's try to reformulate:
will cause all writes to retry until a transaction that consumes the message succeeds;
will cause all reads to retry until a transaction that provides a message succeeds.
But now the first point doesn't make sense: If a write retries, there is no message to be consumed, the transaction didn't pause, it's been discarded and started over - possibly producing a different message!
In other words: Any data can ever leave a STM transaction only when it succeeds (completes). This is by design - the transactions are always atomic from the point of view of the outside world / other transactions - you can never observe results of only a part of a transaction. You can never observe two transactions interacting.
So a 0-length queue is a bad analogy - it will never allow to pass any data though. At the end of any transaction, it'll have to have to be empty, so no data will ever pass through.
Nevertheless I believe it'll be possible to reformulate the requirements according to your goals and subsequently find a solution.
You say you would be happy with one side or the other being in IO rather than STM. So then it is not too hard to code this up. Let's start with the version that has receiving in IO. To make this happen, the receiver will have to initiate the handshake.
type SynchronousVar a = TChan (TMVar a)
send :: SynchronousVar a -> a -> STM a
receive :: SynchronousVar a -> IO a
send svar a = do
tmvar <- readTChan svar
putTMVar tmvar a
receive svar = do
tmvar <- newEmptyTMVarIO
atomically $ writeTChan svar tmvar
atomically $ takeTMVar tmvar
A similar protocol can be written that has sending start the handshake.
type SynchronousVar a = TChan (a, TMVar ())
send :: SynchronousVar a -> a -> IO a
receive :: SynchronousVar a -> STM a
send svar a = do
tmvar <- newEmptyTMVarIO
atomically $ writeTChan svar (a, tmvar)
atomically $ takeTMVar tmvar
receive svar = do
(a, tmvar) <- readTChan svar
putTMvar tmvar ()
return a
Probably, if you really need synchronous communication, this is because you want two-way communication (i.e. the action that's running in IO wants to know something about the thread it's synchronizing with). It is not hard to extend the above protocol to pass off a tad more information about the synchronization (by adding it to the one-tuple in the former case or to the TMVar in the latter case).
Can I do long polling in Yesod, or any other Haskell web framework with comparable database facilities?
To be precise, I want to delay a HTTP response until something interesting happens. There should also be a timeout after which the client will be served a response saying "nothing happened" and then the client will issue the same request.
To make life even more complicated, the app I have in mind is serving all its stuff over both HTTP/HTML5 and a really compact UDP protocol to MIDP clients. Events from either protocol can release responses in either protocol.
TIA,
Adrian.
I can't answer all the issues of the more complicated UDP stuff, but the short answer is that, yes, Yesod supports long polling. You can essentially do something like:
myHandler = do
mres <- timeout timeoutInMicroseconds someAction
case mres of
Nothing -> return nothingHappenedResponse
Just res -> doSomething res
You'll probably want to used System.Timeout.Lifted from the lifted-base package.
Michael's answer hits the timeout requirement. For general clients you do not want to keep HTTP responses waiting for more than about 60 seconds as they may be connecting through a proxy or similar which tend to get impatient after about that long. If you're on a more tightly controlled network then you may be able to relax this timeout. One minor correction is that the parameter to timeout is in microseconds not nanoseconds.
For the 'wait for something interesting to happen' part, we use the check combinator from Control.Concurrent.STM (which wraps up retry) so our handler thread waits on a TVar:
someAction = do
interestingStuff <- atomically $ do
currentStuff <- readTVar theStuff
check $ isInteresting currentStuff
return currentStuff
respondWith interestingStuff
Meanwhile, other threads (incl HTTP handlers) are updating theStuff :: TVar Stuff - each update triggers a new calculation of isInteresting and potentially a response if it returns True.
This is compatible with serving the same information over UDP: simply share theStuff between your UDP server threads and the Yesod threads.
I've worked my way through Don Stewart's Roll your own IRC bot tutorial, and am playing around with some extensions to it. My current code is essentially the same as the "The monadic, stateful, exception-handling bot in all its glory"; it's a bit too long to paste here unless someone requests it.
Being a Comcast subscriber, it's particularly important that the bot be able to reconnect after periods of poor connectivity. My approach is to simply time the PING requests from the server, and if it goes without seeing a PING for a certain time, to try reconnecting.
So far, the best solution I've found is to wrap the hGetLine in the listen loop with System.Timeout.timeout. However, this seems to require defining a custom exception so that the catch in main can call main again, rather than return (). It also seems quite fragile to specify a timeout value for each individual hGetLine.
Is there a better solution, perhaps something that wraps an IO a like bracket and catch so that the entire main can handle network timeouts without the overhead of a new exception type?
How about running a separate thread that performs all the reading and writing and takes care of periodically reconnecting the handle?
Something like this
input :: Chan Char
output :: Chan Char
putChar c = writeChan output c
keepAlive = forever $ do
h <- connectToServer
catch
(forever $
do c <- readChan output; timeout 4000 (hPutChar h c); return ())
(\_ -> return ())
The idea is to encapsulate all the difficulty with periodically reconnecting into a separate thread.
I'm writing a little notification server to push data to a client. The basic architecture looks something like this (pared down pseudo-code):
acceptConnections sock = forever $ do
connection <- accept sock
forkIO (handleConnection connection)
handleConnection connection = do
connectionHandle <- socketToHandle connection ReadWriteMode
handleMessage connectionHandle
hClose connectionHandle
handleMessage connectionHandle = forever $ do
message <- hGetLine connectionHandle
if shouldPushMessage message
then hPutStrLn targetConnection message
else return ()
Where targetConnection (in handleMessage) is from a separate connection and is hanging up handleMessage in a different thread waiting for its buffer to be filled. I would think this would cause a problem as I have 2 threads accessing the same Handle. So, my question is, why isn't this a problem? Or is it, and I just haven't seen it turn into an issue yet? In my actual application, when I grab targetConnection, I do so through a map I access via an MVar, but it's not being safely accessed at the hGetLine call.
Disclaimer: I'm a complete Haskell and multi-threaded newb
Thanks for any explanations/insight!
Handle, as implemented in GHC, is already an MVar wrapping over the underlying IODevice. I didn't quite get what you're doing (not saying it was unclear, I'm a little ill so perhaps I'm slow) but am guessing GHCs built in thread-safe handling of Handle is saving you.