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

hanafuda-webapp.cabal

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

src/Keys.hs

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

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)

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 :: IO T
-new = 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)