89 lines
3.4 KiB
OCaml
89 lines
3.4 KiB
OCaml
|
(**************************************************************************)
|
||
|
|
(* *)
|
||
|
|
(* Copyright (c) 2014 - 2016. *)
|
||
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
||
|
|
(* *)
|
||
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
||
|
|
(* *)
|
||
|
|
(**************************************************************************)
|
||
|
|
|
||
|
|
let protocol =
|
||
|
|
Protocol_hash.of_b58check
|
||
|
|
"ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im"
|
||
|
|
|
||
|
|
let call_service1 cctxt s block a1 =
|
||
|
|
Client_node_rpcs.call_service1 cctxt
|
||
|
|
(s Node_rpc_services.Blocks.proto_path) block a1
|
||
|
|
|
||
|
|
let call_error_service1 cctxt s block a1 =
|
||
|
|
call_service1 cctxt s block a1 >|= wrap_error
|
||
|
|
|
||
|
|
let forge_block cctxt command block net_id pred_blk hash fitness =
|
||
|
|
call_service1 cctxt
|
||
|
|
Services.Forge.block block
|
||
|
|
(net_id, pred_blk, (Time.now ()),
|
||
|
|
{ Types.Block.command ; hash ; fitness })
|
||
|
|
|
||
|
|
let mine cctxt command proto_hash fitness seckey =
|
||
|
|
let block =
|
||
|
|
match Client_config.block () with
|
||
|
|
| `Prevalidation -> `Head 0
|
||
|
|
| `Test_prevalidation -> `Test_head 0
|
||
|
|
| b -> b in
|
||
|
|
Client_node_rpcs.Blocks.info cctxt block >>= fun bi ->
|
||
|
|
forge_block
|
||
|
|
cctxt command block bi.net bi.hash proto_hash fitness >>= fun blk ->
|
||
|
|
let signed_blk = Environment.Ed25519.append_signature seckey blk in
|
||
|
|
Client_node_rpcs.inject_block cctxt ~wait:true signed_blk >>=? fun hash ->
|
||
|
|
cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
|
||
|
|
return ()
|
||
|
|
|
||
|
|
let handle_error cctxt = function
|
||
|
|
| Ok res ->
|
||
|
|
Lwt.return res
|
||
|
|
| Error exns ->
|
||
|
|
pp_print_error Format.err_formatter exns ;
|
||
|
|
cctxt.Client_commands.error "%s" "cannot continue"
|
||
|
|
|
||
|
|
let commands () =
|
||
|
|
let open Cli_entries in
|
||
|
|
[
|
||
|
|
command ~desc: "Activate a protocol" begin
|
||
|
|
prefixes [ "activate" ; "protocol" ] @@
|
||
|
|
param ~name:"version" ~desc:"Protocol version (b58check)"
|
||
|
|
(fun _ p -> Lwt.return @@ Protocol_hash.of_b58check p) @@
|
||
|
|
prefixes [ "with" ; "fitness" ] @@
|
||
|
|
param ~name:"fitness"
|
||
|
|
~desc:"Hardcoded fitness of the first block (integer)"
|
||
|
|
(fun _ p -> Lwt.return (Int64.of_string p)) @@
|
||
|
|
prefixes [ "and" ; "key" ] @@
|
||
|
|
param ~name:"password" ~desc:"Dictator's key"
|
||
|
|
(fun _ key ->
|
||
|
|
Lwt.return (Environment.Ed25519.secret_key_of_b58check key))
|
||
|
|
stop
|
||
|
|
end
|
||
|
|
(fun hash fitness seckey cctxt ->
|
||
|
|
mine cctxt Activate hash fitness seckey >>= handle_error cctxt)
|
||
|
|
;
|
||
|
|
command ~desc: "Fork a test protocol" begin
|
||
|
|
prefixes [ "fork" ; "test" ; "protocol" ] @@
|
||
|
|
param ~name:"version" ~desc:"Protocol version (b58check)"
|
||
|
|
(fun _ p -> Lwt.return (Protocol_hash.of_b58check p)) @@
|
||
|
|
prefixes [ "with" ; "fitness" ] @@
|
||
|
|
param ~name:"fitness"
|
||
|
|
~desc:"Hardcoded fitness of the first block (integer)"
|
||
|
|
(fun _ p -> Lwt.return (Int64.of_string p)) @@
|
||
|
|
prefixes [ "and" ; "key" ] @@
|
||
|
|
param ~name:"password" ~desc:"Dictator's key"
|
||
|
|
(fun _ key ->
|
||
|
|
Lwt.return (Environment.Ed25519.secret_key_of_b58check key))
|
||
|
|
stop
|
||
|
|
end
|
||
|
|
(fun hash fitness seckey cctxt ->
|
||
|
|
mine cctxt Activate_testnet hash fitness seckey >>= handle_error cctxt) ;
|
||
|
|
]
|
||
|
|
|
||
|
|
let () =
|
||
|
|
Client_commands.register protocol @@
|
||
|
|
commands ()
|