Use session keys in the client to remove ambiguity

src/Data.hs

@@ -7,4 +7,3 @@ class RW a b where
   update :: (a -> a) -> b -> b
   set :: a -> b -> b
   set = update . const
-

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 Player (Session(..), Status(..))
-import qualified Server (logIn, logOut, disconnect)
+import qualified Server (logIn, logOut, disconnect, setStatus)
-import qualified Session (App, debug, get, player, serve, update)
+import qualified Session (App, T(..), current, debug, get, serve, server, try, update)
-import qualified Message (FromClient(..), T(..), broadcast, receive, relay, send)
+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
+      asks Session.key >>= Session.update . Server.logOut
-      >>= maybe
+      connected
-        connected
+    edges invitation@(Message.Invitation {Message.to}) = do
-        (onErrorGoto loggedIn)
+      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
+  asks Session.key >>= Session.update . Server.disconnect
-  _ <- Session.update Server.disconnect -- ignoring never-occuring error
+  Message.relay Message.LogOut Message.broadcast
-  case leaving of
-    Player.Login from -> Message.broadcast $
-      Message.Relay {Message.from, Message.message = Message.LogOut}
-    _ -> return ()
 
 main :: IO ()
 main = do

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 Control.Monad.Reader (asks, lift)
-import qualified Player (Login(..), Name, T(..))
+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}
+    Relay {from :: Player.Key, message :: FromClient}
-  | Welcome {room :: Server.T}
+  | 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 :: (Player.Key, Player.Session) -> T -> Session.App ()
-sendTo obj player = do
+sendTo (key, session) obj = do
-  Session.debug $ '(' : playerLogin ++ ") <" ++ (unpack encoded)
+  Session.debug $ '(' : show key ++ ") <" ++ (unpack encoded)
-  lift $ sendTextData (Player.connection player) $ encoded
+  lift $ sendTextData (Player.connection session) $ encoded
   where
     encoded = encode $ obj
-    playerLogin = unpack $ encode $ Player.login player
 
 send :: T -> Session.App ()
-send obj =
+send obj = do
-  (obj `sendTo`) =<< Session.player
+  key <- asks Session.key
+  session <- Session.current
+  sendTo (key, session) obj
 
 broadcast :: T -> Session.App ()
 broadcast obj =
-  Session.get Server.bySessionId
+  (toList . Server.sessions) <$> Session.server
-  >>= mapM_ (obj `sendTo`)
+  >>= 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)
+  (\from -> f $ Relay {from, message}) =<< asks Session.key
-  >> Session.debug "Relayed"
-  where
-    ifLoggedIn Player.Anonymous = return ()
-    ifLoggedIn (Player.Login from) = f $ Relay {from, message}
 
 receive :: Session.App FromClient
 receive = do

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(..)
+      Key(..)
-    , Name(..)
+    , Name
+    , Session(..)
     , Status(..)
     , T(..)
     , new
+    , openSession
   ) where
 
-import Data.Monoid ((<>))
+import Data.Text (Text, pack)
-import Data.Text (Text)
+import Data.Aeson (FromJSON(..), ToJSON(..), ToJSONKey(..), genericToEncoding)
-import Data.Aeson (FromJSON(..), ToJSON(..), (.=), Value(..), genericToEncoding, object, pairs)
+import Data.Aeson.Types (toJSONKeyText)
-import qualified JSON (defaultOptions, singleLCField)
+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
+  | Answering Key
-  | Waiting Name
+  | Waiting Key
   deriving (Generic)
 
