state: atomic, no lwt

Author: yasunariw

lib/action.ml

@@ -136,7 +136,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
     let current_status = n.state in
     let rules = cfg.status_rules.rules in
     let action_on_match (branches : branch list) ~notify_channels ~notify_dm =
-      let%lwt () = State.set_repo_pipeline_status ctx.state repo.url ~pipeline ~branches ~status:current_status in
+      State.set_repo_pipeline_status ctx.state repo.url ~pipeline ~branches ~status:current_status;
       let%lwt direct_message =
         if notify_dm then begin
           match%lwt Slack_api.lookup_user ~ctx ~cfg ~email:n.commit.commit.author.email () with
@@ -172,7 +172,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
       Lwt.return (direct_message @ chans)
     in
     if Context.is_pipeline_allowed ctx repo.url ~pipeline then begin
-      let%lwt repo_state = State.find_or_add_repo ctx.state repo.url in
+      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, notify_channels, notify_dm) -> action_on_match n.branches ~notify_channels ~notify_dm
@@ -342,10 +342,9 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
             ( match ctx.state_filepath with
             | None -> Lwt.return_unit
             | Some path ->
-              ( match%lwt State.save ctx.state path with
-              | Ok () -> Lwt.return_unit
-              | Error e -> action_error e
-              )
+            match State.save ctx.state path with
+            | Ok () -> Lwt.return_unit
+            | Error e -> action_error e
             )
           )
         )
@@ -369,7 +368,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
           ctx.state_filepath
           |> Option.map_default
                (fun path ->
-                 match%lwt State.save ctx.state path with
+                 match State.save ctx.state path with
                  | Ok () -> Lwt.return_unit
                  | Error msg ->
                    log#warn "failed to save state file %s : %s" path msg;

lib/context.ml

@@ -100,7 +100,7 @@ let refresh_state ctx =
       | Error e -> fmt_error "error while getting local file: %s\nfailed to get state from file %s" e path
       | Ok file ->
         (* todo: extract state related parts to state.ml *)
-        let state = { ctx.state with state = State_j.state_of_string file } in
+        let state = { State.state = State_j.state_of_string file } in
         Ok { ctx with state }
     end
     else Ok ctx

lib/state.ml

@@ -1,16 +1,15 @@
 open Common
 open Devkit
 
-type t = {
-  state : State_t.state;
-  lock : Lwt_mutex.t;  (** protect access to mutable string map `pipeline_statuses` *)
-}
+let log = Log.from "state"
+
+type t = { state : State_t.state }
 
 let empty_repo_state () : State_t.repo_state = { pipeline_statuses = StringMap.empty }
 
 let empty () : t =
   let state = State_t.{ repos = Stringtbl.empty (); bot_user_id = None } in
-  { state; lock = Lwt_mutex.create () }
+  { state }
 
 let find_or_add_repo' state repo_url =
   match Stringtbl.find_opt state.State_t.repos repo_url with
@@ -20,31 +19,23 @@ let find_or_add_repo' state repo_url =
     Stringtbl.add state.State_t.repos repo_url new_repo;
     new_repo
 
-let set_repo_state { state; lock } repo_url repo_state =
-  Lwt_mutex.with_lock lock @@ fun () ->
-  Stringtbl.replace state.repos repo_url repo_state;
-  Lwt.return_unit
+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 find_or_add_repo { state; lock } repo_url =
-  Lwt_mutex.with_lock lock @@ fun () -> find_or_add_repo' state repo_url |> Lwt.return
-
-let set_repo_pipeline_status { state; lock } repo_url ~pipeline ~(branches : Github_t.branch list) ~status =
+let set_repo_pipeline_status { state } repo_url ~pipeline ~(branches : Github_t.branch list) ~status =
   let set_branch_status branch_statuses =
     let new_statuses = List.map (fun (b : Github_t.branch) -> b.name, status) branches in
     let init = Option.default StringMap.empty branch_statuses in
     Some (List.fold_left (fun m (key, data) -> StringMap.add key data m) init new_statuses)
   in
-  Lwt_mutex.with_lock lock @@ fun () ->
   let repo_state = find_or_add_repo' state repo_url in
-  repo_state.pipeline_statuses <- StringMap.update pipeline set_branch_status repo_state.pipeline_statuses;
-  Lwt.return_unit
+  repo_state.pipeline_statuses <- StringMap.update pipeline set_branch_status repo_state.pipeline_statuses
 
 let set_bot_user_id { state; _ } user_id = state.State_t.bot_user_id <- Some user_id
 let get_bot_user_id { state; _ } = state.State_t.bot_user_id
-let log = Log.from "state"
 
 let save { state; _ } path =
   let data = State_j.string_of_state state |> Yojson.Basic.from_string |> Yojson.Basic.pretty_to_string in
   match write_to_local_file ~data path with
-  | Ok () -> Lwt.return @@ Ok ()
-  | Error e -> Lwt.return @@ fmt_error "error while writing to local file %s: %s\nfailed to save state" path e
+  | Ok () -> Ok ()
+  | Error e -> fmt_error "error while writing to local file %s: %s\nfailed to save state" path e

test/test.ml

@@ -40,7 +40,7 @@ let process_gh_payload ~(secrets : Config_t.secrets) ~config (kind, path, state_
     let secrets = { secrets with repos = [ { url = repo.url; gh_token = None; gh_hook_secret = None } ] } in
     let ctx = Context.make () in
     ctx.secrets <- Some secrets;
-    let%lwt _ = State.find_or_add_repo ctx.state repo.url in
+    let (_ : State_t.repo_state) = State.find_or_add_repo ctx.state repo.url in
     match state_path with
     | None ->
       Context.set_repo_config ctx repo.url config;
@@ -52,7 +52,7 @@ let process_gh_payload ~(secrets : Config_t.secrets) ~config (kind, path, state_
       Lwt.return ctx
     | Ok file ->
       let repo_state = State_j.repo_state_of_string file in
-      let%lwt () = State.set_repo_state ctx.state repo.url repo_state in
+      State.set_repo_state ctx.state repo.url repo_state;
       Context.set_repo_config ctx repo.url config;
       Lwt.return ctx
   in