Add a new Keys module to interface saltine and in the future implement keypair caching
This commit is contained in:
parent
13cd466e87
commit
0c5229ae6d
4 changed files with 16 additions and 3 deletions
|
@ -24,6 +24,7 @@ executable hanafudapi
|
|||
other-modules: App
|
||||
, Automaton
|
||||
, Config
|
||||
, Keys
|
||||
, Messaging
|
||||
, Game
|
||||
, RW
|
||||
|
|
8
src/Keys.hs
Normal file
8
src/Keys.hs
Normal file
|
@ -0,0 +1,8 @@
|
|||
module Keys (
|
||||
getKeyPair
|
||||
) where
|
||||
|
||||
import Crypto.Saltine.Core.Box (Keypair, newKeypair)
|
||||
|
||||
getKeyPair :: IO Keypair
|
||||
getKeyPair = newKeypair
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue