send slack notifications with web api if token is configured

Adds a way to send notifications without per-channel webhooks. The
sending mechanism will authenticate with a bearer token that is
valid for any channel that the bot has been added to. The channel
is specified in a new `channel` field in the notification payload.

A note on error handling: for web API requests, Slack always
returns a 200 response and communicates the error message in the
response body, so checking for status alone isn't enough.

Author: yasunariw

lib/api.ml

@@ -9,5 +9,5 @@ module type Github = sig
 end
 
 module type Slack = sig
-  val send_notification : chan:string -> msg:post_message_req -> url:string -> (unit, string) Result.t Lwt.t
+  val send_notification : ctx:Context.t -> msg:post_message_req -> (unit, string) Result.t Lwt.t
 end

lib/api_local.ml

@@ -21,18 +21,18 @@ module Github : Api.Github = struct
 end
 
 module Slack : Api.Slack = struct
-  let send_notification ~chan ~msg ~url:_ =
+  let send_notification ~ctx:_ ~msg =
     let json = msg |> Slack_j.string_of_post_message_req |> Yojson.Basic.from_string |> Yojson.Basic.pretty_to_string in
-    Stdio.printf "will notify #%s\n" chan;
+    Stdio.printf "will notify #%s\n" msg.channel;
     Stdio.printf "%s\n" json;
     Lwt.return @@ Ok ()
 end
 
 module Slack_simple : Api.Slack = struct
   let log = Log.from "slack"
 
-  let send_notification ~chan ~msg ~url:_ =
-    log#info "will notify %s%s" chan
+  let send_notification ~ctx:_ ~(msg : Slack_t.post_message_req) =
+    log#info "will notify %s%s" msg.channel
       ( match msg.Slack_t.text with
       | None -> ""
       | Some s -> Printf.sprintf " with %S" s
@@ -43,9 +43,9 @@ end
 module Slack_json : Api.Slack = struct
   let log = Log.from "slack"
 
-  let send_notification ~chan ~msg ~url:_ =
+  let send_notification ~ctx:_ ~(msg : Slack_t.post_message_req) =
+    log#info "will notify %s" msg.channel;
     let json = Slack_j.string_of_post_message_req msg in
-    log#info "will notify %s" chan;
     let url = Uri.of_string "https://api.slack.com/docs/messages/builder" in
     let url = Uri.add_query_param url ("msg", [ json ]) in
     log#info "%s" (Uri.to_string url);

lib/api_remote.ml

@@ -50,12 +50,35 @@ end
 module Slack : Api.Slack = struct
   let log = Log.from "slack"
 
-  let send_notification ~chan ~msg ~url =
-    let data = Slack_j.string_of_post_message_req msg in
-    let body = `Raw ("application/json", data) in
-    log#info "sending to %s : %s" chan data;
-    match%lwt http_request ~body `POST url with
-    | Ok _ -> Lwt.return @@ Ok ()
-    | Error e ->
-      Lwt.return @@ fmt_error "error while querying remote: %s\nfailed to send Slack notification to %s" e url
+  let bearer_token_header access_token = sprintf "Authorization: Bearer %s" (Uri.pct_decode access_token)
+
+  (** `send_notification ctx msg` notifies `msg.channel` with the payload `msg`;
+      uses web API with access token if available, or with webhook otherwise *)
+  let send_notification ~(ctx : Context.t) ~(msg : Slack_t.post_message_req) =
+    log#info "sending to %s" msg.channel;
+    let build_error e = fmt_error "%s\nfailed to send Slack notification" e in
+    let build_query_error url e = build_error @@ sprintf "error while querying %s: %s" url e in
+    let secrets = Context.get_secrets_exn ctx in
+    let headers, url, webhook_mode =
+      match secrets.slack_access_token with
+      | Some access_token -> [ bearer_token_header access_token ], Some "https://slack.com/api/chat.postMessage", false
+      | None -> [], Context.hook_of_channel ctx msg.channel, true
+    in
+    match url with
+    | None -> Lwt.return @@ build_error @@ sprintf "no token or webhook configured to notify channel %s" msg.channel
+    | Some url ->
+      let data = Slack_j.string_of_post_message_req msg in
+      let body = `Raw ("application/json", data) in
+      log#info "data: %s" data;
+      ( match%lwt http_request ~body ~headers `POST url with
+      (* error detection in response: slack uses status codes for webhooks versus a 200 code w/ `error` field for web api *)
+      | Ok s ->
+        if webhook_mode then Lwt.return @@ Ok ()
+        else (
+          let res = Slack_j.post_message_res_of_string s in
+          if res.ok then Lwt.return @@ Ok ()
+          else Lwt.return @@ build_query_error url (Option.value ~default:"an unknown error occurred" res.error)
+        )
+      | Error e -> Lwt.return @@ build_query_error url e
+      )
 end

lib/config.atd

@@ -39,7 +39,12 @@ type webhook = {
 (* This is the structure of the secrets file which stores sensitive information, and
    shouldn't be checked into version control.  *)
 type secrets = {
-  slack_hooks : webhook list;
-  ?gh_token : string option; (* GitHub personal access token, if repo access requires it *)
-  ?gh_hook_token : string option; (* GitHub webhook token to secure the webhook *)
+  (* GitHub personal access token, if repo access requires it *)
+  ?gh_token : string nullable;
+  (* GitHub webhook token to secure the webhook *)
+  ?gh_hook_token : string nullable;
+  (* list of Slack webhook & channel name pairs *)
+  ~slack_hooks <ocaml default="[]"> : webhook list;
+  (* Slack bot token obtained via OAuth, enabling message posting to the workspace *)
+  ?slack_access_token : string nullable;
 }

lib/slack.atd

@@ -54,7 +54,14 @@ type message_block = [
 ] <json adapter.ocaml="Atdgen_runtime.Json_adapter.Type_field">
 
 type post_message_req = {
+  channel: string;
   ?text: string nullable;
   ?attachments: message_attachment list nullable;
   ?blocks: message_block list nullable;
 }
+
+type post_message_res = {
+  ok: bool;
+  ?channel: string nullable;
+  ?error: string nullable;
+}