builder-web/test/router.ml

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 _ when String.length value = 36 -> None
          | _ -> Some {
              param;
              expected = "Uuidm.t"
            }
        end
      | None -> None
    
  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")
    in
    let response_json =
      verified_params |> to_yojson |> Yojson.Safe.to_string
    in
    Dream.respond response_json

end
                   
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
  |> List.map (fun (meth, route, _handler) ->
      meth, route, Param_verification.verify)
  |> 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 *)
  |> 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))

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 = "" 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;
          `File Fpath.(v "some" / "path");
        ]
        |> List.map (fun artifact ->
            let descr =
              Fmt.str "Job_build_artifact.make: %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.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;
      ];
    (* 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";
        "/";
        "";
      ]
  ]