use synchronous I/O for local file manipulation for simplicity

Author: yasunariw

lib/api_local.ml

@@ -9,15 +9,14 @@ let cache_dir = Caml.Filename.concat cwd "github-api-cache"
 module Github : Api.Github = struct
   let get_config ~(ctx : Context.t) ~repo:_ =
     let url = Caml.Filename.concat cwd ctx.config_filename in
-    match%lwt get_local_file url with
-    | Error e -> Lwt.return @@ fmt_error "error while getting local file: %s\nfailed to get config %s" e url
-    | Ok res -> Lwt.return @@ Ok (Config_j.config_of_string res)
+    try Lwt.return @@ Ok (url |> get_local_file |> Config_j.config_of_string)
+    with Sys_error e -> Lwt.return @@ fmt_error "error while getting local file: %s\nfailed to get config %s" e url
 
   let get_api_commit ~ctx:_ ~repo:_ ~sha =
     let url = Caml.Filename.concat cache_dir sha in
-    match%lwt get_local_file url with
-    | Error e -> Lwt.return @@ fmt_error "error while getting local file: %s\nfailed to get api commit %s" e url
-    | Ok res -> Lwt.return @@ Ok (Github_j.api_commit_of_string res)
+    try Lwt.return @@ Ok (url |> get_local_file |> Github_j.api_commit_of_string)
+    with Sys_error e ->
+      Lwt.return @@ fmt_error "error while getting local file: %s\nfailed to get api commit %s" e url
 end
 
 module Slack : Api.Slack = struct

lib/common.ml

@@ -42,16 +42,6 @@ let http_request ?headers ?body meth path =
   | `Ok s -> Lwt.return @@ Ok s
   | `Error e -> Lwt.return @@ Error e
 
-let get_local_file path =
-  try%lwt
-    let%lwt data = Lwt_io.with_file ~mode:Lwt_io.input path (fun ic -> Lwt_io.read ic) in
-    Lwt.return @@ Ok data
-  with exn -> Lwt.return @@ Error (Exn.str exn)
-
-let write_to_local_file ~data path =
-  try%lwt
-    let%lwt () =
-      Lwt_io.with_file ~flags:[ O_CREAT; O_WRONLY; O_TRUNC ] ~mode:Lwt_io.output path (fun oc -> Lwt_io.write oc data)
-    in
-    Lwt.return @@ Ok ()
-  with exn -> Lwt.return @@ Error (Exn.str exn)
+let get_local_file path = Std.input_file path
+
+let write_to_local_file ~data path = Devkit.Files.save_as path (fun oc -> Stdio.Out_channel.fprintf oc "%s" data)

lib/context.ml

@@ -53,20 +53,17 @@ let log = Log.from "context"
 
 let refresh_secrets ctx =
   let path = ctx.secrets_filepath in
-  match%lwt get_local_file path with
-  | Ok res ->
-    ctx.secrets <- Some (Config_j.secrets_of_string res);
-    Lwt.return @@ Ok ctx
-  | Error e -> Lwt.return @@ fmt_error "error while getting local file: %s\nfailed to get secrets from file %s" e path
+  try
+    ctx.secrets <- Some (path |> get_local_file |> Config_j.secrets_of_string);
+    Ok ctx
+  with Sys_error e -> fmt_error "error while getting local file: %s\nfailed to get secrets from file %s" e path
 
 let refresh_state ctx =
   match ctx.state_filepath with
-  | None -> Lwt.return @@ Ok ctx
+  | None -> Ok ctx
   | Some path ->
-    ( match%lwt get_local_file path with
-    | Ok res ->
-      log#info "loading saved state from file %s" path;
-      let state = State_j.state_of_string res in
-      Lwt.return @@ Ok { ctx with state }
-    | Error e -> Lwt.return @@ fmt_error "error while getting local file: %s\nfailed to get state from file %s" e path
-    )
+  try
+    log#info "loading saved state from file %s" path;
+    let state = path |> get_local_file |> State_j.state_of_string in
+    Ok { ctx with state }
+  with Sys_error e -> fmt_error "error while getting local file: %s\nfailed to get state from file %s" e path

src/notabot.ml

@@ -11,48 +11,31 @@ let log = Log.from "monorobot"
 let http_server_action addr port config secrets state =
   log#info "monorobot starting";
   let ctx = Context.make ~config_filename:config ~secrets_filepath:secrets ?state_filepath:state () in
