From d3e3716d9ffa781e4986c8a745a68a15f4a03d89 Mon Sep 17 00:00:00 2001 From: benmandrew Date: Fri, 12 May 2023 12:22:11 +0100 Subject: [PATCH 01/10] Initial implementation of multiple slack channel URIs --- src/build.ml | 23 +++++++++++--------- src/build.mli | 2 +- src/main.ml | 56 +++++++++++++++++++++++++++++++++++++++++------- src/pipeline.ml | 14 ++++++------ src/pipeline.mli | 6 +++--- 5 files changed, 72 insertions(+), 29 deletions(-) diff --git a/src/build.ml b/src/build.ml index 04ecc33..46514b0 100644 --- a/src/build.ml +++ b/src/build.ml @@ -58,7 +58,7 @@ module Make(T : S.T) = struct | Error (`Active _) -> Github.Api.CheckRunStatus.v ~url `Queued | Error (`Msg m) -> Github.Api.CheckRunStatus.v ~url (`Completed (`Failure m)) ~summary:m - let repo ?channel ~web_ui ~org:(org, github) ?additional_build_args ~name build_specs = + let repo ?channels ~web_ui ~org:(org, github) ?additional_build_args ~name build_specs = let repo_name = Printf.sprintf "%s/%s" org name in let repo = { Github.Repo_id.owner = org; name } in let root = Current.return ~label:repo_name () in (* Group by repo in the diagram *) @@ -87,17 +87,20 @@ module Make(T : S.T) = struct build_specs |> List.map (fun (build_info, deploys) -> Current.all ( deploys |> List.map (fun (branch, deploy_info) -> - let service = T.name deploy_info in - let commit, src = head_of ?github repo branch in - let deploy = T.deploy build_info deploy_info ?additional_build_args src in - match channel, commit with - | Some channel, Some commit -> notify ~channel ~web_ui ~service ~commit ~repo:repo_name deploy - | _ -> deploy - ) + let service = T.name deploy_info in + let commit, src = head_of ?github repo branch in + let deploy = T.deploy build_info deploy_info ?additional_build_args src in + match channels, commit with + | Some channels, Some commit -> + List.map + (fun channel -> + notify ~channel ~web_ui ~service ~commit ~repo:repo_name deploy) + channels + | _ -> [ deploy ] + ) |> List.flatten ) ) - ) - |> Current.collapse ~key:"repo" ~value:repo_name ~input:root + ) |> Current.collapse ~key:"repo" ~value:repo_name ~input:root in Current.all (deployment :: Option.to_list builds) end diff --git a/src/build.mli b/src/build.mli index 882ee21..d183424 100644 --- a/src/build.mli +++ b/src/build.mli @@ -13,7 +13,7 @@ val api : org -> Current_github.Api.t option module Make(T : S.T) : sig val repo : - ?channel:Current_slack.channel -> + ?channels:Current_slack.channel list -> web_ui:(string -> Uri.t) -> org:org -> ?additional_build_args:string list Current.t -> diff --git a/src/main.ml b/src/main.ml index fd9c7f7..7230281 100644 --- a/src/main.ml +++ b/src/main.ml @@ -16,12 +16,52 @@ let read_first_line path = Fun.protect (fun () -> input_line ch) ~finally:(fun () -> close_in ch) -let read_channel_uri path = +let read_file path = + let ch = open_in path in + Fun.protect (fun () -> really_input_string ch (in_channel_length ch)) + ~finally:(fun () -> close_in ch) + +(* + [ + { + "uri":"ci-firehose-uri", + "modes":["success", "failure"], + }, + { + "uri":"opam-uri", + "modes":["failure"], + }, + ] +*) + +type slack_channel_mode = + | Success + | Failure + | Both + +type slack_channel = { uri : Current_slack.channel; mode : slack_channel_mode } + +let read_channels_file path = + let open Yojson.Safe in + let mode_of_t t = match Util.to_string t with + | "success" -> Success + | "failure" -> Failure + | "both" -> Both + | _ -> raise (Util.Type_error ("\"mode\" must be any of: \"success\", \"failure\", or \"both\"", t)) + in + let read_channel ch = + let uri = + Util.(member "uri" ch |> to_string) + |> String.trim + |> Uri.of_string + |> Current_slack.channel in + let mode = Util.member "mode" ch |> mode_of_t in + { uri; mode } + in try - let uri = read_first_line path in - Current_slack.channel (Uri.of_string (String.trim uri)) + read_file path |> from_string |> Util.to_list |> List.map read_channel with ex -> - Fmt.failwith "Failed to read slack URI from %S: %a" path Fmt.exn ex + Fmt.failwith "Failed to read slack URIs from %S: %a" path Fmt.exn ex (* Access control policy for Tarides. *) let has_role_tarides user role = @@ -84,18 +124,18 @@ let has_role_ocaml user role = let main () config mode app slack auth staging_password_file flavour = let vat = Capnp_rpc_unix.client_only_vat () in - let channel = read_channel_uri slack in + let channels = read_channels_file slack in let staging_auth = staging_password_file |> Option.map (fun path -> staging_user, read_first_line path) in let engine = match flavour with | Tarides sched -> let sched = Current_ocluster.Connection.create (Capnp_rpc_unix.Vat.import_exn vat sched) in - Current.Engine.create ~config (Pipeline.tarides ~app ~notify:channel ~sched ~staging_auth) + Current.Engine.create ~config (Pipeline.tarides ~app ~notify:channels ~sched ~staging_auth) | OCaml sched -> let sched = Current_ocluster.Connection.create (Capnp_rpc_unix.Vat.import_exn vat sched) in - Current.Engine.create ~config (Pipeline.ocaml_org ~app ~notify:channel ~sched ~staging_auth) + Current.Engine.create ~config (Pipeline.ocaml_org ~app ~notify:channels ~sched ~staging_auth) | Mirage sched -> let sched = Current_ocluster.Connection.create (Capnp_rpc_unix.Vat.import_exn vat sched) in - Current.Engine.create ~config (Pipeline.mirage ~app ~notify:channel ~sched ~staging_auth) + Current.Engine.create ~config (Pipeline.mirage ~app ~notify:channels ~sched ~staging_auth) in let authn = Option.map Current_github.Auth.make_login_uri auth in let webhook_secret = Current_github.App.webhook_secret app in diff --git a/src/pipeline.ml b/src/pipeline.ml index 3be7bdd..e18b20d 100644 --- a/src/pipeline.ml +++ b/src/pipeline.ml @@ -327,7 +327,7 @@ let build_kit (v : Cluster_api.Docker.Spec.options) = { v with buildkit = true } For each one, it lists the builds that are made from that repository. For each build, it says which which branch gives the desired live version of the service, and where to deploy it. *) -let tarides ?app ?notify:channel ?filter ~sched ~staging_auth () = +let tarides ?app ?notify:channels ?filter ~sched ~staging_auth () = (* [web_ui collapse_value] is a URL back to the deployment service, for links in status messages. *) let web_ui = @@ -338,7 +338,7 @@ let tarides ?app ?notify:channel ?filter ~sched ~staging_auth () = let ocurrent = Build.org ?app ~account:"ocurrent" 12497518 in let ocaml_bench = Build.org ?app ~account:"ocaml-bench" 19839896 in - let build (org, name, builds) = Cluster_build.repo ?channel ~web_ui ~org ~name builds in + let build (org, name, builds) = Cluster_build.repo ?channels ~web_ui ~org ~name builds in let docker ?archs = let timeout = match archs with | Some archs when List.mem `Linux_riscv64 archs -> Int64.mul timeout 2L @@ -402,7 +402,7 @@ let tarides ?app ?notify:channel ?filter ~sched ~staging_auth () = For each one, it lists the builds that are made from that repository. For each build, it says which which branch gives the desired live version of the service, and where to deploy it. *) -let ocaml_org ?app ?notify:channel ?filter ~sched ~staging_auth () = +let ocaml_org ?app ?notify:channels ?filter ~sched ~staging_auth () = (* [web_ui collapse_value] is a URL back to the deployment service, for links in status messages. *) let web_ui = @@ -415,7 +415,7 @@ let ocaml_org ?app ?notify:channel ?filter ~sched ~staging_auth () = let ocaml_opam = Build.org ?app ~account:"ocaml-opam" 23690708 in let build ?additional_build_args (org, name, builds) = - Cluster_build.repo ?channel ?additional_build_args ~web_ui ~org ~name builds in + Cluster_build.repo ?channels ?additional_build_args ~web_ui ~org ~name builds in let docker_with_timeout timeout = docker ~sched:(Current_ocluster.v ~timeout ?push_auth:staging_auth sched) in @@ -507,7 +507,7 @@ let unikernel dockerfile ~target args services = |> List.map (fun (branch, service) -> branch, { Packet_unikernel.service }) in (build_info, deploys) -let mirage ?app ?notify:channel ~sched ~staging_auth () = +let mirage ?app ?notify:channels ~sched ~staging_auth () = (* [web_ui collapse_value] is a URL back to the deployment service, for links in status messages. *) let web_ui = @@ -517,8 +517,8 @@ let mirage ?app ?notify:channel ~sched ~staging_auth () = (* GitHub organisations to monitor. *) let mirage = Build.org ?app ~account:"mirage" 7175142 in let ocurrent = Build.org ?app ~account:"ocurrent" 6853813 in - let build_unikernel (org, name, builds) = Build_unikernel.repo ?channel ~web_ui ~org ~name builds in - let build_docker (org, name, builds) = Cluster_build.repo ?channel ~web_ui ~org ~name builds in + let build_unikernel (org, name, builds) = Build_unikernel.repo ?channels ~web_ui ~org ~name builds in + let build_docker (org, name, builds) = Cluster_build.repo ?channels ~web_ui ~org ~name builds in let sched = Current_ocluster.v ~timeout ?push_auth:staging_auth sched in let docker = docker ~sched in Current.all @@ (List.map build_unikernel [ diff --git a/src/pipeline.mli b/src/pipeline.mli index 81da85c..83b5306 100644 --- a/src/pipeline.mli +++ b/src/pipeline.mli @@ -9,7 +9,7 @@ end val tarides : ?app:Current_github.App.t -> - ?notify:Current_slack.channel -> + ?notify:Current_slack.channel list -> ?filter:(Current_github.Repo_id.t -> bool) -> sched:Current_ocluster.Connection.t -> staging_auth:(string * string) option -> @@ -17,7 +17,7 @@ val tarides : val ocaml_org : ?app:Current_github.App.t -> - ?notify:Current_slack.channel -> + ?notify:Current_slack.channel list -> ?filter:(Current_github.Repo_id.t -> bool) -> sched:Current_ocluster.Connection.t -> staging_auth:(string * string) option -> @@ -25,7 +25,7 @@ val ocaml_org : val mirage : ?app:Current_github.App.t -> - ?notify:Current_slack.channel -> + ?notify:Current_slack.channel list -> sched:Current_ocluster.Connection.t -> staging_auth:(string * string) option -> unit -> unit Current.t From b9b386713a6d6f7633813ff66a8f9565672bbc4b Mon Sep 17 00:00:00 2001 From: benmandrew Date: Mon, 15 May 2023 12:12:46 +0100 Subject: [PATCH 02/10] URI and mode passed to notify --- src/build.ml | 7 ++++--- src/build.mli | 2 +- src/dune | 2 +- src/main.ml | 33 ++++----------------------------- src/pipeline.mli | 6 +++--- src/slack_channel.ml | 16 ++++++++++++++++ 6 files changed, 29 insertions(+), 37 deletions(-) create mode 100644 src/slack_channel.ml diff --git a/src/build.ml b/src/build.ml index 46514b0..07b4181 100644 --- a/src/build.ml +++ b/src/build.ml @@ -29,7 +29,8 @@ let head_of ?github repo name = let notify ?channel ~web_ui ~service ~commit ~repo x = match channel with | None -> x - | Some channel -> + | Some (channel, mode) -> + ignore mode; let s = let+ state = Current.state x and+ commit in @@ -93,8 +94,8 @@ module Make(T : S.T) = struct match channels, commit with | Some channels, Some commit -> List.map - (fun channel -> - notify ~channel ~web_ui ~service ~commit ~repo:repo_name deploy) + (fun Slack_channel.{ uri; mode } -> + notify ~channel:(uri, mode) ~web_ui ~service ~commit ~repo:repo_name deploy) channels | _ -> [ deploy ] ) |> List.flatten diff --git a/src/build.mli b/src/build.mli index d183424..fa496b8 100644 --- a/src/build.mli +++ b/src/build.mli @@ -13,7 +13,7 @@ val api : org -> Current_github.Api.t option module Make(T : S.T) : sig val repo : - ?channels:Current_slack.channel list -> + ?channels:Slack_channel.t list -> web_ui:(string -> Uri.t) -> org:org -> ?additional_build_args:string list Current.t -> diff --git a/src/dune b/src/dune index 158c086..f9a9cae 100644 --- a/src/dune +++ b/src/dune @@ -47,6 +47,6 @@ str lwt lwt.unix) - (modules index pipeline aws caddy logging mirage s build) + (modules index pipeline aws caddy logging mirage s build slack_channel) (preprocess (pps ppx_deriving.std ppx_deriving_yojson))) diff --git a/src/main.ml b/src/main.ml index 7230281..dace7ab 100644 --- a/src/main.ml +++ b/src/main.ml @@ -21,47 +21,22 @@ let read_file path = Fun.protect (fun () -> really_input_string ch (in_channel_length ch)) ~finally:(fun () -> close_in ch) -(* - [ - { - "uri":"ci-firehose-uri", - "modes":["success", "failure"], - }, - { - "uri":"opam-uri", - "modes":["failure"], - }, - ] -*) - -type slack_channel_mode = - | Success - | Failure - | Both - -type slack_channel = { uri : Current_slack.channel; mode : slack_channel_mode } - let read_channels_file path = let open Yojson.Safe in - let mode_of_t t = match Util.to_string t with - | "success" -> Success - | "failure" -> Failure - | "both" -> Both - | _ -> raise (Util.Type_error ("\"mode\" must be any of: \"success\", \"failure\", or \"both\"", t)) - in let read_channel ch = let uri = Util.(member "uri" ch |> to_string) |> String.trim |> Uri.of_string |> Current_slack.channel in - let mode = Util.member "mode" ch |> mode_of_t in - { uri; mode } + let mode = Util.member "mode" ch + |> Slack_channel.mode_of_json_string in + Slack_channel.v uri mode in try read_file path |> from_string |> Util.to_list |> List.map read_channel with ex -> - Fmt.failwith "Failed to read slack URIs from %S: %a" path Fmt.exn ex + Fmt.failwith "Failed to read slack URI file '%S': %a" path Fmt.exn ex (* Access control policy for Tarides. *) let has_role_tarides user role = diff --git a/src/pipeline.mli b/src/pipeline.mli index 83b5306..345fa26 100644 --- a/src/pipeline.mli +++ b/src/pipeline.mli @@ -9,7 +9,7 @@ end val tarides : ?app:Current_github.App.t -> - ?notify:Current_slack.channel list -> + ?notify:Slack_channel.t list -> ?filter:(Current_github.Repo_id.t -> bool) -> sched:Current_ocluster.Connection.t -> staging_auth:(string * string) option -> @@ -17,7 +17,7 @@ val tarides : val ocaml_org : ?app:Current_github.App.t -> - ?notify:Current_slack.channel list -> + ?notify:Slack_channel.t list -> ?filter:(Current_github.Repo_id.t -> bool) -> sched:Current_ocluster.Connection.t -> staging_auth:(string * string) option -> @@ -25,7 +25,7 @@ val ocaml_org : val mirage : ?app:Current_github.App.t -> - ?notify:Current_slack.channel list -> + ?notify:Slack_channel.t list -> sched:Current_ocluster.Connection.t -> staging_auth:(string * string) option -> unit -> unit Current.t diff --git a/src/slack_channel.ml b/src/slack_channel.ml new file mode 100644 index 0000000..fc8ec85 --- /dev/null +++ b/src/slack_channel.ml @@ -0,0 +1,16 @@ +type mode = + | Success + | Failure + | Both + +type t = { uri : Current_slack.channel; mode : mode } + +let mode_of_json_string t = + let open Yojson.Safe in + match Util.to_string t with + | "success" -> Success + | "failure" -> Failure + | "both" -> Both + | _ -> raise (Util.Type_error ("\"mode\" must be any of: \"success\", \"failure\", or \"both\"", t)) + +let v uri mode = { uri; mode } From b96b69634fb7b2297435eeb61fa9e5e7139eb531 Mon Sep 17 00:00:00 2001 From: benmandrew Date: Mon, 15 May 2023 14:15:49 +0100 Subject: [PATCH 03/10] Conditionally send Slack messages --- src/build.ml | 27 +++++++++++++++++---------- src/slack_channel.ml | 8 +++----- 2 files changed, 20 insertions(+), 15 deletions(-) diff --git a/src/build.ml b/src/build.ml index 07b4181..aa2f068 100644 --- a/src/build.ml +++ b/src/build.ml @@ -30,20 +30,27 @@ let notify ?channel ~web_ui ~service ~commit ~repo x = match channel with | None -> x | Some (channel, mode) -> - ignore mode; let s = let+ state = Current.state x and+ commit in - let uri = Github.Api.Commit.uri commit in - Fmt.str "@[Deploy <%a|%a> as %s: <%s|%a>@]" - Uri.pp uri Github.Api.Commit.pp_short commit - service - (Uri.to_string (web_ui repo)) (Current_term.Output.pp Current.Unit.pp) state + match state, mode with + | Error (`Msg _), Slack_channel.Failure + | _, Slack_channel.All -> ( + let uri = Github.Api.Commit.uri commit in + let s = Fmt.str "@[Deploy <%a|%a> as %s: <%s|%a>@]" + Uri.pp uri Github.Api.Commit.pp_short commit + service + (Uri.to_string (web_ui repo)) (Current_term.Output.pp Current.Unit.pp) state + in + Some s) + | _ -> None in - Current.all [ - Current_slack.post channel ~key:("deploy-" ^ service) s; - x (* If [x] fails, the whole pipeline should fail too. *) - ] + Current.(option_iter + (fun s -> all [ + Current_slack.post channel ~key:("deploy-" ^ service) s; + x (* If [x] fails, the whole pipeline should fail too. *) + ] + )) s let label l x = Current.component "%s" l |> diff --git a/src/slack_channel.ml b/src/slack_channel.ml index fc8ec85..3da9644 100644 --- a/src/slack_channel.ml +++ b/src/slack_channel.ml @@ -1,16 +1,14 @@ type mode = - | Success + | All | Failure - | Both type t = { uri : Current_slack.channel; mode : mode } let mode_of_json_string t = let open Yojson.Safe in match Util.to_string t with - | "success" -> Success + | "all" -> All | "failure" -> Failure - | "both" -> Both - | _ -> raise (Util.Type_error ("\"mode\" must be any of: \"success\", \"failure\", or \"both\"", t)) + | _ -> raise (Util.Type_error ("\"mode\" must be: \"all\", or \"failure\"", t)) let v uri mode = { uri; mode } From 909701b192fa9b173787ac8b1e6818a8465f7bab Mon Sep 17 00:00:00 2001 From: benmandrew Date: Mon, 15 May 2023 15:38:47 +0100 Subject: [PATCH 04/10] Attempt at testing parsing of channel data --- deployer.opam | 1 + dune-project | 1 + src/build.ml | 4 ++++ src/local.ml | 25 ++++++++++++++++++++----- src/main.ml | 19 +------------------ src/pipeline.ml | 12 ++++++------ src/slack_channel.ml | 19 ++++++++++++++++++- src/slack_channel.mli | 4 ++++ test/test.ml | 2 +- 9 files changed, 56 insertions(+), 31 deletions(-) create mode 100644 src/slack_channel.mli diff --git a/deployer.opam b/deployer.opam index 87d14fc..5c3897d 100644 --- a/deployer.opam +++ b/deployer.opam @@ -35,6 +35,7 @@ depends: [ "current_ssh" "ocluster-api" "capnp-rpc-unix" + "sexplib" "fmt" "ppx_deriving_yojson" "ppx_deriving" diff --git a/dune-project b/dune-project index 967625e..4a09fdf 100644 --- a/dune-project +++ b/dune-project @@ -21,6 +21,7 @@ ocluster-api ; Opam dependencies capnp-rpc-unix + sexplib fmt ppx_deriving_yojson ppx_deriving diff --git a/src/build.ml b/src/build.ml index aa2f068..3a50d41 100644 --- a/src/build.ml +++ b/src/build.ml @@ -42,6 +42,7 @@ let notify ?channel ~web_ui ~service ~commit ~repo x = service (Uri.to_string (web_ui repo)) (Current_term.Output.pp Current.Unit.pp) state in + Logs.err (fun m -> m "Message: %s" s); Some s) | _ -> None in @@ -89,6 +90,7 @@ module Make(T : S.T) = struct in Current.collapse ~key:"repo" ~value:collapse_value ~input:refs pipeline and deployment = + Logs.err (fun m -> m "Starting deployment current"); let root = label "deployments" root in Current.with_context root @@ fun () -> Current.all ( @@ -104,6 +106,8 @@ module Make(T : S.T) = struct (fun Slack_channel.{ uri; mode } -> notify ~channel:(uri, mode) ~web_ui ~service ~commit ~repo:repo_name deploy) channels + | Some _, _ -> Logs.err (fun m -> m "channels");[ deploy ] + | _, Some _ -> Logs.err (fun m -> m "commit");[ deploy ] | _ -> [ deploy ] ) |> List.flatten ) diff --git a/src/local.ml b/src/local.ml index 5ce187e..ad12436 100644 --- a/src/local.ml +++ b/src/local.ml @@ -14,16 +14,23 @@ let read_first_line path = Fun.protect (fun () -> input_line ch) ~finally:(fun () -> close_in ch) -let main () config mode app sched staging_password_file repo flavour = +let read_file path = + let ch = open_in path in + Fun.protect (fun () -> really_input_string ch (in_channel_length ch)) + ~finally:(fun () -> close_in ch) + +let main () config mode app slack sched staging_password_file repo flavour = Logs.info (fun f -> f "Is this thing on?"); + let channels = Slack_channel.parse_json @@ read_file slack in let filter = Option.map (=) repo in let vat = Capnp_rpc_unix.client_only_vat () in + let sched = Current_ocluster.Connection.create (Capnp_rpc_unix.Vat.import_exn vat sched) in let staging_auth = staging_password_file |> Option.map (fun path -> staging_user, read_first_line path) in let engine = match flavour with - | `Tarides -> Current.Engine.create ~config (Pipeline.tarides ?app ~sched ~staging_auth ?filter) - | `OCaml -> Current.Engine.create ~config (Pipeline.ocaml_org ?app ~sched ~staging_auth ?filter) - | `Mirage -> Current.Engine.create ~config (Pipeline.mirage ?app ~sched ~staging_auth) + | `Tarides -> Current.Engine.create ~config (Pipeline.tarides ?app ~notify:channels ~sched ~staging_auth ?filter) + | `OCaml -> Current.Engine.create ~config (Pipeline.ocaml_org ?app ~notify:channels ~sched ~staging_auth ?filter) + | `Mirage -> Current.Engine.create ~config (Pipeline.mirage ?app ~notify:channels ~sched ~staging_auth) in let webhook_secret = Option.value ~default:webhook_secret @@ Option.map Current_github.App.webhook_secret app in let has_role = Current_web.Site.allow_all in @@ -41,6 +48,14 @@ let main () config mode app sched staging_password_file repo flavour = (* Command-line parsing *) open Cmdliner +let slack = + Arg.required @@ + Arg.opt Arg.(some file) None @@ + Arg.info + ~doc:"A file containing the URI of the endpoint for status updates." + ~docv:"URI-FILE" + ["slack"] + let submission_service = Arg.required @@ Arg.opt Arg.(some Capnp_rpc_unix.sturdy_uri) None @@ @@ -68,7 +83,7 @@ let repo = let cmd = let doc = "build and deploy services from Git" in let cmd_t = Term.(term_result (const main $ Logging.cmdliner $ Current.Config.cmdliner $ Current_web.cmdliner - $ Current_github.App.cmdliner_opt $ submission_service $ staging_password $ repo $ Pipeline.Flavour.cmdliner)) in + $ Current_github.App.cmdliner_opt $ slack $ submission_service $ staging_password $ repo $ Pipeline.Flavour.cmdliner)) in let info = Cmd.info "deploy" ~doc in Cmd.v info cmd_t diff --git a/src/main.ml b/src/main.ml index dace7ab..11eff90 100644 --- a/src/main.ml +++ b/src/main.ml @@ -21,23 +21,6 @@ let read_file path = Fun.protect (fun () -> really_input_string ch (in_channel_length ch)) ~finally:(fun () -> close_in ch) -let read_channels_file path = - let open Yojson.Safe in - let read_channel ch = - let uri = - Util.(member "uri" ch |> to_string) - |> String.trim - |> Uri.of_string - |> Current_slack.channel in - let mode = Util.member "mode" ch - |> Slack_channel.mode_of_json_string in - Slack_channel.v uri mode - in - try - read_file path |> from_string |> Util.to_list |> List.map read_channel - with ex -> - Fmt.failwith "Failed to read slack URI file '%S': %a" path Fmt.exn ex - (* Access control policy for Tarides. *) let has_role_tarides user role = match user with @@ -99,7 +82,7 @@ let has_role_ocaml user role = let main () config mode app slack auth staging_password_file flavour = let vat = Capnp_rpc_unix.client_only_vat () in - let channels = read_channels_file slack in + let channels = Slack_channel.parse_json @@ read_file slack in let staging_auth = staging_password_file |> Option.map (fun path -> staging_user, read_first_line path) in let engine = match flavour with | Tarides sched -> diff --git a/src/pipeline.ml b/src/pipeline.ml index e18b20d..119e209 100644 --- a/src/pipeline.ml +++ b/src/pipeline.ml @@ -260,7 +260,7 @@ module Cluster = struct in let images = List.map build_arch archs in match auth with - | None -> Current.all (Current.fail "No auth configured; can't push final image" :: List.map Current.ignore_value images) + | None -> Current.all ((*Current.fail "No auth configured; can't push final image" ::*) List.map Current.ignore_value images) | Some auth -> let multi_hash = Current_docker.push_manifest ~auth images ~tag:(Cluster_api.Docker.Image_id.to_string hub_id) in match services with @@ -336,7 +336,7 @@ let tarides ?app ?notify:channels ?filter ~sched ~staging_auth () = (* GitHub organisations to monitor. *) let ocurrent = Build.org ?app ~account:"ocurrent" 12497518 in - let ocaml_bench = Build.org ?app ~account:"ocaml-bench" 19839896 in + (* let ocaml_bench = Build.org ?app ~account:"ocaml-bench" 19839896 in *) let build (org, name, builds) = Cluster_build.repo ?channels ~web_ui ~org ~name builds in let docker ?archs = @@ -348,9 +348,9 @@ let tarides ?app ?notify:channels ?filter ~sched ~staging_auth () = in Current.all @@ List.map build @@ filter_list filter [ - ocurrent, "ocurrent-deployer", [ + (* ocurrent, "ocurrent-deployer", [ docker "Dockerfile" ["live-ci3", "ocurrent/ci.ocamllabs.io-deployer:live-ci3", [`Ci3 "deployer_deployer"]]; - ]; + ]; *) ocurrent, "ocaml-ci", [ docker "Dockerfile" ["live-engine", "ocurrent/ocaml-ci-service:live", [`Ci "ocaml-ci_ci"]] ~archs:[`Linux_x86_64; `Linux_arm64]; @@ -360,7 +360,7 @@ let tarides ?app ?notify:channels ?filter ~sched ~staging_auth () = "staging-www", "ocurrent/ocaml-ci-web:staging", [`Ci "test-www"]] ~archs:[`Linux_x86_64; `Linux_arm64]; ]; - ocurrent, "ocluster", [ + (* ocurrent, "ocluster", [ docker "Dockerfile" ["live-scheduler", "ocurrent/ocluster-scheduler:live", []] ~archs:[`Linux_x86_64; `Linux_arm64] ~options:include_git; docker "Dockerfile.worker" ["live-worker", "ocurrent/ocluster-worker:live", []] @@ -395,7 +395,7 @@ let tarides ?app ?notify:channels ?filter ~sched ~staging_auth () = ]; ocurrent, "multicoretests-ci", [ docker "Dockerfile" ["live", "ocurrent/multicoretests-ci:live", [`Ci4 "infra_multicoretests-ci"]]; - ]; + ]; *) ] (* This is a list of GitHub repositories to monitor. diff --git a/src/slack_channel.ml b/src/slack_channel.ml index 3da9644..db1da29 100644 --- a/src/slack_channel.ml +++ b/src/slack_channel.ml @@ -11,4 +11,21 @@ let mode_of_json_string t = | "failure" -> Failure | _ -> raise (Util.Type_error ("\"mode\" must be: \"all\", or \"failure\"", t)) -let v uri mode = { uri; mode } +let parse_json s = + let open Yojson.Safe in + let read_channel ch = + let uri = + Util.(member "uri" ch |> to_string) + |> String.trim + |> Uri.of_string + |> Current_slack.channel in + let mode = + Util.member "mode" ch + |> mode_of_json_string + in + { uri; mode } + in + try + from_string s |> Util.to_list |> List.map read_channel + with ex -> + Fmt.failwith "Failed to parse slack URIs '%S': %a" s Fmt.exn ex diff --git a/src/slack_channel.mli b/src/slack_channel.mli new file mode 100644 index 0000000..c41a082 --- /dev/null +++ b/src/slack_channel.mli @@ -0,0 +1,4 @@ +type mode = All | Failure +type t = { uri : Current_slack.channel; mode : mode; } + +val parse_json : string -> t list diff --git a/test/test.ml b/test/test.ml index f202274..9b43e3b 100644 --- a/test/test.ml +++ b/test/test.ml @@ -5,4 +5,4 @@ let () = Unix.putenv "EMAIL" "test@example.com"; Lwt_main.run @@ Alcotest_lwt.run "deployer" - [ ("index", Test_index.tests); ] + [ ("index", Test_index.tests); ] From 9e90033627f664db9313e7f783a100a19b3bc5f4 Mon Sep 17 00:00:00 2001 From: benmandrew Date: Thu, 8 Jun 2023 15:12:22 +0200 Subject: [PATCH 05/10] Messages sending conditionally with dummy jobs --- src/build.ml | 20 +++++++++++++------- src/pipeline.ml | 3 ++- src/slack_channel.mli | 2 ++ 3 files changed, 17 insertions(+), 8 deletions(-) diff --git a/src/build.ml b/src/build.ml index 3a50d41..93a0c77 100644 --- a/src/build.ml +++ b/src/build.ml @@ -60,19 +60,19 @@ let label l x = module Make(T : S.T) = struct (* TODO Summarise build results. *) - let status_of_build ~url build = + (* let status_of_build ~url build = let+ state = Current.state build in match state with | Ok _ -> Github.Api.CheckRunStatus.v ~url (`Completed `Success) ~summary:"Passed" | Error (`Active _) -> Github.Api.CheckRunStatus.v ~url `Queued - | Error (`Msg m) -> Github.Api.CheckRunStatus.v ~url (`Completed (`Failure m)) ~summary:m + | Error (`Msg m) -> Github.Api.CheckRunStatus.v ~url (`Completed (`Failure m)) ~summary:m *) let repo ?channels ~web_ui ~org:(org, github) ?additional_build_args ~name build_specs = let repo_name = Printf.sprintf "%s/%s" org name in let repo = { Github.Repo_id.owner = org; name } in let root = Current.return ~label:repo_name () in (* Group by repo in the diagram *) Current.with_context root @@ fun () -> - let builds = github |> Option.map @@ fun github -> + (* let builds = github |> Option.map @@ fun github -> let refs = Github.Api.ci_refs github repo in let collapse_value = repo_name ^ "-builds" in let url = web_ui collapse_value in @@ -88,8 +88,8 @@ module Make(T : S.T) = struct |> status_of_build ~url |> Github.Api.CheckRun.set_status commit "deployability" in - Current.collapse ~key:"repo" ~value:collapse_value ~input:refs pipeline - and deployment = + Current.collapse ~key:"repo" ~value:collapse_value ~input:refs pipeline *) + let deployment = Logs.err (fun m -> m "Starting deployment current"); let root = label "deployments" root in Current.with_context root @@ fun () -> @@ -99,7 +99,12 @@ module Make(T : S.T) = struct deploys |> List.map (fun (branch, deploy_info) -> let service = T.name deploy_info in let commit, src = head_of ?github repo branch in - let deploy = T.deploy build_info deploy_info ?additional_build_args src in + (* let deploy = T.deploy build_info deploy_info ?additional_build_args src in *) + (* let deploy = Current.return () in *) + let deploy = Current.fail "Massive and catastrophic failure, very sad!" in + ignore src; + ignore build_info; + ignore additional_build_args; match channels, commit with | Some channels, Some commit -> List.map @@ -114,5 +119,6 @@ module Make(T : S.T) = struct ) ) |> Current.collapse ~key:"repo" ~value:repo_name ~input:root in - Current.all (deployment :: Option.to_list builds) + (* Current.all (deployment :: Option.to_list builds) *) + deployment end diff --git a/src/pipeline.ml b/src/pipeline.ml index 119e209..a6c68ec 100644 --- a/src/pipeline.ml +++ b/src/pipeline.ml @@ -335,7 +335,8 @@ let tarides ?app ?notify:channels ?filter ~sched ~staging_auth () = fun repo -> Uri.with_query' base ["repo", repo] in (* GitHub organisations to monitor. *) - let ocurrent = Build.org ?app ~account:"ocurrent" 12497518 in + (* let ocurrent = Build.org ?app ~account:"ocurrent" 12497518 in *) + let ocurrent = Build.org ?app ~account:"benmandrew" 29914802 in (* let ocaml_bench = Build.org ?app ~account:"ocaml-bench" 19839896 in *) let build (org, name, builds) = Cluster_build.repo ?channels ~web_ui ~org ~name builds in diff --git a/src/slack_channel.mli b/src/slack_channel.mli index c41a082..a53f9c3 100644 --- a/src/slack_channel.mli +++ b/src/slack_channel.mli @@ -1,4 +1,6 @@ type mode = All | Failure +(** The condition on which we send a Slack message *) + type t = { uri : Current_slack.channel; mode : mode; } val parse_json : string -> t list From 13a7340ecfbb06d4d02fcb6749c4062705b2380c Mon Sep 17 00:00:00 2001 From: benmandrew Date: Thu, 8 Jun 2023 15:45:43 +0200 Subject: [PATCH 06/10] Add repositories field to slack_channel --- src/build.ml | 17 +++++++++++++---- src/slack_channel.ml | 19 ++++++++++++++++--- src/slack_channel.mli | 5 ++++- 3 files changed, 33 insertions(+), 8 deletions(-) diff --git a/src/build.ml b/src/build.ml index 93a0c77..946f77f 100644 --- a/src/build.ml +++ b/src/build.ml @@ -67,6 +67,18 @@ module Make(T : S.T) = struct | Error (`Active _) -> Github.Api.CheckRunStatus.v ~url `Queued | Error (`Msg m) -> Github.Api.CheckRunStatus.v ~url (`Completed (`Failure m)) ~summary:m *) + let send_slack_message ~web_ui ~service ~commit ~repo_name deploy channels = + let f Slack_channel.{ uri; mode; repositories } = + match repositories with + | All_repos -> notify ~channel:(uri, mode) ~web_ui ~service ~commit ~repo:repo_name deploy + | Some_repos repositories -> + if List.exists (String.equal repo_name) repositories then + notify ~channel:(uri, mode) ~web_ui ~service ~commit ~repo:repo_name deploy + else + Current.return () + in + List.map f channels + let repo ?channels ~web_ui ~org:(org, github) ?additional_build_args ~name build_specs = let repo_name = Printf.sprintf "%s/%s" org name in let repo = { Github.Repo_id.owner = org; name } in @@ -107,10 +119,7 @@ module Make(T : S.T) = struct ignore additional_build_args; match channels, commit with | Some channels, Some commit -> - List.map - (fun Slack_channel.{ uri; mode } -> - notify ~channel:(uri, mode) ~web_ui ~service ~commit ~repo:repo_name deploy) - channels + send_slack_message ~web_ui ~service ~commit ~repo_name deploy channels | Some _, _ -> Logs.err (fun m -> m "channels");[ deploy ] | _, Some _ -> Logs.err (fun m -> m "commit");[ deploy ] | _ -> [ deploy ] diff --git a/src/slack_channel.ml b/src/slack_channel.ml index db1da29..49fea0c 100644 --- a/src/slack_channel.ml +++ b/src/slack_channel.ml @@ -2,7 +2,13 @@ type mode = | All | Failure -type t = { uri : Current_slack.channel; mode : mode } +type repositories = + | All_repos + | Some_repos of string list + +type t = { uri : Current_slack.channel; mode : mode; repositories : repositories } + +open Yojson.Safe let mode_of_json_string t = let open Yojson.Safe in @@ -11,8 +17,11 @@ let mode_of_json_string t = | "failure" -> Failure | _ -> raise (Util.Type_error ("\"mode\" must be: \"all\", or \"failure\"", t)) +let repositories_of_json_string = function + | `Null -> All_repos + | l -> Some_repos (List.map Util.to_string @@ Util.to_list l) + let parse_json s = - let open Yojson.Safe in let read_channel ch = let uri = Util.(member "uri" ch |> to_string) @@ -23,7 +32,11 @@ let parse_json s = Util.member "mode" ch |> mode_of_json_string in - { uri; mode } + let repositories = + Util.member "repositories" ch + |> repositories_of_json_string + in + { uri; mode; repositories } in try from_string s |> Util.to_list |> List.map read_channel diff --git a/src/slack_channel.mli b/src/slack_channel.mli index a53f9c3..4103fb6 100644 --- a/src/slack_channel.mli +++ b/src/slack_channel.mli @@ -1,6 +1,9 @@ type mode = All | Failure (** The condition on which we send a Slack message *) -type t = { uri : Current_slack.channel; mode : mode; } + +type repositories = All_repos | Some_repos of string list + +type t = { uri : Current_slack.channel; mode : mode; repositories : repositories } val parse_json : string -> t list From 75fba00d9d250d176ede513e4d45d20f115b122d Mon Sep 17 00:00:00 2001 From: benmandrew Date: Fri, 9 Jun 2023 14:16:03 +0200 Subject: [PATCH 07/10] Make Slack file optional --- src/local.ml | 7 +++++-- src/main.ml | 7 +++++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/local.ml b/src/local.ml index ad12436..da3f867 100644 --- a/src/local.ml +++ b/src/local.ml @@ -21,7 +21,10 @@ let read_file path = let main () config mode app slack sched staging_password_file repo flavour = Logs.info (fun f -> f "Is this thing on?"); - let channels = Slack_channel.parse_json @@ read_file slack in + let channels = + Option.(map (fun s -> Slack_channel.parse_json @@ read_file s) slack + |> value ~default:[]) + in let filter = Option.map (=) repo in let vat = Capnp_rpc_unix.client_only_vat () in @@ -49,7 +52,7 @@ let main () config mode app slack sched staging_password_file repo flavour = open Cmdliner let slack = - Arg.required @@ + Arg.value @@ Arg.opt Arg.(some file) None @@ Arg.info ~doc:"A file containing the URI of the endpoint for status updates." diff --git a/src/main.ml b/src/main.ml index 11eff90..4da8c33 100644 --- a/src/main.ml +++ b/src/main.ml @@ -82,7 +82,10 @@ let has_role_ocaml user role = let main () config mode app slack auth staging_password_file flavour = let vat = Capnp_rpc_unix.client_only_vat () in - let channels = Slack_channel.parse_json @@ read_file slack in + let channels = + Option.(map (fun s -> Slack_channel.parse_json @@ read_file s) slack + |> value ~default:[]) + in let staging_auth = staging_password_file |> Option.map (fun path -> staging_user, read_first_line path) in let engine = match flavour with | Tarides sched -> @@ -120,7 +123,7 @@ let main () config mode app slack auth staging_password_file flavour = open Cmdliner let slack = - Arg.required @@ + Arg.value @@ Arg.opt Arg.(some file) None @@ Arg.info ~doc:"A file containing the URI of the endpoint for status updates." From cadf72b39ba3f533a54e1572a8375c12c4a03161 Mon Sep 17 00:00:00 2001 From: benmandrew Date: Fri, 9 Jun 2023 15:14:54 +0200 Subject: [PATCH 08/10] Corrections and removing debug stuff --- src/build.ml | 68 +++++++++++++++++++++---------------------------- src/pipeline.ml | 39 ++++++++++++++-------------- 2 files changed, 48 insertions(+), 59 deletions(-) diff --git a/src/build.ml b/src/build.ml index 946f77f..39d9bf0 100644 --- a/src/build.ml +++ b/src/build.ml @@ -29,7 +29,7 @@ let head_of ?github repo name = let notify ?channel ~web_ui ~service ~commit ~repo x = match channel with | None -> x - | Some (channel, mode) -> + | Some { Slack_channel.uri; mode; repositories = _ } -> let s = let+ state = Current.state x and+ commit in @@ -42,14 +42,13 @@ let notify ?channel ~web_ui ~service ~commit ~repo x = service (Uri.to_string (web_ui repo)) (Current_term.Output.pp Current.Unit.pp) state in - Logs.err (fun m -> m "Message: %s" s); Some s) | _ -> None in Current.(option_iter (fun s -> all [ - Current_slack.post channel ~key:("deploy-" ^ service) s; - x (* If [x] fails, the whole pipeline should fail too. *) + Current_slack.post uri ~key:("deploy-" ^ service) s; + x (* If [x] fails, the whole pipeline should fail too. *) ] )) s @@ -60,22 +59,22 @@ let label l x = module Make(T : S.T) = struct (* TODO Summarise build results. *) - (* let status_of_build ~url build = + let status_of_build ~url build = let+ state = Current.state build in match state with | Ok _ -> Github.Api.CheckRunStatus.v ~url (`Completed `Success) ~summary:"Passed" | Error (`Active _) -> Github.Api.CheckRunStatus.v ~url `Queued - | Error (`Msg m) -> Github.Api.CheckRunStatus.v ~url (`Completed (`Failure m)) ~summary:m *) + | Error (`Msg m) -> Github.Api.CheckRunStatus.v ~url (`Completed (`Failure m)) ~summary:m let send_slack_message ~web_ui ~service ~commit ~repo_name deploy channels = - let f Slack_channel.{ uri; mode; repositories } = - match repositories with - | All_repos -> notify ~channel:(uri, mode) ~web_ui ~service ~commit ~repo:repo_name deploy + let f channel = + match channel.Slack_channel.repositories with + | All_repos -> notify ~channel ~web_ui ~service ~commit ~repo:repo_name deploy | Some_repos repositories -> if List.exists (String.equal repo_name) repositories then - notify ~channel:(uri, mode) ~web_ui ~service ~commit ~repo:repo_name deploy + notify ~channel ~web_ui ~service ~commit ~repo:repo_name deploy else - Current.return () + deploy in List.map f channels @@ -84,7 +83,7 @@ module Make(T : S.T) = struct let repo = { Github.Repo_id.owner = org; name } in let root = Current.return ~label:repo_name () in (* Group by repo in the diagram *) Current.with_context root @@ fun () -> - (* let builds = github |> Option.map @@ fun github -> + let builds = github |> Option.map @@ fun github -> let refs = Github.Api.ci_refs github repo in let collapse_value = repo_name ^ "-builds" in let url = web_ui collapse_value in @@ -93,41 +92,32 @@ module Make(T : S.T) = struct |> Current.list_iter (module Github.Api.Commit) @@ fun commit -> let src = Current.map Github.Api.Commit.id commit in Current.all ( - List.map (fun (build_info, _) -> - T.build ?additional_build_args build_info repo src - ) build_specs + List.map (fun (build_info, _) -> + T.build ?additional_build_args build_info repo src + ) build_specs ) |> status_of_build ~url |> Github.Api.CheckRun.set_status commit "deployability" in - Current.collapse ~key:"repo" ~value:collapse_value ~input:refs pipeline *) - let deployment = - Logs.err (fun m -> m "Starting deployment current"); + Current.collapse ~key:"repo" ~value:collapse_value ~input:refs pipeline + and deployment = let root = label "deployments" root in Current.with_context root @@ fun () -> Current.all ( build_specs |> List.map (fun (build_info, deploys) -> - Current.all ( - deploys |> List.map (fun (branch, deploy_info) -> - let service = T.name deploy_info in - let commit, src = head_of ?github repo branch in - (* let deploy = T.deploy build_info deploy_info ?additional_build_args src in *) - (* let deploy = Current.return () in *) - let deploy = Current.fail "Massive and catastrophic failure, very sad!" in - ignore src; - ignore build_info; - ignore additional_build_args; - match channels, commit with - | Some channels, Some commit -> - send_slack_message ~web_ui ~service ~commit ~repo_name deploy channels - | Some _, _ -> Logs.err (fun m -> m "channels");[ deploy ] - | _, Some _ -> Logs.err (fun m -> m "commit");[ deploy ] - | _ -> [ deploy ] - ) |> List.flatten - ) + Current.all ( + deploys |> List.map (fun (branch, deploy_info) -> + let service = T.name deploy_info in + let commit, src = head_of ?github repo branch in + let deploy = T.deploy build_info deploy_info ?additional_build_args src in + match channels, commit with + | Some channels, Some commit -> + send_slack_message ~web_ui ~service ~commit ~repo_name deploy channels + | _ -> [ deploy ] + ) |> List.flatten ) - ) |> Current.collapse ~key:"repo" ~value:repo_name ~input:root + ) + ) |> Current.collapse ~key:"repo" ~value:repo_name ~input:root in - (* Current.all (deployment :: Option.to_list builds) *) - deployment + Current.all (deployment :: Option.to_list builds) end diff --git a/src/pipeline.ml b/src/pipeline.ml index a6c68ec..40133aa 100644 --- a/src/pipeline.ml +++ b/src/pipeline.ml @@ -260,7 +260,7 @@ module Cluster = struct in let images = List.map build_arch archs in match auth with - | None -> Current.all ((*Current.fail "No auth configured; can't push final image" ::*) List.map Current.ignore_value images) + | None -> Current.all (Current.fail "No auth configured; can't push final image" :: List.map Current.ignore_value images) | Some auth -> let multi_hash = Current_docker.push_manifest ~auth images ~tag:(Cluster_api.Docker.Image_id.to_string hub_id) in match services with @@ -335,9 +335,8 @@ let tarides ?app ?notify:channels ?filter ~sched ~staging_auth () = fun repo -> Uri.with_query' base ["repo", repo] in (* GitHub organisations to monitor. *) - (* let ocurrent = Build.org ?app ~account:"ocurrent" 12497518 in *) - let ocurrent = Build.org ?app ~account:"benmandrew" 29914802 in - (* let ocaml_bench = Build.org ?app ~account:"ocaml-bench" 19839896 in *) + let ocurrent = Build.org ?app ~account:"ocurrent" 12497518 in + let ocaml_bench = Build.org ?app ~account:"ocaml-bench" 19839896 in let build (org, name, builds) = Cluster_build.repo ?channels ~web_ui ~org ~name builds in let docker ?archs = @@ -349,9 +348,9 @@ let tarides ?app ?notify:channels ?filter ~sched ~staging_auth () = in Current.all @@ List.map build @@ filter_list filter [ - (* ocurrent, "ocurrent-deployer", [ + ocurrent, "ocurrent-deployer", [ docker "Dockerfile" ["live-ci3", "ocurrent/ci.ocamllabs.io-deployer:live-ci3", [`Ci3 "deployer_deployer"]]; - ]; *) + ]; ocurrent, "ocaml-ci", [ docker "Dockerfile" ["live-engine", "ocurrent/ocaml-ci-service:live", [`Ci "ocaml-ci_ci"]] ~archs:[`Linux_x86_64; `Linux_arm64]; @@ -361,7 +360,7 @@ let tarides ?app ?notify:channels ?filter ~sched ~staging_auth () = "staging-www", "ocurrent/ocaml-ci-web:staging", [`Ci "test-www"]] ~archs:[`Linux_x86_64; `Linux_arm64]; ]; - (* ocurrent, "ocluster", [ + ocurrent, "ocluster", [ docker "Dockerfile" ["live-scheduler", "ocurrent/ocluster-scheduler:live", []] ~archs:[`Linux_x86_64; `Linux_arm64] ~options:include_git; docker "Dockerfile.worker" ["live-worker", "ocurrent/ocluster-worker:live", []] @@ -396,7 +395,7 @@ let tarides ?app ?notify:channels ?filter ~sched ~staging_auth () = ]; ocurrent, "multicoretests-ci", [ docker "Dockerfile" ["live", "ocurrent/multicoretests-ci:live", [`Ci4 "infra_multicoretests-ci"]]; - ]; *) + ]; ] (* This is a list of GitHub repositories to monitor. @@ -441,19 +440,19 @@ let ocaml_org ?app ?notify:channels ?filter ~sched ~staging_auth () = ]; ocurrent, "docker-base-images", [ - (* Docker base images @ images.ci.ocaml.org *) - docker "Dockerfile" ["live", "ocurrent/base-images:live", [`Ocamlorg_images "base-images_builder"]]; - ]; + (* Docker base images @ images.ci.ocaml.org *) + docker "Dockerfile" ["live", "ocurrent/base-images:live", [`Ocamlorg_images "base-images_builder"]]; + ]; ocurrent, "ocaml-docs-ci", [ - docker "Dockerfile" ["live", "ocurrent/docs-ci:live", [`Docs "infra_docs-ci"]]; - docker "docker/init/Dockerfile" ["live", "ocurrent/docs-ci-init:live", [`Docs "infra_init"]]; - docker "docker/storage/Dockerfile" ["live", "ocurrent/docs-ci-storage-server:live", [`Docs "infra_storage-server"]]; - docker "Dockerfile" ["staging", "ocurrent/docs-ci:staging", [`Staging_docs "infra_docs-ci"]]; - docker "docker/init/Dockerfile" ["staging", "ocurrent/docs-ci-init:staging", [`Staging_docs "infra_init"]]; - docker "docker/storage/Dockerfile" ["staging", "ocurrent/docs-ci-storage-server:staging", [`Staging_docs "infra_storage-server"]]; - ]; - ] in + docker "Dockerfile" ["live", "ocurrent/docs-ci:live", [`Docs "infra_docs-ci"]]; + docker "docker/init/Dockerfile" ["live", "ocurrent/docs-ci-init:live", [`Docs "infra_init"]]; + docker "docker/storage/Dockerfile" ["live", "ocurrent/docs-ci-storage-server:live", [`Docs "infra_storage-server"]]; + docker "Dockerfile" ["staging", "ocurrent/docs-ci:staging", [`Staging_docs "infra_docs-ci"]]; + docker "docker/init/Dockerfile" ["staging", "ocurrent/docs-ci-init:staging", [`Staging_docs "infra_init"]]; + docker "docker/storage/Dockerfile" ["staging", "ocurrent/docs-ci-storage-server:staging", [`Staging_docs "infra_storage-server"]]; + ]; + ] in let head_of repo id = match Build.api ocaml_opam with @@ -525,7 +524,7 @@ let mirage ?app ?notify:channels ~sched ~staging_auth () = Current.all @@ (List.map build_unikernel [ mirage, "mirage-www", [ unikernel "Dockerfile" ~target:"hvt" ["EXTRA_FLAGS=--tls=true --metrics --separate-networks"] ["master", "www"]; - unikernel "Dockerfile" ~target:"xen" ["EXTRA_FLAGS=--tls=true"] []; (* (no deployments) *) + unikernel "Dockerfile" ~target:"xen" ["EXTRA_FLAGS=--tls=true"] []; (* (no deployments) *) unikernel "Dockerfile" ~target:"hvt" ["EXTRA_FLAGS=--tls=true --metrics --separate-networks"] ["next", "next"]; ]; ] @ List.map build_docker [ From bb4b245c1c13216e31639a58347a6d4cb737bffb Mon Sep 17 00:00:00 2001 From: benmandrew Date: Mon, 12 Jun 2023 15:03:54 +0200 Subject: [PATCH 09/10] Document slack_channel --- src/slack_channel.mli | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/src/slack_channel.mli b/src/slack_channel.mli index 4103fb6..396ae1f 100644 --- a/src/slack_channel.mli +++ b/src/slack_channel.mli @@ -1,9 +1,43 @@ type mode = All | Failure (** The condition on which we send a Slack message *) - type repositories = All_repos | Some_repos of string list +(** The set of repos that we send Slack messages for *) type t = { uri : Current_slack.channel; mode : mode; repositories : repositories } val parse_json : string -> t list +(** [parse_json s] parses the JSON string [s], the format of which is a list of objects with fields: + + - [uri], the URI endpoint for the Slack application, of the form + ["https://hooks.slack.com/services/***/***/***"] + - [mode], which is the condition on which we send a Slack message. + ["all"] corresponds to [All], ["failure"] corresponds to [Failure] + - [repositories], an optional parameter. If it is not present, then + we apply the record to all repositories being deployed. If it is + present, then it must contain a list of repositories, each being + represented as a string of the format ["org/repo"], e.g. + ["ocurrent/ocaml-ci"]. + + Here is an example of a valid JSON string: + {[ + \[ + { + uri:"https://hooks.slack.com/services/***/***/***", + mode:"failure", + repositories:["ocurrent/ocaml-ci", "ocurrent/opam-repo-ci"] + }, + { + uri:"https://hooks.slack.com/services/***/***/***", + mode:"all" + } + \] + ]} + + The first record in the list says that when there is a deploy + failure on the [ocurrent/ocaml-ci] or the [ocurrent/opam-repo-ci] + repos, send a Slack message to the specified URI. + + The second record says that for every repo, for each event on the + deployment of those repos (successes and failures), send a Slack + message to the specified URI. *) From 12ad1a22b30343ea3b65acea6811f975d0caaad5 Mon Sep 17 00:00:00 2001 From: benmandrew Date: Mon, 12 Jun 2023 17:22:18 +0200 Subject: [PATCH 10/10] Add fallback for backwards compatibility (and hide state) --- src/build.ml | 2 +- src/slack_channel.ml | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/build.ml b/src/build.ml index 39d9bf0..19bfb81 100644 --- a/src/build.ml +++ b/src/build.ml @@ -31,7 +31,7 @@ let notify ?channel ~web_ui ~service ~commit ~repo x = | None -> x | Some { Slack_channel.uri; mode; repositories = _ } -> let s = - let+ state = Current.state x + let+ state = Current.state ~hidden:true x and+ commit in match state, mode with | Error (`Msg _), Slack_channel.Failure diff --git a/src/slack_channel.ml b/src/slack_channel.ml index 49fea0c..f02a368 100644 --- a/src/slack_channel.ml +++ b/src/slack_channel.ml @@ -40,5 +40,7 @@ let parse_json s = in try from_string s |> Util.to_list |> List.map read_channel - with ex -> - Fmt.failwith "Failed to parse slack URIs '%S': %a" s Fmt.exn ex + with _ -> + let uri = Current_slack.channel @@ Uri.of_string @@ String.trim s in + [ { uri; mode = All; repositories = All_repos } ] + (* Fmt.failwith "Failed to parse slack URIs '%S': %a" s Fmt.exn e *)