diff --git a/src/proto_014_PtKathma/lib_plugin/RPC.ml b/src/proto_014_PtKathma/lib_plugin/RPC.ml index 3cd04ae080349640e682fc134193ba156b2f5f6b..e20ba5872997c7a1479d6a38821ccf6be7c25753 100644 --- a/src/proto_014_PtKathma/lib_plugin/RPC.ml +++ b/src/proto_014_PtKathma/lib_plugin/RPC.ml @@ -2425,7 +2425,6 @@ let estimated_time round_durations ~current_level ~current_round ~current_timestamp ~level ~round = if Level.(level <= current_level) then Result.return_none else - Round.of_int round >>? fun round -> Round.timestamp_of_round round_durations ~round @@ -2458,7 +2457,7 @@ module Baking_rights = struct type t = { level : Raw_level.t; delegate : Signature.Public_key_hash.t; - round : int; + round : Round.t; timestamp : Timestamp.t option; } @@ -2472,7 +2471,7 @@ module Baking_rights = struct (obj4 (req "level" Raw_level.encoding) (req "delegate" Signature.Public_key_hash.encoding) - (req "round" uint16) + (req "round" Round.encoding) (opt "estimated_time" Timestamp.encoding)) let default_max_round = 64 @@ -2531,16 +2530,17 @@ module Baking_rights = struct end let baking_rights_at_level ctxt max_round level = - Baking.baking_rights ctxt level >>=? fun delegates -> Round.get ctxt >>=? fun current_round -> let current_level = Level.current ctxt in let current_timestamp = Timestamp.current ctxt in let round_durations = Alpha_context.Constants.round_durations ctxt in - let rec loop l acc round = - if Compare.Int.(round > max_round) then return (List.rev acc) + let rec loop ctxt acc round = + if Round.(round > max_round) then + (* returns the ctxt with an updated cache of slot holders *) + return (ctxt, List.rev acc) else - let (Misc.LCons (pk, next)) = l in - let delegate = Signature.Public_key.hash pk in + Stake_distribution.baking_rights_owner ctxt level ~round + >>=? fun (ctxt, _slot, (_, delegate)) -> estimated_time round_durations ~current_level @@ -2550,9 +2550,9 @@ module Baking_rights = struct ~round >>?= fun timestamp -> let acc = {level = level.level; delegate; round; timestamp} :: acc in - next () >>=? fun l -> loop l acc (round + 1) + loop ctxt acc (Round.succ round) in - loop delegates [] 0 + loop ctxt [] Round.zero let remove_duplicated_delegates rights = List.rev @@ fst @@ -2577,16 +2577,19 @@ module Baking_rights = struct cycles q.levels in - let max_round = - match q.max_round with + Round.of_int + (match q.max_round with | None -> default_max_round | Some max_round -> Compare.Int.min max_round - (Constants.consensus_committee_size ctxt) - in - List.map_es (baking_rights_at_level ctxt max_round) levels - >|=? fun rights -> + (Constants.consensus_committee_size ctxt)) + >>?= fun max_round -> + List.fold_left_map_es + (fun ctxt l -> baking_rights_at_level ctxt max_round l) + ctxt + levels + >|=? fun (_ctxt, rights) -> let rights = if q.all then List.concat rights else List.concat_map remove_duplicated_delegates rights @@ -2699,7 +2702,7 @@ module Endorsing_rights = struct ~current_round ~current_timestamp ~level - ~round:0 + ~round:Round.zero >>?= fun estimated_time -> let rights = Slot.Map.fold @@ -2708,7 +2711,9 @@ module Endorsing_rights = struct rights [] in - return {level = level.level; delegates_rights = rights; estimated_time} + (* returns the ctxt with an updated cache of slot holders *) + return + (ctxt, {level = level.level; delegates_rights = rights; estimated_time}) let register () = Registration.register0 ~chunked:true S.endorsing_rights (fun ctxt q () -> @@ -2720,8 +2725,8 @@ module Endorsing_rights = struct cycles q.levels in - List.map_es (endorsing_rights_at_level ctxt) levels - >|=? fun rights_per_level -> + List.fold_left_map_es endorsing_rights_at_level ctxt levels + >|=? fun (_ctxt, rights_per_level) -> match q.delegates with | [] -> rights_per_level | _ :: _ as delegates -> @@ -2799,20 +2804,25 @@ module Validators = struct path end - let endorsing_slots_at_level ctxt level = - Baking.endorsing_rights ctxt level >|=? fun (_, rights) -> - Signature.Public_key_hash.Map.fold - (fun delegate slots acc -> {level = level.level; delegate; slots} :: acc) - (rights :> Slot.t list Signature.Public_key_hash.Map.t) - [] + let add_endorsing_slots_at_level (ctxt, acc) level = + Baking.endorsing_rights ctxt level >|=? fun (ctxt, rights) -> + ( ctxt, + Signature.Public_key_hash.Map.fold + (fun delegate slots acc -> + {level = level.level; delegate; slots} :: acc) + (rights :> Slot.t list Signature.Public_key_hash.Map.t) + acc ) let register () = Registration.register0 ~chunked:true S.validators (fun ctxt q () -> let levels = requested_levels ~default_level:(Level.current ctxt) ctxt [] q.levels in - List.concat_map_es (endorsing_slots_at_level ctxt) levels - >|=? fun rights -> + List.fold_left_es + add_endorsing_slots_at_level + (ctxt, []) + (List.rev levels) + >|=? fun (_ctxt, rights) -> match q.delegates with | [] -> rights | _ :: _ as delegates -> diff --git a/src/proto_014_PtKathma/lib_protocol/test/helpers/block.ml b/src/proto_014_PtKathma/lib_protocol/test/helpers/block.ml index 943e150a34625b5d74cc55642562feb09c55c60d..d435936f91cdec6833b30cc54490e32d8dccb3f8 100644 --- a/src/proto_014_PtKathma/lib_protocol/test/helpers/block.ml +++ b/src/proto_014_PtKathma/lib_protocol/test/helpers/block.ml @@ -70,7 +70,8 @@ let get_next_baker_by_round round block = let {Plugin.RPC.Baking_rights.delegate = pkh; timestamp; _} = WithExceptions.Option.get ~loc:__LOC__ @@ List.find - (fun {Plugin.RPC.Baking_rights.round = r; _} -> r = round) + (fun {Plugin.RPC.Baking_rights.round = r; _} -> + Round.to_int32 r = Int32.of_int round) bakers in (pkh, round, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) @@ -82,11 +83,12 @@ let get_next_baker_by_account pkh block = | Some b -> return b | None -> failwith "No slots found for %a" Signature.Public_key_hash.pp pkh) >>=? fun {Plugin.RPC.Baking_rights.delegate = pkh; timestamp; round; _} -> + Environment.wrap_tzresult (Round.to_int round) >>?= fun round -> return (pkh, round, WithExceptions.Option.to_exn ~none:(Failure __LOC__) timestamp) let get_next_baker_excluding excludes block = - Plugin.RPC.Baking_rights.get rpc_ctxt block >|=? fun bakers -> + Plugin.RPC.Baking_rights.get rpc_ctxt block >>=? fun bakers -> let {Plugin.RPC.Baking_rights.delegate = pkh; timestamp; round; _} = WithExceptions.Option.get ~loc:__LOC__ @@ List.find @@ -95,7 +97,8 @@ let get_next_baker_excluding excludes block = (List.mem ~equal:Signature.Public_key_hash.equal delegate excludes)) bakers in - (pkh, round, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) + Environment.wrap_tzresult (Round.to_int round) >>?= fun round -> + return (pkh, round, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) let dispatch_policy = function | By_round r -> get_next_baker_by_round r diff --git a/src/proto_014_PtKathma/lib_protocol/test/helpers/context.mli b/src/proto_014_PtKathma/lib_protocol/test/helpers/context.mli index c11e6c1020213f4857eede9db5d9e3aedbce3adc..526a32f02e84ca92bea87178fc0ccb610de84272 100644 --- a/src/proto_014_PtKathma/lib_protocol/test/helpers/context.mli +++ b/src/proto_014_PtKathma/lib_protocol/test/helpers/context.mli @@ -57,7 +57,7 @@ val get_bakers : t -> public_key_hash list tzresult Lwt.t -val get_baker : t -> round:int -> public_key_hash tzresult Lwt.t +val get_baker : t -> round:Round.t -> public_key_hash tzresult Lwt.t val get_first_different_baker : public_key_hash -> public_key_hash trace -> public_key_hash diff --git a/src/proto_014_PtKathma/lib_protocol/test/integration/consensus/test_baking.ml b/src/proto_014_PtKathma/lib_protocol/test/integration/consensus/test_baking.ml index 6a6bd357fc3c4463046660fb5fc64796f71d421d..da92ec76574ba26f220ea0ea9021c27b46ec31a3 100644 --- a/src/proto_014_PtKathma/lib_protocol/test/integration/consensus/test_baking.ml +++ b/src/proto_014_PtKathma/lib_protocol/test/integration/consensus/test_baking.ml @@ -189,7 +189,7 @@ let get_contract_for_pkh contracts pkh = [b2]. *) let test_rewards_block_and_payload_producer () = Context.init_n ~consensus_threshold:1 10 () >>=? fun (genesis, contracts) -> - Context.get_baker (B genesis) ~round:0 >>=? fun baker_b1 -> + Context.get_baker (B genesis) ~round:Round.zero >>=? fun baker_b1 -> get_contract_for_pkh contracts baker_b1 >>=? fun baker_b1_contract -> Block.bake ~policy:(By_round 0) genesis >>=? fun b1 -> Context.get_endorsers (B b1) >>=? fun endorsers -> @@ -219,7 +219,7 @@ let test_rewards_block_and_payload_producer () = Op.transaction (B b1) ~fee baker_b1_contract baker_b1_contract Tez.zero >>=? fun tx -> Block.bake ~policy:(By_round 0) ~operations:(tx :: endos) b1 >>=? fun b2 -> - Context.get_baker (B b1) ~round:0 >>=? fun baker_b2 -> + Context.get_baker (B b1) ~round:Round.zero >>=? fun baker_b2 -> get_contract_for_pkh contracts baker_b2 >>=? fun baker_b2_contract -> Context.Contract.balance (B b2) baker_b2_contract >>=? fun bal -> Context.Delegate.current_frozen_deposits (B b2) baker_b2 @@ -255,7 +255,7 @@ let test_rewards_block_and_payload_producer () = >|=? Operation.pack) preendorsers >>=? fun preendos -> - Context.get_baker (B b1) ~round:0 >>=? fun baker_b2 -> + Context.get_baker (B b1) ~round:Round.zero >>=? fun baker_b2 -> Context.get_bakers (B b1) >>=? fun bakers -> let baker_b2' = Context.get_first_different_baker baker_b2 bakers in Block.bake @@ -285,7 +285,7 @@ let test_rewards_block_and_payload_producer () = Context.Contract.balance (B b2') baker_b2'_contract >>=? fun bal' -> Context.Delegate.current_frozen_deposits (B b2') baker_b2' >>=? fun frozen_deposits' -> - Context.get_baker (B genesis) ~round:0 >>=? fun baker_b1 -> + Context.get_baker (B genesis) ~round:Round.zero >>=? fun baker_b1 -> let reward_for_b1' = if Signature.Public_key_hash.equal baker_b2' baker_b1 then baking_reward else Tez.zero diff --git a/src/proto_014_PtKathma/lib_protocol/test/integration/consensus/test_double_preendorsement.ml b/src/proto_014_PtKathma/lib_protocol/test/integration/consensus/test_double_preendorsement.ml index 1f844fe614b8f7255e03b78915eaa842763a8c68..369f52642e5204d7931dcb5805c943485cbafdbc 100644 --- a/src/proto_014_PtKathma/lib_protocol/test/integration/consensus/test_double_preendorsement.ml +++ b/src/proto_014_PtKathma/lib_protocol/test/integration/consensus/test_double_preendorsement.ml @@ -193,7 +193,7 @@ end = struct (* bake `nb_blocks_before_denunciation` before double preend. denunciation *) bake_n nb_blocks_before_denunciation blk >>=? fun blk -> let op : Operation.packed = Op.double_preendorsement (B blk) op1 op2 in - Context.get_baker (B blk) ~round:0 >>=? fun baker -> + Context.get_baker (B blk) ~round:Round.zero >>=? fun baker -> bake ~policy:(By_account baker) blk ~operations:[op] >>= function | Ok new_head -> test_expected_ok loc baker blk new_head d1 d2 >>=? fun () -> diff --git a/src/proto_015_PtLimaPt/lib_plugin/RPC.ml b/src/proto_015_PtLimaPt/lib_plugin/RPC.ml index 4f63b6481ca3a13cb60b979b7e76f11769b4a93b..096ba8dc290b20c3d650790a5ef6a54801593f6d 100644 --- a/src/proto_015_PtLimaPt/lib_plugin/RPC.ml +++ b/src/proto_015_PtLimaPt/lib_plugin/RPC.ml @@ -2770,7 +2770,6 @@ let estimated_time round_durations ~current_level ~current_round ~current_timestamp ~level ~round = if Level.(level <= current_level) then Result.return_none else - Round.of_int round >>? fun round -> Round.timestamp_of_round round_durations ~round @@ -2804,7 +2803,7 @@ module Baking_rights = struct level : Raw_level.t; delegate : public_key_hash; consensus_key : public_key_hash; - round : int; + round : Round.t; timestamp : Timestamp.t option; } @@ -2818,7 +2817,7 @@ module Baking_rights = struct (obj5 (req "level" Raw_level.encoding) (req "delegate" Signature.Public_key_hash.encoding) - (req "round" uint16) + (req "round" Round.encoding) (opt "estimated_time" Timestamp.encoding) (req "consensus_key" Signature.Public_key_hash.encoding)) @@ -2882,15 +2881,20 @@ module Baking_rights = struct end let baking_rights_at_level ctxt max_round level = - Baking.baking_rights ctxt level >>=? fun delegates -> Round.get ctxt >>=? fun current_round -> let current_level = Level.current ctxt in let current_timestamp = Timestamp.current ctxt in let round_durations = Alpha_context.Constants.round_durations ctxt in - let rec loop l acc round = - if Compare.Int.(round > max_round) then return (List.rev acc) + let rec loop ctxt acc round = + if Round.(round > max_round) then + (* returns the ctxt with an updated cache of slot holders *) + return (ctxt, List.rev acc) else - let (Misc.LCons ({Consensus_key.consensus_pkh; delegate}, next)) = l in + Stake_distribution.baking_rights_owner ctxt level ~round + >>=? fun ( ctxt, + _slot, + {Consensus_key.consensus_pkh; delegate; consensus_pk = _} ) + -> estimated_time round_durations ~current_level @@ -2909,9 +2913,9 @@ module Baking_rights = struct } :: acc in - next () >>=? fun l -> loop l acc (round + 1) + loop ctxt acc (Round.succ round) in - loop delegates [] 0 + loop ctxt [] Round.zero let remove_duplicated_delegates rights = List.rev @@ fst @@ -2936,16 +2940,19 @@ module Baking_rights = struct cycles q.levels in - let max_round = - match q.max_round with + Round.of_int + (match q.max_round with | None -> default_max_round | Some max_round -> Compare.Int.min max_round - (Constants.consensus_committee_size ctxt) - in - List.map_es (baking_rights_at_level ctxt max_round) levels - >|=? fun rights -> + (Constants.consensus_committee_size ctxt)) + >>?= fun max_round -> + List.fold_left_map_es + (fun ctxt l -> baking_rights_at_level ctxt max_round l) + ctxt + levels + >|=? fun (_ctxt, rights) -> let rights = if q.all then List.concat rights else List.concat_map remove_duplicated_delegates rights @@ -3082,7 +3089,7 @@ module Endorsing_rights = struct ~current_round ~current_timestamp ~level - ~round:0 + ~round:Round.zero >>?= fun estimated_time -> let rights = Slot.Map.fold @@ -3098,7 +3105,9 @@ module Endorsing_rights = struct rights [] in - return {level = level.level; delegates_rights = rights; estimated_time} + (* returns the ctxt with an updated cache of slot holders *) + return + (ctxt, {level = level.level; delegates_rights = rights; estimated_time}) let register () = Registration.register0 ~chunked:true S.endorsing_rights (fun ctxt q () -> @@ -3110,8 +3119,8 @@ module Endorsing_rights = struct cycles q.levels in - List.map_es (endorsing_rights_at_level ctxt) levels - >|=? fun rights_per_level -> + List.fold_left_map_es endorsing_rights_at_level ctxt levels + >|=? fun (_ctxt, rights_per_level) -> let rights_per_level = match q.consensus_keys with | [] -> rights_per_level @@ -3202,21 +3211,25 @@ module Validators = struct path end - let endorsing_slots_at_level ctxt level = - Baking.endorsing_rights ctxt level >|=? fun (_, rights) -> - Signature.Public_key_hash.Map.fold - (fun _pkh {Baking.delegate; consensus_key; slots} acc -> - {level = level.level; delegate; consensus_key; slots} :: acc) - rights - [] + let add_endorsing_slots_at_level (ctxt, acc) level = + Baking.endorsing_rights ctxt level >|=? fun (ctxt, rights) -> + ( ctxt, + Signature.Public_key_hash.Map.fold + (fun _pkh {Baking.delegate; consensus_key; slots} acc -> + {level = level.level; delegate; consensus_key; slots} :: acc) + rights + acc ) let register () = Registration.register0 ~chunked:true S.validators (fun ctxt q () -> let levels = requested_levels ~default_level:(Level.current ctxt) ctxt [] q.levels in - List.concat_map_es (endorsing_slots_at_level ctxt) levels - >|=? fun rights -> + List.fold_left_es + add_endorsing_slots_at_level + (ctxt, []) + (List.rev levels) + >|=? fun (_ctxt, rights) -> let rights = match q.delegates with | [] -> rights diff --git a/src/proto_015_PtLimaPt/lib_protocol/test/helpers/block.ml b/src/proto_015_PtLimaPt/lib_protocol/test/helpers/block.ml index 2d0cbb2058ae6a80d29f116fc945c73cd50489ae..78ef6d167556c269a5b3854f5c96bd2d97147408 100644 --- a/src/proto_015_PtLimaPt/lib_protocol/test/helpers/block.ml +++ b/src/proto_015_PtLimaPt/lib_protocol/test/helpers/block.ml @@ -79,7 +79,8 @@ let get_next_baker_by_round round block = let {Plugin.RPC.Baking_rights.delegate = pkh; consensus_key; timestamp; _} = WithExceptions.Option.get ~loc:__LOC__ @@ List.find - (fun {Plugin.RPC.Baking_rights.round = r; _} -> r = round) + (fun {Plugin.RPC.Baking_rights.round = r; _} -> + Round.to_int32 r = Int32.of_int round) bakers in ( pkh, @@ -100,6 +101,7 @@ let get_next_baker_by_account pkh block = round; _; } -> + Environment.wrap_tzresult (Round.to_int round) >>?= fun round -> return ( pkh, consensus_key, @@ -107,7 +109,7 @@ let get_next_baker_by_account pkh block = WithExceptions.Option.to_exn ~none:(Failure __LOC__) timestamp ) let get_next_baker_excluding excludes block = - Plugin.RPC.Baking_rights.get rpc_ctxt block >|=? fun bakers -> + Plugin.RPC.Baking_rights.get rpc_ctxt block >>=? fun bakers -> let { Plugin.RPC.Baking_rights.delegate = pkh; consensus_key; @@ -125,10 +127,12 @@ let get_next_baker_excluding excludes block = excludes)) bakers in - ( pkh, - consensus_key, - round, - WithExceptions.Option.to_exn ~none:(Failure "") timestamp ) + Environment.wrap_tzresult (Round.to_int round) >>?= fun round -> + return + ( pkh, + consensus_key, + round, + WithExceptions.Option.to_exn ~none:(Failure "") timestamp ) let dispatch_policy = function | By_round r -> get_next_baker_by_round r diff --git a/src/proto_015_PtLimaPt/lib_protocol/test/helpers/context.mli b/src/proto_015_PtLimaPt/lib_protocol/test/helpers/context.mli index 31b691bc5ff6417ca4b68e33fdb027edf7dea414..b204ffd1adbd0014484dfb04e91f543a67d304a0 100644 --- a/src/proto_015_PtLimaPt/lib_protocol/test/helpers/context.mli +++ b/src/proto_015_PtLimaPt/lib_protocol/test/helpers/context.mli @@ -62,7 +62,7 @@ val get_bakers : t -> public_key_hash list tzresult Lwt.t -val get_baker : t -> round:int -> public_key_hash tzresult Lwt.t +val get_baker : t -> round:Round.t -> public_key_hash tzresult Lwt.t val get_first_different_baker : public_key_hash -> public_key_hash trace -> public_key_hash diff --git a/src/proto_015_PtLimaPt/lib_protocol/test/integration/consensus/test_baking.ml b/src/proto_015_PtLimaPt/lib_protocol/test/integration/consensus/test_baking.ml index d029b34d9335f94c22330270cf2ef37dda642b9f..75cc4075c1889f25cd75eefb40d785ef8761af35 100644 --- a/src/proto_015_PtLimaPt/lib_protocol/test/integration/consensus/test_baking.ml +++ b/src/proto_015_PtLimaPt/lib_protocol/test/integration/consensus/test_baking.ml @@ -189,7 +189,7 @@ let get_contract_for_pkh contracts pkh = [b2]. *) let test_rewards_block_and_payload_producer () = Context.init_n ~consensus_threshold:1 10 () >>=? fun (genesis, contracts) -> - Context.get_baker (B genesis) ~round:0 >>=? fun baker_b1 -> + Context.get_baker (B genesis) ~round:Round.zero >>=? fun baker_b1 -> get_contract_for_pkh contracts baker_b1 >>=? fun baker_b1_contract -> Block.bake ~policy:(By_round 0) genesis >>=? fun b1 -> Context.get_endorsers (B b1) >>=? fun endorsers -> @@ -219,7 +219,7 @@ let test_rewards_block_and_payload_producer () = Op.transaction (B b1) ~fee baker_b1_contract baker_b1_contract Tez.zero >>=? fun tx -> Block.bake ~policy:(By_round 0) ~operations:(endos @ [tx]) b1 >>=? fun b2 -> - Context.get_baker (B b1) ~round:0 >>=? fun baker_b2 -> + Context.get_baker (B b1) ~round:Round.zero >>=? fun baker_b2 -> get_contract_for_pkh contracts baker_b2 >>=? fun baker_b2_contract -> Context.Contract.balance (B b2) baker_b2_contract >>=? fun bal -> Context.Delegate.current_frozen_deposits (B b2) baker_b2 @@ -255,7 +255,7 @@ let test_rewards_block_and_payload_producer () = >|=? Operation.pack) preendorsers >>=? fun preendos -> - Context.get_baker (B b1) ~round:0 >>=? fun baker_b2 -> + Context.get_baker (B b1) ~round:Round.zero >>=? fun baker_b2 -> Context.get_bakers (B b1) >>=? fun bakers -> let baker_b2' = Context.get_first_different_baker baker_b2 bakers in Block.bake @@ -285,7 +285,7 @@ let test_rewards_block_and_payload_producer () = Context.Contract.balance (B b2') baker_b2'_contract >>=? fun bal' -> Context.Delegate.current_frozen_deposits (B b2') baker_b2' >>=? fun frozen_deposits' -> - Context.get_baker (B genesis) ~round:0 >>=? fun baker_b1 -> + Context.get_baker (B genesis) ~round:Round.zero >>=? fun baker_b1 -> let reward_for_b1' = if Signature.Public_key_hash.equal baker_b2' baker_b1 then baking_reward else Tez.zero diff --git a/src/proto_015_PtLimaPt/lib_protocol/test/integration/consensus/test_double_preendorsement.ml b/src/proto_015_PtLimaPt/lib_protocol/test/integration/consensus/test_double_preendorsement.ml index a4e2db412204a4f9fadf12c4bd087613c02ec070..59af65007267ba5a098bf792ddd13e348d602c81 100644 --- a/src/proto_015_PtLimaPt/lib_protocol/test/integration/consensus/test_double_preendorsement.ml +++ b/src/proto_015_PtLimaPt/lib_protocol/test/integration/consensus/test_double_preendorsement.ml @@ -209,7 +209,7 @@ end = struct (* bake `nb_blocks_before_denunciation` before double preend. denunciation *) bake_n nb_blocks_before_denunciation blk >>=? fun blk -> let op : Operation.packed = Op.double_preendorsement (B blk) op1 op2 in - Context.get_baker (B blk) ~round:0 >>=? fun baker -> + Context.get_baker (B blk) ~round:Round.zero >>=? fun baker -> bake ~policy:(By_account baker) blk ~operations:[op] >>= function | Ok new_head -> test_expected_ok loc baker blk new_head d1 d2 >>=? fun () ->