Handling disconnects in yesod-websockets

Question

I'm trying to get yesod-websockets working with my bootstrapped postgresql based yesod app. The websocket should act as a real-time update of a postgres table, thus I need to maintain a state containing a list of connected clients and their userId. How can I run a function as soon as the websocket disconnected? In a bigger picture, this function should be used to remove the websocket connection from the state list.

What I have so far:

type LobbyState = [(UserId, WS.Connection)]

addClient :: (UserId, WS.Connection) -> LobbyState -> LobbyState
addClient (userId, conn) state = (userId, conn) : state

chatApp :: UserId -> WebSocketsT Handler ()
chatApp userId = do
  conn <- ask
  -- connections is a MVar [(UserId, WS.Connection)]
  connections <- lobbyConnections <$> getYesod
  modifyMVar_ connections $ \s -> do
    let s' = addClient (userId, conn) s
    return s'
  -- how to wait for disconnect and execute a function?

getGameR :: Handler TypedContent
getGameR = do
  -- TODO: correct usage??
  userId <- requireAuthId
  webSockets $ chatApp userId
  -- some more normal HTML handler code

In the example they use the following snippet:

race_
        (forever $ atomically (readTChan readChan) >>= sendTextData)
        (sourceWS $$ mapM_C (\msg ->
            atomically $ writeTChan writeChan $ name <> ": " <> msg))

I understand how I could utilize a TChan to forever send updates, but how can I react to the actual disconnect event to clean up some state?

Might be of some use: hackage.haskell.org/package/websockets-0.12.7.1/docs/… — Chris Stryczynski

Jonas Dellinger Jonas Dellinger · Accepted Answer · 2020-08-18T11:30:21

Thanks to Chris Stryczynski's comment, I was able to solve it via a catch handler.

A sample echo server with a cleanup after a client disconnects could look like this:

chatApp :: WebSocketsT Handler ()
chatApp =
  ( forever $ do
      msg :: Text <- receiveData
      sendTextData msg
  )
    `catch` ( \(e :: ConnectionException) -> do
                let eshow = fromString $ show e
                putStrLn $ eshow
                -- clean up specific state here
                case e of
                  CloseRequest code msg ->  -- Handle specific close codes/msg
                    return ()
            )

Handling disconnects in yesod-websockets

1 Answers