From 2a2f522d71abccf9c642ce244ba33bc1ba9a1715 Mon Sep 17 00:00:00 2001 From: Bertrand Bonnefoy-Claudet Date: Wed, 9 Feb 2022 15:44:21 +0100 Subject: [PATCH] Allow the user to provide a project name A project name can now be given instead of a project ID. The new option is `--project-name`. --- cs_api_cli/cs_api_cli.ml | 42 +++++++++++++++++++++++++--- cs_api_core/cs_api_core.ml | 55 +++++++++++++++++++++++++++++++++++++ cs_api_core/cs_api_core.mli | 4 +++ 3 files changed, 97 insertions(+), 4 deletions(-) diff --git a/cs_api_cli/cs_api_cli.ml b/cs_api_cli/cs_api_cli.ml index 578b747..97a82c9 100644 --- a/cs_api_cli/cs_api_cli.ml +++ b/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) diff --git a/cs_api_core/cs_api_core.ml b/cs_api_core/cs_api_core.ml index faafdc2..2b7c74b 100644 --- a/cs_api_core/cs_api_core.ml +++ b/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 diff --git a/cs_api_core/cs_api_core.mli b/cs_api_core/cs_api_core.mli index 56070b5..37b4847 100644 --- a/cs_api_core/cs_api_core.mli +++ b/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