tcp-server.ml

open Lwt

let listen_addr = Unix.inet_addr_loopback
let port = 5432

(* Shared mutable counter *)
let counter = ref 0

let max_pending_req = 10

let handle_message msg =
  match msg with
  | "read" -> Printf.sprintf "%s\n" (string_of_int !counter)
  | "inc" -> counter := !counter + 1; "Counter is incremented!\n"
  | _ -> "Unknown command\n"

let rec handle_conn ic oc () =
  Lwt_io.read_line_opt ic >>=
    (fun msg ->
      match msg with
      | Some msg ->
         let reply = handle_message msg in
         Lwt_io.write oc reply >>= handle_conn ic oc
      | None -> Logs_lwt.info (fun m -> m "Connection closed\n") >>= return)

let accept_conn conn =
  let fd, _ = conn in
  let ic = Lwt_io.of_fd ~mode:Lwt_io.Input fd in
  let oc = Lwt_io.of_fd ~mode:Lwt_io.Output fd in
  Lwt.on_failure (handle_conn ic oc ()) (fun e -> Logs.err (fun m -> m "%s\n" (Printexc.to_string e)));
  Logs_lwt.info (fun m -> m "New connection\n") >>= return

let create_server sock =
  let rec serve () =
    Lwt_unix.accept sock >>= accept_conn >>= serve
  in serve

let create_socket () =
  let sock = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_STREAM 0 in
  Lwt_unix.bind sock @@ Lwt_unix.ADDR_INET (listen_addr, port) >>= fun () ->
  Lwt_unix.listen sock max_pending_req;
  return sock

let () =
  Lwt_main.run ((create_socket ()) >>= fun sock ->
  let serve = create_server sock in serve ())