Get failed steps from buildkite when notifications arrive out of order (

#177)

* get failed steps from buildkite api if needed

* add tests

lib/action.ml

@@ -207,26 +207,24 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) (Buildkite_api :
           Lwt.return (List.map Status_notification.inject_channel chans))
     in
     let get_failed_builds_channel_id () =
-      let pipeline_config, has_failed_builds_channel =
+      let has_failed_builds_channel =
         match cfg.status_rules.allowed_pipelines with
-        | None -> None, false
+        | None -> false
         | Some allowed_pipelines ->
-          List.fold_left
-            (fun acc ({ failed_builds_channel; name; _ } as pipeline_config) ->
-              match is_main_branch && name = context && Option.is_some failed_builds_channel with
-              | true -> Some pipeline_config, true
-              | false -> acc)
-            (None, false) allowed_pipelines
+          List.exists
+            (fun ({ failed_builds_channel; name; _ } : Config_t.pipeline) ->
+              is_main_branch && name = context && Option.is_some failed_builds_channel)
+            allowed_pipelines
       in
+
       (* only notify the failed builds channels for full failed or canceled builds on the main branch
-         that have new failed steps that weren't failing in previous builds *)
-      let should_notify_fail =
-        let notify_canceled_build =
-          Option.map_default
-            (fun pipeline_config -> pipeline_config.notify_canceled_builds && is_canceled_build n)
-            false pipeline_config
-        in
-        (is_failed_build n || notify_canceled_build) && has_failed_builds_channel && new_failed_steps n repo_state <> []
+         that have failed steps that weren't failing in previous builds *)
+      let%lwt should_notify_fail =
+        match Util.Build.notify_fail n cfg with
+        | false -> Lwt.return false
+        | true ->
+          let%lwt new_failed_steps = new_failed_steps ~get_build:(Buildkite_api.get_build ~ctx) n repo_state in
+          Lwt.return (new_failed_steps <> [])
       in
 
       (* only notify the failed builds channels for successful builds on the main branch if they fix the pipeline *)
@@ -267,14 +265,14 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) (Buildkite_api :
           is_success_build n && has_failed_builds_channel && previous_build_is_failed
       in
       match should_notify_fail || should_notify_success, cfg.status_rules.allowed_pipelines with
-      | false, _ | _, None -> []
+      | false, _ | _, None -> Lwt.return []
       | true, Some allowed_pipelines ->
         let to_failed_builds_channel_id ({ name; failed_builds_channel; _ } : Config_t.pipeline) =
           match String.equal name context, failed_builds_channel with
           | true, Some failed_builds_channel -> Some [ Status_notification.inject_channel failed_builds_channel ]
           | _ -> None
         in
-        List.find_map to_failed_builds_channel_id allowed_pipelines |> Option.default []
+        Lwt.return @@ (List.find_map to_failed_builds_channel_id allowed_pipelines |> Option.default [])
     in
     let action_on_match (branches : branch list) ~notify_channels ~notify_dm =
       let%lwt direct_message = get_dm_id ~notify_dm in
@@ -327,7 +325,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) (Buildkite_api :
             let notify_dm = notify_dm && not (State.mem_repo_pipeline_commits ctx.state n) in
             action_on_match branches ~notify_channels ~notify_dm
         in
-        let failed_builds_channel = get_failed_builds_channel_id () in
+        let%lwt failed_builds_channel = get_failed_builds_channel_id () in
         Lwt.return (dm_and_channels @ failed_builds_channel |> List.sort_uniq Status_notification.compare)
     in
     State.set_repo_pipeline_status ctx.state n;
@@ -410,7 +408,15 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) (Buildkite_api :
             log#warn "couldn't match commit email %s to slack profile: %s" email e;
             Lwt.return_none)
       in
-      let notifs = List.map (generate_status_notification ?slack_user_id ~ctx cfg n) channels in
+      let%lwt failed_steps =
+        let repo_state = State.find_or_add_repo ctx.state repo.url in
+        match Util.Build.notify_fail n cfg with
+        | false -> Lwt.return_none
+        | true ->
+          let%lwt failed_steps = Util.Build.new_failed_steps ~get_build:(Buildkite_api.get_build ~ctx) n repo_state in
+          Lwt.return_some failed_steps
+      in
+      let notifs = List.map (generate_status_notification ?slack_user_id ?failed_steps cfg n) channels in
       Lwt.return notifs
 
   let send_notifications (ctx : Context.t) notifications =

lib/api.ml

@@ -40,4 +40,10 @@ end
 
 module type Buildkite = sig
   val get_build_branch : ctx:Context.t -> Github_t.status_notification -> (Github_t.branch, string) Result.t Lwt.t
