add builds map to pipeline state

lib/action.ml

@@ -161,7 +161,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
         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;
+            State.set_repo_pipeline_commit ctx.state n;
             (* To send a DM, channel parameter is set to the user id of the recipient *)
             Lwt.return [ Slack_user_id.to_channel_id res.user.id ]
           | Error e ->
@@ -233,7 +233,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
       end
       else Lwt.return []
     in
-    State.set_repo_pipeline_status ctx.state repo.url ~pipeline n;
+    State.set_repo_pipeline_status_new ctx.state n;
     Lwt.return recipients
 
   let partition_commit_comment (ctx : Context.t) n =

lib/state.atd

@@ -7,6 +7,38 @@ type user_id = string wrap <ocaml t="Common.Slack_user_id.t" wrap="Common.Slack_
 type channel_id = string wrap <ocaml t="Common.Slack_channel.Ident.t" wrap="Common.Slack_channel.Ident.inject" unwrap="Common.Slack_channel.Ident.project">
 type any_channel = string wrap <ocaml t="Common.Slack_channel.Any.t" wrap="Common.Slack_channel.Any.inject" unwrap="Common.Slack_channel.Any.project">
 
+type ci_commit_new = {
+  sha: string;
+  author: string;
+  commit_message: string;
+}
+
+type failed_step = {
+  name: string;
+  build_link: string option;
+}
+
+type build_status_new = {
+  status: status_state;
+  build_number: string;
+  build_link: string option;
+  commit: ci_commit_new;
+  is_finished: bool;
+  failed_steps: failed_step list;
+  created_at: string;
+  finished_at: string nullable;
+}
+
+(* A map from builds numbers to build statuses *)
+type build_statuses = build_status_new map_as_object
+
+(* A map from branch names to [build_statuses] maps *)
+type branch_statuses_new = build_statuses map_as_object
+
+(* A map from pipeline names to [branch_statuses] maps.
+   This tracks the last build state matched by the status_rules for each pipeline and branch *)
+type pipeline_statuses_new = branch_statuses_new map_as_object
+
 type ci_commit = {
   sha: string;
   author: string;
@@ -48,6 +80,7 @@ type slack_threads = slack_thread list map_as_object
 
 (* The runtime state of a given GitHub repository *)
 type repo_state = {
+  ~pipeline_statuses_new <ocaml mutable default="Common.StringMap.empty">: pipeline_statuses_new;
   ~pipeline_statuses <ocaml mutable default="Common.StringMap.empty">: pipeline_statuses;
   ~pipeline_commits <ocaml mutable default="Common.StringMap.empty">: pipeline_commits;
   ~slack_threads <ocaml mutable default="Common.StringMap.empty">: slack_threads;

lib/state.ml

@@ -6,7 +6,12 @@ let log = Log.from "state"
 type t = { state : State_t.state }
 
 let empty_repo_state () : State_t.repo_state =
-  { pipeline_statuses = StringMap.empty; pipeline_commits = StringMap.empty; slack_threads = StringMap.empty }
+  {
+    pipeline_statuses_new = StringMap.empty;
+    pipeline_statuses = StringMap.empty;
+    pipeline_commits = StringMap.empty;
+    slack_threads = StringMap.empty;
+  }
 
 let empty () : t =
   let state = State_t.{ repos = Stringtbl.empty (); bot_user_id = None } in
@@ -23,6 +28,77 @@ let find_or_add_repo' state repo_url =
 let set_repo_state { state } repo_url repo_state = Stringtbl.replace state.repos repo_url repo_state
 let find_or_add_repo { state } repo_url = find_or_add_repo' state repo_url
 
+let set_repo_pipeline_status_new { state } (n : Github_t.status_notification) =
+  let target_url = Option.get n.target_url in
+  let context = n.context in
+  let { Util.Build.is_pipeline_step; pipeline_name }, build_number =
+    match
+      ( Util.Build.parse_context ~context ~build_url:target_url,
+        Util.Build.get_build_number ~context ~build_url:target_url )
+    with
+    | Ok context, Ok build_number -> context, build_number
+    | Error msg, _ | _, Error msg -> failwith msg
+  in
+  let init_build_state =
+    (* TODO: handle getting a notification for a step before we get the notification for build started. (edge case).
+       What would happen is that the build status is created with the "wrong" state and with empty failing steps *)
+    {
+      State_t.status = n.state;
+      build_number;
+      build_link = n.target_url;
+      commit = { sha = n.sha; author = n.commit.commit.author.email; commit_message = n.commit.commit.message };
+      is_finished = false;
+      failed_steps = [];
+      created_at = n.updated_at;
+      finished_at = None;
+    }
+  in
+  let update_build_status builds_map build_number =
+    match StringMap.find_opt build_number builds_map with
+    | Some (current_build_status : State_t.build_status_new) ->
+      let is_finished = is_pipeline_step = false && (n.state = Success || n.state = Failure || n.state = Error) in
+      let finished_at = if is_finished then Some n.updated_at else None in
+      let failed_steps =
+        if is_pipeline_step && n.state = Failure then
+          { State_t.name = n.context; build_link = n.target_url } :: current_build_status.failed_steps
+        else current_build_status.failed_steps
+      in
+      { current_build_status with status = n.state; is_finished; finished_at; failed_steps }
+    | None -> init_build_state
+  in
+  let update_branch_status branches_statuses =
+    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 ->
+                  let updated_status = update_build_status builds_map build_number in
+                  StringMap.add build_number updated_status builds_map
+                | None -> StringMap.singleton build_number init_build_state)
+              (StringMap.singleton build_number init_build_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
+  let repo_state = find_or_add_repo' state n.repository.url in
+  match n.state with
+  | Success ->
+    (* if the build/step is successful, we remove it from the state to avoid the file to grow too much.
+       We only clean up on the whole pipeline, not on individual steps *)
+    (* TODO: what do we want here? Should it be taken care of by another function? *)
+    if not is_pipeline_step then
+      repo_state.pipeline_statuses_new <- StringMap.remove pipeline_name repo_state.pipeline_statuses_new
+  | _ ->
+    repo_state.pipeline_statuses_new <-
+      StringMap.update pipeline_name update_branch_status repo_state.pipeline_statuses_new
+
 let set_repo_pipeline_status { state } repo_url ~pipeline (notification : Github_t.status_notification) =
   let branches = notification.branches in
   let set_branch_status per_branch_statuses =
@@ -86,12 +162,18 @@ let set_repo_pipeline_status { state } repo_url ~pipeline (notification : Github
     repo_state.pipeline_statuses <- StringMap.remove pipeline repo_state.pipeline_statuses
   | _ -> repo_state.pipeline_statuses <- StringMap.update pipeline set_branch_status repo_state.pipeline_statuses
 
-let set_repo_pipeline_commit { state } repo_url ~pipeline ~commit =
+let set_repo_pipeline_commit { state } (n : Github_t.status_notification) =
   let rotation_threshold = 1000 in
-  let repo_state = find_or_add_repo' state repo_url in
+  let repo_state = find_or_add_repo' state n.repository.url in
+  let pipeline =
+    (* We only need to track messages for the base pipeline, not the steps *)
+    match Util.Build.parse_context ~context:n.context ~build_url:(Option.get n.target_url) with
+    | Ok { Util.Build.pipeline_name; _ } -> pipeline_name
+    | Error _ -> n.context
+  in
   let set_commit commits =
     let { State_t.s1; s2 } = Option.default { State_t.s1 = StringSet.empty; s2 = StringSet.empty } commits in
-    let s1 = StringSet.add commit s1 in
+    let s1 = StringSet.add n.sha s1 in
     let s1, s2 = if StringSet.cardinal s1 > rotation_threshold then StringSet.empty, s1 else s1, s2 in
     Some { State_t.s1; s2 }
   in

lib/util.ml

@@ -28,8 +28,45 @@ 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
+  type pipeline_check = {
+    is_pipeline_step : bool;
+    pipeline_name : string;
+  }
+
   let buildkite_is_failed_re = Re2.create_exn {|^Build #\d+ failed|}
 
+  let parse_context ~context ~build_url =
+    let rec get_name context build_url =
+      match String.length context with
+      | 0 -> Error "failed to get pipeline name from notification"
+      | _ when Devkit.Stre.exists build_url (context ^ "/") ->
+        (* We need to add the "/" to context to avoid partial matches between the context and the build_url *)
+        Ok context
+      | _ ->
+      (* Matches the notification context against the build_url to get the base pipeline name.
+         Drop path levels from the context until we find a match with the build_url. This is the base name. *)
+      match String.rindex_opt context '/' with
+      | Some idx -> get_name (String.sub context 0 idx) build_url
+      | None -> Error "failed to get pipeline name from notification"
+    in
+    (* if we have a buildkit pipeline, we need to strip the `buildkite/` prefix to get the real name *)
+    let context' = Stre.drop_prefix context "buildkite/" in
+    let pipeline_name = get_name context' build_url in
+    Result.map (fun pipeline_name -> { is_pipeline_step = pipeline_name <> context'; pipeline_name }) pipeline_name
+
+  let get_build_number ~context ~build_url =
+    match parse_context ~context ~build_url with
+    | Error msg -> Error msg
+    | Ok { pipeline_name; _ } ->
+      (* build urls are in the form of .../<base_pipeline_name>/builds/<build_number>.
+         Pipeline steps have an html anchor after the build number *)
+      let re = Re2.create_exn (Printf.sprintf ".*/%s/builds/(\\d+)#?" pipeline_name) in
+      (match Re2.find_submatches_exn re build_url with
+      | [| _; Some build_number |] -> Ok build_number
+      | _ | (exception _) ->
+        (* we either match on the first case or get an exception. *)
+        Error "failed to get build number from url")
+
   let is_failed_build (n : Github_t.status_notification) =
     n.state = Failure && Re2.matches buildkite_is_failed_re (Option.default "" n.description)