robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch '20220802_test_hardcoded_links_in_albatross_and_builder'

Browse source
This commit is contained in:
Robur 2023-03-13 11:32:45 +00:00
commit ae2a920a42
1 changed files with 61 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

93
test/router.ml
View file

@ -14,40 +14,30 @@ module Param_verification = struct
module P = struct module P = struct
let is_string : (string * string) option -> _ option = function let is_string : (string * string) -> _ option =
| Some _ -> None Fun.const None
| None -> None
let is_uuid = function let is_uuid (param, value) =
| Some (param, value) -> match Uuidm.of_string value with
begin match Uuidm.of_string value with | Some _ when String.length value = 36 -> None
| Some _ when String.length value = 36 -> None | _ -> Some {
| _ -> Some { param;
param; expected = "Uuidm.t"
expected = "Uuidm.t" }
}
end
| None -> None
end end
let param req tag = let verify parameters req =
match Dream.param req tag with let verified_params =
| param -> Some (tag, param) List.fold_left (fun acc p ->
| exception _ -> None match acc with
| None ->
let ( &&& ) v v' = if String.starts_with ~prefix:"build" p then
match v with P.is_uuid (p, Dream.param req p)
| None -> v' else
| Some _ as some -> some P.is_string (p, Dream.param req p)
| Some _ as x -> x)
let verify req = None parameters
let verified_params =
P.is_string (param req "job")
&&& P.is_uuid (param req "build")
&&& P.is_uuid (param req "build_left")
&&& P.is_uuid (param req "build_right")
&&& P.is_string (param req "platform")
in in
let response_json = let response_json =
verified_params |> to_yojson |> Yojson.Safe.to_string verified_params |> to_yojson |> Yojson.Safe.to_string
@ -55,6 +45,14 @@ module Param_verification = struct
Dream.respond response_json Dream.respond response_json
end 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)
let router = let router =
(* XXX: this relies on [Builder_web.routes] only using {data,cache,config}dir (* XXX: this relies on [Builder_web.routes] only using {data,cache,config}dir
@ -63,7 +61,7 @@ let router =
let nodir = Fpath.v "/nonexistant" in let nodir = Fpath.v "/nonexistant" in
Builder_web.routes ~datadir:nodir ~cachedir:nodir ~configdir:nodir Builder_web.routes ~datadir:nodir ~cachedir:nodir ~configdir:nodir
|> List.map (fun (meth, route, _handler) -> |> List.map (fun (meth, route, _handler) ->
meth, route, Param_verification.verify) meth, route, Param_verification.verify (find_parameters route))
|> Builder_web.to_dream_routes |> Builder_web.to_dream_routes
|> Dream.router |> Dream.router
(* XXX: we test without remove_trailing_url_slash to ensure we don't produce (* XXX: we test without remove_trailing_url_slash to ensure we don't produce
@ -159,5 +157,36 @@ let () =
"/f/bin/unikernel.hvt"; "/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))
] ]