Add two SQL requests to collect older builds according to a parameter
This commit is contained in:
parent
81be4229c1
commit
fb49d8eae2
4 changed files with 102 additions and 1 deletions
|
@ -203,6 +203,31 @@ module Build = struct
|
|||
job_id : [`job] id;
|
||||
}
|
||||
|
||||
let pp ppf t =
|
||||
Fmt.pf ppf "@[<hov>{ uuid=@ %a;@ \
|
||||
start=@ %a;@ \
|
||||
finish=@ %a;@ \
|
||||
result=@ @[<hov>%a@];@ \
|
||||
console=@ %a;@ \
|
||||
script=@ %a;@ \
|
||||
platform=@ %S;@ \
|
||||
main_binary=@ @[<hov>%a@];@ \
|
||||
input_id=@ @[<hov>%a@];@ \
|
||||
user_id=@ %Lx;@ \
|
||||
job_id=@ %Lx;@ }@]"
|
||||
Uuidm.pp t.uuid
|
||||
Ptime.pp t.start
|
||||
Ptime.pp t.finish
|
||||
Builder.pp_execution_result t.result
|
||||
Fpath.pp t.console
|
||||
Fpath.pp t.script
|
||||
t.platform
|
||||
Fmt.(Dump.option int64) t.main_binary
|
||||
Fmt.(Dump.option (using Cstruct.to_string string)) t.input_id
|
||||
t.user_id
|
||||
t.job_id
|
||||
|
||||
|
||||
let t =
|
||||
let rep =
|
||||
Caqti_type.(tup3
|
||||
|
@ -326,6 +351,39 @@ module Build = struct
|
|||
LIMIT 1
|
||||
|}
|
||||
|
||||
let get_builds_older_than =
|
||||
Caqti_type.(tup3 (id `job) (option string) ptime) ->* Caqti_type.(tup2 t file) @@
|
||||
{| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
|
||||
b.result_code, b.result_msg, b.console, b.script,
|
||||
b.platform, b.main_binary, b.input_id, b.user, b.job,
|
||||
a.filepath, a.localpath, a.sha256, a.size
|
||||
FROM build_artifact a
|
||||
INNER JOIN build b ON b.id = a.build
|
||||
WHERE b.main_binary = a.id AND b.job = $1
|
||||
AND ($2 IS NULL OR platform = $2)
|
||||
AND (CAST((b.finish_d * 3600) AS REAL) + CAST(b.finish_ps AS REAL) / 1000000000000) <= CAST(strftime('%s', $3) AS REAL)
|
||||
ORDER BY b.start_d DESC, b.start_ps DESC
|
||||
|}
|
||||
(* NOTE(dinosaure): [sqlite3] does not have the [date] type. [finish_d] is
|
||||
the number of days and [finish_ps] is the number of picoseconds. We try
|
||||
to cast these two fields into a [REAL] which corresponds to the seconds
|
||||
since 1970-01-01. Actually, our precision is bad because [strftime] and
|
||||
[$3] don't have the pico-second precision... *)
|
||||
|
||||
let get_builds_and_exclude_the_first =
|
||||
Caqti_type.(tup3 (id `job) (option string) int) ->* Caqti_type.tup2 t file @@
|
||||
{| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
|
||||
b.result_code, b.result_msg, b.console, b.script,
|
||||
b.platform, b.main_binary, b.input_id, b.user, b.job,
|
||||
a.filepath, a.localpath, a.sha256, a.size
|
||||
FROM build_artifact a
|
||||
INNER JOIN build b ON b.id = a.build
|
||||
WHERE b.main_binary = a.id AND b.job = $1
|
||||
AND ($2 IS NULL OR platform = $2)
|
||||
ORDER BY b.start_d DESC, b.start_ps DESC
|
||||
LIMIT -1 OFFSET $3
|
||||
|}
|
||||
|
||||
let get_latest_successful =
|
||||
Caqti_type.(tup2 (id `job) (option string)) ->? t @@
|
||||
{| SELECT
|
||||
|
|
|
@ -110,6 +110,8 @@ sig
|
|||
job_id : [`job] id;
|
||||
}
|
||||
|
||||
val pp : t Fmt.t
|
||||
|
||||
val get_by_uuid :
|
||||
(Uuidm.t, [`build] id * t, [ `One | `Zero ])
|
||||
Caqti_request.t
|
||||
|
@ -127,6 +129,10 @@ sig
|
|||
val get_latest_successful :
|
||||
([`job] id * string option, t, [ `One | `Zero ])
|
||||
Caqti_request.t
|
||||
val get_builds_older_than :
|
||||
([`job] id * string option * Ptime.t, t * file, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
val get_builds_and_exclude_the_first :
|
||||
([`job] id * string option * int, t * file, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
val get_previous_successful_different_output :
|
||||
([`build] id, t, [ `One | `Zero ])
|
||||
Caqti_request.t
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
(test
|
||||
(name test_builder_db)
|
||||
(modules test_builder_db)
|
||||
(libraries builder_db caqti.blocking alcotest mirage-crypto-rng.unix))
|
||||
(libraries ptime.clock.os builder_db caqti.blocking alcotest mirage-crypto-rng.unix))
|
||||
|
||||
(test
|
||||
(name markdown_to_html)
|
||||
|
|
|
@ -276,6 +276,39 @@ let test_artifact_remove_by_build (module Db : CONN) =
|
|||
get_opt "no build" >>= fun (id, _build) ->
|
||||
Db.exec Builder_db.Build_artifact.remove_by_build id
|
||||
|
||||
let test_get_builds_older_than (module Db : CONN) =
|
||||
add_second_build (module Db) >>= fun () ->
|
||||
let date = Option.get (Ptime.of_float_s (3600. /. 2.)) in
|
||||
Db.find_opt Builder_db.Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
|
||||
Db.collect_list Builder_db.Build.get_builds_older_than (job_id, None, date) >>= fun builds ->
|
||||
let builds = List.map (fun ({ Builder_db.Build.uuid; _ }, _) -> uuid) builds in
|
||||
Alcotest.(check (list Testable.uuid)) "last build" builds [ uuid ];
|
||||
Db.collect_list Builder_db.Build.get_builds_older_than (job_id, None, Ptime_clock.now ()) >>= fun builds ->
|
||||
let builds = List.map (fun ({ Builder_db.Build.uuid; _ }, _) -> uuid) builds in
|
||||
(* NOTE(dinosaure): from the most recent to the older. *)
|
||||
Alcotest.(check (list Testable.uuid)) "last builds" builds [ uuid'; uuid ];
|
||||
Ok ()
|
||||
|
||||
let test_builds_and_exclude_the_first (module Db : CONN) =
|
||||
add_second_build (module Db) >>= fun () ->
|
||||
Db.find_opt Builder_db.Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
|
||||
Db.collect_list Builder_db.Build.get_builds_and_exclude_the_first (job_id, None, 1) >>= fun builds ->
|
||||
let builds = List.map (fun ({ Builder_db.Build.uuid; _ }, _) -> uuid) builds in
|
||||
Alcotest.(check (list Testable.uuid)) "keep recent build" builds [ uuid ];
|
||||
Db.collect_list Builder_db.Build.get_builds_and_exclude_the_first (job_id, None, 2) >>= fun builds ->
|
||||
let builds = List.map (fun ({ Builder_db.Build.uuid; _ }, _) -> uuid) builds in
|
||||
Alcotest.(check (list Testable.uuid)) "keep 2 builds" builds [];
|
||||
Db.collect_list Builder_db.Build.get_builds_and_exclude_the_first (job_id, None, 3) >>= fun builds ->
|
||||
let builds = List.map (fun ({ Builder_db.Build.uuid; _ }, _) -> uuid) builds in
|
||||
Alcotest.(check (list Testable.uuid)) "last more builds than we have" builds [];
|
||||
Db.collect_list Builder_db.Build.get_builds_and_exclude_the_first (job_id, None, 0) >>= fun builds ->
|
||||
let builds = List.map (fun ({ Builder_db.Build.uuid; _ }, _) -> uuid) builds in
|
||||
Alcotest.(check (list Testable.uuid)) "delete all builds" builds [ uuid'; uuid ];
|
||||
Db.collect_list Builder_db.Build.get_builds_and_exclude_the_first (job_id, None, -1) >>= fun builds ->
|
||||
let builds = List.map (fun ({ Builder_db.Build.uuid; _ }, _) -> uuid) builds in
|
||||
Alcotest.(check (list Testable.uuid)) "test an incomprehensible argument (-1)" builds [ uuid'; uuid ];
|
||||
Ok ()
|
||||
|
||||
let () =
|
||||
let open Alcotest in
|
||||
Alcotest.run "Builder_db" [
|
||||
|
@ -310,4 +343,8 @@ let () =
|
|||
test_case "Other artifact doesn't exists" `Quick (with_build_db test_artifact_exists_false);
|
||||
test_case "Remove by build" `Quick (with_build_db test_artifact_remove_by_build);
|
||||
];
|
||||
"vacuum", [
|
||||
test_case "Get builds older than now" `Quick (with_build_db test_get_builds_older_than);
|
||||
test_case "Get older builds and keep a fixed number of then" `Quick (with_build_db test_builds_and_exclude_the_first);
|
||||
]
|
||||
]
|
||||
|
|
Loading…
Reference in a new issue