(*****************************************************************************) (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) (* to deal in the Software without restriction, including without limitation *) (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) (* and/or sell copies of the Software, and to permit persons to whom the *) (* Software is furnished to do so, subject to the following conditions: *) (* *) (* The above copyright notice and this permission notice shall be included *) (* in all copies or substantial portions of the Software. *) (* *) (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) (* DEALINGS IN THE SOFTWARE. *) (* *) (*****************************************************************************) open Alpha_context open Misc type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *) type error += | Timestamp_too_early of { minimal_time : Timestamp.t; provided_time : Timestamp.t; priority : int; endorsing_power_opt : int option; } (* `Permanent *) type error += Unexpected_endorsement (* `Permanent *) type error += Invalid_endorsement_slot of int (* `Permanent *) type error += Unexpected_endorsement_slot of int (* `Permanent *) type error += | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *) type error += Invalid_signature (* `Permanent *) type error += Invalid_stamp (* `Permanent *) let () = register_error_kind `Permanent ~id:"baking.timestamp_too_early" ~title:"Block forged too early" ~description:"The block timestamp is before the minimal valid one." ~pp:(fun ppf (minimal_time, provided_time, priority, endorsing_power) -> let message_regarding_endorsements = match endorsing_power with | None -> "" | Some power -> Format.asprintf " and endorsing power %d" power in Format.fprintf ppf "Block forged too early: %a is before the minimal time %a for \ priority %d%s)" Time.pp_hum provided_time Time.pp_hum minimal_time priority message_regarding_endorsements) Data_encoding.( obj4 (req "minimal_time" Time.encoding) (req "provided_time" Time.encoding) (req "priority" int31) (opt "endorsing_power" int31)) (function | Timestamp_too_early {minimal_time; provided_time; priority; endorsing_power_opt} -> Some (minimal_time, provided_time, priority, endorsing_power_opt) | _ -> None) (fun (minimal_time, provided_time, priority, endorsing_power_opt) -> Timestamp_too_early {minimal_time; provided_time; priority; endorsing_power_opt}) ; register_error_kind `Permanent ~id:"baking.invalid_fitness_gap" ~title:"Invalid fitness gap" ~description:"The gap of fitness is out of bounds" ~pp:(fun ppf (m, g) -> Format.fprintf ppf "The gap of fitness %Ld is not between 0 and %Ld" g m) Data_encoding.(obj2 (req "maximum" int64) (req "provided" int64)) (function Invalid_fitness_gap (m, g) -> Some (m, g) | _ -> None) (fun (m, g) -> Invalid_fitness_gap (m, g)) ; register_error_kind `Permanent ~id:"baking.invalid_block_signature" ~title:"Invalid block signature" ~description:"A block was not signed with the expected private key." ~pp:(fun ppf (block, pkh) -> Format.fprintf ppf "Invalid signature for block %a. Expected: %a." Block_hash.pp_short block Signature.Public_key_hash.pp_short pkh) Data_encoding.( obj2 (req "block" Block_hash.encoding) (req "expected" Signature.Public_key_hash.encoding)) (function | Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None) (fun (block, pkh) -> Invalid_block_signature (block, pkh)) ; register_error_kind `Permanent ~id:"baking.invalid_signature" ~title:"Invalid block signature" ~description:"The block's signature is invalid" ~pp:(fun ppf () -> Format.fprintf ppf "Invalid block signature") Data_encoding.empty (function Invalid_signature -> Some () | _ -> None) (fun () -> Invalid_signature) ; register_error_kind `Permanent ~id:"baking.insufficient_proof_of_work" ~title:"Insufficient block proof-of-work stamp" ~description:"The block's proof-of-work stamp is insufficient" ~pp:(fun ppf () -> Format.fprintf ppf "Insufficient proof-of-work stamp") Data_encoding.empty (function Invalid_stamp -> Some () | _ -> None) (fun () -> Invalid_stamp) ; register_error_kind `Permanent ~id:"baking.unexpected_endorsement" ~title:"Endorsement from unexpected delegate" ~description: "The operation is signed by a delegate without endorsement rights." ~pp:(fun ppf () -> Format.fprintf ppf "The endorsement is signed by a delegate without endorsement rights.") Data_encoding.unit (function Unexpected_endorsement -> Some () | _ -> None) (fun () -> Unexpected_endorsement) ; register_error_kind `Permanent ~id:"baking.invalid_endorsement_slot" ~title:"Endorsement slot out of range" ~description:"The endorsement slot provided is negative or too high." ~pp:(fun ppf v -> Format.fprintf ppf "Endorsement slot %d provided is negative or too high." v) Data_encoding.(obj1 (req "slot" uint16)) (function Invalid_endorsement_slot v -> Some v | _ -> None) (fun v -> Invalid_endorsement_slot v) ; register_error_kind `Permanent ~id:"baking.unexpected_endorsement_slot" ~title:"Endorsement slot not the smallest possible" ~description:"The endorsement slot provided is not the smallest possible." ~pp:(fun ppf v -> Format.fprintf ppf "Endorsement slot %d provided is not the smallest possible." v) Data_encoding.(obj1 (req "slot" uint16)) (function Unexpected_endorsement_slot v -> Some v | _ -> None) (fun v -> Unexpected_endorsement_slot v) (* The function implements the fast-path case in [minimal_time]. (See [minimal_valid_time] for the definition of the fast-path.) *) let minimal_time_fastpath_case minimal_block_delay pred_timestamp = Timestamp.(pred_timestamp +? minimal_block_delay) (* The function implements the slow-path case in [minimal_time]. (See [minimal_valid_time] for the definition of the slow-path.) *) let minimal_time_slowpath_case time_between_blocks priority pred_timestamp = let rec cumsum_time_between_blocks acc durations p = if Compare.Int32.( <= ) p 0l then ok acc else match durations with | [] -> cumsum_time_between_blocks acc [Period.one_minute] p | [last] -> Period.mult p last >>? fun period -> Timestamp.(acc +? period) | first :: durations -> Timestamp.(acc +? first) >>? fun acc -> let p = Int32.pred p in cumsum_time_between_blocks acc durations p in cumsum_time_between_blocks pred_timestamp time_between_blocks (Int32.succ priority) let minimal_time constants ~priority pred_timestamp = let priority = Int32.of_int priority in if Compare.Int32.(priority = 0l) then minimal_time_fastpath_case constants.Constants.minimal_block_delay pred_timestamp else minimal_time_slowpath_case constants.time_between_blocks priority pred_timestamp let earlier_predecessor_timestamp ctxt level = let current = Level.current ctxt in let current_timestamp = Timestamp.current ctxt in let gap = Level.diff level current in let step = Constants.minimal_block_delay ctxt in if Compare.Int32.(gap < 1l) then failwith "Baking.earlier_block_timestamp: past block." else Period.mult (Int32.pred gap) step >>? fun delay -> Timestamp.(current_timestamp +? delay) let check_timestamp c ~priority pred_timestamp = minimal_time (Constants.parametric c) priority pred_timestamp >>? fun minimal_time -> let timestamp = Timestamp.current c in record_trace (Timestamp_too_early { minimal_time; provided_time = timestamp; priority; endorsing_power_opt = None; }) Timestamp.(timestamp -? minimal_time) >>? fun _block_delay -> ok () type error += Incorrect_priority (* `Permanent *) type error += Incorrect_number_of_endorsements (* `Permanent *) let () = register_error_kind `Permanent ~id:"incorrect_priority" ~title:"Incorrect priority" ~description:"Block priority must be non-negative." ~pp:(fun ppf () -> Format.fprintf ppf "The block priority must be non-negative.") Data_encoding.unit (function Incorrect_priority -> Some () | _ -> None) (fun () -> Incorrect_priority) let () = let description = "The number of endorsements must be non-negative and at most the \ endorsers_per_block constant." in register_error_kind `Permanent ~id:"incorrect_number_of_endorsements" ~title:"Incorrect number of endorsements" ~description ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) Data_encoding.unit (function Incorrect_number_of_endorsements -> Some () | _ -> None) (fun () -> Incorrect_number_of_endorsements) let rec reward_for_priority reward_per_prio prio = match reward_per_prio with | [] -> (* Empty reward list in parameters means no rewards *) Tez.zero | [last] -> last | first :: rest -> if Compare.Int.(prio <= 0) then first else reward_for_priority rest (pred prio) let baking_reward ctxt ~block_priority ~included_endorsements = error_unless Compare.Int.(block_priority >= 0) Incorrect_priority >>? fun () -> error_unless Compare.Int.( included_endorsements >= 0 && included_endorsements <= Constants.endorsers_per_block ctxt) Incorrect_number_of_endorsements >>? fun () -> let reward_per_endorsement = reward_for_priority (Constants.baking_reward_per_endorsement ctxt) block_priority in Tez.(reward_per_endorsement *? Int64.of_int included_endorsements) let endorsing_reward ctxt ~block_priority num_slots = error_unless Compare.Int.(block_priority >= 0) Incorrect_priority >>? fun () -> let reward_per_endorsement = reward_for_priority (Constants.endorsement_reward ctxt) block_priority in Tez.(reward_per_endorsement *? Int64.of_int num_slots) let baking_priorities c level = let rec f priority = Roll.baking_rights_owner c level ~priority >|=? fun delegate -> LCons (delegate, fun () -> f (succ priority)) in f 0 let endorsement_rights ctxt level = fold_right_s (fun slot acc -> Roll.endorsement_rights_owner ctxt level ~slot >|=? fun pk -> let pkh = Signature.Public_key.hash pk in let right = match Signature.Public_key_hash.Map.find_opt pkh acc with | None -> (pk, [slot], false) | Some (pk, slots, used) -> (pk, slot :: slots, used) in Signature.Public_key_hash.Map.add pkh right acc) (0 --> (Constants.endorsers_per_block ctxt - 1)) Signature.Public_key_hash.Map.empty let[@coq_axiom_with_reason "gadt"] check_endorsement_rights ctxt chain_id ~slot (op : Kind.endorsement Operation.t) = if Compare.Int.(slot < 0 (* should not happen because of binary format *)) || Compare.Int.(slot >= Constants.endorsers_per_block ctxt) then fail (Invalid_endorsement_slot slot) else let current_level = Level.current ctxt in let (Single (Endorsement {level; _})) = op.protocol_data.contents in Roll.endorsement_rights_owner ctxt (Level.from_raw ctxt level) ~slot >>=? fun pk -> let pkh = Signature.Public_key.hash pk in match Operation.check_signature pk chain_id op with | Error _ -> fail Unexpected_endorsement | Ok () -> ( ( if Raw_level.(succ level = current_level.level) then return (Alpha_context.allowed_endorsements ctxt) else endorsement_rights ctxt (Level.from_raw ctxt level) ) >>=? fun endorsements -> match Signature.Public_key_hash.Map.find_opt pkh endorsements with | None -> fail Unexpected_endorsement (* unexpected *) | Some (_pk, slots, v) -> error_unless Compare.Int.(slot = List.hd slots) (Unexpected_endorsement_slot slot) >>?= fun () -> return (pkh, slots, v) ) let select_delegate delegate delegate_list max_priority = let rec loop acc l n = if Compare.Int.(n >= max_priority) then return (List.rev acc) else let (LCons (pk, t)) = l in let acc = if Signature.Public_key_hash.equal delegate (Signature.Public_key.hash pk) then n :: acc else acc in t () >>=? fun t -> loop acc t (succ n) in loop [] delegate_list 0 let first_baking_priorities ctxt ?(max_priority = 32) delegate level = baking_priorities ctxt level >>=? fun delegate_list -> select_delegate delegate delegate_list max_priority let check_hash hash stamp_threshold = let bytes = Block_hash.to_bytes hash in let word = TzEndian.get_int64 bytes 0 in Compare.Uint64.(word <= stamp_threshold) let check_header_proof_of_work_stamp shell contents stamp_threshold = let hash = Block_header.hash {shell; protocol_data = {contents; signature = Signature.zero}} in check_hash hash stamp_threshold let check_proof_of_work_stamp ctxt block = let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in if check_header_proof_of_work_stamp block.Block_header.shell block.protocol_data.contents proof_of_work_threshold then ok_unit else error Invalid_stamp let check_signature block chain_id key = let check_signature key {Block_header.shell; protocol_data = {contents; signature}} = let unsigned_header = Data_encoding.Binary.to_bytes_exn Block_header.unsigned_encoding (shell, contents) in Signature.check ~watermark:(Block_header chain_id) key signature unsigned_header in if check_signature key block then return_unit else fail (Invalid_block_signature (Block_header.hash block, Signature.Public_key.hash key)) let max_fitness_gap _ctxt = 1L let check_fitness_gap ctxt (block : Block_header.t) = let current_fitness = Fitness.current ctxt in Fitness.to_int64 block.shell.fitness >>? fun announced_fitness -> let gap = Int64.sub announced_fitness current_fitness in if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then error (Invalid_fitness_gap (max_fitness_gap ctxt, gap)) else ok_unit (* The minimal threshold on the endorsing power for the fast-path case is 60% of the maximal endorsing power. *) let fastpath_endorsing_power_threshold maximal_endorsing_power = 3 * maximal_endorsing_power / 5 (* This function computes the minimal time at which a block is valid. It distinguishes between the "fast-path" case, when the priority is 0 and the endorsing power is at least 60% of the maximal endorsing power, and the "slow-path" case, when this condition is not satisfied. *) let minimal_valid_time constants ~priority ~endorsing_power ~predecessor_timestamp = if Compare.Int.(priority = 0) && Compare.Int.( endorsing_power >= fastpath_endorsing_power_threshold constants.Constants.endorsers_per_block) then minimal_time_fastpath_case constants.minimal_block_delay predecessor_timestamp else minimal_time_slowpath_case constants.time_between_blocks (Int32.of_int priority) predecessor_timestamp >>? fun minimal_time -> let delay_per_missing_endorsement = constants.Constants.delay_per_missing_endorsement in let missing_endorsements = let minimal_required_endorsements = constants.Constants.initial_endorsers in Compare.Int.max 0 (minimal_required_endorsements - endorsing_power) in Period.mult (Int32.of_int missing_endorsements) delay_per_missing_endorsement >|? fun delay -> Time.add minimal_time (Period.to_seconds delay)