store retrieved jobs in state

lib/action.ml

@@ -489,7 +489,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) (Buildkite_api :
     in
     try%lwt
       let secrets = Context.get_secrets_exn ctx in
-      match%lwt Github.parse_exn headers body ~get_build:(Buildkite_api.get_build ~ctx) with
+      match%lwt Github.parse_exn headers body ~get_build_branch:(Buildkite_api.get_build_branch ~ctx) with
       | exception Failure msg ->
         log#warn "skipping event : %s" msg;
         Lwt.return_unit

lib/api.ml

@@ -39,5 +39,7 @@ module type Slack = sig
 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 : 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 ~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,6 +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 Buildkite_j.get_build_res_of_string
+      with_cache_file url read
     | _ -> failwith "failed to get all build details from the notification. Is this a Buildkite notification?"
+
+  let get_build_branch ~ctx:_ (n : Github_t.status_notification) =
+    get_build' n (fun s : Github_t.branch ->
+        let { branch; _ } : Buildkite_t.get_branch_res = Buildkite_j.get_branch_res_of_string s in
+        { name = branch })
+
+  let get_build ~ctx:_ (n : Github_t.status_notification) = get_build' n Buildkite_j.get_build_res_of_string
 end

lib/api_remote.ml

@@ -230,11 +230,18 @@ end
 module Buildkite : Api.Buildkite = struct
   let log = Log.from "buildkite"
 
