move config into its own hashtable

lib/action.ml

@@ -88,7 +88,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
 
   let partition_status (ctx : Context.t) (n : status_notification) =
     let repo = n.repository in
-    let cfg = State.find_repo_config_exn ctx.state repo.url 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
@@ -111,8 +111,8 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
         | Ok commit -> Lwt.return @@ partition_commit cfg commit.files
         )
     in
-    if State.is_pipeline_allowed ctx.state repo.url ~pipeline then begin
-      let repo_state = State.find_repo_exn ctx.state repo.url 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
@@ -131,7 +131,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     else Lwt.return []
 
   let partition_commit_comment (ctx : Context.t) n =
-    let cfg = State.find_repo_config_exn ctx.state n.repository.url in
+    let cfg = Context.find_repo_config_exn ctx n.repository.url in
     match n.comment.commit_id with
     | None -> action_error "unable to find commit id for this commit comment event"
     | Some sha ->
@@ -151,7 +151,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
 
   let generate_notifications (ctx : Context.t) req =
     let repo = Github.repo_of_notification req in
-    let cfg = State.find_repo_config_exn ctx.state repo.url in
+    let cfg = Context.find_repo_config_exn ctx repo.url in
     match req with
     | Github.Push n ->
       partition_push cfg n |> List.map ~f:(fun (channel, n) -> generate_push_notification n channel) |> Lwt.return
@@ -181,20 +181,19 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     Lwt_list.iter_s notify notifications
 
   (** `refresh_repo_config ctx n` fetches the latest repo config if it's
-      uninitialized in state, or if the incoming request `n` is a push
+      uninitialized, or if the incoming request `n` is a push
       notification containing commits that touched the config file. *)
   let refresh_repo_config (ctx : Context.t) notification =
     let repo = Github.repo_of_notification notification in
     let fetch_config () =
       match%lwt Github_api.get_config ~ctx ~repo with
       | Ok config ->
-        State.set_repo_config ctx.state ~repo_url:repo.url ~config;
+        Context.set_repo_config ctx repo.url config;
         Context.print_config ctx repo.url;
         Lwt.return @@ Ok ()
       | Error e -> action_error e
     in
-    let repo_state = State.find_or_add_repo ctx.state repo.url in
-    match repo_state.config with
+    match Context.find_repo_config ctx repo.url with
     | None -> fetch_config ()
     | Some _ ->
     match notification with
@@ -251,9 +250,6 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     | Context.Context_error msg ->
       log#error "%s" msg;
       Lwt.return_unit
-    | State.State_error msg ->
-      log#error "%s" msg;
-      Lwt.return_unit
 
   let process_link_shared_event (ctx : Context.t) (event : Slack_t.link_shared_event) =
     let process link =

lib/context.ml

@@ -4,13 +4,14 @@ open Devkit
 
 exception Context_error of string
 
-let context_error msg = raise (Context_error msg)
+let context_error fmt = Printf.ksprintf (fun msg -> raise (Context_error msg)) fmt
 
 type t = {
   config_filename : string;
   secrets_filepath : string;
   state_filepath : string option;
   mutable secrets : Config_t.secrets option;
+  config : Config_t.config Table.t;
   state : State_t.state;
 }
 
@@ -20,6 +21,7 @@ let default () : t =
     secrets_filepath = "secrets.json";
     state_filepath = None;
     secrets = None;
+    config = Table.empty ();
     state = State.empty ();
   }
 
@@ -34,6 +36,15 @@ let get_secrets_exn ctx =
   | None -> context_error "secrets is uninitialized"
   | Some secrets -> secrets
 
+let find_repo_config ctx repo_url = Hashtbl.find ctx.config repo_url
+
+let find_repo_config_exn ctx repo_url =
+  match find_repo_config ctx repo_url with
+  | None -> context_error "config uninitialized for repo %s" repo_url
+  | Some config -> config
+
+let set_repo_config ctx repo_url config = Hashtbl.set ctx.config ~key:repo_url ~data:config
+
 let gh_token_of_secrets (secrets : Config_t.secrets) repo_url =
   match Map.find secrets.repos repo_url with
   | None -> secrets.gh_token
@@ -50,6 +61,18 @@ let hook_of_channel ctx channel_name =
   | Some hook -> Some hook.url
   | None -> None
 
