diff --git a/src/lib_protocol_environment_sigs/v1/RPC_path.mli b/src/lib_protocol_environment_sigs/v1/RPC_path.mli index 8fdd626bf..1fbe98e2b 100644 --- a/src/lib_protocol_environment_sigs/v1/RPC_path.mli +++ b/src/lib_protocol_environment_sigs/v1/RPC_path.mli @@ -28,9 +28,3 @@ val add_final_args: ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a list) path val (/:*): ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a list) path - -val prefix: - ('prefix, 'a) path -> ('a, 'params) path -> ('prefix, 'params) path - -val map: - ('a -> 'b) -> ('b -> 'a) -> ('prefix, 'a) path -> ('prefix, 'b) path diff --git a/src/lib_protocol_environment_sigs/v1/RPC_service.mli b/src/lib_protocol_environment_sigs/v1/RPC_service.mli index b81f53970..0fac2a381 100644 --- a/src/lib_protocol_environment_sigs/v1/RPC_service.mli +++ b/src/lib_protocol_environment_sigs/v1/RPC_service.mli @@ -43,19 +43,6 @@ val error_encoding: ('meth, 'prefix, 'params, 'query, 'input, 'output) service -> unit Data_encoding.t -val prefix: - ('prefix, 'inner_prefix) RPC_path.t -> - ('meth, 'inner_prefix, 'params, 'query, - 'input, 'output) service -> - ('meth, 'prefix, 'params, - 'query, 'input, 'output) service - -val map: - ('a -> 'b) -> - ('b -> 'a) -> - ('meth, 'pr, 'a, 'q, 'i, 'o) service -> - ('meth, 'pr, 'b, 'q, 'i, 'o) service - val get_service: ?description: string -> query: 'query RPC_query.t -> diff --git a/vendors/ocplib-resto/lib_ezresto-directory/test/ezDirectory.ml b/vendors/ocplib-resto/lib_ezresto-directory/test/ezDirectory.ml index f909c77b8..5be2ca08d 100644 --- a/vendors/ocplib-resto/lib_ezresto-directory/test/ezDirectory.ml +++ b/vendors/ocplib-resto/lib_ezresto-directory/test/ezDirectory.ml @@ -26,7 +26,7 @@ let dir = (fun i j () () -> Lwt.return (`Ok (float_of_int i+.j))) let dir = register dir alternate_add_service' - (fun (i,j) () () -> Lwt.return (`Ok (i+j))) + (fun (((), i),j) () () -> Lwt.return (`Ok (i+ int_of_float j))) let dir = register_describe_directory_service dir describe_service diff --git a/vendors/ocplib-resto/lib_ezresto-directory/test/ezResto_test.ml b/vendors/ocplib-resto/lib_ezresto-directory/test/ezResto_test.ml index 5a9ce5092..a3c344566 100644 --- a/vendors/ocplib-resto/lib_ezresto-directory/test/ezResto_test.ml +++ b/vendors/ocplib-resto/lib_ezresto-directory/test/ezResto_test.ml @@ -48,7 +48,7 @@ module Test(Request : sig 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 alternate_add_service' (1, 2) () 3) ; + assert (test alternate_add_service' (((), 1), 2.) () 3) ; () end diff --git a/vendors/ocplib-resto/lib_ezresto-directory/test/ezServices.ml b/vendors/ocplib-resto/lib_ezresto-directory/test/ezServices.ml index 98bdd64a5..4b5b9bee9 100644 --- a/vendors/ocplib-resto/lib_ezresto-directory/test/ezServices.ml +++ b/vendors/ocplib-resto/lib_ezresto-directory/test/ezServices.ml @@ -41,10 +41,7 @@ let alternate_add_service' = ~input:Json_encoding.null ~output:Json_encoding.int ~error:Json_encoding.empty - Path.(map - (fun (((),i),f) -> (i,int_of_float f)) - (fun (i,f) -> (((),i),float_of_int f)) - (root / "bar" /: Arg.int /: Arg.float / "add")) + Path.(root / "bar" /: Arg.int /: Arg.float / "add") let minus_service r = post_service diff --git a/vendors/ocplib-resto/lib_ezresto/ezResto.ml b/vendors/ocplib-resto/lib_ezresto/ezResto.ml index e30a5091e..13eb6547a 100644 --- a/vendors/ocplib-resto/lib_ezresto/ezResto.ml +++ b/vendors/ocplib-resto/lib_ezresto/ezResto.ml @@ -23,7 +23,6 @@ module Path = struct let add_arg = Path.add_arg let (/) = add_suffix let (/:) = add_arg - let map = Path.map end module Query = Query type ('meth, 'params, 'query, 'input, 'output, 'error) service = diff --git a/vendors/ocplib-resto/lib_ezresto/ezResto.mli b/vendors/ocplib-resto/lib_ezresto/ezResto.mli index 2c06cb929..ca378b905 100644 --- a/vendors/ocplib-resto/lib_ezresto/ezResto.mli +++ b/vendors/ocplib-resto/lib_ezresto/ezResto.mli @@ -49,8 +49,6 @@ module Path : sig val add_arg: 'params path -> 'a Arg.arg -> ('params * 'a) path val (/:): 'params path -> 'a Arg.arg -> ('params * 'a) path - val map: ('a -> 'b) -> ('b -> 'a) -> 'a path -> 'b path - end module Query : sig diff --git a/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml b/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml index f98fe5c22..0ed751556 100644 --- a/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml +++ b/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml @@ -181,7 +181,7 @@ module Make (Encoding : ENCODING) = struct : type p pr. (pr, p) Path.path -> p directory -> pr directory = fun path dir -> let rec prefix - : type k pr. (pr, k) Resto.Internal.rpath -> k directory -> pr directory + : type k pr. (pr, k) Resto.Internal.path -> k directory -> pr directory = fun path dir -> match path with | Root -> dir @@ -195,9 +195,7 @@ module Make (Encoding : ENCODING) = struct services = MethMap.empty }) | DynamicTail _ -> invalid_arg "RestoDirectory.prefix" in - match Resto.Internal.to_path path with - | Path path -> prefix path dir - | MappedPath (path, map, _) -> prefix path (map_directory map dir) + prefix (Resto.Internal.to_path path) dir let conflict steps kind = raise (Conflict (steps, kind)) @@ -431,7 +429,7 @@ module Make (Encoding : ENCODING) = struct let rec transparent_resolve : type pr p. - pr directory -> (pr, p) rpath -> p -> p directory option Lwt.t + pr directory -> (pr, p) path -> p -> p directory option Lwt.t = fun dir path rargs -> match path with | Root -> Lwt.return_some dir @@ -488,16 +486,7 @@ module Make (Encoding : ENCODING) = struct params -> query -> input -> (output, error) Answer.t Lwt.t = fun dir service params query body -> let service = Service.Internal.to_service service in - begin - match service.path with - | Service.Internal.Path p -> - transparent_resolve dir p params - | Service.Internal.MappedPath (p, _, f) -> begin - transparent_resolve dir p (f params) >>= function - | None -> Lwt.return_none - | Some dir -> Lwt.return_some (map f dir) - end - end >>= function + transparent_resolve dir service.path params >>= function | None -> Lwt.return (`Not_found None) | Some (Static { services ; _ }) -> begin try @@ -522,7 +511,7 @@ module Make (Encoding : ENCODING) = struct let rec describe_rpath : type a b. Description.path_item list -> - (a, b) rpath -> Description.path_item list + (a, b) path -> Description.path_item list = fun acc path -> match path with | Root -> acc @@ -538,7 +527,7 @@ module Make (Encoding : ENCODING) = struct ****************************************************************************) let rec step_of_path - : type p rk. (rk, p) rpath -> step list -> step list + : type p rk. (rk, p) path -> step list -> step list = fun path acc -> match path with | Root -> acc @@ -551,7 +540,7 @@ module Make (Encoding : ENCODING) = struct let rec insert : type k rk. - (rk, k) rpath -> rk directory -> k directory * (k directory -> rk directory) + (rk, k) path -> rk directory -> k directory * (k directory -> rk directory) = fun path dir -> match path with | Root -> dir, (fun x -> x) @@ -629,7 +618,7 @@ module Make (Encoding : ENCODING) = struct fun root s handler -> let s = Service.Internal.to_service s in let register - : type k. (pr, k) rpath -> (k -> q -> i -> (o, e) Answer.t Lwt.t) -> + : type k. (pr, k) path -> (k -> q -> i -> (o, e) Answer.t Lwt.t) -> pr directory = fun path handler -> let dir, insert = insert path root in @@ -662,9 +651,7 @@ module Make (Encoding : ENCODING) = struct | Static _ -> conflict path (CService s.meth) | Dynamic _ -> conflict path CBuilder | DynamicTail _ -> conflict path CTail in - match s.path with - | Path p -> register p handler - | MappedPath (p, map, _) -> register p (fun p i -> handler (map p) i) + register s.path handler let register = (register @@ -681,7 +668,7 @@ module Make (Encoding : ENCODING) = struct fun ?descr root path builder -> let path = Resto.Internal.to_path path in let register - : type k. (pr, k) rpath -> (k -> k directory Lwt.t) -> pr directory = + : type k. (pr, k) path -> (k -> k directory Lwt.t) -> pr directory = fun path builder -> let dir, insert = insert path root in match dir with @@ -692,11 +679,7 @@ module Make (Encoding : ENCODING) = struct | Static ({ subdirs = Some _ ; _ }) -> conflict path CDir | Dynamic _ -> conflict path CBuilder | DynamicTail _ -> conflict path CTail in - match path with - | Path p -> register p builder - | MappedPath (p, map, _) -> - register p - (fun args -> builder (map args) >|= map_directory map) + register path builder let register_describe_directory_service : type pr. diff --git a/vendors/ocplib-resto/lib_resto-directory/test/directory.ml b/vendors/ocplib-resto/lib_resto-directory/test/directory.ml index 675a5b2bb..107f60c54 100644 --- a/vendors/ocplib-resto/lib_resto-directory/test/directory.ml +++ b/vendors/ocplib-resto/lib_resto-directory/test/directory.ml @@ -28,7 +28,7 @@ let dir = (fun i j () () -> Lwt.return (`Ok (float_of_int i+.j))) let dir = register dir alternate_add_service' - (fun (i,j) () () -> Lwt.return (`Ok (i+j))) + (fun (((),i),j) () () -> Lwt.return (`Ok (i+ int_of_float j))) let dir = register dir dummy_service (fun ((((((((),_a), _b), _c), _d), _e), _f), _g) () () -> Lwt.return (`Ok ())) diff --git a/vendors/ocplib-resto/lib_resto-directory/test/resto_test.ml b/vendors/ocplib-resto/lib_resto-directory/test/resto_test.ml index f6a21e26e..fa095641e 100644 --- a/vendors/ocplib-resto/lib_resto-directory/test/resto_test.ml +++ b/vendors/ocplib-resto/lib_resto-directory/test/resto_test.ml @@ -69,7 +69,7 @@ module Test(Request : sig 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) ; + assert (test alternate_add_service' (((), 1), 2.) () 3) ; () end diff --git a/vendors/ocplib-resto/lib_resto-directory/test/services.ml b/vendors/ocplib-resto/lib_resto-directory/test/services.ml index 51a48b7b9..21c677b64 100644 --- a/vendors/ocplib-resto/lib_resto-directory/test/services.ml +++ b/vendors/ocplib-resto/lib_resto-directory/test/services.ml @@ -43,10 +43,7 @@ let alternate_add_service' = ~input:Json_encoding.null ~output:Json_encoding.int ~error:Json_encoding.empty - Path.(map - (fun (((),i),f) -> (i,int_of_float f)) - (fun (i,f) -> (((),i),float_of_int f)) - (root / "bar" /: Arg.int /: Arg.float / "add")) + Path.(root / "bar" /: Arg.int /: Arg.float / "add") let minus_service = post_service diff --git a/vendors/ocplib-resto/lib_resto/resto.ml b/vendors/ocplib-resto/lib_resto/resto.ml index 3d8998030..d020c613f 100644 --- a/vendors/ocplib-resto/lib_resto/resto.ml +++ b/vendors/ocplib-resto/lib_resto/resto.ml @@ -69,57 +69,35 @@ module Internal = struct let from_arg x = x let to_arg x = x - type (_,_) rpath = - | Root : ('rkey, 'rkey) rpath - | Static : ('rkey, 'key) rpath * string -> ('rkey, 'key) rpath - | Dynamic : ('rkey, 'key) rpath * 'a arg -> ('rkey, 'key * 'a) rpath - | DynamicTail : ('rkey, 'key) rpath * 'a arg -> ('rkey, 'key * 'a list) rpath - type (_,_) path = - | Path: ('prefix, 'params) rpath -> ('prefix, 'params) path - | MappedPath: - ('prefix, 'key) rpath * ('key -> 'params) * ('params -> 'key) -> - ('prefix, 'params) path + | Root : ('rkey, 'rkey) path + | Static : ('rkey, 'key) path * string -> ('rkey, 'key) path + | Dynamic : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a) path + | DynamicTail : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a list) path - let rec rsubst0 : type a b. (a, a) rpath -> (b, b) rpath = function + let rec subst0 : type a b. (a, a) path -> (b, b) path = function | Root -> Root - | Static (rpath, name) -> Static (rsubst0 rpath, name) - | Dynamic (rpath, arg) -> assert false (* impossible *) - | DynamicTail (rpath, arg) -> assert false (* impossible *) + | Static (path, name) -> Static (subst0 path, name) + | Dynamic (path, arg) -> assert false (* impossible *) + | DynamicTail (path, arg) -> assert false (* impossible *) - let subst0 = function - | Path rpath -> Path (rsubst0 rpath) - | MappedPath _ -> invalid_arg "Resto.Path.subst0" - - let rec rsubst1 : type a b c. (a, a * c) rpath -> (b, b * c) rpath = function + let rec subst1 : type a b c. (a, a * c) path -> (b, b * c) path = function | Root -> assert false (* impossible *) - | Static (rpath, name) -> Static (rsubst1 rpath, name) - | Dynamic (rpath, arg) -> Dynamic (rsubst0 rpath, arg) - | DynamicTail (rpath, arg) -> DynamicTail (rsubst0 rpath, arg) + | Static (path, name) -> Static (subst1 path, name) + | Dynamic (path, arg) -> Dynamic (subst0 path, arg) + | DynamicTail (path, arg) -> DynamicTail (subst0 path, arg) - let subst1 = function - | Path rpath -> Path (rsubst1 rpath) - | MappedPath _ -> invalid_arg "Resto.Path.subst1" - - let rec rsubst2 : type a b c d. (a, (a * c) * d) rpath -> (b, (b * c) * d) rpath = function + let rec subst2 : type a b c d. (a, (a * c) * d) path -> (b, (b * c) * d) path = function | Root -> assert false (* impossible *) - | Static (rpath, name) -> Static (rsubst2 rpath, name) - | Dynamic (rpath, arg) -> Dynamic (rsubst1 rpath, arg) - | DynamicTail (rpath, arg) -> DynamicTail (rsubst1 rpath, arg) + | Static (path, name) -> Static (subst2 path, name) + | Dynamic (path, arg) -> Dynamic (subst1 path, arg) + | DynamicTail (path, arg) -> DynamicTail (subst1 path, arg) - let subst2 = function - | Path rpath -> Path (rsubst2 rpath) - | MappedPath _ -> invalid_arg "Resto.Path.subst2" - - let rec rsubst3 : type a b c d e. (a, ((a * c) * d) * e) rpath -> (b, ((b * c) * d) * e) rpath = function + let rec subst3 : type a b c d e. (a, ((a * c) * d) * e) path -> (b, ((b * c) * d) * e) path = function | Root -> assert false (* impossible *) - | Static (rpath, name) -> Static (rsubst3 rpath, name) - | Dynamic (rpath, arg) -> Dynamic (rsubst2 rpath, arg) - | DynamicTail (rpath, arg) -> DynamicTail (rsubst2 rpath, arg) - - let subst3 = function - | Path rpath -> Path (rsubst3 rpath) - | MappedPath _ -> invalid_arg "Resto.Path.subst3" + | Static (path, name) -> Static (subst3 path, name) + | Dynamic (path, arg) -> Dynamic (subst2 path, arg) + | DynamicTail (path, arg) -> DynamicTail (subst2 path, arg) let from_path x = x let to_path x = x @@ -245,52 +223,33 @@ module Path = struct type ('a, 'b) t = ('a, 'b) Internal.path type ('a, 'b) path = ('a, 'b) Internal.path - type ('a, 'b) rpath = ('a, 'b) Internal.rpath type 'prefix context = ('prefix, 'prefix) path - let root = Path Root - let open_root = Path Root + let root = Root + let open_root = Root let add_suffix (type p pr) (path : (p, pr) path) name = match path with - | Path (DynamicTail _) -> invalid_arg "Resto.Path.add_suffix" - | MappedPath (DynamicTail _, _, _) -> invalid_arg "Resto.Path.add_suffix" - | Path path -> Path (Static (path, name)) - | MappedPath (path, map, rmap) -> - MappedPath (Static (path, name), map, rmap) + | DynamicTail _ -> invalid_arg "Resto.Path.add_suffix" + | path -> Static (path, name) let add_arg (type p pr) (path : (p, pr) path) arg = match path with - | Path (DynamicTail _) -> invalid_arg "Resto.Path.add_arg" - | MappedPath (DynamicTail _, _, _) -> invalid_arg "Resto.Path.add_arg" - | Path path -> Path (Dynamic (path, arg)) - | MappedPath (path, map, rmap) -> - MappedPath (Dynamic (path, arg), - (fun (x, y) -> (map x, y)), - (fun (x, y) -> (rmap x, y))) + | DynamicTail _ -> invalid_arg "Resto.Path.add_arg" + | path -> Dynamic (path, arg) let add_final_args (type p pr) (path : (p, pr) path) arg = match path with - | Path (DynamicTail _) -> invalid_arg "Resto.Path.add_final_arg" - | MappedPath (DynamicTail _, _, _) -> invalid_arg "Resto.Path.add_final_arg" - | Path path -> Path (DynamicTail (path, arg)) - | MappedPath (path, map, rmap) -> - MappedPath (DynamicTail (path, arg), - (fun (x, y) -> (map x, y)), - (fun (x, y) -> (rmap x, y))) - - let map map rmap = function - | Path p -> MappedPath (p, map, rmap) - | MappedPath (p, map', rmap') -> - MappedPath (p, (fun x -> map (map' x)), (fun x -> rmap' (rmap x))) + | DynamicTail _ -> invalid_arg "Resto.Path.add_final_arg" + | path -> DynamicTail (path, arg) let prefix : type p pr a. (pr, a) path -> (a, p) path -> (pr, p) path = fun p1 p2 -> let rec prefix : type pr a k. - (pr, a) path -> (a, k) rpath -> (pr, k) path + (pr, a) path -> (a, k) path -> (pr, k) path = fun p1 p2 -> match p2 with | Root -> p1 @@ -299,12 +258,8 @@ module Path = struct | DynamicTail (path, arg) -> add_final_args (prefix p1 path) arg in match p1 with - | Path (DynamicTail _) -> invalid_arg "Resto.Path.prefix" - | MappedPath (DynamicTail _, _, _) -> invalid_arg "Resto.Path.prefix" - | _ -> - match p2 with - | Path p2 -> prefix p1 p2 - | MappedPath (p2, m, rm) -> map m rm (prefix p1 p2) + | DynamicTail _ -> invalid_arg "Resto.Path.prefix" + | _ -> prefix p1 p2 let (/) = add_suffix let (/:) = add_arg @@ -658,10 +613,6 @@ module MakeService(Encoding : ENCODING) = struct let subst2 s = { s with path = Internal.subst2 s.path } let subst3 s = { s with path = Internal.subst3 s.path } - let map f g (s : (_,_,_,_,_,_,_) service) = - { s with path = Path.map f g s.path } - - let meth = fun { meth } -> meth let query @@ -711,7 +662,7 @@ module MakeService(Encoding : ENCODING) = struct : type pr p. (pr, p) path -> p -> string list = fun path args -> let rec forge_request_args - : type k. (pr, k) rpath -> k -> string list -> string list + : type k. (pr, k) path -> k -> string list -> string list = fun path args acc -> match path, args with | Root, _ -> @@ -723,9 +674,7 @@ module MakeService(Encoding : ENCODING) = struct | DynamicTail (path, arg), (args, xs) -> forge_request_args path args (List.fold_right (fun x acc -> arg.construct x :: acc) xs acc) in - match path with - | Path path -> forge_request_args path args [] - | MappedPath (path, _, rmap) -> forge_request_args path (rmap args) [] + forge_request_args path args [] let forge_request_query : type q. q query -> q -> (string * string) list diff --git a/vendors/ocplib-resto/lib_resto/resto.mli b/vendors/ocplib-resto/lib_resto/resto.mli index 1218fa9ec..eda4b4ac0 100644 --- a/vendors/ocplib-resto/lib_resto/resto.mli +++ b/vendors/ocplib-resto/lib_resto/resto.mli @@ -75,9 +75,6 @@ module Path : sig val prefix: ('prefix, 'a) path -> ('a, 'params) path -> ('prefix, 'params) path - val map: - ('a -> 'b) -> ('b -> 'a) -> ('prefix, 'a) path -> ('prefix, 'b) path - end (** Service directory description *) @@ -192,17 +189,11 @@ module Internal : sig val from_arg : 'a arg -> 'a Arg.t val to_arg : 'a Arg.t -> 'a arg - type (_, _) rpath = - | Root : ('rkey, 'rkey) rpath - | Static : ('rkey, 'key) rpath * string -> ('rkey, 'key) rpath - | Dynamic : ('rkey, 'key) rpath * 'a arg -> ('rkey, 'key * 'a) rpath - | DynamicTail : ('rkey, 'key) rpath * 'a arg -> ('rkey, 'key * 'a list) rpath - type (_, _) path = - | Path: ('prefix, 'params) rpath -> ('prefix, 'params) path - | MappedPath: - ('prefix, 'key) rpath * ('key -> 'params) * ('params -> 'key) -> - ('prefix, 'params) path + | Root : ('rkey, 'rkey) path + | Static : ('rkey, 'key) path * string -> ('rkey, 'key) path + | Dynamic : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a) path + | DynamicTail : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a list) path val from_path : ('a, 'b) path -> ('a, 'b) Path.t val to_path : ('a, 'b) Path.t -> ('a, 'b) path @@ -338,12 +329,6 @@ module MakeService(Encoding : ENCODING) : sig ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service - val map: - ('a -> 'b) -> - ('b -> 'a) -> - ('meth, 'pr, 'a, 'q, 'i, 'o, 'e) service -> - ('meth, 'pr, 'b, 'q, 'i, 'o, 'e) service - val subst0: ([< meth ] as 'm, 'p, 'p, 'q, 'i, 'o, 'e) service -> ('m, 'p2, 'p2, 'q, 'i, 'o, 'e) service