Source file RPC_client.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
open Tezos_proxy
module Service = Tezos_rpc.Service
module Events = Proxy_events
let rec print_path : type pr p. (pr, p) Resto.Internal.path -> string list =
fun path ->
match path with
| Root -> []
| Static (path, s) -> s :: print_path path
| Dynamic (path, arg) ->
Printf.sprintf "<%s>" arg.descr.name :: print_path path
| DynamicTail (path, arg) ->
Printf.sprintf "<%s>" arg.descr.name :: print_path path
let print_service : type p q i o. (_, _, p, q, i, o) Service.t -> string =
fun serv ->
let iserv = Service.Internal.to_service serv in
String.concat "/" (List.rev (print_path iserv.path))
let method_is_writer = function
| `POST | `DELETE | `PUT | `PATCH -> true
| `GET -> false
class http_local_ctxt (printer : Tezos_client_base.Client_context.printer)
(http_ctxt : Tezos_rpc.Context.generic) (mode : Proxy_services.mode) protocol :
Tezos_rpc.Context.generic =
let local_ctxt =
Tezos_mockup_proxy.RPC_client.local_ctxt
(Proxy_services.build_directory printer http_ctxt mode protocol)
in
let dispatch_local_or_distant ~debug_name ~local ~distant meth path =
let open Lwt_syntax in
let meth_string = Tezos_rpc.Service.string_of_meth meth in
let delegate () =
let* () =
Events.(emit delegate_to_http) (meth_string, debug_name, path)
in
distant ()
in
if method_is_writer meth then delegate ()
else
let* r = local () in
match r with
| Ok x ->
let* () =
Events.(emit done_locally) (meth_string, debug_name, path)
in
return_ok x
| Error [Tezos_rpc.Context.Not_found _] -> delegate ()
| Error _ as err -> Lwt.return err
in
object
method base = Uri.empty
method call_service
: 'm 'p 'q 'i 'o.
(([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) Tezos_rpc.Service.t ->
'p ->
'q ->
'i ->
'o tzresult Lwt.t =
fun service params query input ->
let local () = local_ctxt#call_service service params query input in
let distant () = http_ctxt#call_service service params query input in
let meth = Tezos_rpc.Service.meth service in
dispatch_local_or_distant
~debug_name:"call_service"
~local
~distant
meth
@@ print_service service
method call_streamed_service
: 'm 'p 'q 'i 'o.
(([< Resto.meth] as 'm), 'pr, 'p, 'q, 'i, 'o) Tezos_rpc.Service.t ->
on_chunk:('o -> unit) ->
on_close:(unit -> unit) ->
'p ->
'q ->
'i ->
(unit -> unit) tzresult Lwt.t =
fun service ~on_chunk ~on_close params query input ->
let local () =
local_ctxt#call_streamed_service
service
~on_chunk
~on_close
params
query
input
in
let distant () =
http_ctxt#call_streamed_service
service
~on_chunk
~on_close
params
query
input
in
let meth = Tezos_rpc.Service.meth service in
dispatch_local_or_distant
~debug_name:"call_streamed_service"
~local
~distant
meth
@@ print_service service
method generic_media_type_call
: Service.meth ->
?body:Data_encoding.json ->
Uri.t ->
Tezos_rpc.Context.generic_call_result
Tezos_error_monad.Error_monad.tzresult
Lwt.t =
let open Lwt_syntax in
fun meth ?body uri ->
let meth_string = Tezos_rpc.Service.string_of_meth meth in
let uri_string = Uri.to_string uri in
let delegate () =
let* () =
Events.(emit delegate_media_type_call_to_http)
(meth_string, uri_string)
in
http_ctxt#generic_media_type_call meth ?body uri
in
if method_is_writer meth then delegate ()
else
let* answer = local_ctxt#generic_media_type_call meth ?body uri in
match answer with
| Ok (`Json (`Not_found _))
| Ok (`Binary (`Not_found _))
| Ok (`Other (_, `Not_found _))
| Error [Tezos_rpc.Context.Not_found _] ->
delegate ()
| Ok x ->
let* () =
Events.(emit done_media_type_call_locally)
(meth_string, uri_string)
in
return_ok x
| Error _ as err -> Lwt.return err
end