diff --git a/src/proto_alpha/lib_client/jbuild b/src/proto_alpha/lib_client/jbuild index ea6258811..67cea0116 100644 --- a/src/proto_alpha/lib_client/jbuild +++ b/src/proto_alpha/lib_client/jbuild @@ -9,6 +9,7 @@ tezos-shell-services tezos-client-base tezos-rpc + tezos-storage tezos-signer-backends bip39)) (library_flags (:standard -linkall)) @@ -17,6 +18,7 @@ -open Tezos_base__TzPervasives -open Tezos_shell_services -open Tezos_client_base + -open Tezos_storage -open Tezos_rpc)))) (alias diff --git a/src/proto_alpha/lib_client/proto_alpha.ml b/src/proto_alpha/lib_client/proto_alpha.ml index cc9b1735b..9b2085bce 100644 --- a/src/proto_alpha/lib_client/proto_alpha.ml +++ b/src/proto_alpha/lib_client/proto_alpha.ml @@ -8,9 +8,12 @@ (**************************************************************************) module Name = struct let name = "alpha" end -module Alpha_environment = Tezos_protocol_environment_faked.MakeV1(Name)() +module T = Tezos_protocol_environment.Make(Tezos_storage.Context) +module Alpha_environment = T.MakeV1(Name)() + module Proto = Tezos_protocol_alpha.Functor.Make(Alpha_environment) module Alpha_block_services = Block_services.Make(Proto)(Proto) + include Proto class type rpc_context = object diff --git a/src/proto_alpha/lib_delegate/client_baking_blocks.ml b/src/proto_alpha/lib_delegate/client_baking_blocks.ml index 362ddae0f..019ca5785 100644 --- a/src/proto_alpha/lib_delegate/client_baking_blocks.ml +++ b/src/proto_alpha/lib_delegate/client_baking_blocks.ml @@ -19,6 +19,7 @@ type block_info = { protocol: Protocol_hash.t ; next_protocol: Protocol_hash.t ; level: Raw_level.t ; + context : Context_hash.t ; } let raw_info cctxt ?(chain = `Main) hash shell_header = @@ -27,12 +28,13 @@ let raw_info cctxt ?(chain = `Main) hash shell_header = Shell_services.Blocks.protocols cctxt ~chain ~block () >>=? fun { current_protocol = protocol ; next_protocol } -> - let { Tezos_base.Block_header.predecessor ; fitness ; timestamp ; level ; _ } = + let { Tezos_base.Block_header.predecessor ; fitness ; + timestamp ; level ; context ; _ } = shell_header in match Raw_level.of_int32 level with | Ok level -> return { hash ; chain_id ; predecessor ; fitness ; - timestamp ; protocol ; next_protocol ; level } + timestamp ; protocol ; next_protocol ; level ; context } | Error _ -> failwith "Cannot convert level into int32" diff --git a/src/proto_alpha/lib_delegate/client_baking_blocks.mli b/src/proto_alpha/lib_delegate/client_baking_blocks.mli index a342e7ce8..351fe2b29 100644 --- a/src/proto_alpha/lib_delegate/client_baking_blocks.mli +++ b/src/proto_alpha/lib_delegate/client_baking_blocks.mli @@ -19,6 +19,7 @@ type block_info = { protocol: Protocol_hash.t ; next_protocol: Protocol_hash.t ; level: Raw_level.t ; + context : Context_hash.t ; } val info: diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml index 69ca1c21e..82c9ae3e1 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.ml +++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml @@ -18,9 +18,21 @@ let generate_proof_of_work_nonce () = let generate_seed_nonce () = match Nonce.of_bytes @@ Rand.generate Constants.nonce_length with - | Error _ -> assert false + | Error _errs -> assert false | Ok nonce -> nonce +let rec retry_call f ?(msg="Call error") ?(n=5) () = + f () >>= function + | Ok r -> return r + | (Error errs) as x -> + if n > 0 then + begin + lwt_log_error "%s\n%a\nRetrying..." + msg pp_print_error errs >>= fun () -> + Lwt_unix.sleep 1. >>= retry_call f ~msg ~n:(n-1) + end + else + Lwt.return x let forge_block_header (cctxt : #Proto_alpha.full) @@ -370,14 +382,16 @@ let rec insert_baking_slot slot = function type state = { genesis: Block_hash.t ; + index : Context.index ; mutable delegates: public_key_hash list ; mutable best: Client_baking_blocks.block_info ; mutable future_slots: (Time.t * (Client_baking_blocks.block_info * int * public_key_hash)) list ; } -let create_state genesis delegates best = +let create_state genesis index delegates best = { genesis ; + index ; delegates ; best ; future_slots = [] ; @@ -491,6 +505,42 @@ let pop_baking_slots state = state.future_slots <- future_slots ; slots + +let filter_invalid_operations (cctxt : #full) state block_info (operations : packed_operation list list) = + let open Client_baking_simulator in + lwt_debug "Starting client-side validation" >>= fun () -> + begin_construction cctxt state.index block_info >>=? fun initial_inc -> + let endorsements = List.nth operations 0 in + let votes = List.nth operations 1 in + let anonymous = List.nth operations 2 in + let managers = List.nth operations 3 in + (* TODO log *) + let validate_operation inc op = + add_operation inc op >>= function + | Error _ -> return None + | Ok inc -> return (Some inc) + in + let filter_valid_operations inc ops = + fold_left_s (fun (inc, acc) op -> + validate_operation inc op >>=? function + | None -> return (inc, acc) + | Some inc -> return (inc, op :: acc) + ) (inc, []) ops + in + let is_valid_endorsement endorsement = + validate_operation initial_inc endorsement >>=? function + | None -> return None + | Some inc -> finalize_construction inc >>= begin function + | Ok _ -> return (Some endorsement) + | Error _ -> return None + end + in + filter_map_s is_valid_endorsement endorsements >>=? fun _endorsements -> + filter_valid_operations initial_inc votes >>=? fun (inc, votes) -> + filter_valid_operations inc anonymous >>=? fun (inc, anonymous) -> + filter_valid_operations inc managers >>=? fun (_, managers) -> + return @@ List.map List.rev [ endorsements ; votes ; anonymous ; managers ] + let bake_slot cctxt state @@ -525,28 +575,46 @@ let bake_slot let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in let operations = classify_operations operations in - Alpha_block_services.Helpers.Preapply.block - cctxt ~chain ~block - ~timestamp ~sort:true ~protocol_data operations >>= function + (* Don't validate if current block is genesis *) + begin + (* Don't load an alpha context if still in genesis *) + if Protocol_hash.(bi.protocol = bi.next_protocol) then + filter_invalid_operations cctxt state bi operations + else + return operations + end >>= function | Error errs -> - lwt_log_error "Error while prevalidating operations:@\n%a" + lwt_log_error "Error while filtering invalid operations (client-side) :@\n%a" pp_print_error errs >>= fun () -> return None - | Ok (shell_header, operations) -> - lwt_debug - "Computed candidate block after %a (slot %d): %a/%d fitness: %a" - Block_hash.pp_short bi.hash priority - (Format.pp_print_list - ~pp_sep:(fun ppf () -> Format.fprintf ppf "+") - (fun ppf operations -> Format.fprintf ppf "%d" (List.length operations.Preapply_result.applied))) - operations - total_op_count - Fitness.pp shell_header.fitness >>= fun () -> - let operations = - List.map (fun l -> List.map snd l.Preapply_result.applied) operations in - return - (Some (bi, priority, shell_header, operations, delegate, seed_nonce_hash)) + | Ok operations -> + retry_call + (fun () -> + Alpha_block_services.Helpers.Preapply.block + cctxt ~chain ~block + ~timestamp ~sort:true ~protocol_data operations) + ~msg:"Error while prevalidating operations" () + >>= function + | Error errs -> + lwt_log_error "Error while prevalidating operations:@\n%a" + pp_print_error + errs >>= fun () -> + return None + | Ok (shell_header, operations) -> + lwt_debug + "Computed candidate block after %a (slot %d): %a/%d fitness: %a" + Block_hash.pp_short bi.hash priority + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "+") + (fun ppf operations -> Format.fprintf ppf "%d" (List.length operations.Preapply_result.applied))) + operations + total_op_count + Fitness.pp shell_header.fitness >>= fun () -> + let operations = + List.map (fun l -> List.map snd l.Preapply_result.applied) operations in + return + (Some (bi, priority, shell_header, operations, delegate, seed_nonce_hash)) let fittest (_, _, (h1: Block_header.shell_header), _, _, _) @@ -635,6 +703,7 @@ let check_error p = let create (cctxt : #Proto_alpha.full) ?max_priority + ~(context_path: string) (delegates: public_key_hash list) (block_stream: Client_baking_blocks.block_info tzresult Lwt_stream.t) (bi: Client_baking_blocks.block_info) = @@ -651,7 +720,9 @@ let create last_get_block := Some t ; t | Some t -> t in - let state = create_state genesis_hash delegates bi in + lwt_debug "Opening shell context" >>= fun () -> + Client_baking_simulator.load_context ~context_path >>= fun index -> + let state = create_state genesis_hash index delegates bi in check_error @@ insert_block cctxt ?max_priority state bi >>= fun () -> (* main loop *) @@ -694,16 +765,15 @@ let create cctxt#message "Starting the baker" >>= fun () -> worker_loop () - - (* Wrapper around previous [create] function that handles the case of unavailable blocks (empty block chain). *) let create (cctxt : #Proto_alpha.full) ?max_priority + ~(context_path: string) (delegates: public_key_hash list) (block_stream: Client_baking_blocks.block_info tzresult Lwt_stream.t) = Client_baking_scheduling.wait_for_first_block ~info:cctxt#message block_stream - (create cctxt ?max_priority delegates block_stream) + (create cctxt ?max_priority ~context_path delegates block_stream) diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.mli b/src/proto_alpha/lib_delegate/client_baking_forge.mli index f2b55eff4..fbe934d86 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.mli +++ b/src/proto_alpha/lib_delegate/client_baking_forge.mli @@ -79,6 +79,7 @@ end val create: #Proto_alpha.full -> ?max_priority: int -> + context_path: string -> public_key_hash list -> Client_baking_blocks.block_info tzresult Lwt_stream.t -> unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_delegate/client_baking_lib.ml b/src/proto_alpha/lib_delegate/client_baking_lib.ml index 4e77a1db2..06bd6e6f8 100644 --- a/src/proto_alpha/lib_delegate/client_baking_lib.ml +++ b/src/proto_alpha/lib_delegate/client_baking_lib.ml @@ -101,31 +101,3 @@ let reveal_nonces cctxt () = Client_baking_forge.get_unrevealed_nonces cctxt cctxt#block >>=? fun nonces -> do_reveal cctxt cctxt#block nonces - -let run_daemon cctxt ?max_priority ~endorsement_delay delegates ~endorsement ~baking ~denunciation = - let endorser = - if endorsement then - Client_daemon.Endorser.run cctxt - ~delay:endorsement_delay - ~min_date:((Time.add (Time.now ()) (Int64.neg 1800L))) - delegates >>=? fun () -> return () - else return () - in - let baker = - if baking then - Client_daemon.Baker.run cctxt - ?max_priority - ~min_date:((Time.add (Time.now ()) (Int64.neg 1800L))) - delegates >>=? fun () -> return () - else return () - in - let accuser = - if denunciation then - Client_daemon.Accuser.run cctxt >>=? fun () -> return () - else - return () - in - endorser >>=? fun () -> - baker >>=? fun () -> - accuser >>=? fun () -> - return () diff --git a/src/proto_alpha/lib_delegate/client_baking_lib.mli b/src/proto_alpha/lib_delegate/client_baking_lib.mli index 7a6278b23..0569f882f 100644 --- a/src/proto_alpha/lib_delegate/client_baking_lib.mli +++ b/src/proto_alpha/lib_delegate/client_baking_lib.mli @@ -45,14 +45,3 @@ val reveal_nonces : #Proto_alpha.full -> unit -> unit Error_monad.tzresult Lwt.t - -(** Initialize the baking daemon *) -val run_daemon: - #Proto_alpha.full -> - ?max_priority:int -> - endorsement_delay:int -> - public_key_hash list -> - endorsement:bool -> - baking:bool -> - denunciation:bool -> - unit Error_monad.tzresult Lwt.t diff --git a/src/proto_alpha/lib_delegate/client_baking_simulator.ml b/src/proto_alpha/lib_delegate/client_baking_simulator.ml new file mode 100644 index 000000000..af9a06979 --- /dev/null +++ b/src/proto_alpha/lib_delegate/client_baking_simulator.ml @@ -0,0 +1,64 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context + +module Main = Alpha_environment.Lift(Main) + +type incremental = { + predecessor: Client_baking_blocks.block_info ; + context : Context.t ; + state: Main.validation_state ; + rev_operations: Operation.packed list ; + header: Tezos_base.Block_header.shell_header ; +} + +let load_context ~context_path = + Context.init ~readonly:true context_path + +let begin_construction (_cctxt : #Proto_alpha.full) index predecessor = + let { Client_baking_blocks.context } = predecessor in + Context.checkout_exn index context >>= fun context -> + let timestamp = Time.now () in + let predecessor_hash = predecessor.hash in + (* Shell_services.Blocks.header cctxt ~chain:`Main ~block:(`Hash (predecessor_hash, 0)) () + * >>=? fun { shell ; _ } -> *) + let header : Tezos_base.Block_header.shell_header = Tezos_base.Block_header.{ + predecessor = predecessor_hash ; + proto_level = 0 (* shell.proto_level *) ; + validation_passes = 0 (* shell.validation_passes *) ; + fitness = predecessor.fitness (* shell.fitness *) ; + timestamp ; + level = 0l (* shell.level *) ; + context = Context_hash.zero ; + operations_hash = Operation_list_list_hash.zero ; + } in + Main.begin_construction + ~predecessor_context: context + ~predecessor_timestamp: header.timestamp + ~predecessor_fitness: header.fitness + ~predecessor_level: header.level + ~predecessor:predecessor_hash + ~timestamp + () >>=? fun state -> + return { + predecessor ; + context ; + state ; + rev_operations = [] ; + header ; + } + +let add_operation st ( op : Operation.packed ) = + Main.apply_operation st.state op >>=? fun (state, _) -> + return { st with state ; rev_operations = op :: st.rev_operations } + +let finalize_construction inc = + Main.finalize_block inc.state >>=? fun _ -> return () diff --git a/src/proto_alpha/lib_delegate/client_baking_simulator.mli b/src/proto_alpha/lib_delegate/client_baking_simulator.mli new file mode 100644 index 000000000..b4734e026 --- /dev/null +++ b/src/proto_alpha/lib_delegate/client_baking_simulator.mli @@ -0,0 +1,27 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context + +type incremental = { + predecessor: Client_baking_blocks.block_info ; + context : Context.t ; + state: Main.validation_state ; + rev_operations: Operation.packed list ; + header: Tezos_base.Block_header.shell_header ; +} + +val load_context : context_path:string -> Context.index Lwt.t + +val begin_construction : #Proto_alpha.full -> Context.index -> Client_baking_blocks.block_info -> incremental tzresult Lwt.t + +val add_operation : incremental -> Operation.packed -> incremental tzresult Lwt.t + +val finalize_construction : incremental -> unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_delegate/client_daemon.ml b/src/proto_alpha/lib_delegate/client_daemon.ml index 5d72f172c..0af304ce5 100644 --- a/src/proto_alpha/lib_delegate/client_daemon.ml +++ b/src/proto_alpha/lib_delegate/client_daemon.ml @@ -18,14 +18,13 @@ module Endorser = struct end - module Baker = struct - let run (cctxt : #Proto_alpha.full) ?max_priority ?min_date delegates = + let run (cctxt : #Proto_alpha.full) ?max_priority ?min_date ~context_path delegates = Client_baking_blocks.monitor_heads cctxt `Main >>=? fun block_stream -> Client_baking_forge.create cctxt - ?max_priority delegates block_stream >>=? fun () -> + ?max_priority ~context_path delegates block_stream >>=? fun () -> ignore min_date; return () diff --git a/src/proto_alpha/lib_delegate/client_daemon.mli b/src/proto_alpha/lib_delegate/client_daemon.mli index 8a782eabc..73e5a29f7 100644 --- a/src/proto_alpha/lib_delegate/client_daemon.mli +++ b/src/proto_alpha/lib_delegate/client_daemon.mli @@ -23,6 +23,7 @@ module Baker : sig #Proto_alpha.full -> ?max_priority: int -> ?min_date: Time.t -> + context_path: string -> public_key_hash list -> unit tzresult Lwt.t end diff --git a/src/proto_alpha/lib_delegate/delegate_commands.ml b/src/proto_alpha/lib_delegate/delegate_commands.ml index df43d5c79..db886dd35 100644 --- a/src/proto_alpha/lib_delegate/delegate_commands.ml +++ b/src/proto_alpha/lib_delegate/delegate_commands.ml @@ -54,14 +54,18 @@ let baker_commands () = title = "Commands related to the baker daemon." } in [ - command ~group ~desc: "Launch a daemon that handles delegate operations." + command ~group ~desc: "Launch the baker daemon." (args1 max_priority_arg) - (prefixes [ "launch" ] + (prefixes [ "launch" ; "with" ; "context" ] + @@ string + ~name:"Context path" + ~desc:"Path to the shell context" @@ seq_of_param Client_keys.Public_key_hash.alias_param) - (fun max_priority delegates cctxt -> + (fun max_priority context_path delegates cctxt -> Client_daemon.Baker.run cctxt ?max_priority ~min_date:((Time.add (Time.now ()) (Int64.neg 1800L))) + ~context_path (List.map snd delegates) ) ] diff --git a/src/proto_alpha/lib_delegate/jbuild b/src/proto_alpha/lib_delegate/jbuild index 96e3b319c..4952f1dd9 100644 --- a/src/proto_alpha/lib_delegate/jbuild +++ b/src/proto_alpha/lib_delegate/jbuild @@ -10,6 +10,7 @@ tezos-client-base tezos-client-alpha tezos-client-commands + tezos-storage tezos-rpc)) (library_flags (:standard -linkall)) (modules (:standard \ @@ -22,6 +23,7 @@ -open Tezos_client_base -open Tezos_client_alpha -open Tezos_client_commands + -open Tezos_storage -open Tezos_rpc)))) (library