Source file dac_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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
open Runnable.Syntax
type endpoint = Node of Dac_node.t | Foreign_endpoint of Endpoint.t
type t = {
name : string;
path : string;
dac_node : endpoint;
base_dir : string;
color : Log.Color.t;
runner : Runner.t option;
}
let rpc_host = function
| Node dac_node -> Dac_node.rpc_host dac_node
| Foreign_endpoint foreign -> Endpoint.rpc_host foreign
let rpc_port = function
| Node dac_node -> Dac_node.rpc_port dac_node
| Foreign_endpoint foreign -> Endpoint.rpc_port foreign
let next_name = ref 1
let fresh_name () =
let index = !next_name in
incr next_name ;
"dac_client" ^ string_of_int index
let () = Test.declare_reset_function @@ fun () -> next_name := 1
let create_with_endpoint ?runner ?name ?path ?base_dir
?(color = Log.Color.FG.green) endpoint =
let name = match name with None -> fresh_name () | Some name -> name in
let base_dir =
match base_dir with None -> Temp.dir ?runner name | Some dir -> dir
in
let path = Option.value ~default:(Uses.path Constant.octez_dac_client) path in
{name; path; dac_node = endpoint; base_dir; color; runner}
let create ?runner ?name ?path ?base_dir ?color dac_node =
create_with_endpoint ?runner ?name ?path ?base_dir ?color (Node dac_node)
let base_dir_arg dac_client = ["--base-dir"; dac_client.base_dir]
let spawn_command ?hooks dac_client command =
let process =
Process.spawn
?runner:dac_client.runner
~name:dac_client.name
~color:dac_client.color
?hooks
dac_client.path
(base_dir_arg dac_client @ command)
in
Runnable.{value = process; run = Process.check_and_read_stdout}
type output = Root_hash of Hex.t | Certificate of Hex.t
let send_payload_output raw_output =
match raw_output =~* rex "Payload stored under root hash: ([0-9A-Fa-f]+)" with
| Some hex -> Root_hash (`Hex hex)
| None -> (
match
raw_output
=~* rex
"No certificate could be obtained.\n\
Payload stored under root hash: ([0-9A-Fa-f]+)\n"
with
| Some hex -> Root_hash (`Hex hex)
| None -> (
match raw_output =~* rex "Certificate received: ([0-9A-Fa-f]+)\n" with
| Some hex -> Certificate (`Hex hex)
| None -> assert false))
let get_certificate_output raw_output =
match raw_output =~* rex "No certificate known for ([0-9A-Fa-f]+)\n" with
| Some _hex -> None
| None -> (
match raw_output =~* rex "Certificate received: ([0-9A-Fa-f]+)\n" with
| Some hex -> Some (Certificate (`Hex hex))
| None -> assert false)
let send_hex_payload ?hooks ?threshold dac_client hex_payload =
let coordinator_endpoint =
Printf.sprintf
"%s:%d"
(rpc_host dac_client.dac_node)
(rpc_port dac_client.dac_node)
in
let threshold_arg =
match threshold with
| None -> []
| Some n -> ["--wait-for-threshold"; string_of_int n]
in
let*? process =
spawn_command
?hooks
dac_client
([
"send";
"payload";
"to";
"coordinator";
coordinator_endpoint;
"with";
"content";
Hex.show hex_payload;
]
@ threshold_arg)
in
let* raw_output = Process.check_and_read_stdout process in
Lwt.return @@ send_payload_output raw_output
let send_payload_from_file ?hooks ?threshold dac_client filename =
let coordinator_endpoint =
Printf.sprintf
"%s:%d"
(rpc_host dac_client.dac_node)
(rpc_port dac_client.dac_node)
in
let threshold_arg =
match threshold with
| None -> []
| Some n -> ["--wait-for-threshold"; string_of_int n]
in
let*? process =
spawn_command
?hooks
dac_client
([
"send";
"payload";
"to";
"coordinator";
coordinator_endpoint;
"from";
"file";
filename;
]
@ threshold_arg)
in
let* raw_output = Process.check_and_read_stdout process in
Lwt.return @@ send_payload_output raw_output
let get_certificate ?hooks dac_client hex_root_hash =
let coordinator_endpoint =
Printf.sprintf
"%s:%d"
(rpc_host dac_client.dac_node)
(rpc_port dac_client.dac_node)
in
let*? process =
spawn_command
?hooks
dac_client
[
"get";
"certificate";
"from";
"coordinator";
coordinator_endpoint;
"for";
"root";
"hash";
Hex.show hex_root_hash;
]
in
let* raw_output = Process.check_and_read_stdout process in
Lwt.return @@ get_certificate_output raw_output