Completely replace App.server by App.get, a function applying a projector to the server

This commit is contained in:
Tissevert 2019-11-18 17:06:02 +01:00
parent fef08fd478
commit 25bcf0631c
4 changed files with 12 additions and 15 deletions

View File

@ -4,7 +4,7 @@ module App (
, Context(..)
, debug
, exec
, server
, get
, session
, update
) where
@ -22,12 +22,9 @@ data Context = Context {
type T a = ReaderT Context IO a
server :: T Server.T
server = asks mServer >>= lift . readMVar
get :: (Server.T -> a) -> T a
get projector =
projector <$> server
lift . fmap projector . readMVar =<< asks mServer
session :: T Session.T
session = do

View File

@ -3,7 +3,7 @@ module Automaton (
loop
) where
import qualified App (Context(..), T, exec, server, session, update)
import qualified App (Context(..), T, exec, get, session, update)
import Control.Monad.Reader (asks)
import qualified Game (new, play)
import qualified Hanafuda.Message as Message (FromClient(..), T(..))
@ -19,7 +19,7 @@ receive :: Message.FromClient -> Session.Status -> App.T ()
receive (Message.Hello {Message.name}) Nothing = do
sessionID <- asks App.sessionID
playerID <- App.exec (Server.register sessionID)
room <- Server.room <$> App.server
room <- App.get Server.room
App.update (Server.update sessionID $ Session.setPlayer playerID name)
Messaging.send $ Message.Welcome room playerID
@ -32,7 +32,7 @@ receive (Message.Hello {Message.name}) (Just player) = do
receive (Message.Tadaima {Message.myID, Message.name}) Nothing = do
sessionID <- asks App.sessionID
App.update $ Server.logIn name myID sessionID
Message.Okaeri . Server.room <$> App.server >>= Messaging.send
Message.Okaeri <$> App.get Server.room >>= Messaging.send
receive (Message.Tadaima {}) (Just _) = sendError "You're already logged in"

View File

@ -5,7 +5,7 @@ module Game (
, play
) where
import qualified App (T, server)
import qualified App (T, get)
import Control.Monad.Except (runExceptT)
import Control.Monad.Reader (lift)
import Control.Monad.Writer (runWriterT)
@ -78,7 +78,7 @@ publicState game = PublicState {
exportGame :: PlayerID -> Game -> App.T PublicGame
exportGame playerID game = do
Keys.T {encrypt, sign} <- Server.keys <$> App.server
Keys.T {encrypt, sign} <- App.get Server.keys
n <- lift newNonce
return $ PublicGame {
nonce = Saltine.encode n
@ -114,7 +114,7 @@ gameOf public private = KoiKoi.Game {
importGame :: PublicGame -> App.T (Either String Game)
importGame PublicGame {nonce, private, public, publicSignature} = do
Keys.T {encrypt, sign} <- Server.keys <$> App.server
Keys.T {encrypt, sign} <- App.get Server.keys
if signVerifyDetached (Keys.public sign) publicSignature $ toJSON public
then return $ do
n <- Saltine.decode nonce `orDie` "Could not decode nonce"

View File

@ -12,7 +12,7 @@ module Messaging (
, sendTo
) where
import qualified App (T, debug, server, session)
import qualified App (T, debug, get, session)
import Control.Monad.Reader (lift)
import Data.Aeson (eitherDecode', encode)
import Data.ByteString.Lazy.Char8 (unpack)
@ -40,7 +40,7 @@ sendToSessions sessions obj = do
sendTo :: [KoiKoi.PlayerID] -> Message.T -> App.T ()
sendTo playerIDs obj = do
sessions <- Server.sessionsWhere selectedPlayer <$> App.server
sessions <- App.get $ Server.sessionsWhere selectedPlayer
sendToSessions (elems sessions) obj
where
selectedPlayer playerID _ = Set.member playerID $ Set.fromList playerIDs
@ -51,8 +51,8 @@ send obj = do
sendToSessions [currentSession] obj
broadcast :: Message.T -> App.T ()
broadcast obj =
(elems . Server.sessions) <$> App.server >>= flip sendToSessions obj
broadcast obj = do
App.get (elems . Server.sessions) >>= flip sendToSessions obj
relay :: FromClient -> (Message.T -> App.T ()) -> App.T ()
relay message f = do