Skip to content

Commit

Permalink
use synchronous I/O for local file manipulation for simplicity
Browse files Browse the repository at this point in the history
  • Loading branch information
yasunariw committed Dec 23, 2020
1 parent dc00f53 commit 5e0d7af
Show file tree
Hide file tree
Showing 5 changed files with 50 additions and 85 deletions.
11 changes: 5 additions & 6 deletions lib/api_local.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
16 changes: 3 additions & 13 deletions lib/common.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
25 changes: 11 additions & 14 deletions lib/context.ml
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ 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;
Expand Down Expand Up @@ -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
59 changes: 21 additions & 38 deletions src/notabot.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
24 changes: 10 additions & 14 deletions test/test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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:";
Expand Down

0 comments on commit 5e0d7af

Please sign in to comment.