Stop broadcasting to clients not yet logged in
This commit is contained in:
parent
d17edb201d
commit
c329ed556c
1 changed files with 4 additions and 2 deletions
|
@ -27,7 +27,7 @@ import Hanafuda.Message (FromClient(..), T(..))
|
||||||
import qualified Hanafuda.Message as Message (T)
|
import qualified Hanafuda.Message as Message (T)
|
||||||
import Network.WebSockets (receiveData, sendTextData)
|
import Network.WebSockets (receiveData, sendTextData)
|
||||||
import Player (playerID, showDebug)
|
import Player (playerID, showDebug)
|
||||||
import qualified Server (T(..), sessionsWhere)
|
import qualified Server (sessionsWhere)
|
||||||
import qualified Session (T(..))
|
import qualified Session (T(..))
|
||||||
|
|
||||||
sendToSessions :: [Session.T] -> Message.T -> App.T ()
|
sendToSessions :: [Session.T] -> Message.T -> App.T ()
|
||||||
|
@ -52,7 +52,9 @@ send obj = do
|
||||||
|
|
||||||
broadcast :: Message.T -> App.T ()
|
broadcast :: Message.T -> App.T ()
|
||||||
broadcast obj = do
|
broadcast obj = do
|
||||||
App.get (elems . Server.sessions) >>= flip sendToSessions obj
|
App.get (concat . elems . allSessions) >>= flip sendToSessions obj
|
||||||
|
where
|
||||||
|
allSessions = Server.sessionsWhere (\_ _ -> True)
|
||||||
|
|
||||||
relay :: FromClient -> (Message.T -> App.T ()) -> App.T ()
|
relay :: FromClient -> (Message.T -> App.T ()) -> App.T ()
|
||||||
relay message f = do
|
relay message f = do
|
||||||
|
|
Loading…
Reference in a new issue