-  Lwt_main.run
-    ( match%lwt Context.refresh_secrets ctx with
-    | Error e ->
-      log#error "%s" e;
-      Lwt.return_unit
-    | Ok ctx ->
-      ( match%lwt Context.refresh_state ctx with
-      | Error e ->
-        log#error "%s" e;
-        Lwt.return_unit
-      | Ok ctx -> Request_handler.run ~ctx ~addr ~port
-      )
-    )
+  match Context.refresh_secrets ctx with
+  | Error e -> log#error "%s" e
+  | Ok ctx ->
+  match Context.refresh_state ctx with
+  | Error e -> log#error "%s" e
+  | Ok ctx -> Lwt_main.run (Request_handler.run ~ctx ~addr ~port)
 
 (** In check mode, instead of actually sending the message to slack, we
     simply print it in the console *)
 let check_gh_action file json config secrets state =
-  Lwt_main.run
-    begin
-      match Github.event_of_filename file with
-      | None ->
-        log#error "aborting because payload %s is not named properly, named should be KIND.NAME_OF_PAYLOAD.json" file;
-        Lwt.return_unit
-      | Some kind ->
-        let headers = [ "x-github-event", kind ] in
-        ( match%lwt Common.get_local_file file with
-        | Error e ->
-          log#error "%s" e;
-          Lwt.return_unit
-        | Ok body ->
-          let ctx = Context.make ~config_filename:config ~secrets_filepath:secrets ?state_filepath:state () in
-          let%lwt () =
-            if json then
-              let module Action = Action.Action (Api_remote.Github) (Api_local.Slack_json) in
-              Action.process_github_notification ctx headers body
-            else
-              let module Action = Action.Action (Api_remote.Github) (Api_local.Slack_simple) in
-              Action.process_github_notification ctx headers body
-          in
-          Lwt.return_unit
-        )
-    end
+  match Github.event_of_filename file with
+  | None ->
+    log#error "aborting because payload %s is not named properly, named should be KIND.NAME_OF_PAYLOAD.json" file
+  | Some kind ->
+    let headers = [ "x-github-event", kind ] in
+    let body = Common.get_local_file file in
+    let ctx = Context.make ~config_filename:config ~secrets_filepath:secrets ?state_filepath:state () in
+    Lwt_main.run
+      ( if json then
+        let module Action = Action.Action (Api_remote.Github) (Api_local.Slack_json) in
+        Action.process_github_notification ctx headers body
+      else
+        let module Action = Action.Action (Api_remote.Github) (Api_local.Slack_simple) in
+        Action.process_github_notification ctx headers body
+      )
 
 let check_slack_action url file =
   let data = Stdio.In_channel.read_all file in

test/test.ml

@@ -24,24 +24,20 @@ let process ~(ctx : Context.t) (kind, path, state_path) =
     match state_path with
     | None -> Lwt.return { ctx with state = State.empty }
     | Some state_path ->
-      ( match%lwt Common.get_local_file state_path with
-      | Error e ->
-        log#error "failed to read %s: %s" state_path e;
-        Lwt.return ctx
-      | Ok file ->
-        let state = State_j.state_of_string file in
-        Lwt.return { ctx with state }
-      )
+    try
+      let state = state_path |> Common.get_local_file |> State_j.state_of_string in
+      Lwt.return { ctx with state }
+    with Sys_error e ->
+      log#error "failed to read %s: %s" state_path e;
+      Lwt.return ctx
   in
   Stdio.printf "===== file %s =====\n" path;
   let headers = [ "x-github-event", kind ] in
-  match%lwt Common.get_local_file path with
-  | Error e ->
-    log#error "failed to read %s: %s" path e;
-    Lwt.return_unit
-  | Ok event ->
+  try
+    let event = Common.get_local_file path in
     let%lwt _ctx = Action_local.process_github_notification ctx headers event in
     Lwt.return_unit
+  with Sys_error e -> Lwt.return @@ log#error "failed to read %s: %s" path e
 
 let () =
   let payloads = get_mock_payloads () in
@@ -56,7 +52,7 @@ let () =
       (* can remove this wrapper once status_rules doesn't depend on Config.t *)
       let config = Config.make config in
       let ctx = { ctx with config = Some config } in
-      ( match%lwt Context.refresh_secrets ctx with
+      ( match Context.refresh_secrets ctx with
       | Ok ctx -> Lwt_list.iter_s (process ~ctx) payloads
       | Error e ->
         log#error "failed to read secrets:";