Refactor

lib/api/game/advertisement.ml

@@ -2,9 +2,10 @@ open Lwt.Syntax
 open Data.Sort
 
 let find_observable ?(start = 1) ?(count = 100) ?(sort = Descending) ?(profile_ids = []) game domain send =
+  let open Models.Stub.Game.Observable_advertisement_member in
   let should_descend = match sort with Ascending -> 0 | Descending -> 1 in
   let base_url = Uri.make ~scheme:"https" ~host:domain ~path:"/game/advertisement/findObservableAdvertisements" () in
-  let url =
+  let url profile_ids =
     Uri.with_query'
       base_url
       [ "title", Data.Game.to_str game
@@ -23,13 +24,24 @@ let find_observable ?(start = 1) ?(count = 100) ?(sort = Descending) ?(profile_i
       ; "profileids", Data.Query.encode_lst_i profile_ids
       ]
   in
-  let* json = send url in
-  match json with
-  | Some j ->
-    Lwt.return
-    @@ Data.Json.try_parse_as
-         (module Models.Response.Game.Observable_advertisements : Data.Json.JsonParsable
-           with type t = Models.Response.Game.Observable_advertisements.t)
-         j
-  | None -> Lwt.return None
+  let fetch_and_parse url =
+    let* json = send url in
+    match json with
+    | Some j ->
+      Lwt.return
+      @@ Data.Json.try_parse_as
+           (module Models.Response.Game.Observable_advertisements : Data.Json.JsonParsable
+             with type t = Models.Response.Game.Observable_advertisements.t)
+           j
+    | None -> Lwt.return None
+  in
+  let handle_empty_profile_ids () =
+    let* initial_response = fetch_and_parse (url []) in
+    match initial_response with
+    | Some data ->
+      let ids = List.map (fun member -> member.profile_id) data.members in
+      fetch_and_parse (url ids)
+    | None -> Lwt.return None
+  in
+  if profile_ids = [] then handle_empty_profile_ids () else fetch_and_parse (url profile_ids)
 ;;

lib/client.ml

@@ -6,65 +6,91 @@ type t =
   ; cookie : Data.Platform.Cookie.t option
   }
 
+(** A global request counter is required for the API *)
+let request_count = ref 0
+
+(** Always use this to access the request count to ensure it increments *)
+let count_request () =
+  request_count := !request_count + 1;
+  !request_count
+;;
+
+let create_client_with_steam_credentials (domain : string) (game : Data.Game.t) (login : Data.Platform.Steam_login.t)
+  =
+  let* cookie = Data.Platform.Cookie.create login domain in
+  let* _ =
+    match cookie with
+    | Some c ->
+      Logger.Async.info
+        ~m:"Client"
+        ~f:"create_client_with_steam_credentials"
+        "Created new cookie '%s' from steam credentials"
+        (Data.Platform.Cookie.to_cookie_string c)
+    | None ->
+      Logger.Async.error
+        ~m:"Client"
+        ~f:"create_client_with_steam_credentials"
+        "Unable to create cookie from steam credentials"
+  in
+  Lwt.return { domain; game; cookie }
+;;
+
 let create ?(login = None) ?(cookie = None) domain game =
   match cookie with
-  | Some c ->
-    let* _ = Lwt_io.printl "Creating client using existing cookie" in
-    Lwt.return { domain; game; cookie = Some c }
+  | Some _ ->
+    let* _ = Logger.Async.info ~m:"Client" ~f:"create" "Creating client with existing cookie" in
+    Lwt.return { domain; game; cookie }
   | None ->
     (match login with
      | Some l ->
-       let* _ = Lwt_io.printl "Creating client using steam credentials" in
-       let* cookie = Data.Platform.Cookie.create l domain in
-       let* _ =
-         match cookie with
-         | Some c ->
-           Lwt_io.printl
-           @@ Printf.sprintf "Cookie created successfully '%s'" (Data.Platform.Cookie.to_cookie_string c)
-         | None -> Lwt_io.printl "Unable to create cookie"
-       in
-       Lwt.return { domain; game; cookie }
-     | None -> Lwt.return { domain; game; cookie = None })
+       let* _ = Logger.Async.info ~m:"Client" ~f:"create" "Creating client with steam credentials" in
+       create_client_with_steam_credentials domain game l
+     | None ->
+       let* _ = Logger.Async.info ~m:"Client" ~f:"create" "Created unauthenticated client" in
+       Lwt.return { domain; game; cookie = None })
 ;;
 
