DM only when user breaks a step

lib/action.ml

@@ -58,7 +58,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     n.commits
     |> List.filter (fun c ->
            let skip = Github.is_merge_commit_to_ignore ~cfg ~branch c in
-           if skip then log#info "main branch merge, ignoring %s: %s" c.id (first_line c.message);
+           if skip then log#info "main branch merge, ignoring %s: %s" c.id (Util.first_line c.message);
            not skip)
     |> List.concat_map (fun commit ->
            let rules = List.filter (filter_by_branch ~distinct:commit.distinct) rules in
@@ -128,71 +128,87 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     in
     if matched_channel_names = [] then default else matched_channel_names
 
+  let buildkite_is_failed_re = Re2.create_exn {|^Build #\d+ failed|}
+
   let partition_status (ctx : Context.t) (n : status_notification) =
     let repo = n.repository in
     let cfg = Context.find_repo_config_exn ctx repo.url in
     let pipeline = n.context in
     let current_status = n.state in
     let rules = cfg.status_rules.rules in
+    let repo_state = State.find_or_add_repo ctx.state n.repository.url in
+
     let action_on_match (branches : branch list) ~notify_channels ~notify_dm =
-      let%lwt direct_message =
-        if notify_dm then begin
-          match%lwt Slack_api.lookup_user ~ctx ~cfg ~email:n.commit.commit.author.email () with
-          | Ok res ->
-            State.set_repo_pipeline_commit ctx.state repo.url ~pipeline ~commit:n.sha;
-            (* To send a DM, channel parameter is set to the user id of the recipient *)
-            Lwt.return [ res.user.id ]
-          | Error e ->
-            log#warn "couldn't match commit email %s to slack profile: %s" n.commit.commit.author.email e;
-            Lwt.return []
-        end
-        else Lwt.return []
-      in
-      let%lwt chans =
-        let default = Stdlib.Option.to_list cfg.prefix_rules.default_channel in
-        match notify_channels with
-        | false -> Lwt.return []
-        | true ->
-        match branches with
-        | [] -> Lwt.return []
-        | _ ->
-        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 (fun ({ name } : branch) -> String.equal name main_branch_name) branches with
-        | false -> Lwt.return default
-        | true ->
-          let sha = n.commit.sha in
-          (match%lwt Github_api.get_api_commit ~ctx ~repo ~sha with
-          | Error e -> action_error e
-          | Ok commit -> Lwt.return @@ partition_commit cfg commit.files)
-      in
-      Lwt.return (direct_message @ chans)
+      let broken_steps = Util.Build.new_failed_steps n repo_state pipeline in
+      match n.state = Failure && broken_steps = [] with
+      | true -> Lwt.return []
+      | false ->
+        let%lwt direct_message =
+          if notify_dm then begin
+            match%lwt Slack_api.lookup_user ~ctx ~cfg ~email:n.commit.commit.author.email () with
+            | Ok res ->
+              State.set_repo_pipeline_commit ctx.state repo.url ~pipeline ~commit:n.sha;
+              (* To send a DM, channel parameter is set to the user id of the recipient *)
+              Lwt.return [ res.user.id ]
+            | Error e ->
+              log#warn "couldn't match commit email %s to slack profile: %s" n.commit.commit.author.email e;
+              Lwt.return []
+          end
+          else Lwt.return []
+        in
+        let%lwt chans =
+          let default = Stdlib.Option.to_list cfg.prefix_rules.default_channel in
+          match notify_channels with
+          | false -> Lwt.return []
+          | true ->
+          match branches with
+          | [] -> Lwt.return []
+          | _ ->
+          match cfg.main_branch_name with
+          | None -> Lwt.return default
+          | Some main_branch_name ->
+          match List.exists (fun ({ name } : branch) -> String.equal name main_branch_name) branches with
+          | false ->
+            (* non-main branch build notifications go to default channel to reduce spam in topic channels *)
+            Lwt.return default
+          | true ->
+            let sha = n.commit.sha in
+            (match%lwt Github_api.get_api_commit ~ctx ~repo ~sha with
+            | Error e -> action_error e
+            | Ok commit -> Lwt.return @@ partition_commit cfg commit.files)
+        in
+        Lwt.return (direct_message @ chans)
     in
+
     let%lwt recipients =
       if Context.is_pipeline_allowed ctx repo.url ~pipeline then begin
-        let repo_state = State.find_or_add_repo ctx.state repo.url in
         match Rule.Status.match_rules ~rules n with
         | Some (Ignore, _, _) | None -> Lwt.return []
         | Some (Allow, notify_channels, notify_dm) -> action_on_match n.branches ~notify_channels ~notify_dm
         | Some (Allow_once, notify_channels, notify_dm) ->
-          let branches =
-            match StringMap.find_opt pipeline repo_state.pipeline_statuses with
-            | Some branch_statuses ->
-              let has_same_status_as_prev (branch : branch) =
-                match StringMap.find_opt branch.name branch_statuses with
-                | Some { status; _ } when status = current_status -> true
-                | _ -> false
-              in
-              let branches = List.filter (Fun.negate has_same_status_as_prev) n.branches in
-              branches
-            | None -> n.branches
-          in
-          let notify_dm =
-            notify_dm && not (State.mem_repo_pipeline_commits ctx.state repo.url ~pipeline ~commit:n.sha)
+          let full_build_failed =
+            n.state = Failure && Re2.matches buildkite_is_failed_re (Option.default "" n.description)
           in
-          action_on_match branches ~notify_channels ~notify_dm
+          (* for failing states, if we only allow one notification, it must be the final one, not an intermediate one *)
+          (match n.state <> Failure || full_build_failed with
+          | false -> Lwt.return []
+          | true ->
+            let branches =
+              match StringMap.find_opt pipeline repo_state.pipeline_statuses with
+              | Some branch_statuses ->
+                let has_same_status_as_prev (branch : branch) =
+                  match StringMap.find_opt branch.name branch_statuses with
+                  | Some { status; _ } when status = current_status -> true
+                  | _ -> false
+                in
+                let branches = List.filter (Fun.negate has_same_status_as_prev) n.branches in
+                branches
+              | None -> n.branches
+            in
+            let notify_dm =
+              notify_dm && not (State.mem_repo_pipeline_commits ctx.state repo.url ~pipeline ~commit:n.sha)
+            in
+            action_on_match branches ~notify_channels ~notify_dm)
       end
       else Lwt.return []
     in
@@ -265,7 +281,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
       Lwt.return notifs
     | Status n ->
       let%lwt channels = partition_status ctx n in
-      let notifs = List.map (generate_status_notification cfg n) channels in
+      let notifs = List.map (generate_status_notification ctx cfg n) channels in
       Lwt.return notifs
 
   let send_notifications (ctx : Context.t) notifications =

lib/api_remote.ml

@@ -1,6 +1,7 @@
 open Printf
 open Devkit
 open Common
+open Util
 
 module Github : Api.Github = struct
   let commits_url ~(repo : Github_t.repository) ~sha =

lib/common.ml

@@ -40,32 +40,3 @@ module Re2 = struct
   let wrap s = create_exn s
   let unwrap = Re2.to_string
 end
-
-open Devkit
-
-let fmt_error ?exn fmt =
-  Printf.ksprintf
-    (fun s ->
-      match exn with
-      | Some exn -> Error (s ^ " :  exn " ^ Exn.str exn)
-      | None -> Error s)
-    fmt
-
-let first_line s =
-  match String.split_on_char '\n' s with
-  | x :: _ -> x
-  | [] -> s
-
-let decode_string_pad s = Stre.rstrip ~chars:"= \n\r\t" s |> Base64.decode_exn ~pad:false
-
-let http_request ?headers ?body meth path =
-  let setup h =
-    Curl.set_followlocation h true;
-    Curl.set_maxredirs h 1
-  in
-  match%lwt Web.http_request_lwt ~setup ~ua:"monorobot" ~verbose:true ?headers ?body meth path with
-  | `Ok s -> Lwt.return @@ Ok s
-  | `Error e -> Lwt.return @@ Error e
-
-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/context.ml

@@ -79,10 +79,11 @@ let is_pipeline_allowed ctx repo_url ~pipeline =
   | None -> true
   | Some config ->
   match config.status_rules.allowed_pipelines with
-  | Some allowed_pipelines when not @@ List.exists (String.equal pipeline) allowed_pipelines -> false
+  | Some allowed_pipelines when not @@ List.mem pipeline allowed_pipelines -> false
   | _ -> true
 
 let refresh_secrets ctx =
+  let open Util in
   let path = ctx.secrets_filepath in
   match Config_j.secrets_of_string (Std.input_file path) with
   | exception exn -> fmt_error ~exn "failed to read secrets from file %s" path
@@ -104,7 +105,7 @@ let refresh_state ctx =
       log#info "loading saved state from file %s" path;
       (* todo: extract state related parts to state.ml *)
       match State_j.state_of_string (Std.input_file path) with
-      | exception exn -> fmt_error ~exn "failed to read state from file %s" path
+      | exception exn -> Util.fmt_error ~exn "failed to read state from file %s" path
       | state -> Ok { ctx with state = { State.state } }
     end
     else Ok ctx

lib/github.ml

@@ -49,7 +49,7 @@ let is_merge_commit_to_ignore ~(cfg : Config_t.config) ~branch commit =
       Merge remote-tracking branch 'origin/develop' into feature_branch
       Merge remote-tracking branch 'origin/develop' (the default message pattern generated by GitHub "Update with merge commit" button)
     *)
-    let title = Common.first_line commit.message in
+    let title = Util.first_line commit.message in
     begin
       match Re2.find_submatches_exn merge_commit_re title with
       | [| Some _; Some incoming_branch; receiving_branch |] ->

lib/slack.ml

@@ -1,5 +1,6 @@
 open Printf
 open Common
+open Util
 open Mrkdwn
 open Github_j
 open Slack_j
@@ -240,11 +241,12 @@ let generate_push_notification notification channel =
 
 let buildkite_description_re = Re2.create_exn {|^Build #(\d+)(.*)|}
 
-let generate_status_notification (cfg : Config_t.config) (notification : status_notification) channel =
-  let { commit; state; description; target_url; context; repository; _ } = notification in
+let generate_status_notification (ctx : Context.t) (cfg : Config_t.config) (notification : status_notification) channel
+    =
+  let { commit; state; description; target_url; context = pipeline; repository; _ } = notification in
   let ({ commit : inner_commit; sha; author; html_url; _ } : status_commit) = commit in
   let ({ message; _ } : inner_commit) = commit in
-  let is_buildkite = String.starts_with context ~prefix:"buildkite" in
+  let is_buildkite = String.starts_with pipeline ~prefix:"buildkite" in
   let color_info =
     match state with
     | Success -> "good"
@@ -264,7 +266,9 @@ let generate_status_notification (cfg : Config_t.config) (notification : status_
         | [| Some _; Some build_nr; Some rest |] ->
           (* We use a zero-with space \u{200B} to prevent slack from interpreting #XXXXXX as a color *)
           sprintf "Build <%s|#\u{200B}%s>%s" target_url build_nr rest
-        | _ -> s
+        | _ | (exception _) ->
+          (* we either match on the first case or get an exception *)
+          s
       in
       Some (sprintf "*Description*: %s." text)
   in
@@ -291,6 +295,20 @@ let generate_status_notification (cfg : Config_t.config) (notification : status_
       in
       [ sprintf "*%s*: %s" (pluralize ~suf:"es" ~len:(List.length branches) "Branch") (String.concat ", " branches) ]
   in
+  let failed_steps_info =
+    let repo_state = State.find_or_add_repo ctx.state repository.url in
+    match Build.new_failed_steps notification repo_state pipeline with
+    | [] -> []
+    | steps_and_links ->
+      let steps_with_links =
+        List.map
+          (fun (s, l) ->
+            let step = Devkit.Stre.drop_prefix s (notification.context ^ "/") in
+            sprintf "<%s|%s>" l step)
+          steps_and_links
+      in
+      [ sprintf "*Steps broken*: %s" (String.concat ", " steps_with_links) ]
+  in
   let summary =
     let state_info =
       match state with
@@ -308,7 +326,7 @@ let generate_status_notification (cfg : Config_t.config) (notification : status_
     | Some target_url ->
       let default_summary =
         sprintf "<%s|[%s]> CI Build Status notification for <%s|%s>: %s" repository.url repository.full_name target_url
-          context state_info
+          pipeline state_info
       in
       if not is_buildkite then default_summary
       else (
@@ -321,9 +339,9 @@ let generate_status_notification (cfg : Config_t.config) (notification : status_
         in
         match pipeline_url with
         | None -> default_summary
-        | Some pipeline_url -> sprintf "<%s|[%s]>: Build %s for \"%s\"" pipeline_url context state_info commit_message)
+        | Some pipeline_url -> sprintf "<%s|[%s]>: Build %s for \"%s\"" pipeline_url pipeline state_info commit_message)
   in
-  let msg = String.concat "\n" @@ List.concat [ commit_info; branches_info ] in
+  let msg = String.concat "\n" @@ List.concat [ commit_info; branches_info; failed_steps_info ] in
   let attachment =
     {
       empty_attachments with
@@ -368,5 +386,5 @@ let validate_signature ?(version = "v0") ?signing_key ~headers body =
   | 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
+    let expected_signature = Printf.sprintf "%s=%s" version (Util.sign_string_sha256 ~key ~basestring) in
     if String.equal expected_signature signature then Ok () else Error "signatures don't match"

lib/state.ml

@@ -107,4 +107,4 @@ let save { state; _ } path =
   try
     Files.save_as path (fun oc -> output_string oc data);
     Ok ()
-  with exn -> fmt_error ~exn "failed to save state to file %s" path
+  with exn -> Util.fmt_error ~exn "failed to save state to file %s" path

lib/util.ml

@@ -0,0 +1,57 @@
+open Devkit
+
+module StringMap = Common.StringMap
+
+let fmt_error ?exn fmt =
+  Printf.ksprintf
+    (fun s ->
+      match exn with
+      | Some exn -> Error (s ^ " :  exn " ^ Exn.str exn)
+      | None -> Error s)
+    fmt
+
+let first_line s =
+  match String.split_on_char '\n' s with
+  | x :: _ -> x
+  | [] -> s
+
+let decode_string_pad s = Stre.rstrip ~chars:"= \n\r\t" s |> Base64.decode_exn ~pad:false
+
+let http_request ?headers ?body meth path =
+  let setup h =
+    Curl.set_followlocation h true;
+    Curl.set_maxredirs h 1
+  in
+  match%lwt Web.http_request_lwt ~setup ~ua:"monorobot" ~verbose:true ?headers ?body meth path with
+  | `Ok s -> Lwt.return @@ Ok s
+  | `Error e -> Lwt.return @@ Error e
+
+let sign_string_sha256 ~key ~basestring =
+  Cstruct.of_string basestring |> Nocrypto.Hash.SHA256.hmac ~key:(Cstruct.of_string key) |> Hex.of_cstruct |> Hex.show
+
+module Build = struct
+  let new_failed_steps (n : Github_t.status_notification) (repo_state : State_t.repo_state) pipeline =
+    let to_failed_steps branch step statuses acc =
+      (* check if step of an allowed pipeline *)
+      match step with
+      | step when step = pipeline -> acc
+      | step when not @@ Devkit.Stre.starts_with step pipeline -> acc
+      | _ ->
+      (* check if this step failed *)
+      match StringMap.find_opt branch statuses with
+      | Some (s : State_t.build_status) when s.status = Failure ->
+        (match s.current_failed_commit, s.original_failed_commit with
+        | Some _, _ ->
+          (* if we have a value for current_failed_commit, this step was already failed and notified *)
+          acc
+        | None, Some { build_link = Some build_link; sha; _ } when sha = n.commit.sha ->
+          (* we need to check the value of the commit sha to avoid false positives *)
+          (step, build_link) :: acc
+        | _ -> acc)
+      | _ -> acc
+    in
+    match n.state = Failure, n.branches with
+    | false, _ | true, [] -> []
+    | true, [ branch ] -> StringMap.fold (to_failed_steps branch.name) repo_state.pipeline_statuses []
+    | true, _ -> []
+end