+  module Build_branches_cache = Cache (struct
+    type t = Buildkite_t.get_branch_res
+  end)
+
+  (* We need a separate cache for builds because we get the branch information at a different point
+     in the build and we'd not be able to get the failed jobs state if we used the same cache *)
   module Builds_cache = Cache (struct
     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. *)
+  let build_branches_cache = Build_branches_cache.create ~ttl:Build_branches_cache.default_purge_interval ()
   let builds_cache = Builds_cache.create ~ttl:Builds_cache.default_purge_interval ()
 
   let buildkite_api_request ?headers ?body meth url read =
@@ -257,24 +264,35 @@ 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 Util.Build.get_org_pipeline_build n with
+    | Error e -> Lwt.return_error e
+    | Ok (org, pipeline, build_nr) ->
+    match Build_branches_cache.get build_branches_cache build_nr with
+    | Some build -> Lwt.return_ok ({ name = build.branch } : Github_t.branch)
+    | None ->
+      let build_url = sprintf "organizations/%s/pipelines/%s/builds/%s" org pipeline build_nr in
+      (match%lwt
+         request_token_auth ~name:"get build branch" ~ctx `GET build_url Buildkite_j.get_branch_res_of_string
+       with
+      | Ok build ->
+        Build_branches_cache.set build_branches_cache build_nr build;
+        Lwt.return_ok ({ name = build.branch } : Github_t.branch)
+      | Error e -> Lwt.return_error e)
+
   let get_build ~(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 build
-      | None ->
-        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_res_of_string
-         with
-        | Ok build ->
-          Builds_cache.set builds_cache build_nr build;
-          Lwt.return_ok build
-        | Error e -> Lwt.return_error e))
-    | _ -> failwith "failed to get the build details from the notification. Is this a Buildkite notification?"
+    match Util.Build.get_org_pipeline_build n with
+    | Error e -> Lwt.return_error e
+    | Ok (org, pipeline, build_nr) ->
+    match Builds_cache.get builds_cache build_nr with
+    | Some build -> Lwt.return_ok build
+    | None ->
+      let build_url = sprintf "organizations/%s/pipelines/%s/builds/%s" org pipeline build_nr in
+      (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 build
+      | Error e -> Lwt.return_error e)
 end

lib/buildkite.atd

@@ -21,12 +21,16 @@ type job = {
   web_url: string;
 }
 
-type get_build_res = {
-  number: int;
+(* There are more fields for the /builds response, but we don't need/want them for now *)
+type get_branch_res = {
   branch: string;
+}
+
+type get_build_res = {
   state: build_state;
+  created_at: string;
+  finished_at: string nullable;
   jobs: job list;
-  (* 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

@@ -78,7 +78,7 @@ let validate_signature ?signing_key ~headers body =
 (** Parse a payload. The type of the payload is detected from the headers.
 
     @raise Failure if unable to extract event from header *)
-let parse_exn ~get_build headers body =
+let parse_exn ~get_build_branch headers body =
   let string_of_abstract_issue_state = function
     | Open -> "open"
     | Closed -> "closed"
@@ -154,8 +154,8 @@ let parse_exn ~get_build headers body =
       | 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 n with
-        | Ok (build : Buildkite_t.get_build_res) -> Lwt.return [ ({ name = build.branch } : Github_t.branch) ]
+        (match%lwt get_build_branch n with
+        | Ok branch -> Lwt.return [ branch ]
         | Error e ->
           log#error "failed to get buildkite build details: %s" e;
           Lwt.return branches)

lib/slack.ml

@@ -407,7 +407,7 @@ let generate_status_notification ?slack_user_id ?failed_steps (cfg : Config_t.co
       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 failed_steps with
       | None -> []

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

lib/util.ml

@@ -82,6 +82,15 @@ module Build = struct
     | build_number -> int_of_string build_number
     | exception _ -> failwith "failed to get build number from url"
 
+  let get_org_pipeline_build (n : Github_t.status_notification) =
+    match n.target_url with
+    | None -> Error "no build url. Is this a Buildkite notification?"
+    | Some build_url ->
+    match Re2.find_submatches_exn 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 |] -> Ok (org, pipeline, build_nr)
+    | _ -> failwith "failed to get the build details from the notification. Is this a Buildkite notification?"
+
   let is_failed_build (n : Github_t.status_notification) =
     n.state = Failure && Re2.matches buildkite_is_failed_re (Option.default "" n.description)
 
@@ -138,25 +147,75 @@ module Build = struct
           | Ok (build : Buildkite_t.get_build_res) ->
           match build.state with
           | Failed | Canceled ->
-            Lwt.return
-            @@ FailedStepSet.of_list
-            @@ List.filter_map
-                 (fun (j : Buildkite_t.job) ->
-                   match j.state with
-                   | Failed -> Some { Buildkite_t.name = j.name; build_url = j.web_url }
-                   | _ -> None)
-                 build.jobs
+            (* if we get here, we know we can use parse_context_exn *)
+            let { pipeline_name; _ } = parse_context_exn ~context:n.context in
+            let failed_steps =
+              FailedStepSet.of_list
+              @@ List.filter_map
+                   (fun (j : Buildkite_t.job) ->
+                     match j.state with
+                     | Failed -> Some { Buildkite_t.name = String.lowercase_ascii j.name; build_url = j.web_url }
+                     | _ -> None)
+                   build.jobs
+            in
+            (* we may not have this build in state, so we need to create one in that case.
+               We need to have a little bit of duplication with state.ml to avoid circular dependencies *)
+            let init_build_state =
+              {
+                State_t.status = n.state;
+                build_number = current_build_number;
+                build_url;
+                commit =
+                  { sha = n.sha; author = n.commit.commit.author.email; commit_message = n.commit.commit.message };
+                is_finished = true;
+                is_canceled = build.state = Canceled;
+                failed_steps;
+                created_at = Timestamp.wrap build.created_at;
+                finished_at = Option.map Timestamp.wrap build.finished_at;
+              }
+            in
+            let update_build_status builds_map =
+              let updated_status =
+                match IntMap.find_opt current_build_number builds_map with
+                | Some (current_build_status : State_t.build_status) -> { current_build_status with failed_steps }
+                | None -> init_build_state
+              in
+              IntMap.add current_build_number updated_status builds_map
+            in
+            let update_pipeline_status branches_statuses =
+              let init_branch_state = IntMap.singleton current_build_number init_build_state in
+              let current_statuses = Option.default StringMap.empty branches_statuses in
+              let updated_statuses =
+                List.map
+                  (fun (branch : Github_t.branch) ->
+                    let builds_map =
+                      Option.map_default
+                        (fun branches_statuses ->
+                          match StringMap.find_opt branch.name branches_statuses with
+                          | Some builds_map -> update_build_status builds_map
+                          | None -> init_branch_state)
+                        init_branch_state branches_statuses
+                    in
+                    branch.name, builds_map)
+                  n.branches
+              in
+              Some (List.fold_left (fun m (key, data) -> StringMap.add key data m) current_statuses updated_statuses)
+            in
+            (* we need to update the state with the failed steps, otherwise we can't calculate
+               the new failed steps in future builds *)
+            repo_state.pipeline_statuses <-
+              StringMap.update pipeline_name update_pipeline_status repo_state.pipeline_statuses;
+            Lwt.return failed_steps
           | _ ->
             log#warn "build state for %s is not failed in buildkite. We will not calculate failed steps" build_url;
             Lwt.return @@ FailedStepSet.empty
         in
+        (* if the current build isn't in state, or doesn't have any failed steps in state, it might be that
+           we didn't get all the notifications, or that the step notifications might arrive after the build
+           failed notification. We need to get the build from the api and parse it to get the failed steps *)
         match get_current_build n repo_state with
         | Some b when not @@ FailedStepSet.is_empty b.failed_steps -> Lwt.return b.failed_steps
-        | Some _ ->
-          (* if the current build isn't in state, or doesn't have any failed steps in state, it might be that
-             we didn't get all the notifications, or that the step notifications might arrive after the build
-             failed notification. We need to get the build from the api and parse it to get the failed steps *)
-          get_failed_steps_from_buildkite ()
+        | Some _ -> get_failed_steps_from_buildkite ()
         | None ->
           log#warn "failed to find build %s in state, maybe it was cleaned up?" build_url;
           get_failed_steps_from_buildkite ()

test/slack_payloads.expected

@@ -609,7 +609,7 @@ will notify #failed-builds
       "fallback": null,
       "mrkdwn_in": [ "fields", "text" ],
       "color": "danger",
-      "text": "*Commit*: `<https://github.com/ahrefs/monorepo/commit/7e0a933e9c71b4ca107680ca958ca1888d5e479b|7e0a933e>` <@id[[email protected]]>\n*Branch*: develop\n*Steps broken*: <https://buildkite.com/ahrefs/pipeline2/builds/181732#0192347d-e4ee-4072-9da4-f441eeb65ed4|pipeline2/failed-step> "
+      "text": "*Commit*: `<https://github.com/ahrefs/monorepo/commit/7e0a933e9c71b4ca107680ca958ca1888d5e479b|7e0a933e>` <@id[[email protected]]>\n*Branch*: develop\n*Steps broken*: <https://buildkite.com/ahrefs/pipeline2/builds/181732#0192347d-e4ee-4072-9da4-f441eeb65ed4|pipeline2/failed-step>"
     }
   ],
   "unfurl_links": false
