Use session keys in the client to remove ambiguity

2018-04-12 23:01:40 +02:00 · 2018-04-12 23:01:40 +02:00 · 59f8751fb6
commit 59f8751fb6
parent fab330b71d
12 changed files with 355 additions and 237 deletions
--- a/src/Data.hs
+++ b/src/Data.hs
@ -7,4 +7,3 @@ class RW a b where
  update :: (a -> a) -> b -> b
  set :: a -> b -> b
  set = update . const
-
--- a/src/Main.hs
+++ b/src/Main.hs
@ -7,11 +7,12 @@ import Network.HTTP.Types.Status (badRequest400)
 import Network.WebSockets (defaultConnectionOptions)
 import Network.Wai.Handler.WebSockets (websocketsOr)
 import Network.Wai (responseLBS)
+import Control.Monad.Reader (asks)
 import qualified Config (listenPort)
-import qualified Player (Login(..), T(..))
-import qualified Server (logIn, logOut, disconnect)
-import qualified Session (App, debug, get, player, serve, update)
-import qualified Message (FromClient(..), T(..), broadcast, receive, relay, send)
+import qualified Player (Session(..), Status(..))
+import qualified Server (logIn, logOut, disconnect, setStatus)
+import qualified Session (App, T(..), current, debug, get, serve, server, try, update)
+import qualified Message (FromClient(..), T(..), broadcast, receive, relay, send, sendTo)

 type Vertex = Session.App ()
 type Edges = Message.FromClient -> Vertex
@ -27,7 +28,7 @@ newVertex name = do
 enter :: Vertex
 enter = do
  Session.debug "Initial state"
-  Session.get id >>= (Message.send . Message.Welcome)
+  Message.Welcome <$> Session.server <*> asks Session.key >>= Message.send
  connected

 onErrorGoto :: Vertex -> String -> Session.App ()
@ -38,7 +39,7 @@ connected  :: Vertex
 connected = newVertex "Connected" edges
  where
    edges logIn@(Message.LogIn login) =
-       Session.update (Server.logIn login)
+       asks Session.key >>= Session.try . (Server.logIn login)
       >>= maybe
        (Message.relay logIn Message.broadcast >> loggedIn)
        (onErrorGoto connected)
@ -49,20 +50,37 @@ loggedIn = newVertex "Logged in" edges
  where
    edges logOut@Message.LogOut = do
      Message.relay logOut Message.broadcast
-      Session.update Server.logOut
-      >>= maybe
-        connected
-        (onErrorGoto loggedIn)
+      asks Session.key >>= Session.update . Server.logOut
+      connected
+    edges invitation@(Message.Invitation {Message.to}) = do
+      session <- Session.get to
+      case Player.status session of
+        Player.LoggedIn True -> do
+          key <- asks Session.key
+          Session.update (Server.setStatus (Player.Waiting to) key)
+          Session.update (Server.setStatus (Player.Answering key) to)
+          (Message.relay invitation $ Message.sendTo (to, session))
+          loggedIn
+        _ -> onErrorGoto loggedIn "They just left"
+    edges (Message.Answer {Message.accept}) = do
+      current <- Session.current
+      case Player.status current of
+        Player.Answering to -> do
+          session <- Session.get to
+          key <- asks Session.key
+          case Player.status session of
+            Player.Waiting for | for == key ->
+              if accept
+                then Session.debug "Yeah ! Let's start a game" >> loggedIn
+                else Session.debug "Oh they said no" >> loggedIn
+            _ -> onErrorGoto loggedIn "They're not waiting for your answer"
+        _ -> onErrorGoto loggedIn "You haven't been invited yet"
    edges _ = loggedIn

 exit :: Vertex
 exit = do
-  leaving <- Player.login <$> Session.player
-  _ <- Session.update Server.disconnect -- ignoring never-occuring error
-  case leaving of
-    Player.Login from -> Message.broadcast $
-      Message.Relay {Message.from, Message.message = Message.LogOut}
-    _ -> return ()
+  asks Session.key >>= Session.update . Server.disconnect
+  Message.relay Message.LogOut Message.broadcast

 main :: IO ()
 main = do
