OCaml-websocket+opium

dune

(executable
 (name host_web)
 (libraries opium websocket-lwt-unix.cohttp))

host_web.ml

open Opium.Std

open Lwt.Infix
open Websocket

let src = Logs.Src.create "websocket.upgrade_connection"

let ws = all "/ws" (fun req ->
                     let body = Request.body req
                     and req = Request.request req in
                     let open Frame in
                     Logs_lwt.app ~src (fun m -> m "[PATH] /ws") >>= fun () ->
                     Cohttp_lwt.Body.drain_body body >>= fun () ->
                     Websocket_cohttp_lwt.upgrade_connection
                       req begin fun { opcode ; content ; _ } ->
                       match opcode with
                       | Opcode.Close ->
                         Logs.app ~src (fun m -> m "[RECV] CLOSE")
                       | _ ->
                         Logs.app ~src (fun m -> m "[RECV] %s" content)
                     end >>= fun (resp, frames_out_fn) ->
                     (* send a message to the client every second *)
                     let num_ref = ref 10 in
                     let rec go () =
                       if !num_ref = 0 then
                         Logs_lwt.app ~src (fun m -> m "[INFO] Test done")
                       else
                         let msg = Printf.sprintf "-> Ping %d" !num_ref in
                         Logs_lwt.app ~src (fun m -> m "[SEND] %s" msg) >>= fun () ->
                         Lwt.wrap1 frames_out_fn @@
                         Some (Frame.create ~content:msg ()) >>= fun () ->
                         decr num_ref ;
                         Lwt_unix.sleep 1. >>=
                         go
                     in
                     Lwt.async go ;
                     let resp =
                       match resp with
                       | `Expert (resp, _) ->
                         let () = print_endline "expert" in
                         Response.create ~headers:resp.headers ~code:resp.status ()
                       | `Response (resp, body) ->
                         let () = print_endline "response" in
                         Response.create ~body ~headers:resp.headers ~code:resp.status ()
                     in Lwt.return resp)

let a =
  App.empty
  |> ws
  |> App.run_command