40 lines
834 B
Haskell
40 lines
834 B
Haskell
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
module WebSocket.Server
|
|
( runWebSocketServer,
|
|
runWSApp,
|
|
)
|
|
where
|
|
|
|
import ClassyPrelude
|
|
import Data.UUID.V4 (nextRandom)
|
|
import Network.WebSockets qualified as WS
|
|
import Types.AppTypes
|
|
import WebSocket
|
|
import WebSocket (WSApp (..))
|
|
|
|
runWebSocketServer ::
|
|
( MonadIO m,
|
|
MonadReader Env m
|
|
) =>
|
|
m ()
|
|
runWebSocketServer = do
|
|
putStrLn "Websocket up at 127.0.0.1:9160"
|
|
wsApp' <- runWSApp
|
|
liftIO $ WS.runServer "127.0.0.1" 9160 wsApp'
|
|
|
|
runWSApp ::
|
|
( MonadIO m,
|
|
MonadReader Env m
|
|
) =>
|
|
m WS.ServerApp
|
|
runWSApp = do
|
|
env <- ask
|
|
return
|
|
( \pending -> do
|
|
conn <- WS.acceptRequest pending
|
|
uuid <- nextRandom
|
|
let wsEnv = WSEnv {appEnv = env, connection = conn, clientId = uuid}
|
|
WS.withPingThread conn 30 (return ()) $ unWSApp wsApp wsEnv
|
|
)
|