Skip to content

Commit d6119ea

Browse files
orbitzorbitz
committed
#978 REFACTOR Add better logging
1 parent f5670bd commit d6119ea

8 files changed

+283
-106
lines changed

‎code/src/terrat_vcs_event_evaluator2/terrat_vcs_event_evaluator2_tasks.ml‎

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2448,12 +2448,12 @@ struct
24482448
fetch Keys.work_manifest_event
24492449
>>= function
24502450
| Some event -> (
2451-
let work_manifest =
2451+
let work_manifest, event_type =
2452+
let module E = Keys.Work_manifest_event in
24522453
match event with
2453-
| Keys.Work_manifest_event.(
2454-
( Initiate { work_manifest; _ }
2455-
| Fail { work_manifest; _ }
2456-
| Result { work_manifest; _ } )) -> work_manifest
2454+
| E.Initiate { work_manifest; _ } -> (work_manifest, "INITIATE")
2455+
| E.Fail { work_manifest; _ } -> (work_manifest, "FAIL")
2456+
| E.Result { work_manifest; _ } -> (work_manifest, "RESULT")
24572457
in
24582458
fetch Keys.work_manifest_event_job
24592459
>>= function
@@ -2467,8 +2467,10 @@ struct
24672467
let context = job.Tjc.Job.context in
24682468
Logs.info (fun m ->
24692469
m
2470-
"%s : context_id=%a : log_id= %s : initiator=%s"
2470+
"%s : EVENT : WORK_MANIFEST : %s : context_id=%a : log_id= %s : \
2471+
initiator=%s"
24712472
(Builder.log_id s)
2473+
event_type
24722474
Uuidm.pp
24732475
context.Tjc.Context.id
24742476
log_id

‎code/src/terrat_vcs_event_evaluator2/terrat_vcs_event_evaluator2_tasks_pr.ml‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1373,7 +1373,8 @@ struct
13731373
let log_id = Builder.mk_log_id ~request_id:(Builder.log_id s) job.Tjc.Job.id in
13741374
Logs.info (fun m ->
13751375
m
1376-
"%s : target=%s : context_id=%a : log_id= %s : job_type=%a"
1376+
"%s : EVENT : PULL_REQUEST : target=%s : context_id=%a : log_id= %s : \
1377+
job_type=%a"
13771378
(Builder.log_id s)
13781379
(Hmap.Key.info Keys.iter_job)
13791380
Uuidm.pp

‎code/src/terrat_vcs_event_evaluator2/terrat_vcs_event_evaluator2_wm_sm.ml‎

Lines changed: 96 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,9 @@ struct
1313
module Wm = Terrat_work_manifest3
1414
module Builder = Terrat_vcs_event_evaluator2_builder.Make (S)
1515

16+
let time_it s l f =
17+
Abbs_time_it.run (fun time -> Logs.info (fun m -> l m (Builder.log_id s) time)) f
18+
1619
type existing_wm =
1720
( S.Api.Account.t,
1821
((unit, unit) S.Api.Pull_request.t, S.Api.Repo.t) Terrat_vcs_provider2.Target.t )
@@ -180,29 +183,43 @@ struct
180183
when eq work_manifest ->
181184
Logs.info (fun m -> m "%s : WM : INITIATE : name=%s" (Builder.log_id s) name);
182185
Builder.run_db s ~f:(fun db ->
183-
Logs.info (fun m ->
186+
time_it
187+
s
188+
(fun m log_id time ->
184189
m
185-
"%s : WM : UPDATE_RUN_ID : name=%s : wm=%a : run_id=%s"
186-
(Builder.log_id s)
190+
"%s : WM : UPDATE_RUN_ID : name=%s : wm=%a : run_id=%s : time=%f"
191+
log_id
187192
name
188193
Uuidm.pp
189194
id
190-
run_id);
191-
S.Work_manifest.update_run_id ~request_id:(Builder.log_id s) db id run_id
192-
>>= fun () ->
193-
update_wm_state ~request_id:(Builder.log_id s) ~name id Wm.State.Running db)
195+
run_id
196+
time)
197+
(fun () ->
198+
S.Work_manifest.update_run_id ~request_id:(Builder.log_id s) db id run_id
199+
>>= fun () ->
200+
update_wm_state ~request_id:(Builder.log_id s) ~name id Wm.State.Running db))
194201
>>= fun () ->
195202
initiate work_manifest s fetcher
196203
>>= fun response ->
197204
fetch Keys.compute_node_id
198205
>>= fun compute_node_id ->
199206
Builder.run_db s ~f:(fun db ->
200-
S.Job_context.Compute_node.set_work
201-
~request_id:(Builder.log_id s)
202-
~compute_node_id
203-
~work_manifest:id
204-
db
205-
response)
207+
time_it
208+
s
209+
(fun m log_id time ->
210+
m
211+
"%s : WM : SET_WORK : compute_node_id=%a : time=%f"
212+
log_id
213+
Uuidm.pp
214+
compute_node_id
215+
time)
216+
(fun () ->
217+
S.Job_context.Compute_node.set_work
218+
~request_id:(Builder.log_id s)
219+
~compute_node_id
220+
~work_manifest:id
221+
db
222+
response))
206223
>>= fun () -> Abb.Future.return (Error (`Suspend_eval name))
207224
| Some (E.Fail { work_manifest; error }) when eq work_manifest -> (
208225
Logs.info (fun m -> m "%s : WM : FAIL : name=%s" (Builder.log_id s) name);
@@ -219,26 +236,45 @@ struct
219236
Logs.info (fun m -> m "%s : WM : RESULT : name=%s" (Builder.log_id s) name);
220237
result work_manifest wm_result s fetcher
221238
>>= fun () ->
222-
Builder.run_db
223-
s
224-
~f:
225-
(update_wm_state
226-
~request_id:(Builder.log_id s)
227-
~name
228-
work_manifest.Wm.id
229-
Wm.State.Completed)
239+
Builder.run_db s ~f:(fun db ->
240+
time_it
241+
s
242+
(fun m log_id time ->
243+
m
244+
"%s : WM : UPDATE_STATE : COMPLETED : wm=%a : time=%f"
245+
log_id
246+
Uuidm.pp
247+
work_manifest.Wm.id
248+
time)
249+
(fun () ->
250+
update_wm_state
251+
~request_id:(Builder.log_id s)
252+
~name
253+
work_manifest.Wm.id
254+
Wm.State.Completed
255+
db))
230256
>>= fun () ->
231257
fetch Keys.job
232258
>>= fun job ->
233259
(* Explicitly query the work manifests for this job because we might
234260
have already created work manifests in parallel operations so we
235261
don't need to do it again. *)
236262
Builder.run_db s ~f:(fun db ->
237-
S.Job_context.Job.query_work_manifests
238-
~request_id:(Builder.log_id s)
239-
db
240-
~job_id:job.Tjc.Job.id
241-
())
263+
time_it
264+
s
265+
(fun m log_id time ->
266+
m
267+
"%s : JOB : QUERY_WORK_MANIFESTS : job_id=%a : time=%f"
268+
log_id
269+
Uuidm.pp
270+
job.Tjc.Job.id
271+
time)
272+
(fun () ->
273+
S.Job_context.Job.query_work_manifests
274+
~request_id:(Builder.log_id s)
275+
db
276+
~job_id:job.Tjc.Job.id
277+
()))
242278
>>= function
243279
| wms when all_wms_completed @@ CCList.filter eq wms ->
244280
Logs.info (fun m ->
@@ -255,11 +291,21 @@ struct
255291
have already created work manifests in parallel operations so we
256292
don't need to do it again. *)
257293
Builder.run_db s ~f:(fun db ->
258-
S.Job_context.Job.query_work_manifests
259-
~request_id:(Builder.log_id s)
260-
db
261-
~job_id:job.Tjc.Job.id
262-
())
294+
time_it
295+
s
296+
(fun m log_id time ->
297+
m
298+
"%s : JOB : QUERY_WORK_MANIFESTS : job_id=%a : time=%f"
299+
log_id
300+
Uuidm.pp
301+
job.Tjc.Job.id
302+
time)
303+
(fun () ->
304+
S.Job_context.Job.query_work_manifests
305+
~request_id:(Builder.log_id s)
306+
db
307+
~job_id:job.Tjc.Job.id
308+
()))
263309
>>= function
264310
| wms when too_many_aborts wms ->
265311
Logs.info (fun m -> m "%s : WM : TOO_MANY_ABORTS" (Builder.log_id s));
@@ -303,15 +349,25 @@ struct
303349
fetch Keys.job
304350
>>= fun job ->
305351
Builder.run_db s ~f:(fun db ->
306-
Abbs_future_combinators.List_result.iter
307-
~f:(fun { Wm.id = work_manifest_id; _ } ->
308-
S.Job_context.Job.add_work_manifest
309-
~request_id:(Builder.log_id s)
310-
db
311-
~job_id:job.Tjc.Job.id
312-
~work_manifest_id
313-
())
314-
wms)
352+
time_it
353+
s
354+
(fun m log_id time ->
355+
m
356+
"%s : JOB : ADD_WORK_MANIFESTS : job_id=%a : time=%f"
357+
log_id
358+
Uuidm.pp
359+
job.Tjc.Job.id
360+
time)
361+
(fun () ->
362+
Abbs_future_combinators.List_result.iter
363+
~f:(fun { Wm.id = work_manifest_id; _ } ->
364+
S.Job_context.Job.add_work_manifest
365+
~request_id:(Builder.log_id s)
366+
db
367+
~job_id:job.Tjc.Job.id
368+
~work_manifest_id
369+
())
370+
wms))
315371
>>= fun () -> Abb.Future.return (Error (`Suspend_eval name)))
316372
| wms when all_wms_completed wms ->
317373
Logs.info (fun m ->

‎code/src/terrat_vcs_event_evaluator2/terrat_vcs_event_evaluator2_wm_sm_build_config.ml‎

Lines changed: 28 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,10 @@ struct
99

1010
module Logs = (val Logs.src_log src : Logs.LOG)
1111
module Builder = Terrat_vcs_event_evaluator2_builder.Make (S)
12+
13+
let time_it s l f =
14+
Abbs_time_it.run (fun time -> Logs.info (fun m -> l m (Builder.log_id s) time)) f
15+
1216
module Bs = Builder.Bs
1317
module Wm_sm = Terrat_vcs_event_evaluator2_wm_sm.Make (S) (Keys)
1418
module Wm = Terrat_work_manifest3
@@ -46,7 +50,11 @@ struct
4650
fetch Keys.account
4751
>>= fun account ->
4852
Builder.run_db s ~f:(fun db ->
49-
S.Db.query_repo_config_json ~request_id:(Builder.log_id s) db account branch_ref)
53+
time_it
54+
s
55+
(fun m log_id time -> m "%s : QUERY_REPO_CONFIG_JSON : time=%f" log_id time)
56+
(fun () ->
57+
S.Db.query_repo_config_json ~request_id:(Builder.log_id s) db account branch_ref))
5058
>>= function
5159
| None ->
5260
fetch Keys.repo
@@ -77,7 +85,10 @@ struct
7785
}
7886
in
7987
Builder.run_db s ~f:(fun db ->
80-
S.Work_manifest.create ~request_id:(Builder.log_id s) db work_manifest)
88+
time_it
89+
s
90+
(fun m log_id time -> m "%s : WORK_MANIFEST : CREATE : time=%f" log_id time)
91+
(fun () -> S.Work_manifest.create ~request_id:(Builder.log_id s) db work_manifest))
8192
>>= fun work_manifest ->
8293
fetch Keys.branch_ref
8394
>>= fun branch_ref ->
@@ -161,7 +172,11 @@ struct
161172
fetch repo_config_raw'
162173
>>= fun (_, repo_config_raw) ->
163174
Builder.run_db s ~f:(fun db ->
164-
Wm_sm.create_token' ~log_id:(Builder.log_id s) (S.Api.Account.id account) id db)
175+
time_it
176+
s
177+
(fun m log_id time -> m "%s : CREATE_TOKEN : wm=%a : time=%f" log_id Uuidm.pp id time)
178+
(fun () ->
179+
Wm_sm.create_token' ~log_id:(Builder.log_id s) (S.Api.Account.id account) id db))
165180
>>= fun token ->
166181
(* FIX: Index *)
167182
let index = None in
@@ -260,12 +275,16 @@ struct
260275
fetch Keys.account
261276
>>= fun account ->
262277
Builder.run_db s ~f:(fun db ->
263-
S.Db.store_repo_config_json
264-
~request_id:(Builder.log_id s)
265-
db
266-
account
267-
branch_ref
268-
config)
278+
time_it
279+
s
280+
(fun m log_id time -> m "%s : STORE_REPO_CONFIG_JSON : time=%f" log_id time)
281+
(fun () ->
282+
S.Db.store_repo_config_json
283+
~request_id:(Builder.log_id s)
284+
db
285+
account
286+
branch_ref
287+
config))
269288
>>= fun () ->
270289
fetch Keys.repo
271290
>>= fun repo ->

‎code/src/terrat_vcs_event_evaluator2/terrat_vcs_event_evaluator2_wm_sm_indexer.ml‎

Lines changed: 25 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,10 @@ struct
99

1010
module Logs = (val Logs.src_log src : Logs.LOG)
1111
module Builder = Terrat_vcs_event_evaluator2_builder.Make (S)
12+
13+
let time_it s l f =
14+
Abbs_time_it.run (fun time -> Logs.info (fun m -> l m (Builder.log_id s) time)) f
15+
1216
module Bs = Builder.Bs
1317
module Wm_sm = Terrat_vcs_event_evaluator2_wm_sm.Make (S) (Keys)
1418
module Wm = Terrat_work_manifest3
@@ -44,7 +48,10 @@ struct
4448
fetch Keys.account
4549
>>= fun account ->
4650
Builder.run_db s ~f:(fun db ->
47-
S.Db.query_index ~request_id:(Builder.log_id s) db account branch_ref)
51+
time_it
52+
s
53+
(fun m log_id time -> m "%s : QUERY_INDEX : time=%f" log_id time)
54+
(fun () -> S.Db.query_index ~request_id:(Builder.log_id s) db account branch_ref))
4855
>>= function
4956
| None ->
5057
fetch Keys.repo
@@ -75,7 +82,10 @@ struct
7582
}
7683
in
7784
Builder.run_db s ~f:(fun db ->
78-
S.Work_manifest.create ~request_id:(Builder.log_id s) db work_manifest)
85+
time_it
86+
s
87+
(fun m log_id time -> m "%s : WORK_MANIFEST : CREATE : time=%f" log_id time)
88+
(fun () -> S.Work_manifest.create ~request_id:(Builder.log_id s) db work_manifest))
7989
>>= fun work_manifest ->
8090
fetch Keys.branch_ref
8191
>>= fun branch_ref ->
@@ -178,7 +188,11 @@ struct
178188
Abb.Future.return (Wm_sm.dirspaceflows_of_changes repo_config_raw matches)
179189
>>= fun dirspaceflows ->
180190
Builder.run_db s ~f:(fun db ->
181-
Wm_sm.create_token' ~log_id:(Builder.log_id s) (S.Api.Account.id account) id db)
191+
time_it
192+
s
193+
(fun m log_id time -> m "%s : CREATE_TOKEN : wm=%a : time=%f" log_id Uuidm.pp id time)
194+
(fun () ->
195+
Wm_sm.create_token' ~log_id:(Builder.log_id s) (S.Api.Account.id account) id db))
182196
>>= fun token ->
183197
let module Dsf = Terrat_change.Dirspaceflow in
184198
let dirs =
@@ -234,9 +248,14 @@ struct
234248
match result with
235249
| Wmr.Work_manifest_index_result index ->
236250
Builder.run_db s ~f:(fun db ->
237-
S.Db.store_index_result ~request_id:(Builder.log_id s) db work_manifest.Wm.id index
238-
>>= fun () ->
239-
S.Db.store_index ~request_id:(Builder.log_id s) db work_manifest.Wm.id index)
251+
time_it
252+
s
253+
(fun m log_id time ->
254+
m "%s : STORE_INDEX : wm=%a : time=%f" log_id Uuidm.pp work_manifest.Wm.id time)
255+
(fun () ->
256+
S.Db.store_index_result ~request_id:(Builder.log_id s) db work_manifest.Wm.id index
257+
>>= fun () ->
258+
S.Db.store_index ~request_id:(Builder.log_id s) db work_manifest.Wm.id index))
240259
>>= fun _ ->
241260
fetch Keys.account
242261
>>= fun account ->

0 commit comments

Comments
 (0)