introduce new status_rules syntax and update state tracking logic (#91)

This implementation properly tracks different build states per pipeline
(`pipeline_statuses` is now a two-level map indexed by pipeline name
and branch name). The “last build state” for a given pipeline + branch
permutation is only updated if the current build notification passes the
defined status_rules. This change also removes the temporary wrapper
around config that was needed for the old status_rules syntax.

Author: yasunariw

lib/action.ml

@@ -2,7 +2,6 @@ open Devkit
 open Base
 open Slack
 open Config_t
-open Config
 open Common
 open Github_j
 
@@ -13,24 +12,14 @@ let action_error msg = raise (Action_error msg)
 let log = Log.from "action"
 
 module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
-  (* this should move to context.ml once rule.ml is refactored to not depend on it *)
-  let print_config ctx =
-    let cfg = Context.get_config_exn ctx in
-    let secrets = Context.get_secrets_exn ctx in
-    log#info "using prefix routing:";
-    Rule.Prefix.print_prefix_routing cfg.prefix_rules.rules;
-    log#info "using label routing:";
-    Rule.Label.print_label_routing cfg.label_rules.rules;
-    log#info "signature checking %s" (if Option.is_some secrets.gh_hook_token then "enabled" else "disabled")
-
-  let partition_push cfg n =
+  let partition_push (cfg : Config_t.config) n =
     let default = Option.to_list cfg.prefix_rules.default_channel in
     let rules = cfg.prefix_rules.rules in
     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
+         let skip = Github.is_main_merge_message ~msg:c.message ?main_branch:cfg.main_branch_name ~branch 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 ->
@@ -45,7 +34,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     |> Map.map ~f:(fun commits -> { n with commits })
     |> Map.to_alist
 
-  let partition_label (cfg : Config.t) (labels : label list) =
+  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 ~f:(Rule.Label.match_rules ~rules) |> List.dedup_and_sort ~compare:String.compare
@@ -87,7 +76,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     | Submitted, _, _ -> partition_label cfg n.pull_request.labels
     | _ -> []
 
-  let partition_commit (cfg : Config.t) files =
+  let partition_commit (cfg : Config_t.config) files =
     let default = Option.to_list cfg.prefix_rules.default_channel in
     let rules = cfg.prefix_rules.rules in
     let matched_channel_names =
@@ -101,18 +90,18 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     let cfg = Context.get_config_exn ctx in
     let pipeline = n.context in
     let current_status = n.state in
-    let updated_at = n.updated_at in
-    let get_commit_info () =
+    let rules = cfg.status_rules.rules in
+    let action_on_match (branches : branch list) =
       let default = Option.to_list cfg.prefix_rules.default_channel in
-      let () = Context.refresh_pipeline_status ~pipeline ~branches:n.branches ~status:current_status ~updated_at ctx in
-      match List.is_empty n.branches with
+      let () = Context.refresh_pipeline_status ~pipeline ~branches ~status:current_status ctx in
+      match List.is_empty branches with
       | true -> Lwt.return []
       | false ->
       match cfg.main_branch_name with
       | None -> Lwt.return default
       | Some main_branch_name ->
       (* non-main branch build notifications go to default channel to reduce spam in topic channels *)
-      match List.exists n.branches ~f:(fun { name } -> String.equal name main_branch_name) with
+      match List.exists branches ~f:(fun { name } -> String.equal name main_branch_name) with
       | false -> Lwt.return default
       | true ->
         let sha = n.commit.sha in
@@ -122,27 +111,23 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
         | Ok commit -> Lwt.return @@ partition_commit cfg commit.files
         )
     in
