Merge branch '20220802_test_hardcoded_links_in_albatross_and_builder'
This commit is contained in:
commit
ae2a920a42
1 changed files with 61 additions and 32 deletions
|
@ -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
|
|
||||||
| param -> Some (tag, param)
|
|
||||||
| exception _ -> None
|
|
||||||
|
|
||||||
let ( &&& ) v v' =
|
|
||||||
match v with
|
|
||||||
| None -> v'
|
|
||||||
| Some _ as some -> some
|
|
||||||
|
|
||||||
let verify req =
|
|
||||||
let verified_params =
|
let verified_params =
|
||||||
P.is_string (param req "job")
|
List.fold_left (fun acc p ->
|
||||||
&&& P.is_uuid (param req "build")
|
match acc with
|
||||||
&&& P.is_uuid (param req "build_left")
|
| None ->
|
||||||
&&& P.is_uuid (param req "build_right")
|
if String.starts_with ~prefix:"build" p then
|
||||||
&&& P.is_string (param req "platform")
|
P.is_uuid (p, Dream.param req p)
|
||||||
|
else
|
||||||
|
P.is_string (p, Dream.param req p)
|
||||||
|
| Some _ as x -> x)
|
||||||
|
None parameters
|
||||||
in
|
in
|
||||||
let response_json =
|
let response_json =
|
||||||
verified_params |> to_yojson |> Yojson.Safe.to_string
|
verified_params |> to_yojson |> Yojson.Safe.to_string
|
||||||
|
@ -56,6 +46,14 @@ module Param_verification = struct
|
||||||
|
|
||||||
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
|
||||||
* in the handlers which are never called here. The path /nonexistant is
|
* in the handlers which are never called here. The path /nonexistant is
|
||||||
|
@ -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))
|
||||||
]
|
]
|
||||||
|
|
Loading…
Reference in a new issue