Allow multiple Slack endpoints with finer-grained conditions

deployer.opam

@@ -35,6 +35,7 @@ depends: [
   "current_ssh"
   "ocluster-api"
   "capnp-rpc-unix"
+  "sexplib"
   "fmt"
   "ppx_deriving_yojson"
   "ppx_deriving"

dune-project

@@ -21,6 +21,7 @@
   ocluster-api
   ; Opam dependencies
   capnp-rpc-unix
+  sexplib
   fmt
   ppx_deriving_yojson
   ppx_deriving

src/build.ml

@@ -29,20 +29,28 @@ let head_of ?github repo name =
 let notify ?channel ~web_ui ~service ~commit ~repo x =
   match channel with
   | None -> x
-  | Some channel ->
+  | Some { Slack_channel.uri; mode; repositories = _ } ->
     let s =
-      let+ state = Current.state x
+      let+ state = Current.state ~hidden:true x
       and+ commit in
-      let uri = Github.Api.Commit.uri commit in
-      Fmt.str "@[<h>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 "@[<h>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 uri ~key:("deploy-" ^ service) s;
+          x (* If [x] fails, the whole pipeline should fail too. *)
+        ]
+      )) s
 
 let label l x =
   Current.component "%s" l |>
@@ -58,7 +66,19 @@ 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 send_slack_message ~web_ui ~service ~commit ~repo_name deploy channels =
+    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 ~web_ui ~service ~commit ~repo:repo_name deploy
+        else
+          deploy
+    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
     let root = Current.return ~label:repo_name () in      (* Group by repo in the diagram *)
@@ -72,9 +92,9 @@ 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"
@@ -85,19 +105,19 @@ module Make(T : S.T) = struct
       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
-                 match channel, commit with
-                 | Some channel, Some commit -> notify ~channel ~web_ui ~service ~commit ~repo:repo_name deploy
-                 | _ -> deploy
-               )
-            )
+          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)
 end

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:Slack_channel.t list ->
     web_ui:(string -> Uri.t) ->
     org:org ->
     ?additional_build_args:string list Current.t ->

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)))

src/local.ml

@@ -14,16 +14,26 @@ 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 =
+    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
+
   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 +51,14 @@ let main () config mode app sched staging_password_file repo flavour =
 (* Command-line parsing *)
 open Cmdliner
 
+let slack =
+  Arg.value @@
+  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 +86,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
 

src/main.ml

@@ -16,12 +16,10 @@ let read_first_line path =
   Fun.protect (fun () -> input_line ch)
     ~finally:(fun () -> close_in ch)
 
-let read_channel_uri path =
-  try
-    let uri = read_first_line path in
-    Current_slack.channel (Uri.of_string (String.trim uri))
-  with ex ->
-    Fmt.failwith "Failed to read slack URI from %S: %a" path Fmt.exn ex
+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)
 
 (* Access control policy for Tarides. *)
 let has_role_tarides user role =
@@ -84,18 +82,21 @@ 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 =
+    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 ->
        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
@@ -122,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."

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
@@ -440,19 +440,19 @@ let ocaml_org ?app ?notify:channel ?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
@@ -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,14 +517,14 @@ 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 [
     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 [

src/pipeline.mli

@@ -9,23 +9,23 @@ end
 
 val tarides :
   ?app:Current_github.App.t ->
-  ?notify:Current_slack.channel ->
+  ?notify:Slack_channel.t list ->
   ?filter:(Current_github.Repo_id.t -> bool) ->
   sched:Current_ocluster.Connection.t ->
   staging_auth:(string * string) option ->
   unit -> unit Current.t
 
 val ocaml_org :
   ?app:Current_github.App.t ->
-  ?notify:Current_slack.channel ->
+  ?notify:Slack_channel.t list ->
   ?filter:(Current_github.Repo_id.t -> bool) ->
   sched:Current_ocluster.Connection.t ->
   staging_auth:(string * string) option ->
   unit -> unit Current.t
 
 val mirage :
   ?app:Current_github.App.t ->
-  ?notify:Current_slack.channel ->
+  ?notify:Slack_channel.t list ->
   sched:Current_ocluster.Connection.t ->
   staging_auth:(string * string) option ->
   unit -> unit Current.t