-data T = T {
+data Session = Session {
       connection :: Connection
-    , login :: Login
     , status :: Status
   }
 
-instance Data.RW Login T where
+instance Data.RW Status Session where
-  update f player@(T {login}) = player {login = f login}
+  update f session@(Session {status}) = session {status = f status}
 
-instance Data.RW Status T where
+new :: Key -> Name -> T
-  update f player@(T {status}) = player {status = f status}
+new key name = T {key, name}
 
-instance ToJSON Name where
+openSession :: Connection -> Session
-  toEncoding = genericToEncoding JSON.defaultOptions
+openSession connection = Session {
-instance FromJSON Name
+      connection
-
+    , status = LoggedIn False
-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}

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.Map ((!?), Map, adjust, delete, insert, lookupMax)
-import Data.Aeson (ToJSON(..), Value(Array))
+import qualified Data.Map as Map (empty)
-import Data.Map ((!), (!?), Map, adjust, delete, elems, empty, insert, lookupMax)
+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 Keys = Map Player.Name Player.Key
-type Players = Map SessionId Player.T
+type Names = Map Player.Key Player.Name
-type SessionIds = Map Player.Name SessionId
+type Sessions = Map Player.Key Player.Session
 data T = T {
-      byName :: SessionIds
+      keys :: Keys
-    , bySessionId :: Players
+    , names :: Names
+    , sessions :: Sessions
   }
 
-instance Data.RW SessionIds T where
+instance Data.RW Keys T where
-  update f server@(T {byName}) = server {byName = f byName}
+  update f server@(T {keys}) = server {keys = f keys}
 
-instance Data.RW Players T where
+instance Data.RW Names T where
-  update f server@(T {bySessionId}) = server {bySessionId = f bySessionId}
+  update f server@(T {names}) = server {names = f names}
 
-loggedInPlayers :: T -> [Player.T]
+instance Data.RW Sessions T where
-loggedInPlayers (T {byName, bySessionId}) =
+  update f server@(T {sessions}) = server {sessions = f sessions}
-  [(bySessionId ! sessionId) | sessionId <- elems byName]
 
 instance ToJSON T where
-  toJSON = Array . fromList . (toJSON <$>) . loggedInPlayers
+  toJSON = toJSON . names
-  toEncoding = toEncoding . loggedInPlayers
+  toEncoding = toEncoding . names
 
 new :: T
 new = T {
-      byName = empty
+      keys = Map.empty
-    , bySessionId = empty
+    , names = Map.empty
+    , sessions = Map.empty
   }
 
-join :: Player.T -> T -> IO (T, SessionId)
+join :: Player.Session -> T -> IO (T, Player.Key)
-join player server@(T {bySessionId}) =
+join session server@(T {sessions}) =
-  return (Data.update (insert sessionId player) server, sessionId)
+  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 :: Player.Key -> T -> T
-disconnect sessionId server =
+disconnect key =
-  Data.update (delete sessionId :: Players -> Players) <$> logOut sessionId server
+  Data.update (delete key :: Sessions -> Sessions) . logOut key
 
-logIn :: Player.Name -> SessionId -> T -> Either String T
+logIn :: Player.Name -> Player.Key -> T -> Either String T
-logIn name sessionId server =
+logIn name key server =
-  Data.update (adjust (Data.set (Player.Login name) :: Player.T -> Player.T) sessionId) <$>
+  Data.update (insert name key) .
-  Data.update (insert name sessionId) <$>
+  Data.update (insert key name) .
-  maybe (Right server) (\_ -> Left "This name is already registered") maybeName
+  setStatus (Player.LoggedIn True) key <$>
-  where
+  maybe (Right server) (\_-> Left "This name is already registered") (keys server !? name)
-    maybeName = byName server !? name
 
-logOut :: SessionId -> T -> Either String T
+logOut :: Player.Key -> T -> T
-logOut sessionId server@(T {bySessionId}) =
+logOut key server =
-  Right $ Data.update (adjust (Data.set Player.Anonymous :: Player.T -> Player.T) sessionId) $
+  maybe
-  (case Player.login $ bySessionId ! sessionId of
+    server
-    (Player.Login name) -> Data.update (delete name :: SessionIds -> SessionIds) server
+    (\name ->
-    Player.Anonymous -> server)
+      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)

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 Player (Key, Session(..), openSession)
-import qualified Server (SessionId, T(..), join, new)
+import qualified Server (T(..), join, new)
 
 data T = T {
-      server :: MVar Server.T
+      mServer :: MVar Server.T
-    , key :: Server.SessionId
+    , key :: Player.Key
   }
 
 type App a = ReaderT T IO a
 
-get :: (Server.T -> a) -> App a
+server :: App Server.T
-get f =
+server = asks mServer >>= lift . readMVar
-  asks server
-  >>= lift . (f <$>) . readMVar
 
-player :: App Player.T
+get :: Player.Key -> App Player.Session
-player = do
+get key =
-  sId <- asks key
+  (! key) . Server.sessions <$> server
-  get ((! sId) . Server.bySessionId)
+
+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)
+try :: (Server.T -> Either String Server.T) -> App (Maybe String)
-update f = do
+try f = do
-  T {server, key} <- ask
+  T {mServer} <- ask
-  currentValue <- lift $ takeMVar server
+  currentValue <- lift $ takeMVar mServer
-  lift $ case f key currentValue of
+  lift $ case f currentValue of
-    Left message -> putMVar server currentValue >> return (Just message)
+    Left message -> putMVar mServer currentValue >> return (Just message)
-    Right updated -> putMVar server updated >> return Nothing
+    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
+                 >>= return . Player.openSession
-                 >>= modifyMVar server . Server.join
+                 >>= modifyMVar mServer . Server.join
     finally
-      (runReaderT onEnter $ T {server, key})
+      (runReaderT onEnter $ T {mServer, key})
-      (runReaderT onExit $ T {server, key})
+      (runReaderT onExit $ T {mServer, key})
 

www/connect.js

