state: store runtime repo state in a hash table indexed by repo url

Author: yasunariw

lib/action.ml

@@ -100,7 +100,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     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 ctx repo.url ~pipeline ~branches ~status:current_status in
+      State.set_repo_pipeline_status ctx.state repo.url ~pipeline ~branches ~status:current_status;
       match List.is_empty branches with
       | true -> Lwt.return []
       | false ->
@@ -118,11 +118,12 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
         )
     in
     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 -> action_on_match n.branches
       | Some Allow_once ->
-      match Map.find ctx.state.pipeline_statuses pipeline with
+      match Map.find repo_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

lib/context.ml

@@ -22,7 +22,7 @@ let default : t =
     state_filepath = None;
     secrets = None;
     config = Stringtbl.empty ();
-    state = State.empty;
+    state = State.empty ();
   }
 
 let make ?config_filename ?secrets_filepath ?state_filepath () =
@@ -61,9 +61,6 @@ let is_pipeline_allowed ctx repo_url ~pipeline =
   | Some allowed_pipelines when not @@ List.exists allowed_pipelines ~f:(String.equal pipeline) -> false
   | _ -> true
 
-let refresh_pipeline_status ctx repo_url ~pipeline ~(branches : Github_t.branch list) ~status =
-  if is_pipeline_allowed ctx repo_url ~pipeline then State.refresh_pipeline_status ctx.state ~pipeline ~branches ~status
-
 let log = Log.from "context"
 
 let refresh_secrets ctx =

lib/state.atd

@@ -1,5 +1,6 @@
 type status_state <ocaml from="Github"> = abstract
 type 'v map_as_object <ocaml from="Common"> = abstract
+type 'v table_as_object <ocaml from="Common"> = abstract
 
 (* A map from branch names to build statuses *)
 type branch_statuses = status_state map_as_object
@@ -9,8 +10,13 @@ type branch_statuses = status_state map_as_object
    branch *)
 type pipeline_statuses = branch_statuses map_as_object
 
+(* The runtime state of a given GitHub repository *)
+type repo_state = {
+  pipeline_statuses <ocaml mutable>: pipeline_statuses
+}
+
 (* The serializable runtime state of the bot *)
 type state = {
-  pipeline_statuses <ocaml mutable>: pipeline_statuses;
+  repos : repo_state table_as_object;
   ?bot_user_id <ocaml mutable>: string nullable;
 }

lib/state.ml

@@ -2,15 +2,21 @@ open Base
 open Common
 open Devkit
 
-let empty : State_t.state = { pipeline_statuses = StringMap.empty; bot_user_id = None }
+let empty_repo_state () : State_t.repo_state = { pipeline_statuses = StringMap.empty }
 
-let refresh_pipeline_status (state : State_t.state) ~pipeline ~(branches : Github_t.branch list) ~status =
-  let update_pipeline_status branch_statuses =
+let empty () : State_t.state = { repos = Stringtbl.empty (); bot_user_id = None }
+
+let find_or_add_repo (state : State_t.state) repo_url =
+  Stringtbl.find_or_add state.repos repo_url ~default:empty_repo_state
+
+let set_repo_pipeline_status (state : State_t.state) repo_url ~pipeline ~(branches : Github_t.branch list) ~status =
+  let set_branch_status branch_statuses =
     let new_statuses = List.map branches ~f:(fun b -> b.name, status) in
     let init = Option.value branch_statuses ~default:(Map.empty (module String)) in
     List.fold_left new_statuses ~init ~f:(fun m (key, data) -> Map.set m ~key ~data)
   in
-  state.pipeline_statuses <- Map.update state.pipeline_statuses pipeline ~f:update_pipeline_status
+  let repo_state = find_or_add_repo state repo_url in
+  repo_state.pipeline_statuses <- Map.update repo_state.pipeline_statuses pipeline ~f:set_branch_status
 
 let log = Log.from "state"