Generate RSA keypairs when the client starts

2019-07-18 22:37:05 +02:00
26 changed files with 543 additions and 494 deletions
--- a/.gitignore
+++ b/.gitignore
@ -1,3 +1 @@
-/dist*
-cabal.project.local
-.ghc*
+/dist/*
--- a/ChangeLog.md
+++ b/ChangeLog.md
@ -1,18 +1,5 @@
 # Revision history for hanafudapi

-## 0.2.3.0  -- 2019-08-24
-
-* Huge refactoring to use the new APILanguage that basically vampirized Game module which become more of a toolbox for the Automaton
-* Fix a couple race conditions in JS client and server encountered when developping and testing Hannah the bot soon to come
-
-## 0.2.2.0  -- 2019-08-12
-
-* Handle the end of games
-
-## 0.2.1.0  -- 2019-01-08
-
-* Use latest changes in the lib to send a log of what happened during a turn
-
 ## 0.2.0.1  -- 2018-08-26

 * Games are now playable
--- a/hanafuda-webapp.cabal
+++ b/hanafuda-webapp.cabal
@ -2,14 +2,14 @@
 -- documentation, see http://haskell.org/cabal/users-guide/

 name:                hanafuda-webapp
-version:             0.2.3.0
+version:             0.2.1.0
 synopsis:            A webapp for the Haskell hanafuda library
 -- description:         
-homepage:            https://git.marvid.fr/hanafuda
+homepage:            https://framagit.org/hanafuda
 license:             BSD3
 license-file:        LICENSE
-author:              Tissevert
-maintainer:          tissevert+devel@marvid.fr
+author:              Sasha
+maintainer:          sasha+frama@marvid.fr
 -- copyright:           
 category:            Web
 build-type:          Simple
@ -17,25 +17,26 @@ extra-source-files:  ChangeLog.md
 cabal-version:       >=1.10
 source-repository head
  type:              git
-  location:          https://git.marvid.fr/hanafuda/webapp
+  location:          https://framagit.org/hanafuda/api

 executable hanafudapi
  main-is:             Main.hs
  other-modules:       App
                     , Automaton
                     , Config
-                     , Messaging
+                     , Message
                     , Game
-                     , RW
+                     , JSON
+                     , Data
+                     , Player
                     , Server
                     , Session
  -- other-extensions:    
-  build-depends:       base >=4.9 && <4.13
+  build-depends:       base >=4.10 && <4.13
                     , bytestring
-                     , containers >= 0.5.9
+                     , containers
                     , unordered-containers
-                     , hanafuda >= 0.3.3
-                     , hanafuda-APILanguage >= 0.1.0
+                     , hanafuda >= 0.3.0
                     , http-types
                     , aeson
                     , mtl
--- a/src/App.hs
+++ b/src/App.hs
@ -12,17 +12,17 @@ module App (
    , update_
  ) where

+import Data.Map ((!))
 import Control.Concurrent (MVar, modifyMVar, putMVar, readMVar, takeMVar)
 import Control.Monad.Reader (ReaderT(..), ask, asks, lift)
-import Data.Map ((!))
-import Hanafuda.KoiKoi (PlayerID)
 import Network.WebSockets (Connection)
-import qualified Server (T(..))
+import qualified Player (Key)
 import qualified Session (T(..))
+import qualified Server (T(..))

 data Context = Context {
      mServer :: MVar Server.T
-    , playerID :: PlayerID
+    , key :: Player.Key
  }

 type T a = ReaderT Context IO a
@ -30,20 +30,20 @@ type T a = ReaderT Context IO a
 server :: T Server.T
 server = asks mServer >>= lift . readMVar

-get :: PlayerID -> T Session.T
-get playerID =
-  (! playerID) . Server.sessions <$> server
+get :: Player.Key -> T Session.T
+get key =
+  (! key) . Server.sessions <$> server

 current :: T Session.T
 current = do
-  asks playerID >>= get
+  asks key >>= get

 connection :: T Connection
 connection = Session.connection <$> current

 debug :: String -> T ()
 debug message =
-  show <$> asks playerID
+  show <$> asks key
  >>= lift . putStrLn . (++ ' ':message)

 try :: (Server.T -> Either String Server.T) -> T (Maybe String)
--- a/src/Automaton.hs
+++ b/src/Automaton.hs
@ -3,108 +3,96 @@ module Automaton (
    start
  ) where

-import qualified App (Context(..), T, current, debug, get, server, try, update_)
-import Control.Monad.Reader (asks)
-import Data.Map (Map, (!?))
+import Control.Monad.Except (runExceptT)
+import Control.Monad.Reader (asks, lift)
+import Control.Monad.Writer (runWriterT)
+import qualified Data (RW(..))
 import qualified Game (new, play)
-import qualified Hanafuda.KoiKoi as KoiKoi (
-    Game, GameBlueprint(..), GameID, Step(..)
-  )
-import qualified Hanafuda.Message as Message (FromClient(..), T(..))
-import qualified Messaging (
-    broadcast, get, notifyPlayers, relay, send, sendTo, update
-  )
-import qualified RW (RW(..))
-import qualified Server (endGame, get, logIn, logOut, update, room)
+import qualified Hanafuda.KoiKoi as KoiKoi (Game(..))
 import qualified Session (Status(..), T(..), Update)
+import qualified Server (get, logIn, logOut, update, register)
+import qualified App (Context(..), T, current, debug, get, server, try, update, update_)
+import qualified Message (FromClient(..), T(..), broadcast, get, notifyPlayers, relay, send, sendTo, update)

-receive :: Session.Status -> Message.FromClient -> App.T ()
+type Vertex = Session.Status

-receive (Session.LoggedIn False) logIn@(Message.LogIn login) =
-  asks App.playerID >>= App.try . (Server.logIn login)
+edges :: Vertex -> Message.FromClient -> App.T Vertex
+
+edges (Session.LoggedIn False) logIn@(Message.LogIn login) =
+  asks App.key >>= App.try . (Server.logIn login)
  >>= maybe
-   (Messaging.relay logIn Messaging.broadcast >> setSessionStatus (Session.LoggedIn True))
-   sendError
+   (Message.relay logIn Message.broadcast >> return (Session.LoggedIn True))
+   (withError $ Session.LoggedIn False)

-receive (Session.LoggedIn True) logOut@Message.LogOut = do
-  Messaging.relay logOut Messaging.broadcast
-  asks App.playerID >>= App.update_ . Server.logOut
-  setSessionStatus (Session.LoggedIn False)
+edges (Session.LoggedIn True) logOut@Message.LogOut = do
+  Message.relay logOut Message.broadcast
+  asks App.key >>= App.update_ . Server.logOut
+  return (Session.LoggedIn False)

-receive (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do
+edges (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do
  session <- App.get to
  case Session.status session of
    Session.LoggedIn True -> do
-      from <- asks App.playerID
-      App.update_ (Server.update to (RW.set $ Session.Answering from :: Session.Update))
-      Messaging.broadcast $ Messaging.update {Message.paired = [from, to]}
-      (Messaging.relay invitation $ Messaging.sendTo [to])
-      setSessionStatus (Session.Waiting to)
-    _ -> sendError "They just left"
+      key <- asks App.key
+      App.update_ (Server.update to (Data.set $ Session.Answering key :: Session.Update))
+      Message.broadcast $ Message.update {Message.paired = [key, to]}
+      (Message.relay invitation $ Message.sendTo [to])
+      return (Session.Waiting to)
+    _ -> Session.LoggedIn True `withError` "They just left"

-receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
+edges (Session.Answering to) message@(Message.Answer {Message.accept}) = do
  session <- App.get to
-  playerID <- asks App.playerID
+  key <- asks App.key
  case Session.status session of
-    Session.Waiting for | for == playerID -> do
-      Messaging.relay message $ Messaging.sendTo [to]
+    Session.Waiting for | for == key -> do
+      Message.relay message $ Message.sendTo [to]
      newStatus <-
        if accept
          then do
-            gameID <- Game.new (for, to)
-            game <- Server.get gameID <$> App.server
-            Messaging.notifyPlayers game []
-            return $ Session.Playing gameID
+            gameKey <- Server.register <$> (lift $ Game.new for to) >>= App.update
+            game <- Server.get gameKey <$> App.server
+            Message.notifyPlayers game []
+            return $ Session.Playing gameKey
          else do
-            Messaging.broadcast $ Messaging.update {Message.alone = [for, to]}
+            Message.broadcast $ Message.update {Message.alone = [key, to]}
            return $ Session.LoggedIn True
-      App.update_ $ Server.update to (RW.set newStatus :: Session.Update)
-      setSessionStatus newStatus
-    _ -> sendError "They're not waiting for your answer"
+      App.update_ $ Server.update to (Data.set newStatus :: Session.Update)
+      return newStatus
+    _ -> (Session.LoggedIn True) `withError` "They're not waiting for your answer"

-receive (Session.Playing gameID) played@(Message.Play {}) = do
-  playerID <- asks App.playerID
-  game <- Server.get gameID <$> App.server
-  (result, logs) <- Game.play playerID (Message.move played) game
+edges status@(Session.Playing gameKey) (Message.Play {Message.move}) = do
+  key <- asks App.key
+  game <- Server.get gameKey <$> App.server
+  (result, logs) <- lift . runWriterT . runExceptT $ Game.play key move game
  case result of
-    Left message -> sendError message
-    Right newGame -> do
-      case KoiKoi.step newGame of
-        KoiKoi.Over -> do
-          App.debug $ "Game " ++ show gameID ++ " ended"
-          App.update_ $ Server.endGame gameID
-        _ -> App.update_ $ Server.update gameID (const newGame)
-      Messaging.notifyPlayers newGame logs
+    Left message -> status `withError` message
+    Right newGame ->
+      case newGame of
+        KoiKoi.Over _ -> undefined
+        KoiKoi.On on -> do
+          App.update_ $ Server.update gameKey (const on)
+          Message.notifyPlayers on logs
+          return status

-receive (Session.Playing gameID) Message.Quit = do
-  games <- (RW.get <$> App.server :: App.T (Map KoiKoi.GameID KoiKoi.Game))
-  case games !? gameID of
-    Nothing -> do
-      playerID <- asks App.playerID
-      Messaging.broadcast $ Messaging.update {Message.alone = [playerID]}
-      setSessionStatus (Session.LoggedIn True)
-    _ -> sendError "Game is still running"
+edges state _ =
+  state `withError` ("Invalid message in state " ++ show state)

-receive state _ = sendError $ "Invalid message in state " ++ show state
+withError :: Vertex -> String -> App.T Vertex
+withError vertex message = 
+  (Message.send $ Message.Error message) >> return vertex

-sendError :: String -> App.T ()
-sendError = Messaging.send . Message.Error
-
-setSessionStatus :: Session.Status -> App.T ()
-setSessionStatus newStatus = do
-  playerID <- asks App.playerID
-  App.update_ $ Server.update playerID $ (RW.set newStatus :: Session.Update)
-  App.debug $ show newStatus
-
-loop :: App.T ()
-loop = do
-  message <- Messaging.get
+run :: App.T ()
+run = do
+  message <- Message.get
  status <- Session.status <$> App.current
-  status `receive` message
-  loop
+  newStatus <- edges status message
+  key <- asks App.key
+  App.update_ $ Server.update key $ (Data.set newStatus :: Session.Update)
+  App.debug $ show newStatus
+  run

 start :: App.T ()
 start = do
  App.debug "Initial state"
-  Message.Welcome . Server.room <$> App.server <*> asks App.playerID >>= Messaging.send
-  loop
+  Message.Welcome <$> App.server <*> asks App.key >>= Message.send
+  run
--- a/src/Data.hs
+++ b/src/Data.hs
@ -0,0 +1,30 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
+module Data (
+      Key(..)
+    , RW(..)
+  ) where
+
+import Data.Aeson (FromJSON(..), ToJSON(..), ToJSONKey(..), genericToEncoding)
+import Data.Aeson.Types (toJSONKeyText)
+import Data.Text (pack)
+import GHC.Generics
+import qualified JSON (defaultOptions)
+
+class RW a b where
+  get :: b -> a
+  set :: a -> b -> b
+  update :: (a ->  a) -> b -> b
+  update f v =
+    set (f (get v)) v
+
+newtype Key a = Key Int deriving (Eq, Ord, Enum, Read, Show, Generic)
+
+instance FromJSON (Key a)
+instance ToJSON (Key a) where
+  toEncoding = genericToEncoding JSON.defaultOptions
+
+instance ToJSONKey (Key a) where
+  toJSONKey = toJSONKeyText (pack . \(Key n) -> show n)
--- a/src/Game.hs
+++ b/src/Game.hs
@ -1,40 +1,118 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Game (
-      export
+      Key
+    , View
+    , T
+    , export
    , new
    , play
  ) where

-import qualified App (T, update)
-import Control.Monad.Except (runExceptT, throwError)
-import Control.Monad.Reader (lift)
-import Control.Monad.Writer (runWriterT)
+import Control.Monad.Except (throwError)
+import Data.Text (pack)
 import Data.Map (mapWithKey)
-import qualified Hanafuda (empty)
-import Hanafuda.KoiKoi (Game, GameBlueprint(..), GameID, Mode(..), PlayerID)
-import qualified Hanafuda.KoiKoi as KoiKoi (
-    Action, Move(..), play, new
-  )
-import Hanafuda.Message (PublicGame)
+import Data.HashMap.Strict (insert)
+import Data.Aeson (FromJSON(..), ToJSON(..), ToJSON1(..), ToJSONKey(..), Value(..), genericParseJSON, genericToEncoding, genericLiftToEncoding, toEncoding1, toJSON1)
+import Data.Aeson.Types (toJSONKeyText)
+import qualified JSON (defaultOptions, singleLCField)
+import qualified Data (Key)
+import qualified Player (Key)
+import qualified Hanafuda (Flower(..), Card(..), Pack, cardsOfPack, empty)
 import qualified Hanafuda.Player (Player(..), Players(..))
-import qualified Server (register)
+import qualified Hanafuda.KoiKoi (Action(..), Game(..), Environment, Mode(..), Move(..), On(..), Over(..), Score, Source(..), Step(..), Yaku(..), new, play)
+import GHC.Generics

-new :: (PlayerID, PlayerID) -> App.T GameID
-new (for, to) =
-  Server.register <$> (lift $ KoiKoi.new (for, to) WholeYear) >>= App.update
+deriving instance Generic Hanafuda.Card
+deriving instance Generic Hanafuda.Flower
+deriving instance Generic Hanafuda.KoiKoi.Action
+deriving instance Generic Hanafuda.KoiKoi.Mode
+deriving instance Generic Hanafuda.KoiKoi.Move
+deriving instance Generic Hanafuda.KoiKoi.Yaku
+deriving instance Generic Hanafuda.KoiKoi.Source
+deriving instance Generic Hanafuda.KoiKoi.Step
+deriving instance Generic1 (Hanafuda.Player.Player Player.Key)
+deriving instance Generic1 (Hanafuda.Player.Players Player.Key)

-export :: PlayerID -> Game -> PublicGame
-export playerID game = game {
-      deck = length $ deck game
-    , players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
-  }
+type On = Hanafuda.KoiKoi.On Player.Key
+type Over = Hanafuda.KoiKoi.Over Player.Key
+type View = Hanafuda.KoiKoi.Game Player.Key
+
+deriving instance Generic On
+deriving instance Generic Over
+deriving instance Generic View
+
+instance FromJSON Hanafuda.Card
+instance ToJSON Hanafuda.Card
+
+instance ToJSON Hanafuda.Flower
+
+instance ToJSON Hanafuda.Pack where
+  toJSON = toJSON . Hanafuda.cardsOfPack
+  toEncoding = toEncoding . Hanafuda.cardsOfPack
+
+instance ToJSON Hanafuda.KoiKoi.Action
+
+instance ToJSON Hanafuda.KoiKoi.Mode
+
+instance FromJSON Hanafuda.KoiKoi.Move where
+  parseJSON = genericParseJSON JSON.singleLCField
+instance ToJSON Hanafuda.KoiKoi.Move where
+  toEncoding = genericToEncoding JSON.singleLCField
+
+instance ToJSON Hanafuda.KoiKoi.Source
+
+instance ToJSON Hanafuda.KoiKoi.Step where
+  toEncoding = genericToEncoding JSON.defaultOptions
+
+instance ToJSON1 (Hanafuda.Player.Player Player.Key) where
+  liftToEncoding = genericLiftToEncoding JSON.defaultOptions
+
+instance ToJSON (Hanafuda.Player.Player Player.Key Hanafuda.KoiKoi.Score) where
+  toJSON = toJSON1
+  toEncoding = toEncoding1
+
+instance ToJSON Hanafuda.KoiKoi.Yaku where
+  toEncoding = genericToEncoding JSON.defaultOptions
+instance ToJSONKey Hanafuda.KoiKoi.Yaku where
+  toJSONKey = toJSONKeyText (pack . show)
+
+instance ToJSON1 (Hanafuda.Player.Players Player.Key) where
+  liftToEncoding = genericLiftToEncoding JSON.defaultOptions
+
+instance ToJSON (Hanafuda.Player.Players Player.Key Hanafuda.KoiKoi.Score) where
+  toJSON = toJSON1
+  toEncoding = toEncoding1
+
+type T = Hanafuda.KoiKoi.On Player.Key
+
+instance ToJSON T
+
+type Key = Data.Key T
+
+new :: Player.Key -> Player.Key -> IO T
+new p1 p2 = do
+  Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear
+
+export :: Player.Key -> T -> Value
+export key on = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck on) $ ast
  where
-    Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
+    Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players on
    maskOpponentsHand k player
-      | k == playerID = player
+      | k == key = player
      | otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
+    Object ast = toJSON $ on {
+        Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
+      }

-play :: PlayerID -> KoiKoi.Move -> Game -> App.T (Either String Game, [KoiKoi.Action])
-play playerID move game = lift . runWriterT . runExceptT $
-  if playing game == playerID
-  then KoiKoi.play move game
-  else throwError "Not your turn"
+play :: Hanafuda.KoiKoi.Environment m => Player.Key -> Hanafuda.KoiKoi.Move -> T -> m (Hanafuda.KoiKoi.Game Player.Key)
+play key move on
+  | Hanafuda.KoiKoi.playing on == key =
+    Hanafuda.KoiKoi.play move on
+  | otherwise = throwError "Not your turn"
--- a/src/JSON.hs
+++ b/src/JSON.hs
@ -0,0 +1,27 @@
+module JSON (
+      defaultOptions
+    , distinct
+    , singleLCField
+  ) where
+
+import Data.Char (toLower)
+import Data.Aeson (
+      Options(..)
+    , SumEncoding(..)
+    , defaultOptions
+  )
+
+first :: (a -> a) -> [a] -> [a]
+first _ [] = []
+first f (x:xs) = f x:xs
+
+singleLCField :: Options
+singleLCField = defaultOptions {
+      constructorTagModifier = (toLower `first`)
+    , sumEncoding = ObjectWithSingleField
+  }
+
+distinct :: Options
+distinct = defaultOptions {
+      sumEncoding = UntaggedValue
+  }
--- a/src/Main.hs
+++ b/src/Main.hs
@ -2,34 +2,33 @@
 {-# LANGUAGE NamedFieldPuns #-}
 module Main where

-import qualified App (Context(..), T, update_)
-import qualified Automaton (start)
-import qualified Config (listenPort)
+import Network.Wai.Handler.Warp (run)
+import Network.HTTP.Types.Status (badRequest400)
+import Network.WebSockets (ServerApp, acceptRequest, defaultConnectionOptions)
+import Network.Wai.Handler.WebSockets (websocketsOr)
+import Network.Wai (responseLBS)
+import Control.Monad.Reader (ReaderT(..), asks)
 import Control.Concurrent (newMVar, modifyMVar)
 import Control.Exception (finally)
-import Control.Monad.Reader (ReaderT(..), asks)
-import qualified Hanafuda.Message as Message (FromClient(..))
-import Messaging (broadcast, relay)
-import Network.HTTP.Types.Status (badRequest400)
-import Network.Wai (responseLBS)
-import Network.Wai.Handler.Warp (run)
-import Network.Wai.Handler.WebSockets (websocketsOr)
-import Network.WebSockets (ServerApp, acceptRequest, defaultConnectionOptions)
-import qualified Server (disconnect, new, register)
+import qualified Config (listenPort)
 import qualified Session (open)
+import qualified Server (disconnect, new, register)
+import qualified App (Context(..), T, update_)
+import qualified Message (FromClient(..), broadcast, relay)
+import qualified Automaton (start)

 exit :: App.T ()
 exit = do
-  asks App.playerID >>= App.update_ . Server.disconnect
-  relay Message.LogOut broadcast
+  asks App.key >>= App.update_ . Server.disconnect
+  Message.relay Message.LogOut Message.broadcast

 serverApp :: App.T () -> App.T () -> IO ServerApp
 serverApp onEnter onExit = do
  mServer <- newMVar Server.new
  return $ \pending -> do
    session <- Session.open <$> acceptRequest pending
-    playerID <- modifyMVar mServer (return . Server.register session)
-    let app = App.Context {App.mServer, App.playerID}
+    key <- modifyMVar mServer (return . Server.register session)
+    let app = App.Context {App.mServer, App.key}
    finally
      (runReaderT onEnter app)
      (runReaderT onExit app)
--- a/src/Message.hs
+++ b/src/Message.hs
@ -0,0 +1,104 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Message (
+      FromClient(..)
+    , T(..)
+    , broadcast
+    , get
+    , notifyPlayers
+    , receive
+    , relay
+    , send
+    , sendTo
+    , update
+  ) where
+
+import Data.List (intercalate)
+import Data.Foldable (forM_)
+import Data.Map (keys)
+import Data.Aeson (FromJSON(..), ToJSON(..), Value, eitherDecode', encode, genericParseJSON, genericToEncoding, defaultOptions)
+import Network.WebSockets (receiveData, sendTextData)
+import Data.ByteString.Lazy.Char8 (unpack)
+import Data.Text (Text)
+import Control.Monad.Reader (asks, lift)
+import qualified Player (Key)
+import qualified Game (T, export)
+import qualified Session (T(..))
+import qualified Server (T(..), get)
+import qualified App (Context(..), T, connection, debug, server)
+import qualified Hanafuda.KoiKoi as KoiKoi (Action, On(..), Move(..))
+import GHC.Generics (Generic)
+
+data FromClient =
+    Answer {accept :: Bool}
+  | Invitation {to :: Player.Key}
+  | LogIn {name :: Text}
+  | LogOut
+  | Play {move :: KoiKoi.Move}
+  | Ping
+  deriving (Generic)
+
+instance ToJSON FromClient where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON FromClient where
+  parseJSON = genericParseJSON defaultOptions
+
+data T =
+    Relay {from :: Player.Key, message :: FromClient}
+  | Welcome {room :: Server.T, key :: Player.Key}
+  | Update {alone :: [Player.Key], paired :: [Player.Key]}
+  | Game {game :: Value, logs :: [KoiKoi.Action]}
+  | Pong
+  | Error {error :: String}
+  deriving (Generic)
+
+instance ToJSON T where
+  toEncoding = genericToEncoding defaultOptions
+
+sendTo :: [Player.Key] -> T -> App.T ()
+sendTo playerKeys obj = do
+  sessions <- getSessions <$> App.server
+  App.debug $ '(' : intercalate ", " recipients ++ ") <" ++ (unpack encoded)
+  lift $ forM_ (Session.connection <$> sessions) $ flip sendTextData encoded
+  where
+    encoded = encode $ obj
+    getSessions server = (\key -> Server.get key server) <$> playerKeys
+    recipients = show <$> playerKeys
+
+send :: T -> App.T ()
+send obj = do
+  key <- asks App.key
+  sendTo [key] obj
+
+broadcast :: T -> App.T ()
+broadcast obj =
+  App.server >>= flip sendTo obj . keys . Server.sessions
+
+relay :: FromClient -> (T -> App.T ()) -> App.T ()
+relay message f = do
+  App.debug "Relaying"
+  (\from -> f $ Relay {from, message}) =<< asks App.key
+
+receive :: App.T FromClient
+receive = do
+  received <- ((lift . receiveData) =<< App.connection)
+  App.debug $ '>':(unpack received)
+  case eitherDecode' received of
+    Left errorMessage -> send (Message.Error errorMessage) >> receive
+    Right clientMessage -> return clientMessage
+
+get :: App.T Message.FromClient
+get =
+  receive >>= pong
+  where
+    pong Ping = send Pong >> get
+    pong m = return m
+
+update :: T
+update = Update {alone = [], paired = []}
+
+notifyPlayers :: Game.T -> [KoiKoi.Action] -> App.T ()
+notifyPlayers game logs =
+  forM_ (keys $ KoiKoi.scores game) $ \k ->
+    sendTo [k] $ Game {game = Game.export k game, logs}
--- a/src/Messaging.hs
+++ b/src/Messaging.hs
@ -1,76 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE FlexibleContexts #-}
-module Messaging (
-      FromClient(..)
-    , T(..)
-    , broadcast
-    , get
-    , notifyPlayers
-    , receive
-    , relay
-    , send
-    , sendTo
-    , update
-  ) where
-
-import qualified App (Context(..), T, connection, debug, server)
-import Control.Monad.Reader (asks, lift)
-import Data.Aeson (eitherDecode', encode)
-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 Hanafuda.Message (FromClient(..), T(..))
-import qualified Hanafuda.Message as Message (T)
-import Network.WebSockets (receiveData, sendTextData)
-import qualified Game (export)
-import qualified Server (T(..), get)
-import qualified Session (T(..))
-
-sendTo :: [KoiKoi.PlayerID] -> Message.T -> App.T ()
-sendTo playerIDs obj = do
-  sessions <- getSessions <$> App.server
-  App.debug $ '(' : intercalate ", " recipients ++ ") <" ++ (unpack encoded)
-  lift $ forM_ (Session.connection <$> sessions) $ flip sendTextData encoded
-  where
-    encoded = encode $ obj
-    getSessions server = (\playerID -> Server.get playerID server) <$> playerIDs
-    recipients = show <$> playerIDs
-
-send :: Message.T -> App.T ()
-send obj = do
-  playerID <- asks App.playerID
-  sendTo [playerID] obj
-
-broadcast :: Message.T -> App.T ()
-broadcast obj =
-  App.server >>= flip sendTo obj . keys . Server.sessions
-
-relay :: FromClient -> (Message.T -> App.T ()) -> App.T ()
-relay message f = do
-  App.debug "Relaying"
-  (\from -> f $ Relay {from, message}) =<< asks App.playerID
-
-receive :: App.T FromClient
-receive = do
-  received <- ((lift . receiveData) =<< App.connection)
-  App.debug $ '>':(unpack received)
-  case eitherDecode' received of
-    Left errorMessage -> send (Error errorMessage) >> receive
-    Right clientMessage -> return clientMessage
-
-get :: App.T FromClient
-get =
-  receive >>= pong
-  where
-    pong Ping = send Pong >> get
-    pong m = return m
-
-update :: T
-update = Update {alone = [], paired = []}
-
-notifyPlayers :: KoiKoi.Game -> [KoiKoi.Action] -> App.T ()
-notifyPlayers game logs =
-  forM_ (keys $ KoiKoi.scores game) $ \k ->
-    sendTo [k] $ Game {game = Game.export k game, logs}
--- a/src/Player.hs
+++ b/src/Player.hs
@ -0,0 +1,30 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Player (
+      Key
+    , T(..)
+  ) where
+
+import Data.Text (Text)
+import qualified Data (Key)
+import GHC.Generics
+
+data T = T {
+    name :: Text
+  } deriving (Eq, Ord, Generic)
+type Key = Data.Key T
+
+{-
+instance FromJSON Key
+instance ToJSON Key where
+  toEncoding = genericToEncoding JSON.defaultOptions
+
+instance ToJSONKey Key where
+  toJSONKey = toJSONKeyText (pack . \(Key n) -> show n)
+
+instance FromJSON Name
+instance ToJSON Name where
+  toEncoding = genericToEncoding JSON.defaultOptions
+-}
--- a/src/RW.hs
+++ b/src/RW.hs
@ -1,11 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-module RW (
-    RW(..)
-  ) where
-
-class RW a b where
-  get :: b -> a
-  set :: a -> b -> b
-  update :: (a ->  a) -> b -> b
-  update f v =
-    set (f (get v)) v
--- a/src/Server.hs
+++ b/src/Server.hs
@ -2,34 +2,36 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
 module Server (
      T(..)
    , disconnect
-    , endGame
    , get
    , logIn
    , logOut
    , new
    , register
-    , room
    , update
  ) where

+import Data.Aeson (ToJSON(..), (.=), object, pairs)
 import Data.Map (Map, (!), (!?), adjust, delete, insert, lookupMax, mapWithKey)
 import qualified Data.Map as Map (empty)
+import Data.Monoid ((<>))
 import Data.Set (Set, member)
 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 qualified RW (RW(..))
+import qualified Data (RW(..))
+import qualified Game (Key, T)
+import qualified Player (Key, T(..))
 import qualified Session (Status(..), T(..), Update)

 type Names = Set Text
-type Players = Map PlayerID Text
-type Sessions = Map PlayerID Session.T
-type Games = Map GameID Game
+type Players = Map Player.Key Player.T
+type Sessions = Map Player.Key Session.T
+type Games = Map Game.Key Game.T
 data T = T {
      names :: Names
    , players :: Players
@ -37,32 +39,38 @@ data T = T {
    , games :: Games
  }

-instance RW.RW Names T where
+instance Data.RW Names T where
  get = names
  set names server = server {names}

-instance RW.RW Players T where
+instance Data.RW Players T where
  get = players
  set players server = server {players}

-instance RW.RW Sessions T where
+instance Data.RW Sessions T where
  get = sessions
  set sessions server = server {sessions}

-instance RW.RW Games T where
+instance Data.RW Games T where
  get = games
  set games server = server {games}

-export :: Sessions -> PlayerID -> Text -> PlayerStatus
-export sessions playerID playerName = PlayerStatus (playerName, alone)
+newtype Player = Player (Text, Bool)
+instance ToJSON Player where
+  toJSON (Player (name, alone)) = object ["name" .= name, "alone" .= alone]
+  toEncoding (Player (name, alone)) = pairs ("name" .= name <> "alone" .= alone)
+
+export :: Sessions -> Player.Key -> Player.T -> Player
+export sessions key player = Player (Player.name player, alone)
  where
    alone =
-      case Session.status (sessions ! playerID) of
+      case Session.status (sessions ! key) of
        Session.LoggedIn True -> True
        _ -> False

-room :: T -> Room
-room (T {players, sessions}) = mapWithKey (export sessions) players
+instance ToJSON T where
+  toJSON (T {players, sessions}) = toJSON $ mapWithKey (export sessions) players
+  toEncoding (T {players, sessions}) = toEncoding $ mapWithKey (export sessions) players

 new :: T
 new = T {
@ -72,41 +80,37 @@ new = T {
    , games = Map.empty
  }

-register :: forall a b. (Enum a, Ord a, RW.RW (Map a b) T) => b -> T -> (T, a)
+register :: forall a b. (Enum a, Ord a, Data.RW (Map a b) T) => b -> T -> (T, a)
 register x server =
-  let playerID = maybe (toEnum 0) (\(n, _) -> succ n) $ lookupMax $ (RW.get server :: Map a b) in
-  (RW.update (insert playerID x) server, playerID)
+  let key = maybe (toEnum 0) (\(n, _) -> succ n) $ lookupMax $ (Data.get server :: Map a b) in
+  (Data.update (insert key x) server, key)

-get :: forall a b. (Ord a, RW.RW (Map a b) T) => a -> T -> b
-get playerID server = (RW.get server :: Map a b) ! playerID
+get :: forall a b. (Ord a, Data.RW (Map a b) T) => a -> T -> b
+get key server = (Data.get server :: Map a b) ! key

-update :: forall a b. (Ord a, RW.RW (Map a b) T) => a -> (b -> b) -> T -> T
-update playerID updator =
-  RW.update (adjust updator playerID :: Map a b -> Map a b)
+update :: forall a b. (Ord a, Data.RW (Map a b) T) => a -> (b -> b) -> T -> T
+update key updator =
+  Data.update (adjust updator key :: Map a b -> Map a b)

-disconnect :: PlayerID -> T -> T
-disconnect playerID =
-  RW.update (delete playerID :: Sessions -> Sessions) . logOut playerID
+disconnect :: Player.Key -> T -> T
+disconnect key =
+  Data.update (delete key :: Sessions -> Sessions) . logOut key

-endGame :: GameID -> T -> T
-endGame playerID =
-  RW.update (delete playerID :: Games -> Games)
-
-logIn :: Text -> PlayerID -> T -> Either String T
-logIn name playerID server =
-  RW.update (Set.insert name) .
-  RW.update (insert playerID name) .
-  update playerID (RW.set $ Session.LoggedIn True :: Session.Update) <$>
+logIn :: Text -> Player.Key -> T -> Either String T
+logIn name key server =
+  Data.update (Set.insert name) .
+  Data.update (insert key $ Player.T {Player.name}) .
+  update key (Data.set $ Session.LoggedIn True :: Session.Update) <$>
  if name `member` names server
    then Left "This name is already registered"
    else Right server

-logOut :: PlayerID -> T -> T
-logOut playerID server =
+logOut :: Player.Key -> T -> T
+logOut key server =
  maybe
    server
-    (\playerName ->
-      RW.update (delete playerID :: Players -> Players) $
-      update playerID (RW.set $ Session.LoggedIn False :: Session.Update) $
-      RW.update (Set.delete playerName :: Names -> Names) server)
-    (players server !? playerID)
+    (\player ->
+      Data.update (delete key :: Players -> Players) $
+      update key (Data.set $ Session.LoggedIn False :: Session.Update) $
+      Data.update (Set.delete $ Player.name player :: Names -> Names) server)
+    (players server !? key)
--- a/src/Session.hs
+++ b/src/Session.hs
@ -1,5 +1,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DeriveGeneric #-}
 module Session (
      Status(..)
    , T(..)
@ -7,16 +8,23 @@ module Session (
    , open
  ) where

-import Hanafuda.KoiKoi (GameID, PlayerID)
 import Network.WebSockets (Connection)
-import qualified RW (RW(..))
+import Data.Aeson (ToJSON(..), genericToEncoding)
+import GHC.Generics (Generic)
+import qualified JSON (singleLCField)
+import qualified Data (RW(..))
+import qualified Player (Key)
+import qualified Game (Key)

 data Status =
    LoggedIn Bool
-  | Answering PlayerID
-  | Waiting PlayerID
-  | Playing GameID
-  deriving (Show)
+  | Answering Player.Key
+  | Waiting Player.Key
+  | Playing Game.Key
+  deriving (Show, Generic)
+
+instance ToJSON Status where
+  toEncoding = genericToEncoding JSON.singleLCField

 data T = T {
      connection :: Connection
@ -24,7 +32,7 @@ data T = T {
  }
 type Update = T -> T

-instance RW.RW Status T where
+instance Data.RW Status T where
  get = status
  set status session = session {status}

--- a/www/game.js
+++ b/www/game.js
@ -9,9 +9,17 @@ function Game(modules) {
  };
  var sets = buildSets();
  var selected = null;
-  var turnedCard = null;
 	var queue = [];

+	window.addEventListener('focus', runQueue);
+  modules.messaging.addEventListener(["Game"], function(o) {
+		if(document.hasFocus()) {
+			modules.async.run(handleGameMessage(o));
+		} else {
+			queue.push(handleGameMessage(o));
+		}
+	});
+
  function buildSets() {
    var sets = {};
    ['river', 'you', 'them'].forEach(function(id) {
@ -30,35 +38,17 @@ function Game(modules) {
    return sets;
  }

-	window.addEventListener('focus', runQueue);
-  modules.messaging.addEventListener(["Game"], function(o) {
-		queue.push(handleGameMessage(o));
-		if(document.hasFocus() && queue.length == 1) {
-			runQueue();
-		} else {
-			modules.statusHandler.set("♪");
-		}
-	});
-
 	function runQueue() {
 		if(queue.length > 0) {
-			var length = queue.length;
 			modules.async.run.apply(null, queue.concat(
-				modules.async.apply(function() {
-					queue = queue.slice(length);
-					runQueue();
-				})
+				modules.async.apply(function() {queue = [];})
 			));
 		}
 	}

 	function handleGameMessage(o) {
-		if(o.game.deck == 24) { // deck is full, means new round
-			if(o.logs.length > 0) { // but still some logs, from the previous round
-				return modules.async.sequence(applyDiff(o), setGame(o)); // so play the diff, then set the new round
-			} else {
-				return setGame(o); // directly set a whole new game
-			}
+		if(o.game.deck == 24) {
+			return o.logs.length > 0 ? modules.async.sequence(applyDiff(o), setGame(o)) : setGame(o);
 		} else {
 			return applyDiff(o);
 		}
@ -79,75 +69,39 @@ function Game(modules) {

 	function handleStep(o) {
 		return function(f) {
-			handleTurnedCard(o, f);
-			if(status.step == "Scored") {
-				if(status.playing) {
-					askKoikoi(o, f);
-				} else {
-					theyScored(o, f);
-				}
-			} else if (status.step == "Over") {
-				gameEnd(o, f);
-			} else {
+			if(status.step == "Turned") {
+    	  setTurned(o.game.step.contents);
+    	} else {
+    	  if(status.step == "ToPlay" && o.game.playing == o.game.oyake) {
+    	    rest.className = ["card", "count" + o.game.deck].join(' ');
+    	  }
+    	  if(deck.lastChild.id != "rest") {
+    	    deck.removeChild(deck.lastChild);
+    	  }
+    	}
+    	if(status.step == "Scored") {
+    	  if(status.playing) {
+    	    modules.screen.dialog({
+    	      text: modules.i18n.get('youScored'),
+    	      answers: [
+    	        {label: 'endRound', action: function() {play({koiKoi: false}); f();}},
+    	        {label: 'koikoi', action: function() {play({koiKoi: true}); f();}}
+    	      ]
+    	    });
+    	  } else {
+    	    modules.screen.dialog({
+    	      text: modules.i18n.get('theyScored')(modules.room.name(o.game.playing)),
+    	      answers: [
+    	        {label: 'ok', action: f}
+    	      ]
+    	    });
+    	  }
+    	} else {
 				f();
 			}
 		};
 	}

-	function handleTurnedCard(o, f) {
-		if(status.step == "Turned") {
-			setTurned(o.game.step.contents);
-		} else {
-			if(status.step == "ToPlay" && o.game.playing == o.game.oyake) {
-				rest.className = ["card", "count" + o.game.deck].join(' ');
-			}
-			if(deck.lastChild.id != "rest") {
-				deck.removeChild(deck.lastChild);
-			}
-		}
-	}
-
-	function askKoikoi(o, f) {
-		modules.screen.dialog({
-			text: modules.i18n.get('youScored'),
-			answers: [
-				{label: 'endRound', action: function() {play({koiKoi: false}); f();}},
-				{label: 'koikoi', action: function() {play({koiKoi: true}); f();}}
-			]
-		});
-
-	}
-
-	function theyScored(o, f) {
-		modules.screen.dialog({
-			text: modules.i18n.get('theyScored')(modules.room.name(o.game.playing)),
-			answers: [
-				{label: 'ok', action: f}
-			]
-		});
-	}
-
-	function gameEnd(o, f) {
-		var winner, maxScore;
-		for(var key in o.game.scores) {
-			if(maxScore == undefined || o.game.scores[key] > maxScore) {
-				winner = key;
-				maxScore = o.game.scores[key];
-			}
-		}
-		modules.screen.dialog({
-			text: modules.i18n.get(modules.session.is(winner) ? 'won' : 'lost'),
-			answers: [{
-				label: 'endGame',
-				action: function() {
-					modules.messaging.send({tag: "Quit"});
-					modules.screen.select('reception');
-					f();
-				}
-			}]
-		});
-	}
-
 	function applyDiff(o) {
 		return modules.async.sequence.apply(null,
 			o.logs.map(animate).concat(
@ -175,8 +129,7 @@ function Game(modules) {
 					movingCards.push([sets[side].hand, dest, card]);
 				} else {
 					var cardSet = {};
-					cardSet[card.name] = turnedCard || new TurnedCard(card.name);
-					turnedCard = null;
+					cardSet[card.name] = turnedCard(card.name);
 					movingCards.push([{card: cardSet, dom: deck}, dest, card]);
 				}
 				return movingCards;
@ -191,7 +144,7 @@ function Game(modules) {

  function moveCard(fromSet, toSet, card) {
    var from, originalCard;
-    var slot = modules.dom.make('li', {class: ['card', 'slot']});
+		var slot = modules.dom.make('li', {class: ['card', 'slot']});
    if (fromSet.card[card.name] != undefined) {
 			originalCard = fromSet.card[card.name].dom;
 			delete fromSet.card[card.name];
@ -302,11 +255,18 @@ function Game(modules) {
    }
  }

+	function turnedCard(cardName) {
+    var card = new Card(cardName);
+    card.dom.id = "turned";
+    deck.appendChild(card.dom);
+		return card;
+	}
+
  function setTurned(cardName) {
-		turnedCard = new TurnedCard(cardName);
+		turnedCard(cardName);
    if(status.playing) {
-      selected = turnedCard;
-      showCandidates(modules.hanafuda.Card[cardName], true);
+      selected = cardName;
+      showCandidates(modules.hanafuda.Card[selected], true);
    }
  }

@ -314,12 +274,6 @@ function Game(modules) {
    matchingInRiver(card).forEach(function(riverCard) {riverCard.setCandidate(yes);});
  }

-  function setSelected(yes) {
-    selected = yes ? this : null;
-    this.dom.classList.toggle('selected', yes);
-    showCandidates(this.value, yes);
-  }
-
  function Card(name) {
    this.value = modules.hanafuda.Card[name];
    this.name = name;
@ -344,8 +298,9 @@ function Game(modules) {
    var card = this;
    return function() {
      if(card.candidate) {
-        var withCard = selected.name;
-        selected.setSelected(false);
+        var withCard = selected;
+        selected = null;
+				showCandidates(card.value, false);
        play(
          status.step == 'ToPlay' ? {capture: [withCard, card.name]} : {choose: card.name}
        );
@ -358,15 +313,6 @@ function Game(modules) {
    this.dom.classList.toggle("candidate", yes);
  }

-  function TurnedCard() {
-    Card.apply(this, arguments);
-    this.dom.id = "turned";
-    deck.appendChild(this.dom);
-  }
-
-  TurnedCard.prototype.onClick = Card.prototype.onClick;
-  TurnedCard.prototype.setSelected = setSelected;
-
  function HandCard() {
    Card.apply(this, arguments);
  }
@ -376,7 +322,7 @@ function Game(modules) {
    return function() {
      if(status.playing && status.step == "ToPlay") {
        if(selected != undefined) {
-          selected.setSelected(false);
+          sets.you.hand.card[selected].setSelected(false);
        } else {
          card.play();
        }
@ -384,7 +330,11 @@ function Game(modules) {
    };
  };

-  HandCard.prototype.setSelected = setSelected;
+  HandCard.prototype.setSelected = function(yes) {
+    selected = yes ? this.name : null;
+    this.dom.classList.toggle('selected', yes);
+    showCandidates(this.value, yes);
+  }

  HandCard.prototype.play = function() {
    var matching = matchingInRiver(this.value);
--- a/www/index.html
+++ b/www/index.html
@ -7,12 +7,12 @@
    <script src="UnitJS/dom.js"></script>
    <script src="translations.js"></script>
    <script src="i18n.js"></script>
+    <script src="lib/jsencrypt.min.js"></script>
    <script src="fun.js"></script>
    <script src="screen.js"></script>
    <script src="messaging.js"></script>
    <script src="session.js"></script>
    <script src="room.js"></script>
-    <script src="statusHandler.js"></script>
    <script src="login.js"></script>
    <script src="hanafuda.js"></script>
    <script src="game.js"></script>
@ -70,6 +70,6 @@
    </div>
    <div id="dialog">
    </div>
-    <p id="error"></p>
+    <p id="debug"></p>
  </body>
 </html>
--- a/www/lib/jsencrypt.min.js
+++ b/www/lib/jsencrypt.min.js
--- a/www/login.js
+++ b/www/login.js
@ -56,7 +56,6 @@ function Login(modules) {
    var name = modules.room.name(o.from);
    // invitations should come only from known players, in doubt say «no»
    if(name) {
-      modules.statusHandler.set("🎴");
      modules.screen.dialog({
        text: modules.i18n.get('invited')(name),
        answers: invitationAnswers
--- a/www/main.js
+++ b/www/main.js
@ -5,13 +5,12 @@ window.addEventListener('load', function() {
  var i18n = I18n({translations: translations});
  var fun = Fun();
  var screen = Screen({dom: dom, i18n: i18n});
-  var messaging = Messaging({screen: screen});
+  var messaging = Messaging();
  var session = Session({messaging: messaging});
  var room = Room({dom: dom, messaging: messaging, session: session, fun: fun});
-  var statusHandler = StatusHandler();
-  var login = Login({dom: dom, i18n: i18n, messaging: messaging, room: room, screen: screen, session: session, statusHandler: statusHandler});
+  var login = Login({dom: dom, i18n: i18n, messaging: messaging, room: room, screen: screen, session: session});
  var hanafuda = Hanafuda({fun: fun});
-  var game = Game({async: async, dom: dom, i18n: i18n, fun: fun, hanafuda: hanafuda, messaging: messaging, room: room, screen: screen, session: session, statusHandler: statusHandler});
+  var game = Game({async: async, dom: dom, i18n: i18n, fun: fun, hanafuda: hanafuda, messaging: messaging, room: room, screen: screen, session: session});

  var domElems = {
    join: document.getElementById('login').join,
--- a/www/messaging.js
+++ b/www/messaging.js
@ -1,7 +1,5 @@
-function Messaging(modules) {
-  var ws = new WebSocket(window.location.origin.replace(/^http/, 'ws') + '/play/');
-  var debug = getParameters().debug;
-  var doLog = debug != undefined && debug.match(/^(?:1|t(?:rue)?|v(?:rai)?)$/i);
+function Messaging(screen) {
+  var ws = new WebSocket('ws://' + window.location.hostname + '/play/');
  var keepAlivePeriod = 20000;
  var routes = {callbacks: [], children: {}};

@ -27,15 +25,6 @@ function Messaging(modules) {
    }
  }

-  function getParameters() {
-    var o = {};
-    window.location.search.substr(1).split('&').forEach(function(s) {
-      var t = s.split('=');
-      o[t[0]] = t[1];
-    });
-    return o;
-  }
-
  function addEventListener(path, callback) {
    var route = get(routes, path, true);
    route.callbacks.push(callback);
@ -53,29 +42,18 @@ function Messaging(modules) {
    if(route != undefined && route.callbacks != undefined) {
      route.callbacks.forEach(function(f) {f(o);});
    } else {
-      console.log("No route found for " + event.data);
+      debug.textContent = event.data;
    }
-    o.direction = 'client < server';
-    log(o);
  };

-  function log(message) {
-    if(doLog) {
-      console.log(message);
-    }
-  }
-
  function start() {
-    ws.addEventListener('message', messageListener);
-    ws.addEventListener('open', ping);
+    ping();
    addEventListener(["Pong"], ping);
-    addEventListener(["Error"], function(o) {modules.screen.error(o.error);});
+    ws.addEventListener('message', messageListener);
  }

  function send(o) {
    ws.send(JSON.stringify(o));
-    o.direction = 'client > server';
-    log(o);
  }

  function ping() {
--- a/www/screen.css
+++ b/www/screen.css
@ -33,22 +33,3 @@ body > div.on {
 #dialog button {
  display: inline-block;
 }
-
-#error {
-  position: absolute;
-  z-index: 1;
-  top: 1em;
-  right: 1em;
-  max-width: 20em;
-  border: 1px solid #e0afac;
-  padding: 1em;
-  border-radius: 0.5em;
-  background: bisque;
-  cursor: pointer;
-  margin: 0;
-  display: none;
-}
-
-#error.on {
-  display: block;
-}
--- a/www/screen.js
+++ b/www/screen.js
@ -1,12 +1,7 @@
 function Screen(modules) {
  var current = document.querySelector("body > div.on");
-  var errorBox = document.getElementById('error');
-  errorBox.addEventListener('click', function() {
-    errorBox.className = "";
-  });

  return {
-    error: error,
    dialog: dialog,
    select: select
  };
@ -40,9 +35,4 @@ function Screen(modules) {
    layer.appendChild(dialog);
    layer.className = "on";
  }
-
-  function error(message) {
-    errorBox.textContent = message;
-    errorBox.className = "on";
-  }
 }
--- a/www/session.js
+++ b/www/session.js
@ -1,6 +1,7 @@
 function Session(modules) {
  var key = null;
  var name = null;
+  var keys = JSON.parse(localStorage.getItem('keys')) || generateKeyPair();

  modules.messaging.addEventListener(["Welcome"], function(o) {
    key = o.key;
@ -29,4 +30,13 @@ function Session(modules) {
  function loggedIn() {
    return name != undefined;
  }
+
+  function generateKeyPair() {
+    var crypt = new JSEncrypt({default_key_size: 1024});
+    crypt.getKey();
+    return {
+      priv: crypt.getPrivateKey(),
+      pub: crypt.getPublicKey()
+    };
+  }
 }
--- a/www/statusHandler.js
+++ b/www/statusHandler.js
@ -1,20 +0,0 @@
-function StatusHandler() {
-  var baseTitle = document.title;
-	window.addEventListener('focus', reset);
-
-  return {
-    reset: reset,
-    set: set
-  };
-
-  function reset() {
-    document.title = baseTitle;
-  }
-
-  function set(newStatus) {
-    if(!document.hasFocus()) {
-      document.title = newStatus + " - " + baseTitle;
-    }
-  }
-
-}
--- a/www/translations.js
+++ b/www/translations.js
@ -17,7 +17,6 @@ function Translations() {
 			alone: "No one to play with yet ! Wait a little",
 			decline: "Decline",
 			endRound: "End the round",
-			endGame: "Return to main menu",
 			join: "Join",
 			invite: "Invite",
 			invited: function(name) {
@ -25,7 +24,6 @@ function Translations() {
 			},
 			koikoi: "KoiKoi !!",
 			leave: "Leave",
-			lost: "You lost the game",
 			monthFlower: function(flower) {
 				return "This month's flower is the " + flower;
 			},
@ -39,7 +37,6 @@ function Translations() {
 			theyScored: function(name) {
 				return name + " scored";
 			},
-			won: "You won !",
 			yourTurn: "Your turn",
 			youScored: "You scored ! Do you want to get your points and end the round or KoiKoi ?"
 		},
@ -60,7 +57,6 @@ function Translations() {
 			alone: "Personne pour jouer pour l'instant ! Attendez un peu",
 			decline: "Refuser",
 			endRound: "Finir la manche",
-			endGame: "Retourner au menu principal",
 			join: "Entrer",
 			invite: "Inviter",
 			invited: function(name) {
@ -68,7 +64,6 @@ function Translations() {
 			},
 			koikoi: "KoiKoi !!",
 			leave: "Partir",
-			lost: "Vous avez perdu",
 			monthFlower: function(flower) {
 				return "C'est le mois des " + flower;
 			},
@ -82,7 +77,6 @@ function Translations() {
 			theyScored: function(name) {
 				return name + " a marqué";
 			},
-			won: "Vous avez gagné !",
 			yourTurn: "À vous",
 			youScored: "Vous avez marqué ! Voulez-vous empocher vos gains et terminer la manche ou faire KoiKoi ?"
 		}