@@ -669,7 +669,7 @@ will notify #failed-builds
       "fallback": null,
       "mrkdwn_in": [ "fields", "text" ],
       "color": "danger",
-      "text": "*Commit*: `<https://github.com/ahrefs/monorepo/commit/0d95302addd66c1816bce1b1d495ed1c93ccd478|0d95302a>` <@id[[email protected]]>\n*Branch*: develop\n*Steps broken*: <https://buildkite.com/ahrefs/pipeline2/builds/2#0192347d-e4ee-4072-9da4-f441eeb65ed4|pipeline2/failed-step> "
+      "text": "*Commit*: `<https://github.com/ahrefs/monorepo/commit/0d95302addd66c1816bce1b1d495ed1c93ccd478|0d95302a>` <@id[[email protected]]>\n*Branch*: develop\n*Steps broken*: <https://buildkite.com/ahrefs/pipeline2/builds/2#0192347d-e4ee-4072-9da4-f441eeb65ed4|pipeline2/failed-step>"
     }
   ],
   "unfurl_links": false

test/test.ml

@@ -33,8 +33,8 @@ let process_gh_payload ~(secrets : Config_t.secrets) ~config (kind, path, state_
   let headers = [ "x-github-event", kind ] in
   let make_test_context event =
     let ctx = Context.make () in
-    let get_build = Api_local.Buildkite.get_build ~ctx in
-    let%lwt n = Github.parse_exn headers event ~get_build in
+    let get_build_branch = Api_local.Buildkite.get_build_branch ~ctx in
+    let%lwt n = Github.parse_exn headers event ~get_build_branch in
     let repo = Github.repo_of_notification n in
     (* overwrite repo url in secrets with that of notification for this test case *)
     let secrets = { secrets with repos = [ { url = repo.url; gh_token = None; gh_hook_secret = None } ] } in