add types to slack channels

lib/action.ml

@@ -31,7 +31,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
           | None -> ()
           | Some email ->
             let username = canonicalize_email_username email in
-            Stringtbl.replace username_to_slack_id_tbl username user.id)
+            Stringtbl.replace username_to_slack_id_tbl username (Slack_channel.string_val user.id))
         res.members;
       Lwt.return_unit
 
@@ -65,21 +65,22 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
            let matched_channel_names =
              Github.modified_files_of_commit commit
              |> List.filter_map (Rule.Prefix.match_rules ~rules)
-             |> List.sort_uniq String.compare
+             |> List.sort_uniq Slack_channel.compare
            in
            let channel_names =
              if matched_channel_names = [] && commit.distinct then default else matched_channel_names
            in
-           List.map (fun n -> n, commit) channel_names)
+           List.map (fun c -> Slack_channel.string_val c, commit) channel_names)
     |> StringMap.of_list_multi
     |> StringMap.map (fun commits -> { n with commits })
     |> StringMap.to_list
+    |> List.map (fun (c, n) -> Slack_channel.to_channel c, n)
 
   let partition_label (cfg : Config_t.config) (labels : label list) =
     let default = cfg.label_rules.default_channel in
     let rules = cfg.label_rules.rules in
-    labels |> List.concat_map (Rule.Label.match_rules ~rules) |> List.sort_uniq String.compare |> fun channel_names ->
-    if channel_names = [] then Stdlib.Option.to_list default else channel_names
+    labels |> List.concat_map (Rule.Label.match_rules ~rules) |> List.sort_uniq Slack_channel.compare
+    |> fun channel_names -> if channel_names = [] then Stdlib.Option.to_list default else channel_names
 
   let partition_pr cfg (n : pr_notification) =
     match n.action with
@@ -124,7 +125,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     let matched_channel_names =
       List.map (fun f -> f.filename) files
       |> List.filter_map (Rule.Prefix.match_rules ~rules)
-      |> List.sort_uniq String.compare
+      |> List.sort_uniq Slack_channel.compare
     in
     if matched_channel_names = [] then default else matched_channel_names
 

lib/api_local.ml

@@ -64,7 +64,7 @@ module Slack : Api.Slack = struct
 
   let lookup_user ?cache:_ ~ctx:_ ~(cfg : Config_t.config) ~email () =
     let email = List.assoc_opt email cfg.user_mappings |> Option.default email in
-    let mock_user = { Slack_t.id = sprintf "id[%s]" email; profile = { email = Some email } } in
+    let mock_user = { Slack_t.id = Slack_channel.to_user (sprintf "id[%s]" email); profile = { email = Some email } } in
     let mock_response = { Slack_t.user = mock_user } in
     Lwt.return @@ Ok mock_response
 

lib/config.atd

@@ -2,6 +2,7 @@ type status_rule <ocaml from="Rule"> = abstract
 type prefix_rule <ocaml from="Rule"> = abstract
 type label_rule <ocaml from="Rule"> = abstract
 type project_owners_rule <ocaml from="Rule"> = abstract
