Revert "Switch session logging out and relaying the log-out message to keep the sessionID accessible until the end" : the solution was to handle cases when the player wasn't logged in separately

This reverts commit 3bd2829cf2.
This commit is contained in:
Tissevert 2019-11-20 18:27:12 +01:00
parent 0d19c4f8dc
commit e5ee61e848
4 changed files with 13 additions and 6 deletions

View file

@ -5,13 +5,15 @@ module App (
, debug , debug
, exec , exec
, get , get
, player
, session , session
, update , update
) where ) where
import Control.Concurrent (MVar, modifyMVar, readMVar) import Control.Concurrent (MVar, modifyMVar, readMVar)
import Control.Monad.Reader (ReaderT(..), ask, asks, lift) import Control.Monad.Reader (ReaderT(..), ask, asks, lift)
import Data.Map ((!)) import Data.Map ((!), (!?))
import qualified Player (T)
import qualified Server (T(..)) import qualified Server (T(..))
import qualified Session (ID, T(..)) import qualified Session (ID, T(..))
@ -31,6 +33,11 @@ session = do
Context {sessionID} <- ask Context {sessionID} <- ask
get $ (! sessionID) . Server.sessions get $ (! sessionID) . Server.sessions
player :: T (Maybe Player.T)
player = do
Context {sessionID} <- ask
get $ (Session.player =<<) . (!? sessionID) . Server.sessions
debug :: String -> T () debug :: String -> T ()
debug message = debug message =
show <$> asks sessionID show <$> asks sessionID

View file

@ -3,7 +3,7 @@ module Automaton (
loop loop
) where ) where
import qualified App (Context(..), T, exec, get, session, update) import qualified App (Context(..), T, exec, get, player, update)
import Control.Monad.Reader (asks) import Control.Monad.Reader (asks)
import qualified Game (new, play) import qualified Game (new, play)
import qualified Hanafuda.Message as Message (FromClient(..), T(..)) import qualified Hanafuda.Message as Message (FromClient(..), T(..))
@ -70,5 +70,5 @@ sendError = Messaging.send . Message.Error
loop :: App.T () loop :: App.T ()
loop = do loop = do
message <- Messaging.get message <- Messaging.get
(receive message . Session.player) =<< App.session receive message =<< App.player
loop loop

View file

@ -21,8 +21,8 @@ import qualified Session (open)
exit :: App.T () exit :: App.T ()
exit = do exit = do
Messaging.relay Message.LogOut broadcast
asks App.sessionID >>= App.update . Server.logOut asks App.sessionID >>= App.update . Server.logOut
Messaging.relay Message.LogOut broadcast
serverApp :: App.T () -> App.T () -> IO ServerApp serverApp :: App.T () -> App.T () -> IO ServerApp
serverApp onEnter onExit = do serverApp onEnter onExit = do

View file

@ -12,7 +12,7 @@ module Messaging (
, sendTo , sendTo
) where ) where
import qualified App (T, debug, get, session) import qualified App (T, debug, get, player, session)
import Control.Monad.Reader (lift) import Control.Monad.Reader (lift)
import Data.Aeson (eitherDecode', encode) import Data.Aeson (eitherDecode', encode)
import Data.ByteString.Lazy.Char8 (unpack) import Data.ByteString.Lazy.Char8 (unpack)
@ -57,7 +57,7 @@ broadcast obj = do
relay :: FromClient -> (Message.T -> App.T ()) -> App.T () relay :: FromClient -> (Message.T -> App.T ()) -> App.T ()
relay message f = do relay message f = do
App.debug "Relaying" App.debug "Relaying"
maybe (return ()) doRelay . Session.player =<< App.session maybe (return ()) doRelay =<< App.player
where where
doRelay player = f $ Relay {from = playerID player, message} doRelay player = f $ Relay {from = playerID player, message}