Skip to content

Commit 0bb06b3

Browse files
yasunariwyasunariw
committed
switch fully to new context structure (breaks tests)
Temporarily disable auxiliary commands. Config.t is now mostly redundant but kept for compatibility with status_rules parsing.
1 parent 98869da commit 0bb06b3

15 files changed

+248
-451
lines changed

‎lib/action.ml‎

Lines changed: 112 additions & 78 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ let action_error msg = raise (Action_error msg)
1313
let log = Log.from "action"
1414

1515
module Github_api = Api_remote.Github
16+
module Slack_api = Api_remote.Slack
1617

1718
module Action = struct
1819
let partition_push cfg n =
@@ -90,56 +91,60 @@ module Action = struct
9091
if List.is_empty matched_channel_names then default else matched_channel_names
9192

9293
let partition_status (ctx : Context.t) (n : status_notification) =
93-
let cfg = ctx.cfg in
94-
let get_commit_info () =
95-
let default () = Lwt.return @@ Option.to_list cfg.prefix_rules.default_channel in
96-
match cfg.main_branch_name with
97-
| None -> default ()
98-
| Some main_branch_name ->
99-
(* non-main branch build notifications go to default channel to reduce spam in topic channels *)
100-
match List.exists n.branches ~f:(fun { name } -> String.equal name main_branch_name) with
101-
| false -> default ()
102-
| true ->
103-
( match%lwt Github.generate_query_commit cfg ~url:n.commit.url ~sha:n.commit.sha with
104-
| None -> default ()
105-
| Some commit ->
106-
(*
107-
match
108-
List.exists n.branches ~f:(fun { name } -> Github.is_main_merge_message ~msg:commit.commit.message ~branch:name cfg)
109-
with
110-
| true ->
111-
log#info "main branch merge, ignoring status event %s: %s" n.context (first_line commit.commit.message);
112-
Lwt.return []
113-
| false ->
114-
*)
115-
Lwt.return (partition_commit cfg commit.files)
116-
)
117-
in
118-
let res =
119-
match
120-
List.exists cfg.status_rules.status ~f:(fun x ->
121-
match x with
122-
| State s -> Poly.equal s n.state
123-
| HideConsecutiveSuccess -> Poly.equal Success n.state
124-
| _ -> false)
125-
with
126-
| false -> Lwt.return []
127-
| true ->
128-
match List.exists ~f:id [ Rule.Status.hide_cancelled n cfg; Rule.Status.hide_success n ctx ] with
129-
| true -> Lwt.return []
130-
| false ->
131-
match cfg.status_rules.title with
132-
| None -> get_commit_info ()
133-
| Some status_filter ->
134-
match List.exists status_filter ~f:(String.equal n.context) with
135-
| false -> Lwt.return []
136-
| true -> get_commit_info ()
137-
in
138-
Context.update_state ctx (Github.Status n);
139-
res
94+
match ctx.config with
95+
| None -> action_error "missing configuration file"
96+
| Some cfg ->
97+
let pipeline = n.context in
98+
let current_status = n.state in
99+
let updated_at = n.updated_at in
100+
let get_commit_info () =
101+
let default = Option.to_list cfg.prefix_rules.default_channel in
102+
let () =
103+
Context.refresh_pipeline_status ~pipeline ~branches:n.branches ~status:current_status ~updated_at ctx
104+
in
105+
match List.is_empty n.branches with
106+
| true -> Lwt.return []
107+
| false ->
108+
match cfg.main_branch_name with
109+
| None -> Lwt.return default
110+
| Some main_branch_name ->
111+
(* non-main branch build notifications go to default channel to reduce spam in topic channels *)
112+
match List.exists n.branches ~f:(fun { name } -> String.equal name main_branch_name) with
113+
| false -> Lwt.return default
114+
| true ->
115+
let sha = n.commit.sha in
116+
let repo = n.repository in
117+
( match%lwt Github_api.get_api_commit ~ctx ~repo ~sha with
118+
| Error e -> action_error e
119+
| Ok commit -> Lwt.return @@ partition_commit cfg commit.files
120+
)
121+
in
122+
let res =
123+
match
124+
List.exists cfg.status_rules.status ~f:(fun x ->
125+
match x with
126+
| State s -> Poly.equal s n.state
127+
| HideConsecutiveSuccess -> Poly.equal Success n.state
128+
| _ -> false)
129+
with
130+
| false -> Lwt.return []
131+
| true ->
132+
match List.exists ~f:id [ Rule.Status.hide_cancelled n cfg; Rule.Status.hide_success n ctx ] with
133+
| true -> Lwt.return []
134+
| false ->
135+
match cfg.status_rules.title with
136+
| None -> get_commit_info ()
137+
| Some status_filter ->
138+
match List.exists status_filter ~f:(String.equal n.context) with
139+
| false -> Lwt.return []
140+
| true -> get_commit_info ()
141+
in
142+
res
140143