-    let res =
-      match
-        List.exists cfg.status_rules.status ~f:(fun x ->
-          match x with
-          | State s -> Poly.equal s n.state
-          | HideConsecutiveSuccess -> Poly.equal Success n.state
-          | _ -> false)
-      with
-      | false -> Lwt.return []
-      | true ->
-      match List.exists ~f:id [ Rule.Status.hide_cancelled n cfg; Rule.Status.hide_success n ctx ] with
-      | true -> Lwt.return []
-      | false ->
-      match cfg.status_rules.title with
-      | None -> get_commit_info ()
-      | Some status_filter ->
-      match List.exists status_filter ~f:(String.equal n.context) with
-      | false -> Lwt.return []
-      | true -> get_commit_info ()
-    in
-    res
+    if Context.is_pipeline_allowed ctx ~pipeline then begin
+      match Rule.Status.match_rules ~rules n with
+      | Some Ignore | None -> Lwt.return []
+      | Some Allow -> action_on_match n.branches
+      | Some Allow_once ->
+      match Map.find ctx.state.pipeline_statuses pipeline with
+      | Some branch_statuses ->
+        let has_same_status_state_as_prev (branch : branch) =
+          match Map.find branch_statuses branch.name with
+          | None -> false
+          | Some state -> Poly.equal state current_status
+        in
+        let branches = List.filter n.branches ~f:(Fn.non @@ has_same_status_state_as_prev) in
+        action_on_match branches
+      | None -> action_on_match n.branches
+    end
+    else Lwt.return []
 
   let partition_commit_comment (ctx : Context.t) n =
     let cfg = Context.get_config_exn ctx in
@@ -213,9 +198,8 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
       let repo = Github.repo_of_notification notification in
       match%lwt Github_api.get_config ~ctx ~repo with
       | Ok config ->
