Add login option

.env.example

@@ -0,0 +1,2 @@
+export STEAM_APP_TICKET=
+export STEAM_USER_ALIAS=

.gitignore

@@ -2,3 +2,4 @@ _opam/
 _build/
 _coverage/
 *.coverage
+.env

Makefile

@@ -1 +1,9 @@
+ifneq (,$(wildcard ./.env))
+    include .env
+    export
+endif
+
+x:
+	set
+
 include make/ocaml/main.mk

dune-project

@@ -24,6 +24,8 @@
     (>= 5.7.0))
   (lwt_ssl
    (>= 1.2.0))
+  (ptime
+    (>= 1.1.0))
   (alcotest
    (and
     :with-test

lib/api/game/login.ml

@@ -1,12 +1,12 @@
-open Lwt.Syntax
-open Data.Platform.Credentials
+(* open Lwt.Syntax *)
+(* open Data.Platform.Credentials *)
 
-let platform_login credentials game domain send =
-  let url = Uri.make ~scheme:"https" ~host:domain ~path:"/game/login/platformlogin" () in
-  let* json = send url in
-  match json with
-  | Some j ->
-    let model = Models.Response.Game.Platform_login.from_json j in
-    Lwt.return @@ Some model
-  | None -> Lwt.return None
-;;
+(* let platform_login credentials game domain send = *)
+(*   let url = Uri.make ~scheme:"https" ~host:domain ~path:"/game/login/platformlogin" () in *)
+(*   let* json = send url in *)
+(*   match json with *)
+(*   | Some j -> *)
+(*     let model = Models.Response.Game.Platform_login.from_json j in *)
+(*     Lwt.return @@ Some model *)
+(*   | None -> Lwt.return None *)
+(* ;; *)

lib/api/game/news.ml

@@ -0,0 +1,8 @@
+open Lwt.Syntax
+
+let get game domain send =
+  let base_url = Uri.make ~scheme:"https" ~host:domain ~path:"/game/news/getNews" () in
+  let url = Uri.with_query' base_url [ "title", Data.Game.to_str game ] in
+  let* json = send url in
+  match json with Some j -> Lwt.return @@ Some (Models.Response.Game.News.from_json j) | None -> Lwt.return None
+;;

lib/client.ml

@@ -3,30 +3,55 @@ open Lwt.Syntax
 type t =
   { domain : string
   ; game : Data.Game.t
-  ; session : Authentication.Session.t option
+  ; cookie : Data.Platform.Cookie.t option
   }
 
-let create domain game = { domain; game; session = None }
+let create ?(login = None) domain game =
+  match login with
+  | Some l ->
+    let* cookie = Data.Platform.Cookie.create l domain in
+    Lwt.return { domain; game; cookie }
+  | None -> Lwt.return { domain; game; cookie = None }
+;;
 
-let get_json (url : Uri.t) =
-  let* resp, body = Cohttp_lwt_unix.Client.get url in
+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 ->
+      let cookies_string =
+        Printf.sprintf
+          "ApplicationGatewayAffinity=%s; ApplicationGatewayAffinityCORS=%s; reliclink=%s"
+          c.application_gateway_affinity
+          c.application_gateway_affinity_cors
+          c.reliclink
+      in
+      Cohttp.Header.add (Cohttp.Header.init ()) "Cookie" cookies_string
+  in
+  let* resp, body = Cohttp_lwt_unix.Client.get ~headers url_with_params in
   let status = Cohttp.Response.status resp in
   if Cohttp.Code.code_of_status status = 200
   then
-    let* body = Cohttp_lwt.Body.to_string body in
-    let json = Yojson.Basic.from_string body in
+    let* body_str = Cohttp_lwt.Body.to_string body in
+    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 in
+    let url_str = Uri.to_string url_with_params in
     let* _ =
-      Lwt_io.printl (Printf.sprintf "HTTP Error: %s for URL: %s" (Cohttp.Code.string_of_status status) url_str)
+      Lwt_io.printl @@ Printf.sprintf "HTTP Error: %s for URL: %s" (Cohttp.Code.string_of_status status) url_str
     in
     Lwt.return None)
 ;;
 
 let get ?requester endpoint client =
-  let actual_requester = match requester with Some r -> r | None -> get_json in
+  let actual_requester = match requester with Some r -> r | None -> get_json ~cookie:client.cookie in
   let* json = endpoint client.game client.domain actual_requester in
   Lwt.return json
 ;;

lib/data/platform/cookie.ml

@@ -0,0 +1,87 @@
+open Lwt.Syntax
+open Steam_login
+
+type t =
+  { application_gateway_affinity : string
+  ; application_gateway_affinity_cors : string
+  ; reliclink : string
+  ; session_id : string
+  ; expires_on : int
+  }
+
+let get_seconds_until_expires c = c.expires_on - int_of_float (Unix.time ())
+
+let make_form_data alias auth =
+  [ "accountType", [ "STEAM" ]
+  ; "activeMatchId", [ "-1" ]
+  ; "alias", [ alias ]
+  ; "appID", [ "813780" ]
+  ; "auth", [ auth ]
+  ; "callNum", [ "0" ]
+  ; "clientLibVersion", [ "185" ]
+  ; "connect_id", [ "" ]
+  ; "country", [ "DK" ]
+  ; "installationType", [ "windows" ]
+  ; "language", [ "en" ]
+  ; "macAddress", [ "2C-4D-54-52-2F-2B" ]
+  ; "majorVersion", [ "4.0.0" ]
+  ; "minorVersion", [ "0" ]
+  ; "platformEnvironment", [ "" ]
+  ; "platformUserID", [ "" ]
+  ; "startGameToken", [ "" ]
+  ; "storeLicenseToken", [ "" ]
+  ; "storetoken", [ "" ]
+  ; "syncHash", [ "[0,0]" ]
+  ; "timeoutOverride", [ "0" ]
+  ; "title", [ "age2" ]
+  ]
+;;
+
+let send_form ~headers uri form =
+  let body = Uri.encoded_of_query form in
+  Cohttp_lwt_unix.Client.post ~headers ~body:(Cohttp_lwt.Body.of_string body) uri
+;;
+
+let extract_cookies headers =
+  let cookies = Cohttp.Header.get_multi headers "set-cookie" in
+  let parse_cookie cookie =
+    let parts = String.split_on_char ';' cookie in
+    List.hd parts |> String.trim
+  in
+  List.map parse_cookie cookies
+;;
+
+let get_cookie_value cookies name =
+  let prefix = name ^ "=" in
+  try
+    List.find (fun cookie -> String.starts_with ~prefix cookie) cookies
+    |> String.split_on_char '='
+    |> List.tl
+    |> String.concat "="
+  with
+  | Not_found -> failwith @@ Printf.sprintf "Cookie '%s' not found in '%s'" name (String.concat ";" cookies)
+;;
+
+let extract_session_id body_str =
+  let json = Yojson.Basic.from_string body_str in
+  match Yojson.Basic.Util.to_list json with
+  | _ :: second :: _ -> Yojson.Basic.Util.to_string second
+  | _ -> failwith "Invalid JSON structure"
+;;
+
+let create login domain =
+  let form = make_form_data login.alias login.app_ticket in
+  let uri = Uri.of_string (Printf.sprintf "https://%s/game/login/platformlogin" domain) in
+  let* response, body =
+    send_form ~headers:(Cohttp.Header.init_with "Content-Type" "application/x-www-form-urlencoded") uri form
+  in
+  let* body_str = Cohttp_lwt.Body.to_string body in
+  let cookies = extract_cookies @@ Cohttp.Response.headers response in
+  let application_gateway_affinity_cors = get_cookie_value cookies "ApplicationGatewayAffinityCORS" in
+  let application_gateway_affinity = get_cookie_value cookies "ApplicationGatewayAffinity" in
+  let reliclink = get_cookie_value cookies "reliclink" in
+  let expires_on = 3600 + int_of_float (Unix.time ()) in
+  let session_id = extract_session_id body_str in
+  let c = { application_gateway_affinity; application_gateway_affinity_cors; reliclink; session_id; expires_on } in
+  Lwt.return @@ Some c
+;;

lib/data/platform/steam_login.ml

@@ -0,0 +1,4 @@
+type t =
+  { alias : string
+  ; app_ticket : string
+  }

lib/dune

@@ -4,7 +4,7 @@
  (name relic_sdk)
  (public_name relic-sdk)
  (flags :standard -safe-string)
- (libraries yojson cohttp-lwt-unix bigarray base64 str)
+ (libraries yojson cohttp-lwt-unix bigarray base64 str ptime)
  (foreign_stubs
   (language c)
   (names zlib_stubs)

lib/models/response/game/news.ml

@@ -0,0 +1,13 @@
+type t =
+  { status : int
+  ; news : Stub.Game.News.t list
+  ; tail : Yojson.Basic.t list
+  }
+
+let to_json n = `List ([ `Int n.id; `List (List.map Stub.Game.News.to_json n.news) ] @ n.tail)
+
+let from_json json =
+  match json with
+  | `List (`Int status :: `List items :: tail) -> { status; news = List.map Stub.Game.News.from_json items; tail }
+  | _ -> failwith "Unexpected JSON format for the news response"
+;;

lib/models/response/game/observable_advertisements.ml

@@ -0,0 +1,14 @@
+type t =
+  { status : int
+  ; advertisements : Stub.Game.Observable_advertisement.t list (* ; avatars : Yojson.Basic.t list *)
+  ; tail : Yojson.Basic.t list
+  }
+
+let to_json a = `List ([ `Int a.id; `List (List.map Stub.Game.Observable_advertisement.to_json a.news) ] @ a.tail)
+
+let from_json json =
+  match json with
+  | `List (`Int status :: `List items :: tail) ->
+    { status; advertisements = List.map Stub.Game.Observable_advertisement.from_json items; tail }
+  | _ -> failwith "Unexpected JSON format for the news response"
+;;