--- a/src/Message.hs
+++ b/src/Message.hs
@ -7,23 +7,25 @@ module Message (
    , receive
    , relay
    , send
+    , sendTo
  ) where

+import Data.Map (toList)
 import Data.Aeson (FromJSON(..), ToJSON(..), eitherDecode', encode, genericParseJSON, genericToEncoding, defaultOptions)
 import Network.WebSockets (receiveData, sendTextData)
 import Data.ByteString.Lazy.Char8 (unpack)
 import Control.Monad (mapM_)
-import Control.Monad.Reader (lift)
-import qualified Player (Login(..), Name, T(..))
+import Control.Monad.Reader (asks, lift)
+import qualified Player (Key, Name, Session(..))
 import qualified Server (T(..))
-import qualified Session (App, connection, debug, get, player)
+import qualified Session (App, T(..), connection, current, debug, server)
 import qualified Hanafuda.KoiKoi as KoiKoi (Move(..))
 import GHC.Generics (Generic)
 import Game ()

 data FromClient =
    Answer {accept :: Bool}
-  | Invitation {to :: Player.Name}
+  | Invitation {to :: Player.Key}
  | LogIn {name :: Player.Name}
  | LogOut
  | Game {move :: KoiKoi.Move}
@ -36,8 +38,8 @@ instance FromJSON FromClient where
  parseJSON = genericParseJSON defaultOptions

 data T =
-    Relay {from :: Player.Name, message :: FromClient}
-  | Welcome {room :: Server.T}
+    Relay {from :: Player.Key, message :: FromClient}
+  | Welcome {room :: Server.T, key :: Player.Key}
  | Pong
  | Error {error :: String}
  deriving (Generic)
@ -45,31 +47,28 @@ data T =
 instance ToJSON T where
  toEncoding = genericToEncoding defaultOptions

-sendTo :: T -> Player.T -> Session.App ()
-sendTo obj player = do
-  Session.debug $ '(' : playerLogin ++ ") <" ++ (unpack encoded)
-  lift $ sendTextData (Player.connection player) $ encoded
+sendTo :: (Player.Key, Player.Session) -> T -> Session.App ()
+sendTo (key, session) obj = do
+  Session.debug $ '(' : show key ++ ") <" ++ (unpack encoded)
+  lift $ sendTextData (Player.connection session) $ encoded
  where
    encoded = encode $ obj
-    playerLogin = unpack $ encode $ Player.login player

 send :: T -> Session.App ()
-send obj =
-  (obj `sendTo`) =<< Session.player
+send obj = do
+  key <- asks Session.key
+  session <- Session.current
+  sendTo (key, session) obj

 broadcast :: T -> Session.App ()
 broadcast obj =
-  Session.get Server.bySessionId
-  >>= mapM_ (obj `sendTo`)
+  (toList . Server.sessions) <$> Session.server
+  >>= mapM_ (flip sendTo obj)

 relay :: FromClient -> (T -> Session.App ()) -> Session.App ()
-relay message f =
+relay message f = do
  Session.debug "Relaying"
-  >> Session.player >>= (ifLoggedIn . Player.login)
-  >> Session.debug "Relayed"
-  where
-    ifLoggedIn Player.Anonymous = return ()
-    ifLoggedIn (Player.Login from) = f $ Relay {from, message}
+  (\from -> f $ Relay {from, message}) =<< asks Session.key

 receive :: Session.App FromClient
 receive = do
--- a/src/Player.hs
+++ b/src/Player.hs
@ -1,70 +1,72 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeFamilies #-}
 module Player (
-      Login(..)
-    , Name(..)
+      Key(..)
+    , Name
+    , Session(..)
    , Status(..)
    , T(..)
    , new
+    , openSession
  ) where

-import Data.Monoid ((<>))
-import Data.Text (Text)
-import Data.Aeson (FromJSON(..), ToJSON(..), (.=), Value(..), genericToEncoding, object, pairs)
-import qualified JSON (defaultOptions, singleLCField)
+import Data.Text (Text, pack)
+import Data.Aeson (FromJSON(..), ToJSON(..), ToJSONKey(..), genericToEncoding)
+import Data.Aeson.Types (toJSONKeyText)
+import qualified JSON (defaultOptions)
 import qualified Data (RW(..))
 import Network.WebSockets (Connection)
 import GHC.Generics

+newtype Key = Key Int deriving (Eq, Ord, Read, Show, Generic)
 newtype Name = Name Text deriving (Eq, Ord, Generic)
-data Login = Anonymous | Login Name
+
+data T = T {
+      key :: Key
+    , name :: Name
+  }
+  deriving (Generic)
+
+instance Data.RW Key T where
+  update f player@(T {key}) = player {key = f key}
+
+instance Data.RW Name T where
+  update f player@(T {name}) = player {name = f name}
+
+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
+
+instance ToJSON T where
+  toEncoding = genericToEncoding JSON.defaultOptions

 data Status =
    LoggedIn Bool
-  | Answering Name
-  | Waiting Name
+  | Answering Key
+  | Waiting Key
  deriving (Generic)

-data T = T {
+data Session = Session {
      connection :: Connection
-    , login :: Login
    , status :: Status
  }

-instance Data.RW Login T where
-  update f player@(T {login}) = player {login = f login}
+instance Data.RW Status Session where
+  update f session@(Session {status}) = session {status = f status}

-instance Data.RW Status T where
-  update f player@(T {status}) = player {status = f status}
+new :: Key -> Name -> T
+new key name = T {key, name}

-instance ToJSON Name where
-  toEncoding = genericToEncoding JSON.defaultOptions
-instance FromJSON Name
-
-instance ToJSON Login where
-  toJSON Anonymous = toJSON Null
-  toJSON (Login name) = toJSON name
-  toEncoding Anonymous = toEncoding Null
-  toEncoding (Login name) = toEncoding name
-
-instance FromJSON Login where
-  parseJSON Null = return Anonymous
-  parseJSON s = Login <$> parseJSON s
-
-instance ToJSON Status where
-  toEncoding = genericToEncoding JSON.singleLCField
-
-instance ToJSON T where
-  toJSON (T {login, status}) = object ["login" .= login, "status" .= status]
-  toEncoding (T {login, status}) = pairs (
-      "login" .= login <> "status" .= status
-    )
-
-new :: Connection -> T
-new connection = T {connection, login = Anonymous, status = LoggedIn False}
+openSession :: Connection -> Session
+openSession connection = Session {
+      connection
+    , status = LoggedIn False
+  }
--- a/src/Server.hs
+++ b/src/Server.hs
@ -2,71 +2,79 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DeriveGeneric #-}
 module Server (
-      SessionId
-    , T(..)
+      T(..)
    , disconnect
    , join
    , logIn
    , logOut
    , new
+    , setStatus
  ) where

-import Data.Vector (fromList)
-import Data.Aeson (ToJSON(..), Value(Array))
-import Data.Map ((!), (!?), Map, adjust, delete, elems, empty, insert, lookupMax)
+import Data.Map ((!?), Map, adjust, delete, insert, lookupMax)
+import qualified Data.Map as Map (empty)
+import Data.Aeson (ToJSON(..))
 import qualified Data (RW(..))
-import qualified Player (Login(..), Name(..), T(..))
+import qualified Player (Key(..), Name, Session(..), Status(..))

-newtype SessionId = SessionId Int deriving (Eq, Ord, Read, Show)
-type Players = Map SessionId Player.T
-type SessionIds = Map Player.Name SessionId
+type Keys = Map Player.Name Player.Key
+type Names = Map Player.Key Player.Name
+type Sessions = Map Player.Key Player.Session
 data T = T {
-      byName :: SessionIds
-    , bySessionId :: Players
+      keys :: Keys
+    , names :: Names
+    , sessions :: Sessions
  }

-instance Data.RW SessionIds T where
-  update f server@(T {byName}) = server {byName = f byName}
+instance Data.RW Keys T where
+  update f server@(T {keys}) = server {keys = f keys}

-instance Data.RW Players T where
-  update f server@(T {bySessionId}) = server {bySessionId = f bySessionId}
+instance Data.RW Names T where
+  update f server@(T {names}) = server {names = f names}

-loggedInPlayers :: T -> [Player.T]
-loggedInPlayers (T {byName, bySessionId}) =
-  [(bySessionId ! sessionId) | sessionId <- elems byName]
+instance Data.RW Sessions T where
+  update f server@(T {sessions}) = server {sessions = f sessions}

 instance ToJSON T where
-  toJSON = Array . fromList . (toJSON <$>) . loggedInPlayers
-  toEncoding = toEncoding . loggedInPlayers
+  toJSON = toJSON . names
+  toEncoding = toEncoding . names

 new :: T
 new = T {
-      byName = empty
-    , bySessionId = empty
+      keys = Map.empty
+    , names = Map.empty
+    , sessions = Map.empty
  }

-join :: Player.T -> T -> IO (T, SessionId)
-join player server@(T {bySessionId}) =
-  return (Data.update (insert sessionId player) server, sessionId)
+join :: Player.Session -> T -> IO (T, Player.Key)
+join session server@(T {sessions}) =
+  return (Data.update (insert key session) server, key)
  where
-    sessionId = SessionId $ maybe 0 (\(SessionId n, _) -> n+1) $ lookupMax bySessionId
+    key = Player.Key $ maybe 0 (\(Player.Key n, _) -> n+1) $ lookupMax sessions

-disconnect :: SessionId -> T -> Either String T
-disconnect sessionId server =
-  Data.update (delete sessionId :: Players -> Players) <$> logOut sessionId server
+disconnect :: Player.Key -> T -> T
+disconnect key =
+  Data.update (delete key :: Sessions -> Sessions) . logOut key

-logIn :: Player.Name -> SessionId -> T -> Either String T
-logIn name sessionId server =
-  Data.update (adjust (Data.set (Player.Login name) :: Player.T -> Player.T) sessionId) <$>
-  Data.update (insert name sessionId) <$>
-  maybe (Right server) (\_ -> Left "This name is already registered") maybeName
-  where
-    maybeName = byName server !? name
+logIn :: Player.Name -> Player.Key -> T -> Either String T
+logIn name key server =
+  Data.update (insert name key) .
+  Data.update (insert key name) .
+  setStatus (Player.LoggedIn True) key <$>
+  maybe (Right server) (\_-> Left "This name is already registered") (keys server !? name)

-logOut :: SessionId -> T -> Either String T
-logOut sessionId server@(T {bySessionId}) =
-  Right $ Data.update (adjust (Data.set Player.Anonymous :: Player.T -> Player.T) sessionId) $
-  (case Player.login $ bySessionId ! sessionId of
-    (Player.Login name) -> Data.update (delete name :: SessionIds -> SessionIds) server
-    Player.Anonymous -> server)
+logOut :: Player.Key -> T -> T
+logOut key server =
+  maybe
+    server
+    (\name ->
+      Data.update (delete key :: Names -> Names) $
+      setStatus (Player.LoggedIn False) key $
+      Data.update (delete name :: Keys -> Keys) server)
+    (names server !? key)
+
+setStatus :: Player.Status -> Player.Key -> T -> T
+setStatus status key =
+  Data.update (adjust (Data.set status) key :: Sessions -> Sessions)
--- a/src/Session.hs
+++ b/src/Session.hs
@ -5,8 +5,10 @@ module Session (
    , connection
    , debug
    , get
-    , player
+    , current
    , serve
+    , server
+    , try
    , update
  ) where

@ -15,50 +17,54 @@ import Control.Concurrent (MVar, newMVar, modifyMVar, putMVar, readMVar, takeMVa
 import Control.Exception (finally)
 import Control.Monad.Reader (ReaderT(..), ask, asks, lift)
 import Network.WebSockets (Connection, ServerApp, acceptRequest)
-import qualified Player (T(..), new)
-import qualified Server (SessionId, T(..), join, new)
+import qualified Player (Key, Session(..), openSession)
+import qualified Server (T(..), join, new)

 data T = T {
-      server :: MVar Server.T
-    , key :: Server.SessionId
+      mServer :: MVar Server.T
+    , key :: Player.Key
  }

 type App a = ReaderT T IO a

-get :: (Server.T -> a) -> App a
-get f =
-  asks server
-  >>= lift . (f <$>) . readMVar
+server :: App Server.T
+server = asks mServer >>= lift . readMVar

-player :: App Player.T
-player = do
-  sId <- asks key
-  get ((! sId) . Server.bySessionId)
+get :: Player.Key -> App Player.Session
+get key =
+  (! key) . Server.sessions <$> server
+
+current :: App Player.Session
+current = do
+  asks key >>= get

 connection :: App Connection
-connection = Player.connection <$> player
+connection = Player.connection <$> current

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

-update :: (Server.SessionId -> Server.T -> Either String Server.T) -> App (Maybe String)
-update f = do
-  T {server, key} <- ask
-  currentValue <- lift $ takeMVar server
-  lift $ case f key currentValue of
-    Left message -> putMVar server currentValue >> return (Just message)
-    Right updated -> putMVar server updated >> return Nothing
+try :: (Server.T -> Either String Server.T) -> App (Maybe String)
+try f = do
+  T {mServer} <- ask
+  currentValue <- lift $ takeMVar mServer
+  lift $ case f currentValue of
+    Left message -> putMVar mServer currentValue >> return (Just message)
+    Right updated -> putMVar mServer updated >> return Nothing
+
+update :: (Server.T -> Server.T) -> App ()
+update f = try (Right . f) >> return ()

 serve :: App () -> App () -> IO ServerApp
 serve onEnter onExit = do
-  server <- newMVar Server.new
+  mServer <- newMVar Server.new
  return $ \pending -> do
    key <- acceptRequest pending
-                 >>= return . Player.new
-                 >>= modifyMVar server . Server.join
+                 >>= return . Player.openSession
+                 >>= modifyMVar mServer . Server.join
    finally
-      (runReaderT onEnter $ T {server, key})
-      (runReaderT onExit $ T {server, key})
+      (runReaderT onEnter $ T {mServer, key})
+      (runReaderT onExit $ T {mServer, key})

--- a/www/connect.js
+++ b/www/connect.js
@ -1,16 +1,18 @@
 window.addEventListener('load', function() {
-	var ws = new WebSocket('ws://' + window.location.hostname + '/play/');
-	var lib = Lib(ws);
-  var room = Room(document.getElementById('players'), lib);
+  var ws = new WebSocket('ws://' + window.location.hostname + '/play/');
+  var sessionKey = null;
+  var lib = Lib(ws);
+  var room = Room(document.getElementById('room'), lib);
  var login = Login(document.getElementById('login'), lib);
  var debug = document.getElementById('debug');
  setTimeout(ping, 20000);

-	ws.addEventListener('message', function(event) {
-		var o = JSON.parse(event.data);
+  ws.addEventListener('message', function(event) {
+    var o = JSON.parse(event.data);
    switch(o.tag) {
      case "Welcome":
-        room.populate(o.room);
+        sessionKey = o.key;
+        room.populate(o.room, sessionKey);
        break;
      case "Pong":
        setTimeout(ping, 10000);
@ -19,20 +21,32 @@ window.addEventListener('load', function() {
        relayedMessage(o)
        break;
      default:
-		    debug.textContent = event.data;
+        debug.textContent = event.data;
    }
-	});
+  });

  function relayedMessage(o) {
    switch(o.message.tag) {
      case "LogIn":
-        room.enter(o.from);
-				login.onLogIn(o.from);
+        room.enter(o.from, o.message.name);
+        if(o.from == sessionKey) {
+          login.on(o.from);
+        }
        break;
      case "LogOut":
        room.leave(o.from);
-				login.onLogOut(o.from);
+        if(o.from == sessionKey) {
+          login.off(o.from);
+        }
        break;
+      case "Invitation":
+        var name = room.name(o.from);
+        var accept = false;
+        // invitations should come only from known players, in doubt say «no»
+        if(name) {
+          accept = confirm(name + " has invited you to a game");
+        }
+        lib.send({tag: "Answer", accept: accept});
    }
  }

--- a/www/index.html
+++ b/www/index.html
@ -1,15 +1,15 @@
 <!DOCTYPE HTML>
 <html>
-	<head>
-		<title>KoiKoi</title>
-		<script src="lib.js"></script>
-		<script src="login.js"></script>
-		<script src="room.js"></script>
-		<script src="connect.js"></script>
-		<link rel="stylesheet" href="skin.css" type="text/css"/>
-	</head>
-	<body>
-		<p>Hanafuda</p>
+  <head>
+    <title>KoiKoi</title>
+    <script src="lib.js"></script>
+    <script src="login.js"></script>
+    <script src="room.js"></script>
+    <script src="connect.js"></script>
+    <link rel="stylesheet" href="skin.css" type="text/css"/>
+  </head>
+  <body>
+    <p>Hanafuda</p>
    <form id="login">
      <p id="join">
        <label for="name">Name</label><input type="text" name="name"/>
@ -19,11 +19,12 @@
        <input type="button" name="leave" value="Leave"/>
      </p>
    </form>
-    <form id="room">
-      <ul id="players">
+    <form id="room" class="off">
+      <ul class="players">
      </ul>
+      <input type="number" hidden name="guest"/>
      <input type="submit" name="invite" value="Invite to a game" disabled/>
    </form>
    <p id="debug"></p>
-	</body>
+  </body>
 </html>
--- a/www/lib.js
+++ b/www/lib.js
@ -1,9 +1,9 @@
 function Lib(ws) {
-	return {
-		clearElement: clearElement,
-		insert: insert,
-		send: send
-	};
+  return {
+    clearElement: clearElement,
+    insert: insert,
+    send: send
+  };

  function clearElement(elem) {
    while(elem.firstChild) {
@ -11,15 +11,15 @@ function Lib(ws) {
    }
  }

-	function insert(obj, t, min, max) {
-		min = min || 0;
-		max = max || t.length;
-		if(max - min < 1) {
-			return min;
-		}
-		var avg = Math.floor((max + min) / 2);
-		return (obj < t[avg]) ? insert(obj, t, min, avg) : insert(obj, t, avg+1, max);
-	}
+  function insert(obj, t, min, max) {
+    min = min == undefined ? 0 : min;
+    max = max == undefined ? t.length : max;
+    if(max - min < 1) {
+      return min;
+    }
+    var avg = Math.floor((max + min) / 2);
+    return (obj < t[avg]) ? insert(obj, t, min, avg) : insert(obj, t, avg+1, max);
+  }

  function send(o) {
    ws.send(JSON.stringify(o));
--- a/www/login.js
+++ b/www/login.js
@ -1,5 +1,4 @@
 function Login(domElem, lib) {
-	var login = null;
  domElem.addEventListener('submit', function(e) {
    e.preventDefault();
    lib.send({tag: "LogIn", name: domElem.name.value})
@ -9,22 +8,16 @@ function Login(domElem, lib) {
    lib.send({tag: "LogOut"})
  });

-	return {
-		onLogIn: onLogIn,
-		onLogOut: onLogOut
-	};
+  return {
+    on: on,
+    off: off
+  };

-	function onLogIn(name) {
-    if(name == domElem.name.value) {
-      domElem.className = "on";
-			login = name;
-    }
-	}
+  function on(name) {
+    domElem.className = "on";
+  }

-	function onLogOut(name) {
-		if(name == login) {
-			login = null;
-      domElem.className = "";
-		}
-	}
+  function off() {
+    domElem.className = "";
+  }
 }
--- a/www/room.js
+++ b/www/room.js
@ -1,40 +1,109 @@
 function Room(domElem, lib) {
-	var players = {};
-	var logins = [];
+  var players = {};
+  var keys = {};
+  var logins = [];
+  var session = {
+    key: null,
+    loggedIn: false,
+    selected: null
+  };
+  var playersList = domElem.getElementsByClassName('players')[0];
+  domElem.addEventListener('submit', function(e) {
+    e.preventDefault();
+    lib.send({tag: "Invitation", to: parseInt(domElem.guest.value)})
+  });

-	return {
-		populate: populate,
-		enter: enter,
-		leave: leave
-	};
+  return {
+    populate: populate,
+    enter: enter,
+    leave: leave,
+    name: name
+  };

-	function Player(name) {
-		var player = {
-			dom: document.createElement('li'),
-			position: null
-		};
+  function Player(key, name) {
+    var player = {
+      name: name,
+      dom: document.createElement('li'),
+      position: null
+    };
    player.dom.textContent = name;
-		return player;
-	}
+    if(key != session.key) {
+      player.dom.addEventListener('click', function(e) {
+        e.preventDefault();
+        if(session.loggedIn) {
+          select(key);
+        }
+      });
+    } else {
+      on();
+      player.dom.title = "Hey ! That's you !";
+    }
+    return player;
+  }

-  function populate(playersList) {
-    lib.clearElement(domElem);
-    for(var i = 0; i < playersList.length; i++) {
-			enter(playersList[i].login || "anon");
+  function populate(playersHash, sessionKey) {
+    session.key = sessionKey;
+    lib.clearElement(playersList);
+    for(var key in playersHash) {
+      enter(key, playersHash[key] || "anon");
    }
  }

-  function enter(name) {
-		var player = Player(name);
-		players[name] = player;
-		player.position = lib.insert(name, logins);
-		beforePlayer = logins[player.position];
-		domElem.insertBefore(player.dom, beforePlayer && players[beforePlayer].dom);
-		logins.splice(player.position, 0, name);
+  function enter(key, name) {
+    var player = Player(key, name);
+    keys[key] = name;
+    players[key] = player;
+    player.position = lib.insert(name, logins);
+    beforePlayer = players[keys[logins[player.position]]];
+    playersList.insertBefore(player.dom, beforePlayer && beforePlayer.dom);
+    logins.splice(player.position, 0, name);
  }

-	function leave(name) {
-		domElem.removeChild(players[name].dom);
-		logins.splice(players[name].position, 1);
-	}
+  function leave(key) {
+    var player = players[key];
+    if(key == session.key) {
+      off();
+    }
+    if(player != undefined) {
+      playersList.removeChild(player.dom);
+      logins.splice(player.position, 1);
+      delete keys[player.name]
+      delete players[key];
+    }
+  }
+
+  function name(key) {
+    player = players[key];
+    return player && player.name;
+  }
+
+  function on() {
+    domElem.className = "";
+    session.loggedIn = true;
+  }
+
+  function off() {
+    domElem.className = "off";
+    session.loggedIn = false;
+  }
+
+  function select(key) {
+    if(key == domElem.guest.value) {
+      unselect(players[key].dom);
+    } else {
+      if(session.selected) {
+        unselect(session.selected);
+      }
+      players[key].dom.className = "selected";
+      session.selected = players[key].dom;
+      domElem.guest.value = key;
+      domElem.invite.disabled = false;
+    }
+  }
+
+  function unselect(dom) {
+    dom.className = "";
+    domElem.guest.value = "";
+    domElem.invite.disabled = true;
+  }
 }
--- a/www/skin.css
+++ b/www/skin.css
@ -10,10 +10,19 @@
  display: inline;
 }

-#players {
+#room .players {
  min-height: 4em;
  border: 1px solid #ccc;
  list-style: none;
  padding-left: 0;
  cursor: pointer;
 }
+
+#room.off .players li {
+  color: #777;
+}
+
+#room .players .selected {
+  background: #92c8f6;
+  color: #fff;
+}