How to use Network.WebSockets.Snap in a snaplet?

Question

It would be nice to be able to use the Network.WebSockets module from inside a snaplet, but I can't figure out how to actually do it.

Using the runWebSocketsSnap :: MonadSnap m => ServerApp -> m () function from Network.WebSockets.Snap it is easy to include a simple stateless websocket server in my app:

routes :: [(ByteString, Handler App App ())]
routes = [ ("/ws", runWebSocketsSnap wsApp) ]

wsApp :: PendingConnection -> IO () -- this is the ServerApp type
wsApp pending = do
    conn <- acceptRequest pending
    forever $ do
        msg <- receiveData conn
        sendTextData conn ("Echo " `mappend` msg :: Text)

But my goal is to maintain a state for the webscket server (for example, a list of the connected clients, as in http://jaspervdj.be/websockets/example.html). Alternatively, access to the acid-state store of the snaplet would be great.

My first idea was to liftIO the websocket actions into the Handler App App monad, and write an app like this:

wsApp :: PendingConnection -> Handler App App ()
wsApp pending = do
    conn <- liftIO $ acceptRequest pending
    forever $ do
        msg <- liftIO $ receiveData conn
        update (SetLastMsg msg)
        liftIO $ sendTextData conn ("Stored msg in datastore.")

But there is no version of runWebSocketsSnap that takes an app of the above form, and I can't figure out how to modify the existing one (source on hackage). It seems to me one would need an alternative to forkIO that takes an action in the Handler App App monad instead, but my understanding of Haskell and especially concurrency in Snap ends here...

Answer 1

The runWebSocketsSnap function requires that its argument be of type PendingConnection -> IO (). This means that you can't access your App data structure inside of that function directly. What you need to do is pass the information to the function as an argument something like this.

routes = [ ("/ws", webSocketsDriver) ]

webSocketsDriver :: Handler App App ()
webSocketsDriver = do
    appState <- get
    runWebSocketsSnap (wsApp appState)

wsApp :: App -> PendingConnection -> IO ()
wsApp app pending = do
    ...