-        print_config ctx;
-        (* can remove this wrapper once status_rules doesn't depend on Config.t *)
-        ctx.config <- Some (Config.make config);
+        Context.print_config ctx;
+        ctx.config <- Some config;
         Lwt.return @@ Ok ()
       | Error e -> action_error e
     in
@@ -233,7 +217,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
   let process_github_notification (ctx : Context.t) headers body =
     try%lwt
       let secrets = Context.get_secrets_exn ctx in
-      match Github.parse_exn ~secret:secrets.gh_hook_token headers body with
+      match Github.parse_exn ?hook_token:secrets.gh_hook_token headers body with
       | exception exn -> Exn_lwt.fail ~exn "failed to parse payload"
       | payload ->
         ( match%lwt refresh_config_of_context ctx payload with
@@ -243,7 +227,11 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
           let%lwt () = send_notifications ctx notifications in
           ( match ctx.state_filepath with
           | None -> Lwt.return_unit
-          | Some path -> Lwt.return @@ State.save path ctx.state
+          | Some path ->
+            ( match%lwt State.save ctx.state path with
+            | Ok () -> Lwt.return_unit
+            | Error e -> action_error e
+            )
           )
         )
     with

lib/common.ml

@@ -22,18 +22,6 @@ let first_line s =
   | x :: _ -> x
   | [] -> s
 
-module Tristate : Atdgen_runtime.Json_adapter.S = struct
-  let normalize = function
-    | `Bool true -> `String "true"
-    | `Bool false -> `String "false"
-    | x -> x
-
-  let restore = function
-    | `String "true" -> `Bool true
-    | `String "false" -> `Bool false
-    | x -> x
-end
-
 let decode_string_pad s =
   String.rstrip ~drop:(List.mem [ '='; ' '; '\n'; '\r'; '\t' ] ~equal:Char.equal) s |> Base64.decode_string
 

lib/config.atd

@@ -1,11 +1,11 @@
-type status_state <ocaml from="Rule"> = abstract
+type status_rule <ocaml from="Rule"> = abstract
 type prefix_rule <ocaml from="Rule"> = abstract
 type label_rule <ocaml from="Rule"> = abstract
 
 (* This type of rule is used for CI build notifications. *)
 type status_rules = {
   ?allowed_pipelines : string list nullable; (* keep only status events with a title matching this list *)
-  rules: status_state;
+  rules: status_rule list;
 }
 
 (* This type of rule is used for events that must be routed based on the

lib/config.ml

@@ -11,8 +11,8 @@ type t = {
   secrets_filepath : string;
   state_filepath : string option;
   mutable secrets : Config_t.secrets option;
-  mutable config : Config.t option;
-  mutable state : State_t.state;
+  mutable config : Config_t.config option;
+  state : State_t.state;
 }
 
 let default : t =
@@ -46,8 +46,19 @@ let hook_of_channel ctx channel_name =
   | Some hook -> Some hook.url
   | None -> None
 
-let refresh_pipeline_status ctx ~pipeline ~(branches : Github_t.branch list) ~status ~updated_at =
-  ctx.state <- State.refresh_pipeline_status ctx.state ~pipeline ~branches ~status ~updated_at
+(** `is_pipeline_allowed ctx p` returns `true` if ctx.config.status_rules
+    doesn't define a whitelist of allowed pipelines, or if the list
+    contains pipeline `p`; returns `false` otherwise. *)
+let is_pipeline_allowed ctx ~pipeline =
+  match ctx.config with
+  | None -> false
+  | Some config ->
+  match config.status_rules.allowed_pipelines with
+  | Some allowed_pipelines when not @@ List.exists allowed_pipelines ~f:(String.equal pipeline) -> false
+  | _ -> true
+
+let refresh_pipeline_status ctx ~pipeline ~(branches : Github_t.branch list) ~status =
+  if is_pipeline_allowed ctx ~pipeline then State.refresh_pipeline_status ctx.state ~pipeline ~branches ~status else ()
 
 let log = Log.from "context"
 
@@ -70,3 +81,12 @@ let refresh_state ctx =
       let state = State_j.state_of_string file in
       Ok { ctx with state }
     )
+
+let print_config ctx =
+  let cfg = get_config_exn ctx in
+  let secrets = get_secrets_exn ctx in
+  log#info "using prefix routing:";
+  Rule.Prefix.print_prefix_routing cfg.prefix_rules.rules;
+  log#info "using label routing:";
+  Rule.Label.print_label_routing cfg.label_rules.rules;
+  log#info "signature checking %s" (if Option.is_some secrets.gh_hook_token then "enabled" else "disabled")

lib/context.ml

@@ -1,6 +1,7 @@
 open Base
-open Devkit
 open Printf
+open Common
+open Devkit
 open Github_j
 
 type t =
@@ -36,44 +37,42 @@ let event_of_filename filename =
   | [ kind; _; "json" ] -> Some kind
   | _ -> None
 
-let is_main_merge_message ~msg:message ~branch (cfg : Config.t) =
-  match cfg.main_branch_name with
+let is_main_merge_message ~msg:message ?main_branch ~branch =
+  match main_branch with
   | Some main_branch when String.equal branch main_branch ->
     (*
       handle "Merge <main branch> into <feature branch>" commits when they are merged into main branch
       we should have already seen these commits on the feature branch but for some reason they are distinct:true
     *)
     let prefix = sprintf "Merge branch '%s' into " main_branch in
     let prefix2 = sprintf "Merge remote-tracking branch 'origin/%s' into " main_branch in
-    let title = Common.first_line message in
+    let title = first_line message in
     String.is_prefix title ~prefix || String.is_prefix title ~prefix:prefix2
   | Some main_branch ->
     let expect = sprintf "Merge branch '%s' into %s" main_branch branch in
     let expect2 = sprintf "Merge remote-tracking branch 'origin/%s' into %s" main_branch branch in
-    let title = Common.first_line message in
+    let title = first_line message in
     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
-    Cstruct.to_string @@ Nocrypto.Hash.SHA1.hmac ~key (Cstruct.of_string body)
-  in
-  let (`Hex request_hash) = Hex.of_string request_hash in
-  String.equal headers_sig (sprintf "sha1=%s" request_hash)
+let has_valid_signature ~hook_token ~headers ~body =
+  match List.Assoc.find headers "x-hub-signature" ~equal:String.equal with
+  | None -> Exn.fail "unable to find header x-hub-signature"
+  | Some signature ->
+    let key = Cstruct.of_string hook_token in
+    let request_hash = Cstruct.to_string @@ Nocrypto.Hash.SHA1.hmac ~key (Cstruct.of_string body) in
+    let (`Hex request_hash) = Hex.of_string request_hash in
+    String.equal signature (sprintf "sha1=%s" request_hash)
 
 (* Parse a payload. The type of the payload is detected from the headers. *)
-let parse_exn ~secret headers body =
-  begin
-    match secret with
-    | None -> ()
-    | Some secret ->
-    match List.Assoc.find headers "x-hub-signature" ~equal:String.equal with
-    | None -> Exn.fail "unable to find header x-hub-signature"
-    | Some req_sig -> if not @@ is_valid_signature ~secret req_sig body then failwith "request signature invalid"
-  end;
+let parse_exn ?hook_token headers body =
+  match
+    Option.value_map hook_token ~default:true ~f:(fun hook_token -> has_valid_signature ~hook_token ~headers ~body)
+  with
+  | false -> failwith "request signature invalid"
+  | true ->
   match List.Assoc.find_exn headers "x-github-event" ~equal:String.equal with
   | exception exn -> Exn.fail ~exn "unable to read x-github-event"
   | "push" -> Push (commit_pushed_notification_of_string body)