builder-web/test/router.ml

193 lines
5.9 KiB
OCaml
Raw Normal View History

2022-06-21 19:20:14 +00:00
module Param_verification = struct
(*> None is 'verified'*)
type t = wrong_type option
[@@deriving yojson,show,eq]
and wrong_type = {
param : string;
expected : string;
}
let alcotyp = Alcotest.testable pp equal
module P = struct
let is_string : (string * string) -> _ option =
Fun.const None
2022-06-21 19:20:14 +00:00
let is_uuid (param, value) =
match Uuidm.of_string value with
| Some _ when String.length value = 36 -> None
| _ -> Some {
param;
expected = "Uuidm.t"
}
2022-06-21 19:20:14 +00:00
end
let verify parameters req =
let verified_params =
List.fold_left (fun acc p ->
match acc with
| None ->
if String.starts_with ~prefix:"build" p then
P.is_uuid (p, Dream.param req p)
else
P.is_string (p, Dream.param req p)
| Some _ as x -> x)
None parameters
2022-06-21 19:20:14 +00:00
in
let response_json =
verified_params |> to_yojson |> Yojson.Safe.to_string
in
Dream.respond response_json
end
let find_parameters path =
List.filter_map (fun s ->
if String.length s > 0 && String.get s 0 = ':' then
Some (String.sub s 1 (String.length s - 1))
else
None)
(String.split_on_char '/' path)
2022-06-21 19:20:14 +00:00
let router =
(* XXX: this relies on [Builder_web.routes] only using {data,cache,config}dir
* in the handlers which are never called here. The path /nonexistant is
* assumed to not exist. *)
let nodir = Fpath.v "/nonexistant" in
Builder_web.routes ~datadir:nodir ~cachedir:nodir ~configdir:nodir
2022-06-21 19:20:14 +00:00
|> List.map (fun (meth, route, _handler) ->
meth, route, Param_verification.verify (find_parameters route))
2022-06-21 19:20:14 +00:00
|> Builder_web.to_dream_routes
|> Dream.router
(* XXX: we test without remove_trailing_url_slash to ensure we don't produce
* urls with trailing slashes: *)
(* |> Builder_web.Middleware.remove_trailing_url_slash *)
2022-06-21 19:20:14 +00:00
|> Dream.test
let test_link method_ target () =
let req = Dream.request ~method_ ~target "" in
let resp = router req in
let status_code = Dream.(status resp |> status_to_int) in
Alcotest.(check' int ~msg:"status-code" ~actual:status_code ~expected:200);
let body =
Dream.body resp
|> Lwt_main.run
|> Yojson.Safe.from_string
|> Param_verification.of_yojson
in
Alcotest.(check' (result Param_verification.alcotyp string) ~msg:"param-verification"
~actual:body ~expected:(Ok None))
2022-06-21 19:20:14 +00:00
let test_link_artifact artifact =
let job_name = "test" in
let build = Uuidm.v `V4 in
test_link `GET @@
Builder_web.Link.Job_build_artifact.make ~job_name ~build ~artifact ()
let () =
Alcotest.run "Router" [
"Link module synced", Alcotest.[
test_case "Link.Root.make" `Quick begin
test_link `GET @@ Builder_web.Link.Root.make ()
end;
test_case "Link.Job.make" `Quick begin
let queries = [ `Platform "test" ] in
let job_name = "test" in
test_link `GET @@ Builder_web.Link.Job.make ~queries ~job_name ()
end;
test_case "Link.Job.make_failed" `Quick begin
let queries = [ `Platform "test" ] in
let job_name = "test" in
test_link `GET @@
Builder_web.Link.Job.make_failed ~queries ~job_name ()
end;
test_case "Link.Job_build.make" `Quick begin
let job_name = "test" in
let build = Uuidm.v `V4 in
test_link `GET @@ Builder_web.Link.Job_build.make ~job_name ~build ()
end;
test_case "Link.Job_build_artifact.make_from_string" `Quick begin
let job_name = "test" in
let build = Uuidm.v `V4 in
2022-07-07 15:36:24 +00:00
let artifact = "" in
2022-06-21 19:20:14 +00:00
test_link `GET @@
Builder_web.Link.Job_build_artifact.make_from_string
~job_name ~build ~artifact ()
end;
] @ Alcotest.(
[
`Main_binary;
`Viz_treemap;
`Viz_dependencies;
`Script;
`Console;
`All_targz;
2022-07-07 15:36:24 +00:00
`File Fpath.(v "some" / "path");
2022-06-21 19:20:14 +00:00
]
|> List.map (fun artifact ->
let descr =
2022-07-07 15:36:24 +00:00
Fmt.str "Job_build_artifact.make: %s" @@
2022-06-21 19:20:14 +00:00
Builder_web.Link.Job_build_artifact.encode_artifact artifact
in
test_case descr `Quick begin
test_link_artifact artifact
end
)
) @ Alcotest.[
test_case "Link.Compare_builds.make" `Quick begin
let left = Uuidm.v `V4 in
let right = Uuidm.v `V4 in
test_link `GET @@
Builder_web.Link.Compare_builds.make ~left ~right ()
end;
test_case "Link.Failed_builds.make" `Quick begin
test_link `GET @@
Builder_web.Link.Failed_builds.make ~count:2 ~start:1 ()
end;
];
2022-07-07 15:36:24 +00:00
(* this doesn't actually test the redirects, unfortunately *)
"Latest", List.map (fun p -> Alcotest.(test_case (""^p) `Quick begin
test_link `GET @@ "/job/test/build/latest" ^ p end))
[
"/f/bin/unikernel.hvt";
"/";
"";
];
"Albatross hardcoded links",
[
(*> Note: these links can be found in
albatross/command-line/albatross_client_update.ml
.. to find them I follewed the trails of 'Albatross_cli.http_host'
*)
begin
let `Hex sha_str =
Cstruct.of_string "foo"
|> Mirage_crypto.Hash.SHA256.digest
|> Hex.of_cstruct
in
Fmt.str "/hash?sha256=%s" sha_str
end;
begin
let jobname = "foo" in
"/job/" ^ jobname ^ "/build/latest"
end;
begin
let job = "foo" in
let build = Uuidm.(v `V4 |> to_string) in
"/job/" ^ job ^ "/build/" ^ build ^ "/main-binary"
end;
begin
let old_uuid = Uuidm.(v `V4 |> to_string) in
let new_uuid = Uuidm.(v `V4 |> to_string) in
Fmt.str "/compare/%s/%s" old_uuid new_uuid
end;
]
|> List.map Alcotest.(fun p ->
test_case ("" ^ p) `Quick (test_link `GET p))
2022-06-21 19:20:14 +00:00
]