+
+  val get_build :
+    ?cache:[ `Use | `Refresh ] ->
+    ctx:Context.t ->
+    Github_t.status_notification ->
+    (Buildkite_t.get_build_res, string) Result.t Lwt.t
 end

lib/api_local.ml

@@ -164,7 +164,7 @@ module Slack_json : Api.Slack = struct
 end
 
 module Buildkite : Api.Buildkite = struct
-  let get_build_branch ~ctx:_ (n : Github_t.status_notification) =
+  let get_build' (n : Github_t.status_notification) read =
     match n.target_url with
     | None -> Lwt.return_error "no build url. Is this a Buildkite notification?"
     | Some build_url ->
@@ -173,8 +173,13 @@ module Buildkite : Api.Buildkite = struct
     | [| Some _; Some org; Some pipeline; Some build_nr |] ->
       let file = clean_forward_slashes (sprintf "organizations/%s/pipelines/%s/builds/%s" org pipeline build_nr) in
       let url = Filename.concat buildkite_cache_dir file in
-      with_cache_file url (fun s : Github_t.branch ->
-          let { branch; _ } : Buildkite_t.get_build_response = Buildkite_j.get_build_response_of_string s in
-          { name = branch })
+      with_cache_file url read
     | _ -> failwith "failed to get all build details from the notification. Is this a Buildkite notification?"
+
+  [@@@warning "-27"]
+  let get_build ?(cache : [ `Use | `Refresh ] option) ~ctx:_ (n : Github_t.status_notification) =
+    get_build' n Buildkite_j.get_build_res_of_string
+
+  let get_build_branch ~ctx (n : Github_t.status_notification) =
+    Lwt_result.map (fun { Buildkite_t.branch; _ } : Github_t.branch -> { name = branch }) (get_build ~ctx n)
 end

lib/api_remote.ml

@@ -231,7 +231,7 @@ module Buildkite : Api.Buildkite = struct
   let log = Log.from "buildkite"
 
   module Builds_cache = Cache (struct
-    type t = Buildkite_t.get_build_response
+    type t = Buildkite_t.get_build_res
   end)
 
   (* 24h cache ttl and purge interval. We store so little data per build that it's not worth cleaning up entries sooner. *)
@@ -257,24 +257,27 @@ module Buildkite : Api.Buildkite = struct
       | Ok res -> Lwt.return @@ Ok res
       | Error e -> Lwt.return @@ fmt_error "%s: failure : %s" name e)
 
