Adapt code to new PublicGame data structure, output messages in the new format and break everything doing so

src/Automaton.hs

@@ -8,7 +8,7 @@ import Control.Monad.Reader (asks)
 import Data.Map (Map, (!?))
 import qualified Game (new, play)
 import qualified Hanafuda.KoiKoi as KoiKoi (
-    Game, GameBlueprint(..), GameID, Step(..)
+    Game(..), GameID, Step(..)
   )
 import qualified Hanafuda.Message as Message (FromClient(..), T(..))
 import qualified Messaging (

src/Game.hs

@@ -5,34 +5,60 @@ module Game (
     , play
   ) where
 
-import qualified App (T, update)
+import qualified App (T, server, update)
 import Control.Monad.Except (runExceptT, throwError)
 import Control.Monad.Reader (lift)
 import Control.Monad.Writer (runWriterT)
+import qualified Crypto.Saltine.Class as Saltine (IsEncoding(..))
+import Crypto.Saltine.Core.SecretBox (newNonce, secretbox)
 import Crypto.Saltine.Core.Sign (signDetached)
-import Data.Aeson (encode)
+import Data.Aeson (ToJSON, encode)
-import Data.Map ((!), mapWithKey)
+import Data.ByteString (ByteString)
-import qualified Hanafuda (empty)
+import Data.ByteString.Lazy (toStrict)
-import Hanafuda.KoiKoi (Game, GameID, Mode(..), PlayerID)
+import Data.Map (Map)
+import qualified Hanafuda (Pack)
+import Hanafuda.KoiKoi (Game, GameID, Mode(..), Player, PlayerID, Players)
 import qualified Hanafuda.KoiKoi as KoiKoi (
     Action, Game(..), Move(..), play, new
   )
 import Hanafuda.Message (PrivateState(..), PublicGame(..), PublicPlayer(..), PublicState(..))
-import qualified Hanafuda.Player (Player(..), Players(..))
+import qualified Hanafuda.Player as Player (Player(..), Players(..), get, next)
-import qualified Server (register)
+import Keys (T(..), secret)
+import qualified Server (T(..), register)
 
 new :: (PlayerID, PlayerID) -> App.T GameID
 new (for, to) =
   Server.register <$> (lift $ KoiKoi.new (for, to) WholeYear) >>= App.update
 
+exportPlayers :: Game -> Map PlayerID Player
+exportPlayers game =
+  let (Player.Players players) = KoiKoi.players game in
+  players
+
 extractPrivateState :: PlayerID -> Game -> PrivateState
-extractPrivateState playerID game = undefined
+extractPrivateState playerID game = PrivateState {
+      opponentHand = getHand opponentID players
+    , deck = KoiKoi.deck game
+  }
+  where
+    players = KoiKoi.players game
+    opponentID = Player.next players playerID
+
+getHand :: PlayerID -> Players -> Hanafuda.Pack
+getHand playerID = Player.hand . (Player.get playerID)
+
+publicPlayer :: Player -> PublicPlayer
+publicPlayer player = PublicPlayer {
+      meld = Player.meld player
+    , yakus = Player.yakus player
+  }
 
 extractPublicState :: Game -> PublicState
 extractPublicState game = PublicState {
       mode = KoiKoi.mode game
     , scores = KoiKoi.scores game
     , month = KoiKoi.month game
+    , players = publicPlayer <$> exportPlayers game
     , playing = KoiKoi.playing game
     , winning = KoiKoi.winning game
     , oyake = KoiKoi.oyake game
@@ -44,19 +70,23 @@ extractPublicState game = PublicState {
 
 export :: PlayerID -> Game -> App.T PublicGame
 export playerID game = do
-  secretKey <- asks $ fst . keypair . mServer
+  Keys.T {encrypt, sign} <- Server.keys <$> App.server
+  n <- lift newNonce
   return $ PublicGame {
-        playerHand = hand $ players ! playerID
+        nonce = Saltine.encode n
-      , privateState = extractPrivateState playerID game
+      , playerHand = getHand playerID (KoiKoi.players game)
+      , privateState = secretbox encrypt n $ toJSON privateState
       , publicState
-      , publicSignature = signDetached secretKey publicState
+      , publicSignature = signDetached (secret sign) $ toJSON publicState
     }
   where
-    Hanafuda.Player.Players players = KoiKoi.players game
+    publicState = extractPublicState game
-    publicState = encode $ extractPublicState game
+    privateState = extractPrivateState playerID game
+    toJSON :: ToJSON a => a -> ByteString
+    toJSON = toStrict . encode
 
 play :: PlayerID -> KoiKoi.Move -> Game -> App.T (Either String Game, [KoiKoi.Action])
 play playerID move game = lift . runWriterT . runExceptT $
-  if playing game == playerID
+  if KoiKoi.playing game == playerID
   then KoiKoi.play move game
   else throwError "Not your turn"

src/Keys.hs

@@ -1,8 +1,26 @@
 module Keys (
-    getKeyPair
+      T(..)
+    , getKeys
+    , public
+    , secret
   ) where
 
-import Crypto.Saltine.Core.Box (Keypair, newKeypair)
+import qualified Crypto.Saltine.Core.SecretBox as Encrypt (Key, newKey)
+import qualified Crypto.Saltine.Core.Sign as Sign (
+    Keypair, PublicKey, SecretKey, newKeypair
+  )
 
-getKeyPair :: IO Keypair
+data T = T {
-getKeyPair = newKeypair
+      encrypt :: Encrypt.Key
+    , sign :: Sign.Keypair
+  }
+
+getKeys :: IO T
+getKeys = do
+  T <$> Encrypt.newKey <*> Sign.newKeypair
+
+public :: Sign.Keypair -> Sign.PublicKey
+public = snd
+
+secret :: Sign.Keypair -> Sign.SecretKey
+secret = fst

src/Messaging.hs

@@ -20,7 +20,7 @@ import Data.ByteString.Lazy.Char8 (unpack)
 import Data.Foldable (forM_)
 import Data.List (intercalate)
 import Data.Map (keys)
-import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game, GameBlueprint(..), PlayerID)
+import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), PlayerID)
 import Hanafuda.Message (FromClient(..), T(..))
 import qualified Hanafuda.Message as Message (T)
 import Network.WebSockets (receiveData, sendTextData)
