diff --git a/hanafuda-webapp.cabal b/hanafuda-webapp.cabal index 83ebb14..679e911 100644 --- a/hanafuda-webapp.cabal +++ b/hanafuda-webapp.cabal @@ -24,6 +24,7 @@ executable hanafudapi other-modules: App , Automaton , Config + , Keys , Messaging , Game , RW diff --git a/src/Keys.hs b/src/Keys.hs new file mode 100644 index 0000000..6e0b8d4 --- /dev/null +++ b/src/Keys.hs @@ -0,0 +1,8 @@ +module Keys ( + getKeyPair + ) where + +import Crypto.Saltine.Core.Box (Keypair, newKeypair) + +getKeyPair :: IO Keypair +getKeyPair = newKeypair diff --git a/src/Main.hs b/src/Main.hs index c99dd25..dac33e8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -26,7 +26,7 @@ exit = do serverApp :: App.T () -> App.T () -> IO ServerApp serverApp onEnter onExit = do - mServer <- newMVar Server.new + mServer <- newMVar =<< Server.new return $ \pending -> do session <- Session.open <$> acceptRequest pending playerID <- modifyMVar mServer (return . Server.register session) diff --git a/src/Server.hs b/src/Server.hs index 82b5755..73275ee 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -16,6 +16,7 @@ module Server ( , update ) where +import Crypto.Saltine.Core.Box (Keypair) import Data.Map (Map, (!), (!?), adjust, delete, insert, lookupMax, mapWithKey) import qualified Data.Map as Map (empty) import Data.Set (Set, member) @@ -23,6 +24,7 @@ import qualified Data.Set as Set (delete, empty, insert) import Data.Text (Text) import Hanafuda.KoiKoi (Game, GameID, PlayerID) import Hanafuda.Message (PlayerStatus(..), Room) +import Keys (getKeyPair) import qualified RW (RW(..)) import qualified Session (Status(..), T(..), Update) @@ -35,6 +37,7 @@ data T = T { , players :: Players , sessions :: Sessions , games :: Games + , keypair :: Keypair } instance RW.RW Names T where @@ -64,12 +67,13 @@ export sessions playerID playerName = PlayerStatus (playerName, alone) room :: T -> Room room (T {players, sessions}) = mapWithKey (export sessions) players -new :: T -new = T { +new :: IO T +new = getKeyPair >>= \keypair -> return $ T { names = Set.empty , players = Map.empty , sessions = Map.empty , games = Map.empty + , keypair } register :: forall a b. (Enum a, Ord a, RW.RW (Map a b) T) => b -> T -> (T, a)