+type channel = string wrap <ocaml t="Slack_channel.t" wrap="Slack_channel.to_channel" unwrap="Slack_channel.string_val">
 
 (* This type of rule is used for CI build notifications. *)
 type status_rules = {
@@ -12,14 +13,14 @@ type status_rules = {
 (* This type of rule is used for events that must be routed based on the
   files they are related to. *)
 type prefix_rules = {
-  ?default_channel: string nullable; (* if none of the rules is matching *)
+  ?default_channel: channel nullable; (* if none of the rules is matching *)
   ~filter_main_branch <ocaml default="false">: bool;
   rules: prefix_rule list;
 }
 
 (* This type of rule is used for PR and issue notifications. *)
 type label_rules = {
-  ?default_channel: string nullable; (* if none of the rules is matching *)
+  ?default_channel: channel nullable; (* if none of the rules is matching *)
   rules: label_rule list;
 }
 

lib/rule.atd

@@ -1,4 +1,5 @@
 type regex = string wrap <ocaml module="Common.Re2">
+type channel = string wrap <ocaml t="Slack_channel.t" wrap="Slack_channel.to_channel" unwrap="Slack_channel.string_val">
 
 (* Text fields from the GitHub payload that can be used in a condition *)
 type comparable_field = [
@@ -71,7 +72,7 @@ type prefix_rule = {
   ?allow <json name="match"> : string list nullable;
   ?ignore : string list nullable;
   ?branch_filters : string list nullable;
-  channel_name <json name="channel"> : string;
+  channel_name <json name="channel"> : channel;
 } <json adapter.ocaml="Atd_adapters.Branch_filters_adapter">
 
 (* A payload matches a label rule with a channel name if absent from the ignore list
@@ -80,7 +81,7 @@ type prefix_rule = {
 type label_rule = {
   ?allow <json name="match"> : string list nullable;
   ?ignore : string list nullable;
-  channel_name <json name="channel"> : string;
+  channel_name <json name="channel"> : channel;
 }
 
 (* Requests reviews from [owners] if a PR is labeled with [label]. Owner format:

lib/rule.ml

@@ -89,7 +89,7 @@ module Prefix = struct
              | Some l, Some [] -> Printf.printf "  %s" (show_match l)
              | Some l, Some i -> Printf.printf "  %s and not %s" (show_match l) (show_match i)
            end;
-           Printf.printf " -> #%s\n%!" rule.channel_name)
+           Printf.printf " -> #%s\n%!" (Slack_channel.string_val rule.channel_name))
 end
 
 module Label = struct
@@ -109,7 +109,7 @@ module Label = struct
       | None | Some [] -> Some rule.channel_name
       | Some allow_list -> if List.exists label_name_equal allow_list then Some rule.channel_name else None
     in
-    rules |> List.filter_map match_rule |> List.sort_uniq String.compare
+    rules |> List.filter_map match_rule |> List.sort_uniq Slack_channel.compare
 
   let print_label_routing rules =
     let show_match l = String.concat " or " l in
@@ -124,7 +124,7 @@ module Label = struct
              | Some l, Some [] -> Printf.printf "  %s" (show_match l)
              | Some l, Some i -> Printf.printf "  %s and not %s" (show_match l) (show_match i)
            end;
-           Printf.printf " -> #%s\n%!" rule.channel_name)
+           Printf.printf " -> #%s\n%!" (Slack_channel.string_val rule.channel_name))
 end
 
 module Project_owners = struct

lib/slack.atd

@@ -1,4 +1,5 @@
 type 'v map_as_object <ocaml from="Common"> = abstract
+type slack_user_id = string wrap <ocaml t="Slack_channel.t" wrap="Slack_channel.to_user" unwrap="Slack_channel.string_val">
 
 type message_field = {
   ?title: string nullable;
@@ -79,7 +80,7 @@ type profile = {
 }
 
 type user = {
-  id: string;
+  id: slack_user_id;
   profile: profile
 }
 

lib/slack.ml

@@ -64,6 +64,7 @@ let format_attachments ~slack_match_func ~footer ~body =
   Option.map (fun t -> markdown_text_attachment ~footer t |> List.map format_mention_in_markdown) body
 
 let generate_pull_request_notification ~slack_match_func notification channel =
+  let channel = Slack_channel.string_val channel in
   let { action; number; sender; pull_request; repository } = notification in
   let ({ body; title; html_url; labels; merged; _ } : pull_request) = pull_request in
   let action, body =
@@ -84,6 +85,7 @@ let generate_pull_request_notification ~slack_match_func notification channel =
   make_message ~text:summary ?attachments:(format_attachments ~slack_match_func ~footer:None ~body) ~channel ()
 
 let generate_pr_review_notification ~slack_match_func notification channel =
+  let channel = Slack_channel.string_val channel in
   let { action; sender; pull_request; review; repository } = notification in
   let ({ number; title; html_url; _ } : pull_request) = pull_request in
   let action_str =
@@ -132,6 +134,7 @@ let generate_pr_review_comment_notification ~slack_match_func notification chann
     ~channel ()
 
 let generate_issue_notification ~slack_match_func notification channel =
+  let channel = Slack_channel.string_val channel in
   let ({ action; sender; issue; repository } : issue_notification) = notification in
   let { number; body; title; html_url; labels; _ } = issue in
   let action, body =
@@ -153,6 +156,7 @@ let generate_issue_notification ~slack_match_func notification channel =
   make_message ~text:summary ?attachments:(format_attachments ~slack_match_func ~footer:None ~body) ~channel ()
 
 let generate_issue_comment_notification ~slack_match_func notification channel =
+  let channel = Slack_channel.string_val channel in
   let { action; issue; sender; comment; repository } = notification in
   let { number; title; _ } = issue in
   let action_str =
@@ -202,6 +206,7 @@ let pp_list_with_previews ~pp_item list =
   else List.map pp_item list
 
 let generate_push_notification notification channel =
+  let channel = Slack_channel.string_val channel in
   let { sender; pusher; created; deleted; forced; compare; commits; repository; _ } = notification in
   let show_descriptive_title_min_commits = 4 in
   let branch_name = Github.commits_branch_of_ref notification.ref in
@@ -267,9 +272,9 @@ let generate_status_notification (cfg : Config_t.config) (notification : status_
     [
       (* if we have a DM notification, we don't need to repeat the commit message and author because
          the user receiving the message is already the author of that commit. Users handles start with U *)
-      (match Devkit.Stre.starts_with channel "U" with
-      | true -> sprintf "*Commit*: `<%s|%s>`" html_url (git_short_sha_hash sha)
-      | false ->
+      (match channel with
+      | Slack_channel.User _ -> sprintf "*Commit*: `<%s|%s>`" html_url (git_short_sha_hash sha)
+      | Channel _ ->
         sprintf "*Commit*: `<%s|%s>` %s - %s" html_url (git_short_sha_hash sha) (first_line message)
           ((* If the author's email is not associated with a github account the author will be missing.
                Using the information from the commit instead, which should be equivalent. *)
@@ -327,9 +332,10 @@ let generate_status_notification (cfg : Config_t.config) (notification : status_
   let attachment =
     { empty_attachments with mrkdwn_in = Some [ "fields"; "text" ]; color = Some color_info; text = Some msg }
   in
-  make_message ~text:summary ~attachments:[ attachment ] ~channel ()
+  make_message ~text:summary ~attachments:[ attachment ] ~channel:(Slack_channel.string_val channel) ()
 
 let generate_commit_comment_notification ~slack_match_func api_commit notification channel =
+  let channel = Slack_channel.string_val channel in
   let { commit; _ } = api_commit in
   let { sender; comment; repository; _ } = notification in
   let commit_id =

lib/slack_channel.ml

@@ -0,0 +1,17 @@
+type t =
+  | User of string
+  | Channel of string
+
+let to_channel c = Channel c
+let to_user u = User u
+
+let string_val c =
+  match c with
+  | Channel s -> s
+  | User s -> s
+
+let compare c1 c2 =
+  match c1, c2 with
+  | Channel c1, Channel c2 -> String.compare c1 c2
+  | User u1, User u2 -> String.compare u1 u2
+  | _ -> failwith "Cannot compare channels of different types"

test/slack_payloads.expected

@@ -485,7 +485,7 @@ will notify #id[[email protected]]
       "fallback": null,
       "mrkdwn_in": [ "fields", "text" ],
       "color": "danger",
-      "text": "*Commit*: `<https://github.com/ahrefs/monorepo/commit/7e0a933e9c71b4ca107680ca958ca1888d5e479b|7e0a933e>` c1 message - author\n*Branch*: author/patches/js-storage"
+      "text": "*Commit*: `<https://github.com/ahrefs/monorepo/commit/7e0a933e9c71b4ca107680ca958ca1888d5e479b|7e0a933e>`\n*Branch*: author/patches/js-storage"
     }
   ],
   "unfurl_links": false
@@ -529,7 +529,7 @@ will notify #id[[email protected]]
       "fallback": null,
       "mrkdwn_in": [ "fields", "text" ],
       "color": "danger",
-      "text": "*Commit*: `<https://github.com/ahrefs/monorepo/commit/0d95302addd66c1816bce1b1d495ed1c93ccd478|0d95302a>` Update README.md - Khady\n*Branch*: master"
+      "text": "*Commit*: `<https://github.com/ahrefs/monorepo/commit/0d95302addd66c1816bce1b1d495ed1c93ccd478|0d95302a>`\n*Branch*: master"
     }
   ],
   "unfurl_links": false