Ocaml Lwl_mvar.take does not block thread

Question

I'm still going on writing a simple game server. Due to a piece of advice from here I implemented mvar support in hope it will block threads while does not contain at least 2 players. But it doesn't wait untill I put any data there. It's always return sleeping Lwt.t. First of all, here we accept connections and offer the player to enter START to begin looking for partners:

let waiting_players = 
    Lwt_mvar.create_empty();;

let rec make_ready player = 
    player >>= fun cli ->
        send_to_client player "Type in START";
        let answer = read_from_client player in 
            answer >>= fun str ->
            match str with
                |"START" -> 
                    let ready_client =  cli in  
                    send_to_client player "Waiting for opponent";
                    Lwt_mvar.put waiting_players ready_client;
                | _ -> 
                    send_to_client player "Unknown command. try again";
                    make_ready player

let handle_income () =
    let in_conection = Lwt_unix.accept sock in 
    in_conection >>= fun (cli, addr) ->
    let player = Lwt.return cli in
    send_to_client player "Welcome to the server. To start game type in START and press Enter";
    make_ready player;;

    val make_ready : Lwt_unix.file_descr Lwt.t -> unit Lwt.t = <fun>
    val handle_income : unit -> unit Lwt.t = <fun>

Seems to be alright but when I call Lwt_mvar.take waiting_players it always returns some values even nothing had been put there before and thread is not blocked. Such a strange (for me) behaviour is better seen at example:

# let bucket = Lwt_mvar.create_empty ();;
val bucket : '_a Lwt_mvar.t = <abstr>

# let apple = Lwt_mvar.take bucket;;
val apple : '_a Lwt.t = <abstr>

# Lwt.state apple;;
- : '_a Lwt.state = Sleep

If "blocking" means returning exactly such sleeping objects, please, tell. And how to make a loop, returning only "ready" objects the best way? Is that a good idea to use Lwt.is_sleeping? Thanks a lot.

Answer 1

There're few issues with your approach and some bugs in your code. So, I will first highlight the latter, and then propose and justify another approach.

Issues

Issue 1

Looks like that your send_to_client returns a value of type unit Lwt.t. If you just ignore it by terminating your expression with ;, then it means, "don't wait until the message is send and move forward". Usually this is not what you want. So, you need to wait until the unit Lwt.t thread is finished, by binding to its return value.

Issue 2

Usually in Lwt programming, functions accepts values of immediate types (i.e., one that are not wrapped into Lwt.t) and returns deferred threads (i.e., values of type 'some Lwt.t). This is usually, of course, nobody prevents you for doing something different. But try to stick with "immediate inputs, delayed output" pattern.

Issue 3

Use tools. Use ocp-indent to indent your code, it will help in readability. Also, it looks like, that you do not use compiler and are playing in a toplevel. Usually it is a bad idea, especially with system programming. Use ocamlbuild to compile and run your code with:

ocamlbuild game.native --

The Game

Programming in OCaml have different philosophy in comparison with programming in Python or other languages with weak type system. In OCaml one should start from designing types and signatures, and later fill in implementations. Of course, this is idealization, and in real life it will a process of iterative refining, but the general approach is still the same. Start with types.

So, at first, let's define a player type. It's trivial, but has a room for improvement.

open Lwt

type player = {
  fd : Lwt_unix.file_descr
}

Next, let's use type system to help us, to understand our problem of game initialization. You need to get two players ready and willing to play your game. That means, that you have three consecutive states:

• Nobody is ready
• One player is ready
• Both (player1, player2) are ready

Actually, since as soon as you reach the third state you're ready for the game, you don't need that state, so we end up with only two choices:

type stage =
  | Nobody
  | One of player

We can use player option type here as it is isomorphic to our choice. But let's be more explicit and use our own stage type. It will keep our model more constrained and fit.

The next step would be to define protocol of interaction between client and server. We will use name request for a message from server to client, and response for messages moving in opposite direction.

type request =
  | Init
  | Wait
  | Unknown_command
  | Bye 

type response =
  | Start
  | Quit

This protocol is abstract, in the sense that it doesn't contain any concrete representation – based on it you can build different representations, e.g., gui interface, or textual chats supporting different languages.

But let's mock up a simplest concrete implementation, that uses textual commands:

let response_of_string msg =
  match String.trim (String.uppercase msg) with
  | "START" -> Some Start
  | "QUIT" -> Some Quit
  | _ -> None

And in the opposite direction (note: it is better to render this messages on client side, and send values of types request and response on wire, it will keep your traffic profile low, and, more important, will allow to attach different clients transparently).

let string_of_request = function
  | Init -> "Welcome to a game server.
    Please, type 
    - `start' to start game;
    - `quit' to finish session"
  | Wait -> "Please wait for another player to join the game"
  | Unknown_command -> "Don't understand this"
  | Bye -> "Thank you, see you later!"

The next step is to define the interface for the Io. This module is responsible for interacting between client and server. Note how we hide with abstraction all details, like using sockets, or strings.

module Io : sig
  val send : player -> request -> unit Lwt.t
  val recv : player -> response option Lwt.t 
end = struct
  let send dst msg = return_unit
  let recv dst = return None
end 

Now, we can define our Game module. At first it will have two different automata:

• init to initialize a game between two players;
• play to play the game once, we get two victims.

Let's say this explicitly in OCaml:

module Game : sig

  (** [play a b] play a game between player [a] and player [b] *) 
  val play : player -> player -> unit Lwt.t

  (** [init next_player] waits until two players are ready to play.
      TODO: Describe a grammar that is recognized by this automaton. *)
  val init : (unit -> player Lwt.t) -> (player * player) Lwt.t
end = struct
  let play a b = return_unit

  let init next_player =
    let rec process stage player = 
      Io.send player Init >>= fun () -> 
      Io.recv player >>= function
      | None ->
        Io.send player Unknown_command >>= fun () ->
        process stage player
      | Some Quit ->
        Io.send player Bye >>= fun () -> 
        next_player () >>= process stage
      | Some Start -> match stage with
        | One a -> return (a,player)
        | Nobody -> 
          Io.send player Wait >>= fun () ->
          next_player () >>= process (One player) in
    next_player () >>= process Nobody
end

Now we can write out main function, that glues everything together:

let main server_sock = 
  let next_player () =
    Lwt_unix.accept server_sock >>=
    fun (fd,_) -> return {fd} in
  Game.init next_player >>= fun (a,b) -> 
  Game.play a b

When you will continue with this approach, you may later notice, that different finite state machines of your game defines different languages (i.e., protocols). So instead of having one protocol, you may end up in using a specific protocol for each FSM, e.g., init_protocol, play_protocol, etc. But you may also notice, that this protocols has some intersections. To handle this, you can use subtyping, and polymorphic variants.

Answer 2

Found a way.

let rec form_pairs () = 
let player1 = Lwt_mvar.take waiting_players in 
    player1 >>= fun descriptor1 ->
let player2 = Lwt_mvar.take waiting_players in 
    player2 >>= fun descriptor2->
Lwt_io.printl "Pairs formed";
Lwt.return (descriptor1, descriptor2);
form_pairs ();;