@@ -72,6 +72,6 @@ update = Update {alone = [], paired = []}
 
 notifyPlayers :: KoiKoi.Game -> [KoiKoi.Action] -> App.T ()
 notifyPlayers game logs =
-  forM_ (keys $ KoiKoi.scores game) $ \k ->
+  forM_ (keys $ KoiKoi.scores game) $ \k -> do
-    game <- Game.export k game
+    state <- Game.export k game
-    sendTo [k] $ Game {game, logs}
+    sendTo [k] $ Game {state, logs}

src/Server.hs

@@ -16,7 +16,6 @@ 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)
@@ -24,7 +23,8 @@ 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 Keys (getKeys)
+import qualified Keys (T)
 import qualified RW (RW(..))
 import qualified Session (Status(..), T(..), Update)
 
@@ -37,7 +37,7 @@ data T = T {
     , players :: Players
     , sessions :: Sessions
     , games :: Games
-    , keypair :: Keypair
+    , keys :: Keys.T
   }
 
 instance RW.RW Names T where
@@ -68,12 +68,12 @@ room :: T -> Room
 room (T {players, sessions}) = mapWithKey (export sessions) players
 
 new :: IO T
-new = getKeyPair >>= \keypair -> return $ T {
+new = getKeys >>= \keys -> return $ T {
       names = Set.empty
     , players = Map.empty
     , sessions = Map.empty
     , games = Map.empty
-    , keypair
+    , keys
   }
 
 register :: forall a b. (Enum a, Ord a, RW.RW (Map a b) T) => b -> T -> (T, a)