diff options
Diffstat (limited to 'Server.hs')
| -rw-r--r-- | Server.hs | 19 |
1 files changed, 9 insertions, 10 deletions
@@ -16,7 +16,6 @@ import Log import Network.Wai import Network.Wai.Handler.Warp import Network.Wai.Handler.WebSockets -import Network.WebSockets hiding (Message) import qualified Network.WebSockets as WS import Network.HTTP.Types import Control.Concurrent @@ -124,7 +123,7 @@ websocketApp :: ServerOpts -> TVar ServerState -> WS.ServerApp websocketApp o ssv pending_conn = do conn <- WS.acceptRequest pending_conn _v <- negotiateWireVersion conn - r <- receiveData conn + r <- WS.receiveData conn case r of SelectMode ClientSends (InitMode email) -> user email o ssv conn SelectMode ClientSends (ConnectMode t) -> @@ -136,7 +135,7 @@ websocketApp o ssv pending_conn = do user :: EmailAddress -> ServerOpts -> TVar ServerState -> WS.Connection -> IO () user email o ssv conn = do sid <- withSessionID (serverDirectory o) $ \(loghv, sid) -> do - sendBinaryData conn (Ready ServerSends sid) + WS.sendBinaryData conn (Ready ServerSends sid) bracket (setup sid loghv) (cleanup sid) go return sid doneSessionLog email o sid @@ -173,7 +172,7 @@ user email o ssv conn = do case v of Just (Broadcast l _from) -> case loggedMessage l of Developer m -> do - sendBinaryData conn (AnyMessage (Developer m)) + WS.sendBinaryData conn (AnyMessage (Developer m)) relaytouser userchan User _ -> relaytouser userchan Nothing -> return () @@ -188,12 +187,12 @@ developer o ssv sid conn = bracket setup cleanup go sessionLogFile (serverDirectory o) sid if exists then do - sendBinaryData conn (Ready ServerSends sid) + WS.sendBinaryData conn (Ready ServerSends sid) replayBacklog o sid conn - sendBinaryData conn Done + WS.sendBinaryData conn Done else protocolError conn "Unknown session ID" go (Just session) = do - sendBinaryData conn (Ready ServerSends sid) + WS.sendBinaryData conn (Ready ServerSends sid) devchan <- replayBacklogAndListen o sid session conn mytid <- mkWeakThreadId =<< myThreadId _ <- relayfromdeveloper mytid session @@ -216,7 +215,7 @@ developer o ssv sid conn = bracket setup cleanup go v <- atomically $ readTMChan devchan case v of Just (Broadcast l from) -> do - let sendit = sendBinaryData conn + let sendit = WS.sendBinaryData conn (AnyMessage $ loggedMessage l) case loggedMessage l of User _ -> sendit @@ -231,7 +230,7 @@ developer o ssv sid conn = bracket setup cleanup go else sendit relaytodeveloper mytid devchan Nothing -> do - sendBinaryData conn Done + WS.sendBinaryData conn Done return () -- | Replay the log of what's happened in the session so far, @@ -253,7 +252,7 @@ replayBacklog :: ServerOpts -> SessionID -> WS.Connection -> IO () replayBacklog o sid conn = do ls <- streamLog (sessionLogFile (serverDirectory o) sid) forM_ ls $ \l -> case loggedMessage <$> l of - Right m -> sendBinaryData conn (AnyMessage m) + Right m -> WS.sendBinaryData conn (AnyMessage m) Left _ -> return () doneSessionLog :: EmailAddress -> ServerOpts -> SessionID -> IO () |