Enable link unfurling for Slack messages (with commit link support)

README.md

@@ -40,6 +40,14 @@ Run the `_build/default/src/monorobot.exe` binary. The following commands are su
         - **Incoming Webhooks:** To use [incoming webhooks](https://api.slack.com/messaging/webhooks), enable them in your app dashboard and create one for each channel you want to notify. Store them in the `slack_hooks` field of your secrets file. If you decide to notify additional channels later, you will need to update the secrets file with the new webhooks and restart the server.
 
 
+### Link Unfurling
+
+You can configure Monorobot to [unfurl GitHub links](https://api.slack.com/reference/messaging/link-unfurling) in Slack messages. Currently, commit links are supported.
+
+1. Give your app `links:read` and `links:write` [permissions](https://api.slack.com/apps).
+1. Configure your app to [support the Events API](https://api.slack.com/events-api#prepare). During the [url verification handshake](https://api.slack.com/events-api#the-events-api__subscribing-to-event-types__events-api-request-urls__request-url-configuration--verification__url-verification-handshake), you should tell Slack to direct event notifications to `<server_domain>/slack/events`. Ensure the server is running before triggering the handshake.
+1. [Register the GitHub domains](https://api.slack.com/reference/messaging/link-unfurling#configuring_domains) you want to support.
+
 ### Documentation
 
 The bot expects two configuration files to be present.

documentation/secret_docs.md

@@ -19,6 +19,7 @@ A secrets file stores sensitive information. Unlike the repository configuration
 | `gh_hook_token` | specify to ensure the bot only receives GitHub notifications from pre-approved repositories | Yes | - |
 | `slack_access_token` | slack bot access token to enable message posting to the workspace | Yes | try to use webhooks defined in `slack_hooks` instead |
 | `slack_hooks` | list of channel names and their corresponding webhook endpoint | Yes | try to use token defined in `slack_access_token` instead |
+| `slack_signing_secret` | specify to verify incoming slack requests | Yes | - |
 
 Note that either `slack_access_token` or `slack_hooks` must be defined.
 

lib/action.ml

@@ -232,4 +232,42 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     | Context.Context_error msg ->
       log#error "%s" msg;
       Lwt.return_unit
+
+  let process_link_shared_event (ctx : Context.t) (event : Slack_t.link_shared_event) =
+    let process link =
+      match Github.gh_link_of_string link with
+      | None -> Lwt.return_none
+      | Some gh_link ->
+      match gh_link with
+      | Commit (repo, sha) ->
+        ( match%lwt Github_api.get_api_commit ~ctx ~repo ~sha with
+        | Error _ -> Lwt.return_none
+        | Ok commit -> Lwt.return_some @@ (link, Slack_message.populate_commit repo commit)
+        )
+    in
+    if List.length event.links > 2 then Lwt.return "ignored: more than two links present"
+    else begin
+      let links = List.map event.links ~f:(fun l -> l.url) in
+      let%lwt unfurls = List.map links ~f:process |> Lwt.all |> Lwt.map List.filter_opt |> Lwt.map StringMap.of_list in
+      if Map.is_empty unfurls then Lwt.return "ignored: no links to unfurl"
+      else begin
+        let req : Slack_j.chat_unfurl_req = { channel = event.channel; ts = event.message_ts; unfurls } in
+        match%lwt Slack_api.send_chat_unfurl ~ctx req with
+        | Ok () -> Lwt.return "ok"
+        | Error e ->
+          log#error "%s" e;
+          Lwt.return "ignored: failed to unfurl links"
+      end
+    end
+
+  let process_slack_event (ctx : Context.t) headers body =
+    let secrets = Context.get_secrets_exn ctx in
+    match Slack_j.event_notification_of_string body with
+    | Url_verification payload -> Lwt.return payload.challenge
+    | Event_callback notification ->
+    match Slack.validate_signature ?signing_key:secrets.slack_signing_secret ~headers body with
+    | Error e -> action_error e
+    | Ok () ->
+    match notification.event with
+    | Link_shared event -> process_link_shared_event ctx event
 end

lib/api.ml

@@ -10,4 +10,6 @@ end
 
 module type Slack = sig
   val send_notification : ctx:Context.t -> msg:post_message_req -> (unit, string) Result.t Lwt.t
+
+  val send_chat_unfurl : ctx:Context.t -> chat_unfurl_req -> (unit, string) Result.t Lwt.t
 end

lib/api_local.ml

@@ -20,7 +20,15 @@ module Github : Api.Github = struct
     | Ok file -> Lwt.return @@ Ok (Github_j.api_commit_of_string file)
 end
 
+module Slack_base : Api.Slack = struct
+  let send_notification ~ctx:_ ~msg:_ = Lwt.return @@ Error "undefined for local setup"
+
+  let send_chat_unfurl ~ctx:_ _ = Lwt.return @@ Error "undefined for local setup"
+end
+
 module Slack : Api.Slack = struct
+  include Slack_base
+
   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" msg.channel;
@@ -29,6 +37,8 @@ module Slack : Api.Slack = struct
 end
 
 module Slack_simple : Api.Slack = struct
+  include Slack_base
+
   let log = Log.from "slack"
 
   let send_notification ~ctx:_ ~(msg : Slack_t.post_message_req) =
@@ -41,6 +51,8 @@ module Slack_simple : Api.Slack = struct
 end
 
 module Slack_json : Api.Slack = struct
+  include Slack_base
+
   let log = Log.from "slack"
 
   let send_notification ~ctx:_ ~(msg : Slack_t.post_message_req) =

lib/api_remote.ml

@@ -81,4 +81,26 @@ module Slack : Api.Slack = struct
         )
       | Error e -> Lwt.return @@ build_query_error url e
       )
+
+  let send_chat_unfurl ~(ctx : Context.t) req =
+    log#info "unfurling Slack links";
+    let secrets = Context.get_secrets_exn ctx in
+    match secrets.slack_access_token with
+    | None -> Lwt.return @@ fmt_error "failed to retrieve Slack access token"
+    | Some access_token ->
+      let data = Slack_j.string_of_chat_unfurl_req req in
+      log#info "%s" data;
+      let url = "https://slack.com/api/chat.unfurl" in
+      let headers = [ bearer_token_header access_token ] in
+      let body = `Raw ("application/json", data) in
+      ( match%lwt http_request ~body ~headers `POST url with
+      | Ok s ->
+        let res = Slack_j.chat_unfurl_res_of_string s in
+        if res.ok then Lwt.return @@ Ok ()
+        else (
+          let msg = Option.value ~default:"an unknown error occurred" res.error in
+          Lwt.return @@ fmt_error "%s\nfailed to unfurl Slack links" msg
+        )
+      | Error e -> Lwt.return @@ fmt_error "error while querying %s: %s\nfailed to unfurl Slack links" url e
+      )
 end

lib/colors.ml

@@ -0,0 +1,13 @@
+(* https://styleguide.github.com/primer/utilities/colors/#background-colors *)
+
+let gray = "#f6f8fa"
+
+let blue = "#0366d6"
+
+let yellow = "#ffd33d"
+
+let red = "#d73a49"
+
+let green = "#28a745"
+
+let purple = "#6f42c1"

lib/common.ml

@@ -35,3 +35,12 @@ let get_local_file path = try Ok (Std.input_file path) with exn -> fmt_error "%s
 let write_to_local_file ~data path =
   try Ok (Devkit.Files.save_as path (fun oc -> Stdio.Out_channel.fprintf oc "%s" data))
   with exn -> fmt_error "%s" (Exn.to_string exn)
+
+let longest_common_prefix xs =
+  match xs with
+  | [] -> ""
+  | [ x ] -> x
+  | x :: _ -> String.sub x ~pos:0 ~len:(Stre.common_prefix x (List.sort xs ~compare:String.compare |> List.last_exn))
+
+let sign_string_sha256 ~key ~basestring =
+  Cstruct.of_string basestring |> Nocrypto.Hash.SHA256.hmac ~key:(Cstruct.of_string key) |> Hex.of_cstruct |> Hex.show

lib/config.atd

@@ -47,4 +47,6 @@ type secrets = {
   ~slack_hooks <ocaml default="[]"> : webhook list;
   (* Slack bot token obtained via OAuth, enabling message posting to the workspace *)
   ?slack_access_token : string nullable;
+ (* Slack uses this secret to sign requests; provide to verify incoming Slack requests *)
+  ?slack_signing_secret : string nullable;
 }

lib/github.atd

@@ -24,6 +24,9 @@ type commit = {
 type github_user = {
   login: string;
   id: int;
+  url: string;
+  html_url: string;
+  avatar_url: string;
 }
 
 type repository = {
@@ -218,12 +221,19 @@ type file = {
   blob_url <ocaml name="url"> : string;
 }
 
+type api_commit_stats = {
+  total: int;
+  additions: int;
+  deletions: int;
+}
+
 type api_commit = {
   sha: commit_hash;
   commit: inner_commit;
   html_url <ocaml name="url"> : string;
   author: github_user;
   files: file list;
+  stats: api_commit_stats;
 }
 
 type commit_comment_notification = {

lib/github.ml

@@ -86,3 +86,50 @@ let parse_exn ~secret headers body =
   | "commit_comment" -> Commit_comment (commit_comment_notification_of_string body)
   | "member" | "create" | "delete" | "release" -> Event (event_notification_of_string body)
   | event -> failwith @@ sprintf "unsupported event : %s" event
+
+type gh_link = Commit of repository * commit_hash
+
+(** `gh_link_of_string s` parses a URL string `s` to try to match a supported
+    GitHub link type, generating repository endpoints if necessary *)
+let gh_link_of_string url_str =
+  let url = Uri.of_string url_str in
+  let path = Uri.path url in
+  let gh_com_html_base owner name = sprintf "https://github.com/%s/%s" owner name in
+  let gh_com_api_base owner name = sprintf "https://api.github.com/repos/%s/%s" owner name in
+  let custom_html_base ?(scheme = "https") base owner name = sprintf "%s://%s/%s/%s" scheme base owner name in
+  let custom_api_base ?(scheme = "https") base owner name =
+    sprintf "%s://%s/api/v3/repos/%s/%s" scheme base owner name
+  in
+  let re = Re.Str.regexp {|^\(.*\)/\(.+\)/\(.+\)/\(commit\)/\([a-z0-9]+\)/?$|} in
+  match Uri.host url with
+  | None -> None
+  | Some host ->
+  match Re.Str.string_match re path 0 with
+  | false -> None
+  | true ->
+    let base = host ^ Re.Str.matched_group 1 path in
+    let owner = Re.Str.matched_group 2 path in
+    let name = Re.Str.matched_group 3 path in
+    let link_type = Re.Str.matched_group 4 path in
+    let item = Re.Str.matched_group 5 path in
+    let scheme = Uri.scheme url in
+    let html_base, api_base =
+      if String.is_suffix base ~suffix:"github.com" then gh_com_html_base owner name, gh_com_api_base owner name
+      else custom_html_base ?scheme base owner name, custom_api_base ?scheme base owner name
+    in
+    let repo =
+      {
+        name;
+        full_name = sprintf "%s/%s" owner name;
+        url = html_base;
+        commits_url = sprintf "%s/commits{/sha}" api_base;
+        contents_url = sprintf "%s/contents/{+path}" api_base;
+      }
+    in
+    begin
+      try
+        match link_type with
+        | "commit" -> Some (Commit (repo, item))
+        | _ -> None
+      with _ -> None
+    end

lib/slack.atd

@@ -1,3 +1,5 @@
+type 'v map_as_object <ocaml from="State"> = abstract
+
 type message_field = {
   ?title: string nullable;
   value: string;
@@ -65,3 +67,53 @@ type post_message_res = {
   ?channel: string nullable;
   ?error: string nullable;
 }
+
+type link_shared_link = {
+  domain: string;
+  url: string;
+}
+
+type link_shared_event = {
+  channel: string;
+  is_bot_user_member: bool;
+  user: string;
+  message_ts: string;
+  ?thread_ts: string option;
+  links: link_shared_link list;
+}
+
+type event = [
+| Link_shared <json name="link_shared"> of link_shared_event
+] <ocaml repr="classic"> <json adapter.ocaml="Atdgen_runtime.Json_adapter.Type_field">
+
+type event_callback_notification = {
+  token: string;
+  team_id: string;
+  api_app_id: string;
+  event: event;
+  event_id: string;
+  event_time: int;
+}
+
+type url_verification_notification = {
+  token: string;
+  challenge: string;
+}
+
+type event_notification = [
+| Event_callback <json name="event_callback"> of event_callback_notification
+| Url_verification <json name="url_verification"> of url_verification_notification
+] <ocaml repr="classic"> <json adapter.ocaml="Atdgen_runtime.Json_adapter.Type_field">
+
+type unfurl = message_attachment
+
+type chat_unfurl_req = {
+  channel: string;
+  ts: string;
+  unfurls: unfurl map_as_object;
+}
+
+type chat_unfurl_res = {
+  ok: bool;
+  ?error: string option;
+}

lib/slack.ml

@@ -1,6 +1,5 @@
 open Printf
 open Base
-open Devkit
 open Common
 open Github_j
 open Slack_j
@@ -33,6 +32,8 @@ let show_labels = function
   | (labels : label list) ->
     Some (sprintf "Labels: %s" @@ String.concat ~sep:", " (List.map ~f:(fun x -> x.name) labels))
 
+let pluralize name num suffix = if num = 1 then sprintf "%s" name else String.concat [ name; suffix ]
+
 let generate_pull_request_notification notification channel =
   let { action; number; sender; pull_request; repository } = notification in
   let ({ body; title; html_url; labels; _ } : pull_request) = pull_request in
@@ -302,8 +303,7 @@ let generate_status_notification (cfg : Config_t.config) (notification : status_
           [ main ]
         | _ -> notification_branches
       in
-      let pluralize s = if Int.equal (List.length branches) 1 then s else sprintf "%ses" s in
-      [ sprintf "*%s*: %s" (pluralize "Branch") (String.concat ~sep:", " branches) ]
+      [ sprintf "*%s*: %s" (pluralize "Branch" (List.length branches) "es") (String.concat ~sep:", " branches) ]
   in
   let summary =
     match target_url with
@@ -358,3 +358,17 @@ let generate_commit_comment_notification api_commit notification channel =
     }
   in
   { channel; text = None; attachments = Some [ attachment ]; blocks = None }
+
+let validate_signature ?(version = "v0") ?signing_key ~headers body =
+  match signing_key with
+  | None -> Ok ()
+  | Some key ->
+  match List.Assoc.find headers "x-slack-signature" ~equal:String.equal with
+  | None -> Error "unable to find header X-Slack-Signature"
+  | Some signature ->
+  match List.Assoc.find headers "x-slack-request-timestamp" ~equal:String.equal with
+  | None -> Error "unable to find header X-Slack-Request-Timestamp"
+  | Some timestamp ->
+    let basestring = Printf.sprintf "%s:%s:%s" version timestamp body in
+    let expected_signature = Printf.sprintf "%s=%s" version (Common.sign_string_sha256 ~key ~basestring) in
+    if String.equal expected_signature signature then Ok () else Error "signatures don't match"