Allow the user to provide a project name

cs_api_cli/cs_api_cli.ml

@@ -16,10 +16,30 @@ let get_file path =
       | _ ->
         Lwt_result.fail ("Could not read file " ^ path ^ " for unknown reasons"))
 
+let resolve_project_name ~api ~verify ~project_id ~project_name =
+  (* The user can provide an ID or a name. If a name is provided, look for the
+     corresponding ID. Otherwise, just return the given ID. *)
+  let open Lwt_result.Infix in
+  match (project_id, project_name) with
+  | (None, None)
+  | (Some _, Some _) ->
+    Lwt_result.fail "Exactly one of project ID or name must be provided."
+  | (Some id, None) -> Lwt_result.return id
+  | (None, Some name) -> (
+    Cs_api_core.build_list_projects_request ~api
+    |> Cs_api_io.send_request ~verify
+    >>= Cs_api_io.get_response
+    >>= fun body ->
+    let projects = Cs_api_core.parse_list_projects_response ~body in
+    match CCList.Assoc.get ~eq:String.equal name projects with
+    | None -> Lwt_result.fail (Printf.sprintf "Project name not found: %s" name)
+    | Some id -> Lwt_result.return id)
+
 let upload_trace
     ~trace_file
     ~trace_name
     ~project_id
+    ~project_name
     ~api_endpoint
     ~api_key
     ~no_check_certificate =
@@ -28,6 +48,8 @@ let upload_trace
   let api = Api.make ~api_endpoint ~api_key in
   (let open Lwt_result.Infix in
   get_file trace_file >>= fun file ->
+  resolve_project_name ~api ~verify ~project_id ~project_name
+  >>= fun project_id ->
   Cs_api_core.build_s3_signed_post_request ~api
   |> Cs_api_io.send_request ~verify
   >>= Cs_api_io.get_response
@@ -73,8 +95,18 @@ let trace_name =
     & info ["n"; "trace-name"] ~docv:"TRACENAME" ~doc)
 
 let project_id =
-  let doc = "ID of the project to which the trace should be added" in
-  Cmdliner.Arg.(required & opt (some int) None & info ["p"; "project-id"] ~doc)
+  let doc =
+    "ID of the project to which the trace should be added. Mutually exclusive \
+     with --project-name."
+  in
+  Cmdliner.Arg.(value & opt (some int) None & info ["p"; "project-id"] ~doc)
+
+let project_name =
+  let doc =
+    "Name of the project to which the trace should be added. Mutually \
+     exclusive with --project-id."
+  in
+  Cmdliner.Arg.(value & opt (some string) None & info ["project-name"] ~doc)
 
 let api_endpoint =
   let doc = "Base URL of the API server." in
@@ -104,11 +136,12 @@ let upload_trace_main
     trace_file
     trace_name
     project_id
+    project_name
     api_endpoint
     api_key
     no_check_certificate =
-  upload_trace ~trace_file ~trace_name ~project_id ~api_endpoint ~api_key
-    ~no_check_certificate
+  upload_trace ~trace_file ~trace_name ~project_id ~project_name ~api_endpoint
+    ~api_key ~no_check_certificate
   |> Lwt_main.run
 
 let upload_trace_term =
@@ -117,6 +150,7 @@ let upload_trace_term =
     $ trace_file
     $ trace_name
     $ project_id
+    $ project_name
     $ api_endpoint
     $ api_key
     $ no_check_certificate)

cs_api_core/cs_api_core.ml

@@ -2,6 +2,15 @@ module Graphql = struct
   let to_global_id ~type_ ~id =
     Printf.sprintf "%s:%d" type_ id |> Base64.encode |> Result.get_ok
 
+  let of_global_id ~type_ global_id =
+    global_id
+    |> Base64.decode
+    |> Result.get_ok
+    |> CCString.chop_prefix ~pre:(Printf.sprintf "%s:" type_)
+    |> CCOption.get_exn_or
+         (Printf.sprintf "Invalid global ID prefix for type %s" type_)
+    |> int_of_string
+
   let create_trace =
     {|
       mutation CreateTrace($projectId: ID!, $name: String!, $key: String!, $size: Int!) {
@@ -19,8 +28,54 @@ module Graphql = struct
         }
       }
     |}
+
+  let list_projects =
+    {|
+      query ListProjects {
+        viewer {
+          organization {
+            projects {
+              edges {
+                node {
+                  id
+                  name
+                }
+              }
+            }
+          }
+        }
+      }
+    |}
 end
 
+let build_list_projects_request ~api =
+  let {Api.endpoint; key} = api in
+  { Api.Request.url = endpoint ^ "/api/v2"
+  ; header = [("API-KEY", key); ("Content-Type", "application/json")]
+  ; method_ = Post
+  ; data =
+      Raw
+        (Yojson.Safe.to_string
+           (`Assoc [("query", `String Graphql.list_projects)])) }
+
+let parse_list_projects_response ~body =
+  let open Yojson.Basic.Util in
+  let json = Yojson.Basic.from_string body in
+  json
+  |> member "data"
+  |> member "viewer"
+  |> member "organization"
+  |> member "projects"
+  |> member "edges"
+  |> to_list
+  |> CCList.map (fun edge ->
+         let node = edge |> member "node" in
+         ( node |> member "name" |> to_string
+         , node
+           |> member "id"
+           |> to_string
+           |> Graphql.of_global_id ~type_:"Project" ))
+
 let parse_s3_signature_request ~body =
   let open CCOption.Infix in
   let open Yojson.Basic.Util in

cs_api_core/cs_api_core.mli

@@ -13,6 +13,10 @@ val parse_s3_response : body:string -> string
 val build_s3_signed_post_request : api:Api.t -> Api.Request.t
 (** Request building functions **)
 
+val build_list_projects_request : api:Api.t -> Api.Request.t
+
+val parse_list_projects_response : body:string -> (string * int) list
+
 val build_file_upload_request :
      s3_url:string
   -> s3_signature:Api.S3Signature.t