This commit is contained in:
parent
c77e006ce4
commit
b8c7b4b954
|
@ -16,16 +16,12 @@ import Network.Wai
|
|||
consumeRequestBodyStrict,
|
||||
responseLBS,
|
||||
)
|
||||
import State.ConnectedClientsState (MonadConnectedClientsRead)
|
||||
import State.RoomDataState
|
||||
( MonadRoomDataStateModify (setRoomDataState),
|
||||
MonadRoomDataStateRead,
|
||||
)
|
||||
import Types.AppTypes (HasConnectedClientState)
|
||||
import Types.RoomsState
|
||||
( HasRoomsState,
|
||||
roomStateDiffers,
|
||||
updateRoomState,
|
||||
( roomStateDiffers,
|
||||
)
|
||||
import Types.WebEnv
|
||||
( HasWebEnv (getRequest),
|
||||
|
|
|
@ -15,7 +15,7 @@ import Control.Monad.Except
|
|||
import Network.HTTP.Types
|
||||
import Network.Wai
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
|
||||
import Network.Wai.Middleware.RequestLogger (logStdout)
|
||||
import RoomDataHandler (roomDataHandler)
|
||||
import State.ConnectedClientsState
|
||||
( MonadConnectedClientsRead (..),
|
||||
|
@ -27,9 +27,7 @@ import State.RoomDataState
|
|||
)
|
||||
import Types.AppTypes (Env (..))
|
||||
import Types.RoomsState
|
||||
( HasRoomsState (getRoomsState),
|
||||
getRoomState,
|
||||
roomStateDiffers,
|
||||
( getRoomState,
|
||||
updateRoomState,
|
||||
)
|
||||
import Types.WebEnv
|
||||
|
@ -122,24 +120,6 @@ notFound = do
|
|||
"404 - Not Found"
|
||||
throwError response
|
||||
|
||||
-- notFound ::
|
||||
-- ( MonadIO m,
|
||||
-- HasWebEnv env,
|
||||
-- MonadReader env m,
|
||||
-- MonadError ResponseReceived m
|
||||
-- ) =>
|
||||
-- m ResponseReceived
|
||||
-- notFound = do
|
||||
-- respond' <- getRespond <$> ask
|
||||
-- response <-
|
||||
-- liftIO $
|
||||
-- respond' $
|
||||
-- responseLBS
|
||||
-- status200
|
||||
-- [("Content-Type", "text/plain")]
|
||||
-- "200 - Success"
|
||||
-- response
|
||||
|
||||
runWebApp ::
|
||||
( MonadIO m,
|
||||
MonadReader Env m
|
||||
|
@ -165,6 +145,6 @@ runWebServer ::
|
|||
) =>
|
||||
m ()
|
||||
runWebServer = do
|
||||
putStrLn "http://localhost:8081/"
|
||||
runWebApp >>= liftIO . (run 8081 . logStdoutDev)
|
||||
putStrLn "Webserver up and running at http://localhost:8081/"
|
||||
runWebApp >>= liftIO . (run 8081 . logStdout)
|
||||
return ()
|
||||
|
|
|
@ -33,11 +33,11 @@ wsApp = do
|
|||
broadcastUserData
|
||||
withCleanUp $ forever $ do
|
||||
handleWSAction
|
||||
broadcastUserData
|
||||
|
||||
handleWSAction ::
|
||||
( MonadWebSocketSession m,
|
||||
MonadConnectedClientsModify m,
|
||||
MonadRoomDataStateRead m,
|
||||
MonadBroadcast m,
|
||||
MonadAllChat m
|
||||
) =>
|
||||
|
@ -47,8 +47,10 @@ handleWSAction = do
|
|||
case msg of
|
||||
JoinRoomMessage _ -> do
|
||||
joinRoom
|
||||
broadcastUserData
|
||||
ClientInfoMessage clientInfo -> do
|
||||
updateClientName clientInfo
|
||||
broadcastUserData
|
||||
AllChatMessageIncomingMessage incomingMessage -> do
|
||||
broadCastAllChatMessage incomingMessage
|
||||
|
||||
|
|
Loading…
Reference in a new issue