-let get_json ?(cookie = None) (url : Uri.t) =
-  let open Data.Platform.Cookie in
-  let url_with_params =
-    match cookie with
-    | None -> url
-    | Some c -> Uri.add_query_params' url [ "sessionID", c.session_id; "connect_id", c.session_id ]
-  in
-  let headers =
-    match cookie with
-    | None -> Cohttp.Header.init ()
-    | Some c -> Cohttp.Header.add (Cohttp.Header.init ()) "Cookie" (Data.Platform.Cookie.to_cookie_string c)
+let add_cookie_query_to_url (cookie : Data.Platform.Cookie.t option) (url : Uri.t) =
+  match cookie with
+  | None -> url
+  | Some c -> Uri.add_query_params' url [ "sessionID", c.session_id; "connect_id", c.session_id ]
+;;
+
+let add_call_num_to_url (url : Uri.t) = Uri.add_query_params' url [ "callNum", string_of_int @@ count_request () ]
+
+let create_headers_from_cookie (cookie : Data.Platform.Cookie.t option) =
+  match cookie with
+  | None -> Cohttp.Header.init ()
+  | Some c -> Cohttp.Header.add (Cohttp.Header.init ()) "Cookie" (Data.Platform.Cookie.to_cookie_string c)
+;;
+
+let report_http_error (status : Cohttp.Code.status_code) (url : Uri.t) (body : string) =
+  let* _ =
+    Logger.Async.error
+      ~m:"Client"
+      ~f:"report_http_error"
+      "HTTP Error: %s for URL: %s. Response: %s"
+      (Cohttp.Code.string_of_status status)
+      (Uri.to_string url)
+      body
   in
-  let* resp, body = Cohttp_lwt_unix.Client.get ~headers url_with_params in
+  Lwt.return_none
+;;
+
+let report_json_body (body_str : string) =
+  let json = Yojson.Basic.from_string body_str in
+  Lwt.return_some json
+;;
+
+let get_json ?(cookie = None) (url : Uri.t) =
+  let url = add_call_num_to_url @@ add_cookie_query_to_url cookie url in
+  let headers = create_headers_from_cookie cookie in
+  let* resp, body = Cohttp_lwt_unix.Client.get ~headers url in
   let status = Cohttp.Response.status resp in
+  let status_i = Cohttp.Code.code_of_status status in
+  let* _ = Logger.Async.debug ~m:"Client" ~f:"get_json" "GET json from %s result: %d" (Uri.to_string url) status_i in
   let* body_str = Cohttp_lwt.Body.to_string body in
