forked from LaurentMazare/btc-ocaml
-
Notifications
You must be signed in to change notification settings - Fork 0
/
btc_rpc.ml
70 lines (64 loc) · 1.82 KB
/
btc_rpc.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
open Core.Std
open Async.Std
module Protocol = struct
module Stats = struct
type query = unit with sexp, bin_io
type response =
{ connected_nodes : Address.t list
; known_nodes : Address.t list
; blockchain_length : int
; tip_depth : int
; tip_difficulty_sum : float
; tip_hash : Hash.t
} with sexp, bin_io
let rpc =
Rpc.Rpc.create
~name:"stats"
~version:1
~bin_query
~bin_response
let handle_query ~network ~blockchain =
fun _connection_state () ->
return
{ connected_nodes = Network.connected_nodes network |> List.map ~f:Node.address
; known_nodes = Network.known_nodes network |> List.map ~f:Node.address
; blockchain_length = Blockchain.blockchain_length blockchain
; tip_depth = Blockchain.tip_depth blockchain
; tip_difficulty_sum = Blockchain.tip_difficulty_sum blockchain
; tip_hash = Blockchain.tip_hash blockchain
}
end
end
module Client = struct
let get_stats ~rpc_port =
Rpc.Connection.client
~host:"127.0.0.1"
~port:rpc_port
()
>>= function
| Error exn -> return (Or_error.of_exn exn)
| Ok connection ->
Rpc.Rpc.dispatch
Protocol.Stats.rpc
connection
()
end
module Server = struct
let start ~network ~blockchain ~rpc_port =
let implementations =
[ Rpc.Rpc.implement Protocol.Stats.rpc (Protocol.Stats.handle_query ~network ~blockchain)
]
in
let implementations =
Rpc.Implementations.create_exn
~on_unknown_rpc:`Continue
~implementations
in
Rpc.Connection.serve
~implementations
~initial_connection_state:(fun _address _connection -> ())
~where_to_listen:(Tcp.on_port rpc_port)
()
>>| fun _tcp_server ->
()
end