-  let get_build_branch ~(ctx : Context.t) (n : Github_t.status_notification) =
-    match n.target_url with
-    | None -> Lwt.return_error "no build url. Is this a Buildkite notification?"
-    | Some build_url ->
-    match Re2.find_submatches_exn Build.buildkite_org_pipeline_build_re build_url with
-    | exception _ -> failwith (sprintf "failed to parse Buildkite build url: %s" build_url)
-    | [| Some _; Some org; Some pipeline; Some build_nr |] ->
-      (match Builds_cache.get builds_cache build_nr with
-      | Some build -> Lwt.return_ok ({ name = build.branch } : Github_t.branch)
-      | None ->
+  let get_build ?(cache : [ `Use | `Refresh ] = `Use) ~(ctx : Context.t) (n : Github_t.status_notification) =
+    match Util.Build.get_org_pipeline_build n with
+    | Error e -> Lwt.return_error e
+    | Ok (org, pipeline, build_nr) ->
+      let get_build' () =
         let build_url = sprintf "organizations/%s/pipelines/%s/builds/%s" org pipeline build_nr in
-        (match%lwt
-           request_token_auth ~name:"get buildkite build details" ~ctx `GET build_url
-             Buildkite_j.get_build_response_of_string
-         with
+        match%lwt
+          request_token_auth ~name:"get build details" ~ctx `GET build_url Buildkite_j.get_build_res_of_string
+        with
         | Ok build ->
           Builds_cache.set builds_cache build_nr build;
-          Lwt.return_ok ({ name = build.branch } : Github_t.branch)
-        | Error e -> Lwt.return_error e))
-    | _ -> failwith "failed to get the build details from the notification. Is this a Buildkite notification?"
+          Lwt.return_ok build
+        | Error e -> Lwt.return_error e
+      in
+      (match cache with
+      | `Use ->
+        (match Builds_cache.get builds_cache build_nr with
+        | Some build -> Lwt.return_ok build
+        | None -> get_build' ())
+      | `Refresh -> get_build' ())
+
+  let get_build_branch ~(ctx : Context.t) (n : Github_t.status_notification) =
+    Lwt_result.map (fun { Buildkite_t.branch; _ } : Github_t.branch -> { name = branch }) (get_build ~ctx n)
 end

lib/buildkite.atd

@@ -1,7 +1,32 @@
-type get_build_response = {
-  number: int;
+(* We keep this type an open enum because buildkite's documentation is not up to date and might have
+   more states. It shouldn't be an issue because we don't care about all the possible states. *)
+type build_state = [
+  | Blocked <json name="blocked">
+  | Canceled <json name="canceled">
+  | Canceling <json name="canceling">
+  | Failed <json name="failed">
+  | Failing <json name="failing">
+  | Finished <json name="finished">
+  | Not_run <json name="not_run">
+  | Passed <json name="passed">
+  | Running <json name="running">
+  | Scheduled <json name="scheduled">
+  | Skipped <json name="skipped">
+  | Other of string
+] <json open_enum> <ocaml repr="classic">
+
+type job = {
+  name: string;
+  state: build_state;
+  web_url: string;
+}
+
+type get_build_res = {
+  state: build_state;
+  created_at: string;
+  finished_at: string nullable;
+  jobs: job list;
   branch: string;
-  (* There are more fields, but we don't need/want them for now *)
 }
 
 (* This is a custom type for the steps state and not a Buildkite type. We have it here

lib/common.ml

@@ -72,15 +72,15 @@ module Slack_user_id = struct
   let to_channel_id = Slack_channel.Any.inject $ project
 end
 
-module VSet (S : Set.OrderedType) = struct
+module Set (S : Set.OrderedType) = struct
   include Set.Make (S)
 
   let wrap = of_list
   let unwrap = elements
 end
 
-module StringSet = VSet (String)
-module FailedStepSet = VSet (struct
+module StringSet = Set (String)
+module FailedStepSet = Set (struct
   type t = Buildkite_t.failed_step
   let compare (t1 : t) (t2 : t) = String.compare t1.name t2.name
 end)

lib/github.ml

@@ -153,6 +153,7 @@ let parse_exn ~get_build_branch headers body =
       match Stre.exists build_url "buildkite" with
       | false -> Lwt.return branches
       | true ->
+        log#info "Found multiple branches in notification, calling buildkite API to get the one for %s" build_url;
         (match%lwt get_build_branch n with
         | Ok branch -> Lwt.return [ branch ]
         | Error e ->

lib/slack.ml

@@ -308,7 +308,7 @@ let generate_push_notification notification channel =
 
 let buildkite_description_re = Re2.create_exn {|^Build #(\d+)(.*)|}
 
-let generate_status_notification ~(ctx : Context.t) ?slack_user_id (cfg : Config_t.config)
+let generate_status_notification ?slack_user_id ?failed_steps (cfg : Config_t.config)
   (notification : status_notification) channel =
   let { commit; state; description; target_url; context; repository; _ } = notification in
   let ({ commit : inner_commit; sha; html_url; _ } : status_commit) = commit in
@@ -404,15 +404,14 @@ let generate_status_notification ~(ctx : Context.t) ?slack_user_id (cfg : Config
     with
     | false -> []
     | true ->
-      let repo_state = State.find_or_add_repo ctx.state repository.url in
       let pipeline = notification.context in
       let slack_step_link (s : Buildkite_t.failed_step) =
         let step = Stre.drop_prefix s.name (pipeline ^ "/") in
-        sprintf "<%s|%s> " s.build_url step
+        sprintf "<%s|%s>" s.build_url step
       in
-      (match Build.new_failed_steps notification repo_state with
-      | [] -> []
-      | steps -> [ sprintf "*Steps broken*: %s" (String.concat ", " (List.map slack_step_link steps)) ])
+      (match failed_steps with
+      | None -> []
+      | Some steps -> [ sprintf "*Steps broken*: %s" (String.concat ", " (List.map slack_step_link steps)) ])
   in
   let msg = String.concat "\n" @@ List.concat [ commit_info; branches_info; failed_builds_info ] in
   let attachment =

lib/state.ml

@@ -91,6 +91,7 @@ let set_repo_pipeline_status { state } (n : Github_t.status_notification) =
     in
     let update_build_status builds_map build_number =
       match IntMap.find_opt build_number builds_map with
+      | None -> init_build_state
       | Some ({ failed_steps; is_finished; _ } as current_build_status : State_t.build_status) ->
         let failed_steps =
           match is_pipeline_step, n.state with
@@ -112,7 +113,6 @@ let set_repo_pipeline_status { state } (n : Github_t.status_notification) =
           finished_at;
           failed_steps;
         }
-      | None -> init_build_state
     in
     let update_pipeline_status =
       update_builds_in_branches ~branches:n.branches