From 0c5229ae6d2b9c2e4d779caa1835f8392bbd1434 Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Sun, 13 Oct 2019 21:48:08 +0200
Subject: [PATCH] Add a new Keys module to interface saltine and in the future
 implement keypair caching

---
 hanafuda-webapp.cabal | 1 +
 src/Keys.hs           | 8 ++++++++
 src/Main.hs           | 2 +-
 src/Server.hs         | 8 ++++++--
 4 files changed, 16 insertions(+), 3 deletions(-)
 create mode 100644 src/Keys.hs

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)