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 ()
let describe config ?(recurse = true) path =
let { RPC.Service.meth ; path } =
let { RPC.Service.meth ; uri } =
RPC.Service.forge_request Node_rpc_services.describe
((), path) { RPC.Description.recurse } in
let path = String.split_path (Uri.path uri) in (* Temporary *)
config#get_json meth path (`O []) >>=? fun json ->
match Data_encoding.Json.destruct (RPC.Service.output_encoding Node_rpc_services.describe) json with
| exception msg ->

View File

@ -347,12 +347,13 @@ let make_request config log_request meth service json =
end
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
let json =
match RPC.Service.input_encoding service with
| RPC.Service.No_input -> assert false (* TODO *)
| RPC.Service.Input input -> Data_encoding.Json.construct input body in
let path = String.split_path (Uri.path uri) in (* Temporary *)
meth, path, json
let call_service0 (rpc : #rpc_sig) service arg =

View File

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

View File

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

View File

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

View File

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

View File

@ -74,15 +74,38 @@ module Test(Request : sig
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 ; path ; query ; input } = Service.forge_request service params query in
let uri =
Uri.make
~path:(String.concat "/" path)
~query:(List.map (fun (k,v) -> k, [v]) query) () in
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 []

View File

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

View File

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

View File

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

View File

@ -10,7 +10,8 @@
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 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 =
('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t
val meth:
('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
'meth
val query:
('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
'query Query.t
@ -316,14 +322,13 @@ module MakeService(Encoding : ENCODING) : sig
type 'input request = {
meth: meth ;
path: string list ;
query: (string * string) list ;
uri: Uri.t ;
input: 'input input ;
}
val forge_request:
('meth, unit, 'params, 'query, 'input, 'output, 'error) service ->
'params -> 'query -> 'input request
?base:Uri.t -> 'params -> 'query -> 'input request
module Internal : sig