refactor prefix + label rule checking

yasunariw · yasunariw · commit 98869dada1ab · 2020-12-20T00:59:42.000+08:00
The config file now distinguishes between undefined lists and empty
lists. This applies to `allowed_pipelines` in the main config, and
`allow` and `ignore` in the prefix/label rules. Now, an undefined field
is interpreted as a global whitelist, and an empty list is interpreted
as a global blacklist.
diff --git a/lib/action.ml b/lib/action.ml
@@ -2,65 +2,46 @@ open Devkit
 open Base
 open Slack
 open Config_t
-open Rule_t
 open Config
 open Common
 open Github_j
 
+exception Action_error of string
+
+let action_error msg = raise (Action_error msg)
+
 let log = Log.from "action"
 
+module Github_api = Api_remote.Github
+
 module Action = struct
   let partition_push cfg n =
-    let group_commit chan l =
-      List.filter_map l ~f:(fun (chan', commit) ->
-        match String.equal chan chan' with
-        | false -> None
-        | true -> Some commit)
-    in
-    let default commit =
-      Option.value_map cfg.prefix_rules.default_channel ~default:[] ~f:(fun webhook -> [ webhook, commit ])
-    in
+    let default = Option.to_list cfg.prefix_rules.default_channel in
     let rules = cfg.prefix_rules.rules in
-    let channels =
-      n.commits
-      |> List.filter ~f:(fun c -> c.distinct)
-      |> List.filter ~f:(fun c ->
-           let branch = Github.commits_branch_of_ref n.ref in
-           let skip = Github.is_main_merge_message ~msg:c.message ~branch cfg in
-           if skip then log#info "main branch merge, ignoring %s: %s" c.id (first_line c.message);
-           not skip)
-      |> List.map ~f:(fun commit ->
-           match Rule.Prefix.filter_push rules commit with
-           | [] -> default commit
-           | l -> l)
-      |> List.concat
-    in
-    let prefix_chans =
-      let chans =
-        Option.to_list cfg.prefix_rules.default_channel
-        @ List.map rules ~f:(fun (rule : prefix_rule) -> rule.channel_name)
-      in
-      List.dedup_and_sort chans ~compare:String.compare
-    in
-    List.filter_map prefix_chans ~f:(fun chan ->
-      match group_commit chan channels with
-      | [] -> None
-      | l -> Some (chan, { n with commits = l }))
-
-  let partition_label cfg (labels : Github_j.label list) =
-    let default = Option.to_list cfg.label_rules.default_channel in
-    match labels with
-    | [] -> default
-    | labels ->
-      let rules = cfg.label_rules.rules in
-      let channels =
-        labels
-        |> List.map ~f:(fun (label : Github_j.label) ->
-             match Rule.Label.filter_label rules label with
-             | [] -> default
-             | l -> l)
-      in
-      List.dedup_and_sort ~compare:String.compare (List.concat channels)
+    n.commits
+    |> List.filter ~f:(fun c -> c.distinct)
+    |> List.filter ~f:(fun c ->
+         let branch = Github.commits_branch_of_ref n.ref in
+         let skip = Github.is_main_merge_message ~msg:c.message ~branch cfg in
+         if skip then log#info "main branch merge, ignoring %s: %s" c.id (first_line c.message);
+         not skip)
+    |> List.concat_map ~f:(fun commit ->
+         let matched_channel_names =
+           Github.modified_files_of_commit commit
+           |> List.filter_map ~f:(Rule.Prefix.match_rules ~rules)
+           |> List.dedup_and_sort ~compare:String.compare
+         in
+         let channel_names = if List.is_empty matched_channel_names then default else matched_channel_names in
+         List.map channel_names ~f:(fun n -> n, commit))
+    |> Map.of_alist_multi (module String)
+    |> Map.map ~f:(fun commits -> { n with commits })
+    |> Map.to_alist
+
+  let partition_label (cfg : Config.t) (labels : label list) =
+    let default = cfg.label_rules.default_channel in
+    let rules = cfg.label_rules.rules in
+    labels |> List.concat_map ~f:(Rule.Label.match_rules ~rules) |> List.dedup_and_sort ~compare:String.compare
+    |> fun channel_names -> if List.is_empty channel_names then Option.to_list default else channel_names
 
   let partition_pr cfg (n : pr_notification) =
     match n.action with
@@ -98,11 +79,15 @@ module Action = struct
     | Submitted, _, _ -> partition_label cfg n.pull_request.labels
     | _ -> []
 
-  let partition_commit cfg files =
-    let names = List.map ~f:(fun f -> f.filename) files in
-    match Rule.Prefix.unique_chans_of_files cfg.prefix_rules.rules names with
-    | _ :: _ as xs -> xs
-    | [] -> Option.to_list cfg.prefix_rules.default_channel
+  let partition_commit (cfg : Config.t) files =
+    let default = Option.to_list cfg.prefix_rules.default_channel in
+    let rules = cfg.prefix_rules.rules in
+    let matched_channel_names =
+      List.map ~f:(fun f -> f.filename) files
+      |> List.filter_map ~f:(Rule.Prefix.match_rules ~rules)
+      |> List.dedup_and_sort ~compare:String.compare
+    in
+    if List.is_empty matched_channel_names then default else matched_channel_names
 
   let partition_status (ctx : Context.t) (n : status_notification) =
     let cfg = ctx.cfg in
@@ -153,18 +138,24 @@ module Action = struct
     Context.update_state ctx (Github.Status n);
     res
 
-  let partition_commit_comment cfg n =
-    let default = Option.to_list cfg.prefix_rules.default_channel in
-    match n.comment.path with
-    | None ->
-      ( match%lwt Github.generate_commit_from_commit_comment cfg n with
-      | None -> Lwt.return default
-      | Some commit -> Lwt.return (partition_commit cfg commit.files)
+  let partition_commit_comment (ctx : Context.t) n =
+    let cfg = ctx.cfg in
+    match n.comment.commit_id with
+    | None -> action_error "unable to find commit id for this commit comment event"
+    | Some sha ->
+      ( match%lwt Github_api.get_api_commit ~ctx ~repo:n.repository ~sha with
+      | Error e -> action_error e
+      | Ok commit ->
+        let default = Option.to_list cfg.prefix_rules.default_channel in
+        let rules = cfg.prefix_rules.rules in
+        ( match n.comment.path with
+        | None -> Lwt.return @@ (partition_commit cfg commit.files, commit)
+        | Some filename ->
+        match Rule.Prefix.match_rules filename ~rules with
+        | None -> Lwt.return (default, commit)
+        | Some chan -> Lwt.return ([ chan ], commit)
+        )
       )
-    | Some p ->
-    match Rule.Prefix.chan_of_file cfg.prefix_rules.rules p with
-    | None -> Lwt.return default
-    | Some chan -> Lwt.return [ chan ]
 
   let generate_notifications (ctx : Context.t) req =
     let cfg = ctx.cfg in
@@ -186,8 +177,8 @@ module Action = struct
       |> List.map ~f:(fun webhook -> webhook, generate_issue_comment_notification n)
       |> Lwt.return
     | Commit_comment n ->
-      let%lwt webhooks = partition_commit_comment cfg n in
-      let%lwt notif = generate_commit_comment_notification cfg n in
+      let%lwt webhooks, api_commit = partition_commit_comment ctx n in
+      let%lwt notif = generate_commit_comment_notification api_commit n in
       let notifs = List.map ~f:(fun webhook -> webhook, notif) webhooks in
       Lwt.return notifs
     | Status n ->
diff --git a/lib/github.ml b/lib/github.ml
@@ -115,6 +115,8 @@ let is_main_merge_message ~msg:message ~branch (cfg : Config.t) =
     String.equal title expect || String.equal title expect2
   | _ -> false
 
+let modified_files_of_commit commit = List.concat [ commit.added; commit.removed; commit.modified ]
+
 let is_valid_signature ~secret headers_sig body =
   let request_hash =
     let key = Cstruct.of_string secret in
diff --git a/lib/rule.atd b/lib/rule.atd
@@ -10,7 +10,9 @@ type status_state = {
 
 (* A filename matches a prefix rule with the channel name if it isn't in the ignore
    list and it is in the allow list. If multiple prefix rules match for a given
-   file, the one to match with the longest prefix is used.
+   file, the one to match with the longest prefix is used. Both `allow` and
+   `ignore` are optional. If `allow` is undefined, then the rule matches all
+   payloads.
 
    If a commit affects 3 files:
    - some/dir/a
@@ -26,15 +28,16 @@ type status_state = {
    ignore should be ["some/other"] 
 *)
 type prefix_rule = {
-  allow : string list; (* empty list means match any *)
-  ~ignore : string list;
-  channel_name <json name="channel"> : string;
+  ?allow : string list nullable;
+  ?ignore : string list nullable;
+  channel_name <json name="channel">: string;
 }
 
 (* A payload matches a label rule with a channel name if absent from the ignore list
-   and present in the allow list. *)
+   and present in the allow list. Both `allow` and `ignore` are optional. If `allow`
+   is undefined, then the rule matches all payloads. *)
 type label_rule = {
-  allow : string list;
-  ~ignore : string list;
-  channel_name <json name="channel"> : string;
+  ?allow : string list nullable;
+  ?ignore : string list nullable;
+  channel_name <json name="channel">: string;
 }
diff --git a/lib/rule.ml b/lib/rule.ml
@@ -36,97 +36,48 @@ module Status = struct
 end
 
 module Prefix = struct
-  type prefix_match =
-    | Match of int
-    | NoMatch
-
-  let chan_of_prefix_rule (r : prefix_rule) = r.channel_name
-
-  let touching_prefix (rule : prefix_rule) name =
-    let match_lengths filename prefixes =
-      List.filter_map
-        ~f:(fun prefix -> if String.is_prefix filename ~prefix then Some (String.length prefix) else None)
-        prefixes
-    in
-    match match_lengths name rule.ignore with
-    | _ :: _ -> NoMatch
-    | [] ->
-    match rule.allow with
-    | [] -> Match 0
-    | _ ->
-    match List.max_elt (match_lengths name rule.allow) ~compare:Int.compare with
-    | Some x -> Match x
-    | None -> NoMatch
-
-  let longest_touching_prefix_rule rules name =
-    let get_m rule = touching_prefix rule name in
-    let reduce_to_longest_match longest_rule_match_pair current_rule =
-      let _, longest_match = longest_rule_match_pair in
-      let current_match = get_m current_rule in
-      let current_rule_match_pair = current_rule, current_match in
-      match longest_match with
-      | NoMatch -> current_rule_match_pair
-      | Match x ->
-      match current_match with
-      | NoMatch -> longest_rule_match_pair
-      | Match y -> if y > x then current_rule_match_pair else longest_rule_match_pair
+  (** `match_rules f rs` returns the channel name of a rule in `rs` that matches
+      file name `f` with the longest prefix, if one exists. A rule `r` matches
+      `f` with prefix length `l`, if `f` has no prefix in `r.ignore` and `l` is
+      the length of the longest prefix of `f` in `r.allow`. An undefined allow
+      list is considered a prefix match of length 0. The ignore list is
+      evaluated before the allow list. *)
+  let match_rules filename ~rules =
+    let compare a b = Int.compare (snd a) (snd b) in
+    let is_prefix prefix = String.is_prefix filename ~prefix in
+    let match_rule (rule : prefix_rule) =
+      match rule.ignore with
+      | Some ignore_list when List.exists ignore_list ~f:is_prefix -> None
+      | _ ->
+      match rule.allow with
+      | None -> Some (rule, 0)
+      | Some allow_list ->
+        allow_list
+        |> List.filter_map ~f:(fun p -> if is_prefix p then Some (rule, String.length p) else None)
+        |> List.max_elt ~compare
     in
-    match rules with
-    | [] -> None
-    | (x : prefix_rule) :: xs ->
-    match List.fold_left xs ~init:(x, get_m x) ~f:reduce_to_longest_match with
-    | _, NoMatch -> None
-    | r, Match _ -> Some r
-
-  let chan_of_file rules file = Option.map ~f:chan_of_prefix_rule @@ longest_touching_prefix_rule rules file
-
-  let unique_chans_of_files rules files =
-    List.dedup_and_sort ~compare:String.compare @@ List.filter_map files ~f:(chan_of_file rules)
-
-  let filter_push rules (commit : Github_t.commit) =
-    let files = List.concat [ commit.added; commit.removed; commit.modified ] in
-    List.map ~f:(fun chan -> chan, commit) @@ unique_chans_of_files rules files
-
-  let print_prefix_routing rules =
-    let show_match l = String.concat ~sep:" or " @@ List.map ~f:(fun s -> s ^ "*") l in
     rules
-    |> List.iter ~f:(fun (rule : prefix_rule) ->
-         begin
-           match rule.allow, rule.ignore with
-           | [], [] -> Stdio.printf "  any"
-           | l, [] -> Stdio.printf "  %s" (show_match l)
-           | [], l -> Stdio.printf "  not %s" (show_match l)
-           | l, i -> Stdio.printf "  %s and not %s" (show_match l) (show_match i)
-         end;
-         Stdio.printf " -> #%s\n%!" rule.channel_name)
+    |> List.filter_map ~f:match_rule
+    |> List.max_elt ~compare
+    |> Option.map ~f:(fun (res : prefix_rule * int) -> (fst res).channel_name)
 end
 
 module Label = struct
-  let touching_label rule name =
-    let name_lc = String.lowercase name in
-    let label_lc = List.map rule.allow ~f:(fun l -> String.lowercase l) in
-    let ignore_lc = List.map rule.ignore ~f:(fun l -> String.lowercase l) in
-    (* convert both labels and config into lowe-case to make label matching case-insensitive *)
-    (List.is_empty label_lc || List.mem ~equal:String.equal label_lc name_lc)
-    && not (List.mem ~equal:String.equal ignore_lc name_lc)
-
-  let filter_label rules (label : Github_j.label) =
-    rules
-    |> List.filter_map ~f:(fun rule ->
-         match touching_label rule label.name with
-         | false -> None
-         | true -> Some rule.channel_name)
-
-  let print_label_routing rules =
-    let show_match l = String.concat ~sep:" or " l in
-    rules
-    |> List.iter ~f:(fun (rule : label_rule) ->
-         begin
-           match rule.allow, rule.ignore with
-           | [], [] -> Stdio.printf "  any"
-           | l, [] -> Stdio.printf "  %s" (show_match l)
-           | [], l -> Stdio.printf "  not %s" (show_match l)
-           | l, i -> Stdio.printf "  %s and not %s" (show_match l) (show_match i)
-         end;
-         Stdio.printf " -> #%s\n%!" rule.channel_name)
+  (** `match_rules l rs` returns the channel names of the rules in `rs` that
+      allow label `l`, if one exists. A rule `r` matches label `l`, if `l` is
+      not a member of `r.ignore` and is a member of `r.allow`. The label name
+      comparison is case insensitive. An undefined allow list is considered a
+      match. The ignore list is evaluated before the allow list. *)
+  let match_rules (label : Github_t.label) ~rules =
+    let label_name = String.lowercase label.name in
+    let label_name_equal name = String.equal label_name (String.lowercase name) in
+    let match_rule rule =
+      match rule.ignore with
+      | Some ignore_list when List.exists ignore_list ~f:label_name_equal -> None
+      | _ ->
+      match rule.allow with
+      | None -> Some rule.channel_name
+      | Some allow_list -> if List.exists allow_list ~f:label_name_equal then Some rule.channel_name else None
+    in
+    rules |> List.filter_map ~f:match_rule |> List.dedup_and_sort ~compare:String.compare
 end
diff --git a/lib/slack.ml b/lib/slack.ml
diff --git a/src/notabot.ml b/src/notabot.ml