141144
let partition_commit_comment (ctx : Context.t) n =
142-
let cfg = ctx.cfg in
145+
match ctx.config with
146+
| None -> action_error "missing configuration file"
147+
| Some cfg ->
143148
match n.comment.commit_id with
144149
| None -> action_error "unable to find commit id for this commit comment event"
145150
| Some sha ->
@@ -158,7 +163,9 @@ module Action = struct
158163
)
159164

160165
let generate_notifications (ctx : Context.t) req =
161-
let cfg = ctx.cfg in
166+
match ctx.config with
167+
| None -> action_error "missing configuration file"
168+
| Some cfg ->
162169
match req with
163170
| Github.Push n ->
164171
partition_push cfg n |> List.map ~f:(fun (webhook, n) -> webhook, generate_push_notification n) |> Lwt.return
@@ -187,37 +194,64 @@ module Action = struct
187194
Lwt.return notifs
188195
| _ -> Lwt.return []
189196

190-
let send_notifications (cfg : Config.t) notifications =
191-
Lwt_list.iter_s
192-
(fun (chan, msg) ->
193-
let url = Config.Chan_map.find chan cfg.chans in
194-
let data = Slack_j.string_of_webhook_notification msg in
195-
log#info "sending to %s : %s" chan data;
196-
Slack.send_notification url data)
197-
notifications
197+
let send_notifications (ctx : Context.t) notifications =
198+
let notify (chan, msg) =
199+
match Context.hook_of_channel ctx chan with
200+
| None ->
201+
log#error "webhook not defined for Slack channel '%s'" chan;
202+
Lwt.return_unit
203+
| Some url ->
204+
( match%lwt Slack_api.send_notification ~chan ~msg ~url with
205+
| Ok () -> Lwt.return_unit
206+
| Error e -> action_error e
207+
)
208+
in
209+
Lwt_list.iter_s notify notifications
198210

