(**************************************************************************) (* ocplib-resto *) (* Copyright (C) 2016, OCamlPro. *) (* *) (* All rights reserved. This file is distributed under the terms *) (* of the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open Services open Directory open Resto_directory open Lwt.Infix let () = Lwt_main.run begin allowed_methods dir () ["foo";"3";"repeat"] >>= function | Ok [`POST] -> Lwt.return_unit | _ -> assert false end let () = Lwt_main.run begin allowed_methods dir () ["bar";"3";"4";"add"] >>= function | Ok [`GET;`POST] -> Lwt.return_unit | _ -> assert false end module Test(Request : sig val request: ('meth, unit, 'params, 'query, 'input, 'output, 'error) Service.t -> 'params -> 'query -> 'input -> [> ('output, 'error) Answer.t ] Lwt.t end) = struct let () = Lwt_main.run begin Request.request describe_service ((), ["foo"; "3"]) { recurse = true } () >>= function | `Ok dir -> Format.printf "@[<v>%a@]@." Resto.Description.pp_print_directory dir ; Lwt.return_unit | _ -> assert false end let () = Lwt_main.run begin Request.request describe_service ((), ["bar"; "3" ; "2." ; "add"]) { recurse = false } () >>= function | `Ok dir -> Format.printf "@[<v>%a@]@." Resto.Description.pp_print_directory dir ; Lwt.return_unit ; | _ -> assert false end let () = Lwt_main.run begin Request.request describe_service ((), []) { recurse = true } () >>= function | `Ok dir -> Format.printf "@[<v>%a@]@." Resto.Description.pp_print_directory dir ; Lwt.return_unit ; | _ -> assert false end let () = let test service args arg expected = Lwt_main.run (Request.request service args () arg) = (`Ok expected) in assert (test repeat_service ((), 3) (`A []) (`A (repeat 3 (`A [])))) ; assert (test add_service ((), 2) 3 5) ; assert (test alternate_add_service (((), 1), 2.5) () 3.5) ; assert (test real_minus_service1 (((), 2.5), 1) () 1.5) ; assert (test alternate_add_service' (((), 1), 2.) () 3) ; () end let split_path path = let l = String.length path in let rec do_slashes acc i = if i >= l then List.rev acc else if String.get path i = '/' then do_slashes acc (i + 1) else do_component acc i i and do_component acc i j = if j >= l then if i = j then List.rev acc else List.rev (String.sub path i (j - i) :: acc) else if String.get path j = '/' then do_slashes (String.sub path i (j - i) :: acc) j else do_component acc i (j + 1) in do_slashes [] 0 module Faked = Test(struct (** Testing faked client/server communication. *) let request (type i) (service: (_,_,_,_,i,_,_) Service.t) params query arg = let { Service.meth ; uri ; input } = Service.forge_request service params query in Format.eprintf "\nREQUEST: %a@." Uri.pp_hum uri ; let path = split_path (Uri.path uri) in let query = List.map (fun (n,vs) -> (n, String.concat "," vs)) (Uri.query uri) in let json = match input with | Service.No_input -> `O [] | Service.Input input -> Json_encoding.construct input arg in lookup dir () meth path >>= function | Ok (Service s) -> begin let query = Resto.Query.parse s.types.query query in begin match s.types.input with | Service.No_input -> s.handler query () | Service.Input input -> s.handler query @@ Json_encoding.destruct input json end >>= function | `Ok res -> let json = Json_encoding.construct s.types.output res in Lwt.return (`Ok (Json_encoding.destruct (Service.output_encoding service) json)) | _ -> failwith "Unexpected lwt result (1)" end | _ -> failwith "Unexpected lwt result (2)" end) module Transparent = Test(struct let request x = transparent_lookup dir x end) let () = Printf.printf "\n### OK Resto ###\n\n%!"