Resto: now depends on package 'uri'

This commit is contained in:
Grégoire Henry 2017-12-07 17:43:21 +01:00 committed by Benjamin Canou
parent e57a0734e5
commit ebd067a261
11 changed files with 95 additions and 33 deletions

View File

@ -43,9 +43,10 @@ let complete cctxt ?block prefix =
call_service2 cctxt Services.Blocks.complete block prefix () call_service2 cctxt Services.Blocks.complete block prefix ()
let describe config ?(recurse = true) path = let describe config ?(recurse = true) path =
let { RPC.Service.meth ; path } = let { RPC.Service.meth ; uri } =
RPC.Service.forge_request Node_rpc_services.describe RPC.Service.forge_request Node_rpc_services.describe
((), path) { RPC.Description.recurse } in ((), path) { RPC.Description.recurse } in
let path = String.split_path (Uri.path uri) in (* Temporary *)
config#get_json meth path (`O []) >>=? fun json -> config#get_json meth path (`O []) >>=? fun json ->
match Data_encoding.Json.destruct (RPC.Service.output_encoding Node_rpc_services.describe) json with match Data_encoding.Json.destruct (RPC.Service.output_encoding Node_rpc_services.describe) json with
| exception msg -> | exception msg ->

View File

@ -347,12 +347,13 @@ let make_request config log_request meth service json =
end end
let forge_request (type i) (service: (_,_,_,_,i,_,_) RPC.Service.t) params body = let forge_request (type i) (service: (_,_,_,_,i,_,_) RPC.Service.t) params body =
let { RPC.Service.meth ; path } = let { RPC.Service.meth ; uri } =
RPC.Service.forge_request service params () in RPC.Service.forge_request service params () in
let json = let json =
match RPC.Service.input_encoding service with match RPC.Service.input_encoding service with
| RPC.Service.No_input -> assert false (* TODO *) | RPC.Service.No_input -> assert false (* TODO *)
| RPC.Service.Input input -> Data_encoding.Json.construct input body in | RPC.Service.Input input -> Data_encoding.Json.construct input body in
let path = String.split_path (Uri.path uri) in (* Temporary *)
meth, path, json meth, path, json
let call_service0 (rpc : #rpc_sig) service arg = let call_service0 (rpc : #rpc_sig) service arg =

View File

@ -21,14 +21,14 @@ module Error = struct
RPC.Path.(root / "errors") RPC.Path.(root / "errors")
let encoding = let encoding =
let { RPC.Service.meth ; path ; _ } = let { RPC.Service.meth ; uri ; _ } =
RPC.Service.forge_request service () () in RPC.Service.forge_request service () () in
describe describe
~description: ~description:
(Printf.sprintf (Printf.sprintf
"The full list of error is available with \ "The full list of error is available with \
the global RPC `%s /%s`" the global RPC `%s %s`"
(RPC.string_of_meth meth) (String.concat "/" path)) (RPC.string_of_meth meth) (Uri.path_and_query uri))
(conv (conv
~schema:Json_schema.any ~schema:Json_schema.any
(fun exn -> `A (List.map json_of_error exn)) (fun exn -> `A (List.map json_of_error exn))

View File

@ -52,15 +52,37 @@ module Test(Request : sig
() ()
end 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 module Faked = Test(struct
(** Testing faked client/server communication. *) (** Testing faked client/server communication. *)
let request (type i) (service: (_,_,_,i,_,_) service) params query (arg: i) = let request (type i) (service: (_,_,_,i,_,_) service) params query (arg: i) =
let { meth ; path ; query ; input } = forge_request service params query in let { meth ; uri ; input } = forge_request service params query in
let uri = Format.eprintf "\nREQUEST: %a@." Uri.pp_hum uri ;
Uri.make let path = split_path (Uri.path uri) in
~path:(String.concat "/" path) let query =
~query:(List.map (fun (k,v) -> k, [v]) query) () in List.map
(fun (n,vs) -> (n, String.concat "," vs))
(Uri.query uri) in
Format.eprintf "\nREQUEST: %a@." Uri.pp_hum uri ; Format.eprintf "\nREQUEST: %a@." Uri.pp_hum uri ;
let json = let json =
match input with match input with

View File

@ -38,8 +38,7 @@ type 'input input = 'input Service.input =
| Input : 'input Json_encoding.encoding -> 'input input | Input : 'input Json_encoding.encoding -> 'input input
type 'input request = 'input Service.request = { type 'input request = 'input Service.request = {
meth: meth ; meth: meth ;
path: string list ; uri: Uri.t ;
query: (string * string) list ;
input: 'input input ; input: 'input input ;
} }
let forge_request = forge_request let forge_request = forge_request

View File

@ -132,14 +132,13 @@ type 'input input =
type 'input request = { type 'input request = {
meth: meth ; meth: meth ;
path: string list ; uri: Uri.t ;
query: (string * string) list ;
input: 'input input ; input: 'input input ;
} }
val forge_request: val forge_request:
('meth, 'params, 'query, 'input, 'output, 'error) service -> ('meth, 'params, 'query, 'input, 'output, 'error) service ->
'params -> 'query -> 'input request ?base:Uri.t -> 'params -> 'query -> 'input request
val query: val query:
('meth, 'params, 'query, 'input, 'output, 'error) service -> ('meth, 'params, 'query, 'input, 'output, 'error) service ->

View File

@ -74,15 +74,38 @@ module Test(Request : sig
end 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 module Faked = Test(struct
(** Testing faked client/server communication. *) (** Testing faked client/server communication. *)
let request (type i) (service: (_,_,_,_,i,_,_) Service.t) params query arg = let request (type i) (service: (_,_,_,_,i,_,_) Service.t) params query arg =
let { Service.meth ; path ; query ; input } = Service.forge_request service params query in let { Service.meth ; uri ; input } =
let uri = Service.forge_request service params query in
Uri.make
~path:(String.concat "/" path)
~query:(List.map (fun (k,v) -> k, [v]) query) () in
Format.eprintf "\nREQUEST: %a@." Uri.pp_hum uri ; 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 = let json =
match input with match input with
| Service.No_input -> `O [] | Service.No_input -> `O []

View File

@ -4,4 +4,5 @@
((name resto) ((name resto)
(public_name ocplib-resto) (public_name ocplib-resto)
(flags (-w -30)) (flags (-w -30))
(libraries ("uri"))
(wrapped false))) (wrapped false)))

View File

@ -17,4 +17,5 @@ build-test: [
depends: [ depends: [
"ocamlfind" {build} "ocamlfind" {build}
"jbuilder" {build} "jbuilder" {build}
"uri"
] ]

View File

@ -17,6 +17,14 @@ let string_of_meth = function
| `PUT -> "PUT" | `PUT -> "PUT"
| `PATCH -> "PATCH" | `PATCH -> "PATCH"
let meth_of_string = function
| "GET" -> Some `GET
| "POST" -> Some `POST
| "DELETE" -> Some `DELETE
| "PUT" -> Some `PUT
| "PATCH" -> Some `PATCH
| _ -> None
module MethMap = Map.Make(struct type t = meth let compare = compare end) module MethMap = Map.Make(struct type t = meth let compare = compare end)
module StringMap = Map.Make(String) module StringMap = Map.Make(String)
@ -498,6 +506,8 @@ module MakeService(Encoding : ENCODING) = struct
{ s with path = Path.map f g s.path } { s with path = Path.map f g s.path }
let meth = fun { meth } -> meth
let query let query
: type pr p i q o e. : type pr p i q o e.
(_, pr, p, q, i, o, e) service -> q Query.t (_, pr, p, q, i, o, e) service -> q Query.t
@ -537,8 +547,7 @@ module MakeService(Encoding : ENCODING) = struct
type 'input request = { type 'input request = {
meth: meth ; meth: meth ;
path: string list ; uri: Uri.t ;
query: (string * string) list ;
input: 'input input ; input: 'input input ;
} }
@ -573,13 +582,14 @@ module MakeService(Encoding : ENCODING) = struct
let forge_request let forge_request
: type p i q o e. : type p i q o e.
(_, unit, p, q, i, o, e) service -> p -> q -> i request (_, unit, p, q, i, o, e) service -> ?base:Uri.t -> p -> q -> i request
= fun s args query -> = fun s ?base:(uri = Uri.empty) args query ->
{ meth = s.meth ; let path = String.concat "/" (forge_request_args s.path args) in
path = forge_request_args s.path args ; let prefix = Uri.path uri in
query = forge_request_query s.types.query query ; let prefixed_path = if prefix = "" then path else prefix ^ "/" ^ path in
input = s.types.input ; let uri = Uri.with_path uri prefixed_path in
} let uri = Uri.with_query' uri (forge_request_query s.types.query query) in
{ meth = s.meth ; uri ; input = s.types.input }
let forge_request = let forge_request =
(forge_request (forge_request

View File

@ -10,7 +10,8 @@
type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ] type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ]
val string_of_meth: meth -> string val string_of_meth: [< meth ] -> string
val meth_of_string: string -> [> meth ] option
module MethMap : Map.S with type key = meth module MethMap : Map.S with type key = meth
module StringMap : Map.S with type key = string module StringMap : Map.S with type key = string
@ -229,6 +230,11 @@ module MakeService(Encoding : ENCODING) : sig
type (+'meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service = type (+'meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service =
('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t
val meth:
('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
'meth
val query: val query:
('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service -> ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
'query Query.t 'query Query.t
@ -316,14 +322,13 @@ module MakeService(Encoding : ENCODING) : sig
type 'input request = { type 'input request = {
meth: meth ; meth: meth ;
path: string list ; uri: Uri.t ;
query: (string * string) list ;
input: 'input input ; input: 'input input ;
} }
val forge_request: val forge_request:
('meth, unit, 'params, 'query, 'input, 'output, 'error) service -> ('meth, unit, 'params, 'query, 'input, 'output, 'error) service ->
'params -> 'query -> 'input request ?base:Uri.t -> 'params -> 'query -> 'input request
module Internal : sig module Internal : sig