diff --git a/src/proto_017_PtNairob/lib_delegate/baking_vdf.ml b/src/proto_017_PtNairob/lib_delegate/baking_vdf.ml index be1efccf954bd89b93ecd6da00c38732189d66f5..67f59f451532956971ee779902bc005a9dda65c9 100644 --- a/src/proto_017_PtNairob/lib_delegate/baking_vdf.ml +++ b/src/proto_017_PtNairob/lib_delegate/baking_vdf.ml @@ -51,11 +51,10 @@ type 'a state = { } let init_block_stream_with_stopper cctxt chain = - Client_baking_blocks.monitor_applied_blocks + Client_baking_blocks.monitor_heads ~next_protocols:(Some [Protocol.hash]) cctxt - ~chains:[chain] - () + chain let stop_block_stream state = Option.iter @@ -354,10 +353,6 @@ let check_new_cycle state (level_info : Level.t) = let process_new_block (cctxt : #Protocol_client_context.full) state {hash; chain_id; protocol; next_protocol; level; _} = let open Lwt_result_syntax in - let* level_info = get_level_info cctxt level in - (* If head is in a new cycle record it in [state.cycle] and reset - * [state.computation_status] to [Not_started]. *) - let* () = check_new_cycle state level_info in if Protocol_hash.(protocol <> next_protocol) then (* If the protocol has changed, emit an event on every new block and take * no further action. It is expected that the daemon corresponding to @@ -365,6 +360,10 @@ let process_new_block (cctxt : #Protocol_client_context.full) state let*! () = Delegate_events.Denunciator.(emit protocol_change_detected) () in return_unit else + let* level_info = get_level_info cctxt level in + (* If head is in a new cycle record it in [state.cycle] and reset + * [state.computation_status] to [Not_started]. *) + let* () = check_new_cycle state level_info in (* If the chain is in the nonce revelation stage, there is nothing to do. *) let* out = is_in_nonce_revelation_stage state.constants level_info in if out then diff --git a/src/proto_017_PtNairob/lib_delegate/client_baking_blocks.ml b/src/proto_017_PtNairob/lib_delegate/client_baking_blocks.ml index 12b9f83b0b403e48146f8d321ae140a6f4e68eda..1655719777cffbde6c763efe73433aa9f71b7a18 100644 --- a/src/proto_017_PtNairob/lib_delegate/client_baking_blocks.ml +++ b/src/proto_017_PtNairob/lib_delegate/client_baking_blocks.ml @@ -161,14 +161,17 @@ let monitor_applied_blocks cctxt ?chains ?protocols ~next_protocols () = stop ) let monitor_heads cctxt ~next_protocols chain = - Monitor_services.heads cctxt ?next_protocols chain - >>=? fun (block_stream, _stop) -> + let open Lwt_result_syntax in + let* block_stream, stop = + Monitor_services.heads cctxt ?next_protocols chain + in return - (Lwt_stream.map_s - (fun (block, ({Tezos_base.Block_header.shell; _} as header)) -> - Block_seen_event.(Event.emit (make block header `Heads)) >>=? fun () -> - raw_info cctxt ~chain block shell) - block_stream) + ( Lwt_stream.map_s + (fun (block, ({Tezos_base.Block_header.shell; _} as header)) -> + let* () = Block_seen_event.(Event.emit (make block header `Heads)) in + raw_info cctxt ~chain block shell) + block_stream, + stop ) type error += | Unexpected_empty_block_list of { diff --git a/src/proto_017_PtNairob/lib_delegate/client_baking_blocks.mli b/src/proto_017_PtNairob/lib_delegate/client_baking_blocks.mli index 41b9f70b8619914da4a5e3ff34f157279a60edc9..8426c19b899485d7a033693d4236d6e7882b47c4 100644 --- a/src/proto_017_PtNairob/lib_delegate/client_baking_blocks.mli +++ b/src/proto_017_PtNairob/lib_delegate/client_baking_blocks.mli @@ -57,7 +57,7 @@ val monitor_heads : #Protocol_client_context.rpc_context -> next_protocols:Protocol_hash.t list option -> Chain_services.chain -> - block_info tzresult Lwt_stream.t tzresult Lwt.t + (block_info tzresult Lwt_stream.t * Tezos_rpc.Context.stopper) tzresult Lwt.t val blocks_from_current_cycle : #Protocol_client_context.rpc_context -> diff --git a/src/proto_018_Proxford/lib_delegate/baking_vdf.ml b/src/proto_018_Proxford/lib_delegate/baking_vdf.ml index e64316cbba81fa37096565231cdc34987467516f..c4c368f537b29834111c30287f565f6a7c66bdaa 100644 --- a/src/proto_018_Proxford/lib_delegate/baking_vdf.ml +++ b/src/proto_018_Proxford/lib_delegate/baking_vdf.ml @@ -51,11 +51,10 @@ type 'a state = { } let init_block_stream_with_stopper cctxt chain = - Client_baking_blocks.monitor_applied_blocks + Client_baking_blocks.monitor_heads ~next_protocols:(Some [Protocol.hash]) cctxt - ~chains:[chain] - () + chain let stop_block_stream state = Option.iter @@ -354,10 +353,6 @@ let check_new_cycle state (level_info : Level.t) = let process_new_block (cctxt : #Protocol_client_context.full) state {hash; chain_id; protocol; next_protocol; level; _} = let open Lwt_result_syntax in - let* level_info = get_level_info cctxt level in - (* If head is in a new cycle record it in [state.cycle] and reset - * [state.computation_status] to [Not_started]. *) - let* () = check_new_cycle state level_info in if Protocol_hash.(protocol <> next_protocol) then (* If the protocol has changed, emit an event on every new block and take * no further action. It is expected that the daemon corresponding to @@ -365,6 +360,10 @@ let process_new_block (cctxt : #Protocol_client_context.full) state let*! () = Delegate_events.Denunciator.(emit protocol_change_detected) () in return_unit else + let* level_info = get_level_info cctxt level in + (* If head is in a new cycle record it in [state.cycle] and reset + * [state.computation_status] to [Not_started]. *) + let* () = check_new_cycle state level_info in (* If the chain is in the nonce revelation stage, there is nothing to do. *) let* out = is_in_nonce_revelation_stage state.constants level_info in if out then diff --git a/src/proto_018_Proxford/lib_delegate/client_baking_blocks.ml b/src/proto_018_Proxford/lib_delegate/client_baking_blocks.ml index dbcc764908a50fb16bd64dca0e2ec3224ba129b4..1b36a8d1cd4d2470b8e22301db83714a0cad55f1 100644 --- a/src/proto_018_Proxford/lib_delegate/client_baking_blocks.ml +++ b/src/proto_018_Proxford/lib_delegate/client_baking_blocks.ml @@ -170,15 +170,16 @@ let monitor_applied_blocks cctxt ?chains ?protocols ~next_protocols () = let monitor_heads cctxt ~next_protocols chain = let open Lwt_result_syntax in - let* block_stream, _stop = + let* block_stream, stop = Monitor_services.heads cctxt ?next_protocols chain in return - (Lwt_stream.map_s - (fun (block, ({Tezos_base.Block_header.shell; _} as header)) -> - let* () = Block_seen_event.(Event.emit (make block header `Heads)) in - raw_info cctxt ~chain block shell) - block_stream) + ( Lwt_stream.map_s + (fun (block, ({Tezos_base.Block_header.shell; _} as header)) -> + let* () = Block_seen_event.(Event.emit (make block header `Heads)) in + raw_info cctxt ~chain block shell) + block_stream, + stop ) type error += | Unexpected_empty_block_list of { diff --git a/src/proto_018_Proxford/lib_delegate/client_baking_blocks.mli b/src/proto_018_Proxford/lib_delegate/client_baking_blocks.mli index 41b9f70b8619914da4a5e3ff34f157279a60edc9..8426c19b899485d7a033693d4236d6e7882b47c4 100644 --- a/src/proto_018_Proxford/lib_delegate/client_baking_blocks.mli +++ b/src/proto_018_Proxford/lib_delegate/client_baking_blocks.mli @@ -57,7 +57,7 @@ val monitor_heads : #Protocol_client_context.rpc_context -> next_protocols:Protocol_hash.t list option -> Chain_services.chain -> - block_info tzresult Lwt_stream.t tzresult Lwt.t + (block_info tzresult Lwt_stream.t * Tezos_rpc.Context.stopper) tzresult Lwt.t val blocks_from_current_cycle : #Protocol_client_context.rpc_context -> diff --git a/src/proto_alpha/lib_delegate/baking_vdf.ml b/src/proto_alpha/lib_delegate/baking_vdf.ml index e64316cbba81fa37096565231cdc34987467516f..003e3115c125088310eeb6898a2c7d8880fcda84 100644 --- a/src/proto_alpha/lib_delegate/baking_vdf.ml +++ b/src/proto_alpha/lib_delegate/baking_vdf.ml @@ -51,11 +51,10 @@ type 'a state = { } let init_block_stream_with_stopper cctxt chain = - Client_baking_blocks.monitor_applied_blocks - ~next_protocols:(Some [Protocol.hash]) + Client_baking_blocks.monitor_heads cctxt - ~chains:[chain] - () + ~next_protocols:(Some [Protocol.hash]) + chain let stop_block_stream state = Option.iter @@ -354,10 +353,6 @@ let check_new_cycle state (level_info : Level.t) = let process_new_block (cctxt : #Protocol_client_context.full) state {hash; chain_id; protocol; next_protocol; level; _} = let open Lwt_result_syntax in - let* level_info = get_level_info cctxt level in - (* If head is in a new cycle record it in [state.cycle] and reset - * [state.computation_status] to [Not_started]. *) - let* () = check_new_cycle state level_info in if Protocol_hash.(protocol <> next_protocol) then (* If the protocol has changed, emit an event on every new block and take * no further action. It is expected that the daemon corresponding to @@ -365,6 +360,10 @@ let process_new_block (cctxt : #Protocol_client_context.full) state let*! () = Delegate_events.Denunciator.(emit protocol_change_detected) () in return_unit else + let* level_info = get_level_info cctxt level in + (* If head is in a new cycle record it in [state.cycle] and reset + * [state.computation_status] to [Not_started]. *) + let* () = check_new_cycle state level_info in (* If the chain is in the nonce revelation stage, there is nothing to do. *) let* out = is_in_nonce_revelation_stage state.constants level_info in if out then diff --git a/src/proto_alpha/lib_delegate/client_baking_blocks.ml b/src/proto_alpha/lib_delegate/client_baking_blocks.ml index dbcc764908a50fb16bd64dca0e2ec3224ba129b4..1b36a8d1cd4d2470b8e22301db83714a0cad55f1 100644 --- a/src/proto_alpha/lib_delegate/client_baking_blocks.ml +++ b/src/proto_alpha/lib_delegate/client_baking_blocks.ml @@ -170,15 +170,16 @@ let monitor_applied_blocks cctxt ?chains ?protocols ~next_protocols () = let monitor_heads cctxt ~next_protocols chain = let open Lwt_result_syntax in - let* block_stream, _stop = + let* block_stream, stop = Monitor_services.heads cctxt ?next_protocols chain in return - (Lwt_stream.map_s - (fun (block, ({Tezos_base.Block_header.shell; _} as header)) -> - let* () = Block_seen_event.(Event.emit (make block header `Heads)) in - raw_info cctxt ~chain block shell) - block_stream) + ( Lwt_stream.map_s + (fun (block, ({Tezos_base.Block_header.shell; _} as header)) -> + let* () = Block_seen_event.(Event.emit (make block header `Heads)) in + raw_info cctxt ~chain block shell) + block_stream, + stop ) type error += | Unexpected_empty_block_list of { diff --git a/src/proto_alpha/lib_delegate/client_baking_blocks.mli b/src/proto_alpha/lib_delegate/client_baking_blocks.mli index 41b9f70b8619914da4a5e3ff34f157279a60edc9..8426c19b899485d7a033693d4236d6e7882b47c4 100644 --- a/src/proto_alpha/lib_delegate/client_baking_blocks.mli +++ b/src/proto_alpha/lib_delegate/client_baking_blocks.mli @@ -57,7 +57,7 @@ val monitor_heads : #Protocol_client_context.rpc_context -> next_protocols:Protocol_hash.t list option -> Chain_services.chain -> - block_info tzresult Lwt_stream.t tzresult Lwt.t + (block_info tzresult Lwt_stream.t * Tezos_rpc.Context.stopper) tzresult Lwt.t val blocks_from_current_cycle : #Protocol_client_context.rpc_context -> diff --git a/tezt/tests/vdf_test.ml b/tezt/tests/vdf_test.ml index ab94327b2f313bf6e42266c147b1984003596d2e..8ddbed1b75b1d97067a00003db0ee97f582d0d8f 100644 --- a/tezt/tests/vdf_test.ml +++ b/tezt/tests/vdf_test.ml @@ -226,10 +226,17 @@ let test_vdf : Protocol.t list -> unit = * checked using [check_n_cycles] *) Protocol.register_test ~__FILE__ ~title:"VDF daemon" ~tags:["vdf"] @@ fun protocol -> - let* node = Node.init [Synchronisation_threshold 0; Private_mode] in - let* client = Client.init ~endpoint:(Node node) () in - let* () = Client.activate_protocol ~protocol client - and* vdf_baker = Vdf.init ~protocol node in + (* Override the `vdf_difficulty` constant in order to preserve the test *) + (* which checks that a computation started too late is eventually canceled. *) + let parameters = [(["vdf_difficulty"], `String "100000")] in + let* parameter_file = + Protocol.write_parameter_file ~base:(Right (protocol, None)) parameters + in + + let* node, client = + Client.init_with_protocol ~parameter_file ~protocol `Client () + in + let* vdf_baker = Vdf.init ~protocol node in (* Track whether a VDF revelation has been injected during the correct stage. * It is set to [false] at the beginning of [bake_vdf_revelation_stage] and