channel_communication.eliom

(* Example website login: localhost:8080/?user_num=1 *)

{shared{
  open Eliom_lib
  open Eliom_content
  open Html5
  open Html5.F
  open Eliom_registration
  open Eliom_parameter
}}

module Channel_example_app =
  Eliom_registration.App (
    struct
      let application_name = "channel_example"
    end)

let main_service =
  Eliom_service.App.service ~path:[] ~get_params:(string "user_num") ()

let new_message_action =
  Eliom_service.Http.post_coservice'
    ~post_params:(string "from_user_id" ** string "to_user_id" ** string "msg") ()

(* Set the scope used by all erefs *)
let eref_scope = Eliom_common.default_process_scope

(* Create a channel eref *)
let channel_ref =
  Eliom_reference.Volatile.eref_from_fun
    ~scope:eref_scope
    (fun () ->
      let (s, notify) = Lwt_stream.create () in
      let c = Eliom_comet.Channel.create s in
      (c, notify)
    )

(* Reactive string eref *)
let react_string_ref =
  Eliom_reference.Volatile.eref_from_fun
    ~scope:eref_scope
    (fun () ->
      let (client_string, send_client_string) :
          (string React.E.t * (?step:React.step -> string -> unit) ) =
        React.E.create ()
      in
      (client_string, send_client_string)
    )

(* Reactive string to display the users session group *)
let react_session_group_ref =
  Eliom_reference.Volatile.eref_from_fun
    ~scope:eref_scope
    (fun () ->
      let (session_group_string, send_session_group_string) :
          (string React.E.t * (?step:React.step -> string -> unit) ) =
        React.E.create ()
      in
      (session_group_string, send_session_group_string)
    )

(* Reactive string to display the users session group size *)
let react_session_group_size_ref =
  Eliom_reference.Volatile.eref_from_fun
    ~scope:eref_scope
    (fun () ->
      let (session_group_size_string, send_session_group_size_string) :
          (string React.E.t * (?step:React.step -> string -> unit) ) =
        React.E.create ()
      in
      (session_group_size_string, send_session_group_size_string)
    )

(* Send a message from one client to another *)
let notify from_user_id to_user_id s =
  (* Get the session group state for the user *)
  let group_state =
    Eliom_state.Ext.volatile_data_group_state ~scope:Eliom_common.default_group_scope to_user_id in
    (* Iterate on all sessions from the group *)
    Eliom_state.Ext.iter_volatile_sub_states ~state:group_state
    (fun sub_state ->
      (* Iterate on all client process states in the session *)
      Eliom_state.Ext.iter_volatile_sub_states ~state:sub_state
      (fun sub_sub_state ->
        let (_, notify) = Eliom_reference.Volatile.Ext.get sub_sub_state channel_ref in
        notify (Some ("Hello from " ^ from_user_id ^ "! You are user " ^ to_user_id ^ "\n\n" ^ s))
      )
    )

(* Action for a client to send a message *)
let () =
  Eliom_registration.Action.register
    ~options:`NoReload
    ~service:new_message_action
    (fun () (from_user_id, (to_user_id, msg)) ->
      Lwt.return @@ notify from_user_id to_user_id msg
    )

(* Post form for one user to send a message to another user *)
let client_message_form =
  Eliom_content.Html5.F.post_form ~service:new_message_action ~port:8080
  (
    fun (from_user_id, (to_user_id, msg)) ->
      [p [pcdata "To:"];
       string_input ~input_type:`Text ~name:to_user_id ();
       p [pcdata "From:"];
       string_input ~input_type:`Text ~name:from_user_id ();
       p [pcdata "Send a message here:"];
       string_input ~input_type:`Text ~name:msg ();
       button ~button_type:`Submit [pcdata "Send Message"]
      ]
  )

let () =
  Channel_example_app.register
    ~service:main_service
    (fun user_num () ->
      (* Set the session group to which the erefs belong *)
      Eliom_state.set_volatile_data_session_group
        ~set_max:1
        ~scope:Eliom_common.default_session_scope
        ~secure:true
        user_num;
      let (channel, _) = Eliom_reference.Volatile.get channel_ref in
      let my_client_string, my_send_client_string = Eliom_reference.Volatile.get react_string_ref in
      let my_send_client_string' =
        server_function Json.t<string> (fun s -> Lwt.return @@ my_send_client_string s)
      in
      let c_down = Eliom_react.Down.of_react my_client_string in
      (* When a message is received on the channel, push it as a reactive event *)
      let _ =
        {unit{
          Lwt.async
            (fun () ->
              Lwt_stream.iter (fun (s : string) -> ignore @@ %my_send_client_string' s) %channel
            )
        }}
      in
      let my_session_group =
        match
          Eliom_state.get_volatile_data_session_group
            ~scope:Eliom_common.default_session_scope
            ~secure:true ()
        with
        | None -> "No session group"
        | Some sg -> sg
      in
      let my_session_group_size =
        match
          Eliom_state.get_volatile_data_session_group_size
            ~scope:Eliom_common.default_session_scope
            ~secure:true ()
        with
        | None -> "0"
        | Some gs -> string_of_int gs
      in
      Lwt.return
        (Eliom_tools.F.html
           ~title:"channel_example"
           ~css:[["css";"channel_example.css"]]
           Eliom_content.Html5.F.(body [
             h2 [pcdata ("Your are logged in as user " ^ user_num)];
             client_message_form ();
             p [pcdata "Your message is:"];
             C.node {{R.pcdata (React.S.hold "No message yet" %c_down)}};
             p [pcdata ("I am a part of the session group named " ^ my_session_group)];
             p [pcdata ("My session group size is " ^ my_session_group_size)]
           ])))