Add a new Keys module to interface saltine and in the future implement keypair caching

This commit is contained in:
Tissevert 2019-10-13 21:48:08 +02:00
parent 13cd466e87
commit 0c5229ae6d
4 changed files with 16 additions and 3 deletions

View file

@ -24,6 +24,7 @@ executable hanafudapi
other-modules: App
, Automaton
, Config
, Keys
, Messaging
, Game
, RW

8
src/Keys.hs Normal file
View file

@ -0,0 +1,8 @@
module Keys (
getKeyPair
) where
import Crypto.Saltine.Core.Box (Keypair, newKeypair)
getKeyPair :: IO Keypair
getKeyPair = newKeypair

View file

@ -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)

View file

@ -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)