You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

98 lines
2.8 KiB

open Lwt.Syntax
type dromedary_info =
{ latitude : float
; longitude : float
; dir : float
; timestamp : float
}
type room = (string, Dream.websocket) Hashtbl.t
let rooms : (string, room) Hashtbl.t = Hashtbl.create ~random:true 1
let alphabet = [| 'a'; 'a'; 'b'; 'c' |]
let room_id_len = 4
let make_room () =
let room_id =
String.init room_id_len (fun _i ->
let k = Random.int (Array.length alphabet) in
alphabet.(k) )
in
Hashtbl.add rooms room_id (Hashtbl.create 5);
room_id
let home_page_post request =
match%lwt Dream.form request with
| `Ok [] ->
let room_id = make_room () in
let url = Format.sprintf "/%s" room_id in
Dream.respond ~status:`See_Other
~headers:[ ("Location", url) ]
"a new room was made"
| invalid_form -> Util.handle_invalid_form invalid_form
let home_page_get request = Dream.html @@ Home.f request
let room request =
let room_id = Dream.param request "room_id" in
Dream.html @@ Room.f room_id request
let send room data =
Hashtbl.to_seq_values room |> List.of_seq
|> Lwt_list.iter_p (fun client -> Dream.send client data)
let forget_client room client_id = Hashtbl.remove room client_id
let handle_session request =
match Dream.session_field request "id" with
| None ->
let id = Uuidm.to_string (Uuidm.v4_gen App.random_state ()) in
let* () = Dream.invalidate_session request in
let* () = Dream.set_session_field request "id" id in
Lwt.return id
| Some id -> Lwt.return id
let handle_client request client =
let room_id = Dream.param request "room_id" in
let* id = handle_session request in
match Hashtbl.find_opt rooms room_id with
| None -> Dream.log "Error room not found" |> Lwt.return
| Some room ->
Hashtbl.add room id client;
let rec loop () =
match%lwt Dream.receive client with
| None ->
forget_client room id;
Dream.close_websocket client
| Some data -> (
let message_to_broadcast_res =
Result.bind (Msg.decode_pos data) (fun pos ->
Msg.encode_pos_with_id (id, pos) )
in
match message_to_broadcast_res with
| Error e ->
Dream.log "Error in encoding/decoding message: %s" e;
failwith e
| Ok s ->
let* () = send room s in
loop () )
in
loop ()
let () =
let logger = if App.log then Dream.logger else Fun.id in
Dream.run ~port:App.port
~error_handler:(Dream.error_template Util.error_template)
@@ logger @@ Dream.memory_sessions
@@ Dream.router
Dream.
[ get "/assets/**" (Dream.static ~loader:Util.asset_loader "")
; get "/" home_page_get
; post "/" home_page_post
; get "/:room_id" room
; get "/:room_id/ws" (fun request ->
Dream.websocket @@ handle_client request )
]