+(** `is_pipeline_allowed s r p` returns `true` if
+    `status_rules` doesn't define a whitelist of allowed
+    pipelines in the config of repo `r`, or if the list
+    contains pipeline `p`; returns `false` otherwise. *)
+let is_pipeline_allowed ctx repo_url ~pipeline =
+  match find_repo_config ctx repo_url with
+  | None -> false
+  | Some config ->
+  match config.status_rules.allowed_pipelines with
+  | Some allowed_pipelines when not @@ List.exists allowed_pipelines ~f:(String.equal pipeline) -> false
+  | _ -> true
+
 let log = Log.from "context"
 
 let refresh_secrets ctx =
@@ -81,7 +104,7 @@ let refresh_state ctx =
     else Ok ctx
 
 let print_config ctx repo_url =
-  let cfg = State.find_repo_config_exn ctx.state repo_url in
+  let cfg = find_repo_config_exn ctx repo_url in
   let secrets = get_secrets_exn ctx in
   let token = gh_hook_token_of_secrets secrets repo_url in
   log#info "using prefix routing:";

lib/state.atd

@@ -13,7 +13,6 @@ type pipeline_statuses = branch_statuses map_as_object
 
 (* The runtime state of a given GitHub repository *)
 type repo_state = {
-  ?config <ocaml mutable>: config option;
   pipeline_statuses <ocaml mutable>: pipeline_statuses
 }
 

lib/state.ml

@@ -2,54 +2,21 @@ open Base
 open Common
 open Devkit
 
-exception State_error of string
-
-let state_error fmt = Printf.ksprintf (fun msg -> raise (State_error msg)) fmt
-
-let empty_repo_state () : State_t.repo_state = { pipeline_statuses = StringMap.empty; config = None }
+let empty_repo_state () : State_t.repo_state = { pipeline_statuses = StringMap.empty }
 
 let empty () : State_t.state = { repos = Table.empty () }
 
 let find_or_add_repo (state : State_t.state) repo_url =
   Hashtbl.find_or_add state.repos repo_url ~default:empty_repo_state
 
-let find_repo_exn (state : State_t.state) repo_url =
-  match Hashtbl.find state.repos repo_url with
-  | None -> state_error "state uninitialized for repo %s" repo_url
-  | Some repo_state -> repo_state
-
-let find_repo_config_exn state repo_url =
-  match (find_repo_exn state repo_url).config with
-  | None -> state_error "config uninitialized for repo %s" repo_url
-  | Some config -> config
-
-let set_repo_config (state : State_t.state) ~repo_url ~config =
-  match Hashtbl.find state.repos repo_url with
-  | None -> state_error "state uninitialized for repo %s" repo_url
-  | Some repo_state -> repo_state.config <- Some config
-
 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
-  match Hashtbl.find state.repos repo_url with
-  | None -> state_error "state uninitialized for repo %s" repo_url
-  | Some repo_state ->
-    repo_state.pipeline_statuses <- Map.update repo_state.pipeline_statuses pipeline ~f:set_branch_status
-
-(** `is_pipeline_allowed s r p` returns `true` if
-    `status_rules` doesn't define a whitelist of allowed
-    pipelines in the config of repo `r`, or if the list
-    contains pipeline `p`; returns `false` otherwise. *)
-let is_pipeline_allowed (state : State_t.state) repo_url ~pipeline =
-  match (find_repo_exn state repo_url).config with
-  | None -> false
-  | Some config ->
-  match config.status_rules.allowed_pipelines with
-  | Some allowed_pipelines when not @@ List.exists allowed_pipelines ~f:(String.equal pipeline) -> false
-  | _ -> true
+  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"
 

test/test.ml

@@ -28,7 +28,7 @@ let process ~(secrets : Config_t.secrets) ~config (kind, path, state_path) =
     ignore (State.find_or_add_repo ctx.state repo.url);
     match state_path with
     | None ->
-      State.set_repo_config ctx.state ~config ~repo_url:repo.url;
+      Context.set_repo_config ctx repo.url config;
       Lwt.return ctx
     | Some state_path ->
     match Common.get_local_file state_path with
@@ -38,7 +38,7 @@ let process ~(secrets : Config_t.secrets) ~config (kind, path, state_path) =
     | Ok file ->
       let repo_state = State_j.repo_state_of_string file in
       Hashtbl.set ctx.state.repos ~key:repo.url ~data:repo_state;
-      State.set_repo_config ctx.state ~repo_url:repo.url ~config;
+      Context.set_repo_config ctx repo.url config;
       Lwt.return ctx
   in
   Stdio.printf "===== file %s =====\n" path;