ligo/lib_embedded_client_genesis/client_proto_main.ml

130 lines
4.9 KiB
OCaml

(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Client_commands
open Tezos_embedded_raw_protocol_genesis
let protocol =
Protocol_hash.of_b58check_exn
"ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im"
let call_service1 rpc_config s block a1 =
Client_rpcs.call_service1 rpc_config
(s Node_rpc_services.Blocks.proto_path) block a1
let call_error_service1 rpc_config s block a1 =
call_service1 rpc_config s block a1 >>= function
| Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err)
| Ok (Ok v) -> return v
| Error _ as err -> Lwt.return err
let forge_block
rpc_config block net_id ?(timestamp = Time.now ()) command fitness =
let block = Client_rpcs.last_baked_block block in
Client_node_rpcs.Blocks.info rpc_config block >>=? fun pred ->
let proto_level =
match command with
| Data.Command.Activate _ -> 1
| Data.Command.Activate_testnet _ -> 0 in
call_service1 rpc_config
Services.Forge.block block
((net_id, Int32.succ pred.level, proto_level,
pred.hash, timestamp, fitness), command)
let bake rpc_config ?timestamp block command fitness seckey =
let block = Client_rpcs.last_baked_block block in
Client_node_rpcs.Blocks.info rpc_config block >>=? fun bi ->
forge_block
rpc_config ?timestamp block bi.net_id command fitness >>=? fun blk ->
let signed_blk = Ed25519.Signature.append seckey blk in
Client_node_rpcs.inject_block rpc_config signed_blk []
let int64_parameter =
(Cli_entries.parameter (fun _ p ->
try return (Int64.of_string p)
with _ -> failwith "Cannot read int64"))
let int_parameter =
(Cli_entries.parameter (fun _ p ->
try return (int_of_string p)
with _ -> failwith "Cannot read int"))
let commands () =
let open Cli_entries in
let args =
args1
(arg
~parameter:"-timestamp"
~doc:"Set the timestamp of the block (and initial time of the chain)"
(parameter (fun _ t ->
match (Time.of_notation t) with
| None -> Error_monad.failwith "Could not parse value provided to -timestamp option"
| Some t -> return t))) in
[
command ~desc: "Activate a protocol"
args
(prefixes [ "activate" ; "protocol" ]
@@ Protocol_hash.param ~name:"version" ~desc:"Protocol version (b58check)"
@@ prefixes [ "with" ; "fitness" ]
@@ param ~name:"fitness"
~desc:"Hardcoded fitness of the first block (integer)"
int64_parameter
@@ prefixes [ "and" ; "passes" ]
@@ param ~name:"passes"
~desc:"Hardcoded number of validation passes (integer)"
int_parameter
@@ prefixes [ "and" ; "key" ]
@@ Client_keys.Secret_key.source_param
~name:"password" ~desc:"Dictator's key"
@@ stop)
begin fun timestamp hash fitness validation_passes seckey cctxt ->
let fitness =
Tezos_embedded_raw_protocol_alpha.Fitness_repr.from_int64 fitness in
bake cctxt.rpc_config ?timestamp cctxt.config.block
(Activate { protocol = hash ; validation_passes })
fitness seckey >>=? fun hash ->
cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
return ()
end ;
command ~desc: "Fork a test protocol"
args
(prefixes [ "fork" ; "test" ; "protocol" ]
@@ Protocol_hash.param ~name:"version" ~desc:"Protocol version (b58check)"
@@ prefixes [ "with" ; "fitness" ]
@@ param ~name:"fitness"
~desc:"Hardcoded fitness of the first block (integer)"
int64_parameter
@@ prefixes [ "and" ; "passes" ]
@@ param ~name:"passes"
~desc:"Hardcoded number of validation passes (integer)"
int_parameter
@@ prefixes [ "and" ; "key" ]
@@ Ed25519.Secret_key.param
~name:"password" ~desc:"Dictator's key"
@@ stop)
begin fun timestamp hash fitness validation_passes seckey cctxt ->
let fitness =
Tezos_embedded_raw_protocol_alpha.Fitness_repr.from_int64 fitness in
bake cctxt.rpc_config ?timestamp cctxt.config.block
(Activate_testnet { protocol = hash ;
validation_passes ;
delay = Int64.mul 24L 3600L })
fitness seckey >>=? fun hash ->
cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
return ()
end ;
]
let () =
Client_commands.register protocol @@
commands ()