From e5ee61e8484bbd6ad13e800ea74578242bb213e2 Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Wed, 20 Nov 2019 18:27:12 +0100
Subject: [PATCH] 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 3bd2829cf28b45e21cb1411199b1e1f409c63476.
---
 src/App.hs       | 9 ++++++++-
 src/Automaton.hs | 4 ++--
 src/Main.hs      | 2 +-
 src/Messaging.hs | 4 ++--
 4 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/src/App.hs b/src/App.hs
index 128ad3a..a63469c 100644
--- a/src/App.hs
+++ b/src/App.hs
@@ -5,13 +5,15 @@ module App (
     , debug
     , exec
     , get
+    , player
     , session
     , update
   ) where
 
 import Control.Concurrent (MVar, modifyMVar, readMVar)
 import Control.Monad.Reader (ReaderT(..), ask, asks, lift)
-import Data.Map ((!))
+import Data.Map ((!), (!?))
+import qualified Player (T)
 import qualified Server (T(..))
 import qualified Session (ID, T(..))
 
@@ -31,6 +33,11 @@ session = do
   Context {sessionID} <- ask
   get $ (! sessionID) . Server.sessions
 
+player :: T (Maybe Player.T)
+player = do
+  Context {sessionID} <- ask
+  get $ (Session.player =<<) . (!? sessionID) . Server.sessions
+
 debug :: String -> T ()
 debug message =
   show <$> asks sessionID
diff --git a/src/Automaton.hs b/src/Automaton.hs
index a89049a..7a0ee85 100644
--- a/src/Automaton.hs
+++ b/src/Automaton.hs
@@ -3,7 +3,7 @@ module Automaton (
     loop
   ) 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 qualified Game (new, play)
 import qualified Hanafuda.Message as Message (FromClient(..), T(..))
@@ -70,5 +70,5 @@ sendError = Messaging.send . Message.Error
 loop :: App.T ()
 loop = do
   message <- Messaging.get
-  (receive message . Session.player) =<< App.session
+  receive message =<< App.player
   loop
diff --git a/src/Main.hs b/src/Main.hs
index 025b4a2..c620c75 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -21,8 +21,8 @@ import qualified Session (open)
 
 exit :: App.T ()
 exit = do
-  Messaging.relay Message.LogOut broadcast
   asks App.sessionID >>= App.update . Server.logOut
+  Messaging.relay Message.LogOut broadcast
 
 serverApp :: App.T () -> App.T () -> IO ServerApp
 serverApp onEnter onExit = do
diff --git a/src/Messaging.hs b/src/Messaging.hs
index e966dea..0a15ef4 100644
--- a/src/Messaging.hs
+++ b/src/Messaging.hs
@@ -12,7 +12,7 @@ module Messaging (
     , sendTo
   ) where
 
-import qualified App (T, debug, get, session)
+import qualified App (T, debug, get, player, session)
 import Control.Monad.Reader (lift)
 import Data.Aeson (eitherDecode', encode)
 import Data.ByteString.Lazy.Char8 (unpack)
@@ -57,7 +57,7 @@ broadcast obj = do
 relay :: FromClient -> (Message.T -> App.T ()) -> App.T ()
 relay message f = do
   App.debug "Relaying"
-  maybe (return ()) doRelay . Session.player =<< App.session
+  maybe (return ()) doRelay =<< App.player
   where
     doRelay player = f $ Relay {from = playerID player, message}