@@ -1,16 +1,18 @@
 window.addEventListener('load', function() {
-	var ws = new WebSocket('ws://' + window.location.hostname + '/play/');
+  var ws = new WebSocket('ws://' + window.location.hostname + '/play/');
-	var lib = Lib(ws);
+  var sessionKey = null;
-  var room = Room(document.getElementById('players'), lib);
+  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) {
+  ws.addEventListener('message', function(event) {
-		var o = JSON.parse(event.data);
+    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);
+        room.enter(o.from, o.message.name);
-				login.onLogIn(o.from);
+        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});
     }
   }
 

www/index.html

@@ -1,15 +1,15 @@
 <!DOCTYPE HTML>
 <html>
-	<head>
+  <head>
-		<title>KoiKoi</title>
+    <title>KoiKoi</title>
-		<script src="lib.js"></script>
+    <script src="lib.js"></script>
-		<script src="login.js"></script>
+    <script src="login.js"></script>
-		<script src="room.js"></script>
+    <script src="room.js"></script>
-		<script src="connect.js"></script>
+    <script src="connect.js"></script>
-		<link rel="stylesheet" href="skin.css" type="text/css"/>
+    <link rel="stylesheet" href="skin.css" type="text/css"/>
-	</head>
+  </head>
-	<body>
+  <body>
-		<p>Hanafuda</p>
+    <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">
+    <form id="room" class="off">
-      <ul id="players">
+      <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>

www/lib.js

@@ -1,9 +1,9 @@
 function Lib(ws) {
-	return {
+  return {
-		clearElement: clearElement,
+    clearElement: clearElement,
-		insert: insert,
+    insert: insert,
-		send: send
+    send: send
-	};
+  };
 
   function clearElement(elem) {
     while(elem.firstChild) {
@@ -11,15 +11,15 @@ function Lib(ws) {
     }
   }
 
-	function insert(obj, t, min, max) {
+  function insert(obj, t, min, max) {
-		min = min || 0;
+    min = min == undefined ? 0 : min;
-		max = max || t.length;
+    max = max == undefined ? t.length : max;
-		if(max - min < 1) {
+    if(max - min < 1) {
-			return min;
+      return min;
-		}
+    }
-		var avg = Math.floor((max + min) / 2);
+    var avg = Math.floor((max + min) / 2);
-		return (obj < t[avg]) ? insert(obj, t, min, avg) : insert(obj, t, avg+1, max);
+    return (obj < t[avg]) ? insert(obj, t, min, avg) : insert(obj, t, avg+1, max);
-	}
+  }
 
   function send(o) {
     ws.send(JSON.stringify(o));

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 {
+  return {
-		onLogIn: onLogIn,
+    on: on,
-		onLogOut: onLogOut
+    off: off
-	};
+  };
 
-	function onLogIn(name) {
+  function on(name) {
-    if(name == domElem.name.value) {
+    domElem.className = "on";
-      domElem.className = "on";
+  }
-			login = name;
-    }
-	}
 
-	function onLogOut(name) {
+  function off() {
-		if(name == login) {
+    domElem.className = "";
-			login = null;
+  }
-      domElem.className = "";
-		}
-	}
 }

www/room.js

@@ -1,40 +1,109 @@
 function Room(domElem, lib) {
-	var players = {};
+  var players = {};
-	var logins = [];
+  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 {
+  return {
-		populate: populate,
+    populate: populate,
-		enter: enter,
+    enter: enter,
-		leave: leave
+    leave: leave,
-	};
+    name: name
+  };
 
-	function Player(name) {
+  function Player(key, name) {
-		var player = {
+    var player = {
-			dom: document.createElement('li'),
+      name: name,
-			position: null
+      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) {
+  function populate(playersHash, sessionKey) {
-    lib.clearElement(domElem);
+    session.key = sessionKey;
-    for(var i = 0; i < playersList.length; i++) {
+    lib.clearElement(playersList);
-			enter(playersList[i].login || "anon");
+    for(var key in playersHash) {
+      enter(key, playersHash[key] || "anon");
     }
   }
 
-  function enter(name) {
+  function enter(key, name) {
-		var player = Player(name);
+    var player = Player(key, name);
-		players[name] = player;
+    keys[key] = name;
-		player.position = lib.insert(name, logins);
+    players[key] = player;
-		beforePlayer = logins[player.position];
+    player.position = lib.insert(name, logins);
-		domElem.insertBefore(player.dom, beforePlayer && players[beforePlayer].dom);
+    beforePlayer = players[keys[logins[player.position]]];
-		logins.splice(player.position, 0, name);
+    playersList.insertBefore(player.dom, beforePlayer && beforePlayer.dom);
+    logins.splice(player.position, 0, name);
   }
 
-	function leave(name) {
+  function leave(key) {
-		domElem.removeChild(players[name].dom);
+    var player = players[key];
-		logins.splice(players[name].position, 1);
+    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;
+  }
 }

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;
+}