-  let curl_command =
-    Printf.sprintf
-      "curl -i -H 'Cookie: %s' '%s'"
-      (match cookie with Some c -> Data.Platform.Cookie.to_cookie_string c | None -> "")
-      (Uri.to_string url_with_params)
-  in
-  let* _ = Lwt_io.printl curl_command in
-  if Cohttp.Code.code_of_status status = 200
-  then (
-    let json = Yojson.Basic.from_string body_str in
-    Lwt.return (Some json))
-  else (
-    (* TODO: Find out what to do with this later. What's the return type? Do we have Result<a,b>? *)
-    let url_str = Uri.to_string url_with_params in
-    let* _ =
-      Lwt_io.printl
-      @@ Printf.sprintf
-           "HTTP Error: %s for URL: %s\nResponse: %s"
-           (Cohttp.Code.string_of_status status)
-           url_str
-           body_str
-    in
-    Lwt.return None)
+  if status_i = 200 then report_json_body body_str else report_http_error status url body_str
 ;;
 
 let get ?requester endpoint client =

lib/data/json.ml

@@ -7,7 +7,7 @@ end
 let try_parse_as (type a) (module M : JsonParsable with type t = a) (j : Yojson.Basic.t) : a option =
   try Some (M.from_json j) with
   | Yojson.Basic.Util.Type_error (msg, _) ->
-    Logs.err (fun m -> m "JSON parsing error: %s" msg);
+    Printf.printf "Json parsing error %s" msg;
     None
   | ex ->
     Logs.err (fun m -> m "Unexpected error: %s" (Printexc.to_string ex));

lib/logger/async.ml

@@ -0,0 +1,12 @@
+let log ?m ?f level fmt =
+  let ksprintf_logger str =
+    let formatted_msg = Base.format_message ?m ?f level str in
+    Lwt_io.printf "%s" formatted_msg
+  in
+  Printf.ksprintf ksprintf_logger fmt
+;;
+
+let debug ?m ?f fmt = log ?m ?f Level.DEBUG fmt
+let info ?m ?f fmt = log ?m ?f Level.INFO fmt
+let warn ?m ?f fmt = log ?m ?f Level.WARN fmt
+let error ?m ?f fmt = log ?m ?f Level.ERROR fmt

lib/logger/base.ml

@@ -0,0 +1,27 @@
+let get_timestamp () =
+  let open Unix in
+  let tm = localtime (time ()) in
+  Printf.sprintf
+    "%04d-%02d-%02d %02d:%02d:%02d"
+    (tm.tm_year + 1900)
+    (tm.tm_mon + 1)
+    tm.tm_mday
+    tm.tm_hour
+    tm.tm_min
+    tm.tm_sec
+;;
+
+let format_message ?(m = "") ?(f = "") level msg =
+  let time_str = get_timestamp () in
+  let level_str = Level.to_string level in
+  let color = Level.to_color level in
+  let reset = Level.reset_color in
+  let location_str =
+    match m, f with
+    | "", "" -> ""
+    | "", f -> Printf.sprintf "[%s]" f
+    | m, "" -> Printf.sprintf "[%s]" m
+    | m, f -> Printf.sprintf "[%s::%s]" m f
+  in
+  Printf.sprintf "[%s] [%s%s%s] %s %s\n%!" time_str color level_str reset location_str msg
+;;

lib/logger/level.ml

@@ -0,0 +1,16 @@
+type t =
+  | DEBUG
+  | INFO
+  | WARN
+  | ERROR
+
+let to_string = function DEBUG -> "DBG" | INFO -> "INF" | WARN -> "WAR" | ERROR -> "ERR"
+
+let to_color = function
+  | DEBUG -> "\x1b[36m" (* Cyan *)
+  | INFO -> "\x1b[32m" (* Green *)
+  | WARN -> "\x1b[33m" (* Yellow *)
+  | ERROR -> "\x1b[31m" (* Red *)
+;;
+
+let reset_color = "\x1b[0m"

lib/logger/sync.ml

@@ -0,0 +1,12 @@
+let log ?m ?f level fmt =
+  let kprintf_logger str =
+    let formatted_msg = Base.format_message ?m ?f level str in
+    Printf.printf "%s" formatted_msg
+  in
+  Printf.ksprintf kprintf_logger fmt
+;;
+
+let debug ?m ?f fmt = log ?m ?f Level.DEBUG fmt
+let info ?m ?f fmt = log ?m ?f Level.INFO fmt
+let warn ?m ?f fmt = log ?m ?f Level.WARN fmt
+let error ?m ?f fmt = log ?m ?f Level.ERROR fmt

lib/models/stub/game/observable_advertisement_member.ml

@@ -1,36 +1,38 @@
 type t =
   { int1 : int
-  ; int2 : int
+  ; profile_id : int
   ; platform_id : string
   ; icon : string
   ; name : string
   ; string1 : string
+  ; int2 : int
   ; int3 : int
   ; int4 : int
   ; int5 : int
-  ; int6 : int
   ; int_null : int option
   ; string2 : string
-  ; int7 : int
+  ; int6 : int
   ; list1 : Yojson.Basic.t list
   }
 
 let from_json json =
   match json with
-  | `List [ int1; int2; platform_id; icon; name; string1; int3; int4; int5; int6; int_null; string2; int7; list1 ] ->
+  | `List
+      [ int1; profile_id; platform_id; icon; name; string1; int2; int3; int4; int5; int_null; string2; int6; list1 ]
+    ->
     { int1 = Yojson.Basic.Util.to_int int1
-    ; int2 = Yojson.Basic.Util.to_int int2
+    ; profile_id = Yojson.Basic.Util.to_int profile_id
     ; platform_id = Yojson.Basic.Util.to_string platform_id
     ; icon = Yojson.Basic.Util.to_string icon
     ; name = Yojson.Basic.Util.to_string name
     ; string1 = Yojson.Basic.Util.to_string string1
+    ; int2 = Yojson.Basic.Util.to_int int2
     ; int3 = Yojson.Basic.Util.to_int int3
     ; int4 = Yojson.Basic.Util.to_int int4
     ; int5 = Yojson.Basic.Util.to_int int5
-    ; int6 = Yojson.Basic.Util.to_int int6
     ; int_null = Yojson.Basic.Util.to_int_option int_null
     ; string2 = Yojson.Basic.Util.to_string string2
-    ; int7 = Yojson.Basic.Util.to_int int7
+    ; int6 = Yojson.Basic.Util.to_int int6
     ; list1 = Yojson.Basic.Util.to_list list1
     }
   | _ -> failwith "Unexpected observable advertisement member format"
@@ -39,18 +41,18 @@ let from_json json =
 let to_json n =
   `List
     [ `Int n.int1
-    ; `Int n.int2
+    ; `Int n.profile_id
     ; `String n.platform_id
     ; `String n.icon
     ; `String n.name
     ; `String n.string1
+    ; `Int n.int2
     ; `Int n.int3
     ; `Int n.int4
     ; `Int n.int5
-    ; `Int n.int6
     ; (match n.int_null with Some i -> `Int i | None -> `Null)
     ; `String n.string2
-    ; `Int n.int7
+    ; `Int n.int6
     ; `List n.list1
     ]
 ;;

shell.nix

@@ -13,6 +13,7 @@ pkgs.mkShell{
     openssl
     ocamlPackages.ocamlformat
     ocamlPackages.ocaml-lsp
+    nodePackages.vscode-json-languageserver
     pkg-config
     wireshark
     zlib

tests/integration/test_case/game/advertisements.ml

@@ -4,18 +4,10 @@ open Lwt.Syntax
 
 let test_get_observable_advertisements test_state _ () =
   let open Data.Sort in
-  let endpoint_asc = Api.Game.Advertisement.find_observable ~sort:Ascending ~count:2 in
-  let endpoint_dsc = Api.Game.Advertisement.find_observable ~sort:Descending ~count:2 in
-  let* lobbies_asc = Client.get endpoint_asc test_state.client in
-  let* lobbies_dsc = Client.get endpoint_dsc test_state.client in
-  match lobbies_asc, lobbies_dsc with
-  | Some a, Some d ->
-    let* _ = Lwt_io.printf "Yepge %d\n" (List.length a.advertisements) in
-    let id_asc = (List.hd a.advertisements).match_id in
-    let id_dsc = (List.hd d.advertisements).match_id in
-    Alcotest.(check int) "Different match IDs" id_asc id_dsc;
-    if id_asc = id_dsc
-    then Lwt.fail_with "Expected different advertisement IDs in ascending and descending order"
-    else Lwt.return_unit
-  | _ -> Lwt.fail_with "No observable advertisements response"
+  let endpoint = Api.Game.Advertisement.find_observable ~sort:Ascending ~count:1 in
+  let* lobbies = Client.get endpoint test_state.client in
+  match lobbies with
+  | Some l when List.length l.members > 0 && List.length l.advertisements > 0 -> Lwt.return_unit
+  | Some _ -> Lwt.fail_with "No members or advertisements found in the observable advertisements"
+  | None -> Lwt.fail_with "No observable advertisements response"
 ;;