diff --git a/test/router.ml b/test/router.ml index 6656da1..33e45c8 100644 --- a/test/router.ml +++ b/test/router.ml @@ -14,40 +14,30 @@ module Param_verification = struct module P = struct - let is_string : (string * string) option -> _ option = function - | Some _ -> None - | None -> None + let is_string : (string * string) -> _ option = + Fun.const None - let is_uuid = function - | Some (param, value) -> - begin match Uuidm.of_string value with - | Some _ when String.length value = 36 -> None - | _ -> Some { - param; - expected = "Uuidm.t" - } - end - | None -> None + let is_uuid (param, value) = + match Uuidm.of_string value with + | Some _ when String.length value = 36 -> None + | _ -> Some { + param; + expected = "Uuidm.t" + } end - let param req tag = - 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 = - 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") + 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 in let response_json = verified_params |> to_yojson |> Yojson.Safe.to_string @@ -55,6 +45,14 @@ module Param_verification = struct 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) let router = (* 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 Builder_web.routes ~datadir:nodir ~cachedir:nodir ~configdir:nodir |> List.map (fun (meth, route, _handler) -> - meth, route, Param_verification.verify) + meth, route, Param_verification.verify (find_parameters route)) |> Builder_web.to_dream_routes |> Dream.router (* XXX: we test without remove_trailing_url_slash to ensure we don't produce @@ -176,7 +174,7 @@ let () = end; begin let jobname = "foo" in - "/job/" ^ jobname ^ "/build/latest/" + "/job/" ^ jobname ^ "/build/latest" end; begin let job = "foo" in @@ -186,9 +184,6 @@ let () = begin let old_uuid = Uuidm.(v `V4 |> to_string) in let new_uuid = Uuidm.(v `V4 |> to_string) in - (*> todo: this is the link hardcoded, but test fails as we don't use - the remove trailing slash middleware *) - (* Fmt.str "/compare/%s/%s/" old_uuid new_uuid *) Fmt.str "/compare/%s/%s" old_uuid new_uuid end; ]