Add tests for router/Link module

lib/builder_web.ml

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

test/dune

@@ -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
+   ))
+ )

test/router.ml

@@ -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;
+      ];
+  ]