Add tests for router/Link module

This commit is contained in:
rand00 2022-06-21 21:20:14 +02:00 committed by Reynir Björnsson
parent c533ea7c07
commit 148ddacbe8
3 changed files with 168 additions and 0 deletions

View file

@ -644,3 +644,5 @@ module Middleware = struct
| _ (* /... *) -> handler req
end
module Link = Link

View file

@ -7,3 +7,14 @@
(name markdown_to_html)
(modules markdown_to_html)
(libraries builder_web alcotest))
(test
(name router)
(modules router)
(libraries builder_web fmt dream yojson alcotest)
(preprocess
(pps
ppx_deriving.std
ppx_deriving_yojson
))
)

155
test/router.ml Normal file
View file

@ -0,0 +1,155 @@
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 -> _ option = function
| Some _ -> None
| None -> None
let is_uuid = function
| Some (param, value) ->
begin match Uuidm.of_string value with
| Some _ -> None
| None -> Some {
param;
expected = "Uuidm.t"
}
end
| None -> None
end
let param req tag =
try Some (tag, Dream.param req tag) with _ -> None
let ( &&& ) v v' =
match v with
| None -> v'
| Some _ as some -> some
let verify req =
let verified_params =
(param req "job" |> P.is_string)
&&& (param req "build" |> P.is_uuid)
&&& (param req "build_left" |> P.is_uuid)
&&& (param req "build_right" |> P.is_uuid)
&&& (param req "platform" |> P.is_string)
in
let response_json =
verified_params |> to_yojson |> Yojson.Safe.to_string
in
Dream.respond response_json
end
let router =
let tmp = Fpath.v "/tmp" in
Builder_web.routes ~datadir:tmp ~cachedir:tmp ~configdir:tmp
|> List.map (fun (meth, route, _handler) ->
meth, route, Param_verification.verify)
|> Builder_web.to_dream_routes
|> Dream.router
|> Builder_web.Middleware.remove_trailing_url_slash
|> 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
|> Result.get_ok
in
Alcotest.(check' Param_verification.alcotyp ~msg:"param-verification"
~actual:body ~expected:None)
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
let artifact = "all.tar.gz" in
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;
]
|> List.map (fun artifact ->
let descr =
Fmt.str "Link..artifact..: %s" @@
Builder_web.Link.Job_build_artifact.encode_artifact artifact
in
test_case descr `Quick begin
test_link_artifact artifact
end
)
) @ Alcotest.[
test_case "Link.Job_build_f.make" `Quick begin
let job_name = "test" in
let build = Uuidm.v `V4 in
let filepath = Fpath.(v "some" / "path") in
test_link `GET @@
Builder_web.Link.Job_build_f.make ~job_name ~build ~filepath ()
end;
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;
];
]