199-
let update_config (ctx : Context.t) = function
200-
| Github.Push n ->
201-
let is_config_file f = String.equal f ctx.data.cfg_filename in
202-
let commit_contains_config_file (c : Github_t.commit) = List.exists ~f:is_config_file (c.added @ c.modified) in
203-
if List.exists ~f:commit_contains_config_file n.commits then Context.refresh_config ctx else Lwt.return_unit
204-
| _ -> Lwt.return_unit
205-
206-
let process_github_notification (ctx_thunk : Context.context_thunk) headers body =
207-
match Github.parse_exn ~secret:ctx_thunk.secrets.gh_webhook_secret headers body with
208-
| exception exn -> Exn_lwt.fail ~exn "unable to parse payload"
209-
| payload ->
210-
try
211-
let%lwt ctx = Context.resolve_ctx_in_thunk ctx_thunk payload in
212-
let%lwt () = update_config ctx payload in
213-
let cfg = ctx.cfg in
214-
let%lwt notifications = generate_notifications ctx payload in
215-
send_notifications cfg notifications
211+
(** `refresh_config_of_context ctx n` updates the current context if the configuration
212+
hasn't been loaded yet, or if the incoming request `n` is a push
213+
notification containing commits that touched the config file. *)
214+
let refresh_config_of_context (ctx : Context.t) notification =
215+
let fetch_config () =
216+
let repo = Github.repo_of_notification notification in
217+
match%lwt Github_api.get_config ~ctx ~repo with
218+
| Ok config ->
219+
(* can remove this wrapper once status_rules doesn't depend on Config.t *)
220+
ctx.config <- Some (Config.make config);
221+
Lwt.return @@ Ok ()
222+
| Error e -> action_error e
223+
in
224+
match ctx.config with
225+
| None -> fetch_config ()
226+
| Some _ ->
227+
match notification with
228+
| Github.Push commit_pushed_notification ->
229+
let commits = commit_pushed_notification.commits in
230+
let modified_files = List.concat_map commits ~f:Github.modified_files_of_commit in
231+
let config_was_modified = List.exists modified_files ~f:(String.equal ctx.config_filename) in
232+
if config_was_modified then fetch_config () else Lwt.return @@ Ok ()
233+
| _ -> Lwt.return @@ Ok ()
234+
235+
let process_github_notification (ctx : Context.t) headers body =
236+
try%lwt
237+
match Github.parse_exn ~secret:ctx.gh_hook_token headers body with
238+
| exception exn -> Exn_lwt.fail ~exn "failed to parse payload"
239+
| payload ->
240+
( match%lwt refresh_config_of_context ctx payload with
241+
| Error e -> action_error e
242+
| Ok () ->
243+
let%lwt notifications = generate_notifications ctx payload in
244+
let%lwt () = send_notifications ctx notifications in
245+
( match ctx.state_filepath with
246+
| None -> Lwt.return_unit
247+
| Some path -> Lwt.return @@ State.save path ctx.state
248+
)
249+
)
216250
with
217-
| Context.Context_error s ->
218-
log#error "error creating context from payload: %s" s;
251+
| Yojson.Json_error msg ->
252+
log#error "failed to parse file as valid JSON (%s)" msg;
219253
Lwt.return_unit
220-
| Github.Remote_config_error s ->
221-
log#error "error retrieving config from payload: %s" s;
254+
| Action_error msg ->
255+
log#error "%s" msg;
222256
Lwt.return_unit
223257
end

‎lib/api_local.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ module Github : Api.Github = struct
1010
let log = Log.from "github"
1111

1212
let get_config ~(ctx : Context.t) ~repo:_ =
13-
let url = Caml.Filename.concat cwd ctx.data.cfg_filename in
13+
let url = Caml.Filename.concat cwd ctx.config_filename in
1414
match%lwt get_local_file url with
1515
| Error e ->
1616
log#error "error while getting local file %s: %s" url e;

‎lib/api_remote.ml‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,8 @@ module Github : Api.Github = struct
1717
Option.value_map token ~default:headers ~f:(fun v -> sprintf "Authorization: token %s" v :: headers)
1818

1919
let get_config ~(ctx : Context.t) ~repo =
20-
let url = contents_url ~repo ~path:ctx.data.cfg_filename in
21-
let headers = build_headers ?token:ctx.secrets.gh_token () in
20+
let url = contents_url ~repo ~path:ctx.config_filename in
21+
let headers = build_headers ?token:ctx.gh_token () in
2222
match%lwt http_get ~headers url with
2323
| Error e ->
2424
log#error "error while querying %s: %s" url e;
@@ -42,7 +42,7 @@ module Github : Api.Github = struct
4242

4343
let get_api_commit ~(ctx : Context.t) ~repo ~sha =
4444
let url = commits_url ~repo ~sha in
45-
let headers = build_headers ?token:ctx.secrets.gh_token () in
45+
let headers = build_headers ?token:ctx.gh_token () in
4646
match%lwt http_get ~headers url with
4747
| Ok res -> Lwt.return @@ Ok (Github_j.api_commit_of_string res)
4848
| Error e ->

‎lib/common.ml‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,20 @@
11
open Base
22
open Devkit
33

4+
module StringMap = struct
5+
type 'a t = 'a Map.M(String).t
6+
7+
let empty : 'a t = Map.empty (module String)
8+
9+
let to_list (l : 'a t) : (string * 'a) list = Map.to_alist l
10+
11+
let of_list (m : (string * 'a) list) : 'a t = Map.of_alist_exn (module String) m
12+
13+
let wrap = of_list
14+
15+
let unwrap = to_list
16+
end
17+
418
let fmt_error fmt = Printf.ksprintf (fun s -> Error s) fmt
519

620
let first_line s =

‎lib/config.atd‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ type label_rule <ocaml from="Rule"> = abstract
44

55
(* This type of rule is used for CI build notifications. *)
66
type status_rules = {
7-
?allowed_pipelines : string list option; (* keep only status events with a title matching this list *)
7+
?allowed_pipelines: string list nullable; (* keep only status events with a title matching this list *)
88
rules: status_state;
99
}
1010

@@ -27,8 +27,7 @@ type config = {
2727
prefix_rules : prefix_rules;
2828
label_rules : label_rules;
2929
status_rules : status_rules;
30-
?main_branch_name: string option; (* used to filter out notifications about merges of main branch into other branches *)
31-
?offline: string option; (* where to find github api data when http calls are not allowed *)
30+
?main_branch_name : string nullable; (* the name of the main branch; used to filter out notifications about merges of main branch into other branches *)
3231
}
3332

3433
(* This specifies the Slack webhook to query to post to the channel with the given name *)

‎lib/config.ml‎

Lines changed: 4 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -11,59 +11,16 @@ type status_rules = {
1111
status : config_status_state list;
1212
}
1313

14+
(* identical to underlying json except for status_rules *)
1415
type t = {
15-
chans : string Chan_map.t;
1616
prefix_rules : Config_t.prefix_rules;
1717
label_rules : Config_t.label_rules;
18-
gh_hook_token : string option;
19-
main_branch_name : string option;
20-
gh_token : string option;
21-
offline : string option;
2218
status_rules : status_rules;
19+
main_branch_name : string option;
2320
}
2421

25-
let make (json_config : Config_t.config) (secrets : Config_t.secrets) =
26-
let chans =
27-
List.fold_left
28-
(fun acc (webhook : Config_t.webhook) ->
29-
match Chan_map.find_opt webhook.channel acc with
30-
| None -> Chan_map.add webhook.channel webhook.url acc
31-
| Some c -> Exn.fail "chan %s is defined multiple time in the config" c)
32-
Chan_map.empty secrets.slack_hooks
33-
in
34-
let () =
35-
List.iteri
36-
(fun i ({ channel_name; _ } : Config_t.prefix_rule) ->
37-
match Chan_map.find_opt channel_name chans with
38-
| None -> Exn.fail "chan %s in prefix_rules %d is missing from slack_hooks" channel_name i
39-
| Some _ -> ())
40-
json_config.prefix_rules.rules
41-
in
42-
let () =
43-
List.iteri
44-
(fun i ({ channel_name; _ } : Config_t.label_rule) ->
45-
match Chan_map.find_opt channel_name chans with
46-
| None -> Exn.fail "chan %s in labels_rules %d is missing from slack_hooks" channel_name i
47-
| Some _ -> ())
48-
json_config.label_rules.rules
49-
in
50-
let () =
51-
match json_config.prefix_rules.default_channel with
52-
| None -> ()
53-
| Some d ->
54-
match Chan_map.find_opt d chans with
55-
| None -> Exn.fail "default chan %s in prefix_rules is missing from slack_hooks" d
56-
| Some _ -> ()
57-
in
58-
let () =
59-
match json_config.label_rules.default_channel with
60-
| None -> ()
61-
| Some d ->
62-
match Chan_map.find_opt d chans with
63-
| None -> Exn.fail "default chan %s in label_rules is missing from slack_hooks" d
64-
| Some _ -> ()
65-
in
66-
let status_rules =
22+
let make (json_config : Config_t.config) =
23+
let status_rules : status_rules =
6724
let status =
6825
let open Github_t in
6926
let j = json_config.status_rules.rules in
@@ -86,21 +43,8 @@ let make (json_config : Config_t.config) (secrets : Config_t.secrets) =
8643
{ title = json_config.status_rules.allowed_pipelines; status }
8744
in
8845
{
89-
chans;
9046
prefix_rules = json_config.prefix_rules;
9147
label_rules = json_config.label_rules;
92-
gh_hook_token = secrets.gh_hook_token;
9348
main_branch_name = json_config.main_branch_name;
94-
gh_token = secrets.gh_token;
95-
offline = json_config.offline;
9649
status_rules;
9750
}
98-
99-
let load_config_file ~config_path = Config_j.config_of_string @@ Stdio.In_channel.read_all config_path
100-
101-
let load_secrets_file ~secrets_path = Config_j.secrets_of_string @@ Stdio.In_channel.read_all secrets_path
102-
103-
let load ~config_path ~secrets_path =
104-
let config = load_config_file ~config_path in
105-
let secrets = load_secrets_file ~secrets_path in
106-
make config secrets

0 commit comments

Comments
 (0)