(**************************************************************************) (* *) (* Copyright (c) 2014 - 2017. *) (* Dynamic Ledger Solutions, Inc. *) (* *) (* All rights reserved. No warranty, explicit or implicit, provided. *) (* *) (**************************************************************************) open Tezos_context open Misc type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *) type error += Invalid_endorsement_slot of int * int (* `Permanent *) type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *) type error += Wrong_delegate of public_key_hash * public_key_hash (* `Permanent *) type error += Cannot_pay_baking_bond (* `Permanent *) type error += Cannot_pay_endorsement_bond (* `Permanent *) let () = register_error_kind `Permanent ~id:"baking.timestamp_too_early" ~title:"Block forged too early" ~description:"The block timestamp is before the first slot \ for this baker at this level" ~pp:(fun ppf (r, p) -> Format.fprintf ppf "Block forged too early (%a is before %a)" Time.pp_hum p Time.pp_hum r) Data_encoding.(obj2 (req "minimum" Time.encoding) (req "provided" Time.encoding)) (function Timestamp_too_early (r, p) -> Some (r, p) | _ -> None) (fun (r, p) -> Timestamp_too_early (r, p)) ; 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_slot" ~title:"Invalid slot" ~description:"The baking slot is out of bounds" ~pp:(fun ppf (m, g) -> Format.fprintf ppf "The baking slot %d is not between 0 and %d" g m) Data_encoding.(obj2 (req "maximum" int16) (req "provided" int16)) (function Invalid_endorsement_slot (m, g) -> Some (m, g) | _ -> None) (fun (m, g) -> Invalid_endorsement_slot (m, g)) ; register_error_kind `Permanent ~id:"baking.wrong_delegate" ~title:"Wrong delegate" ~description:"The block delegate is not the expected one" ~pp:(fun ppf (e, g) -> Format.fprintf ppf "The declared delegate %a is not %a" Ed25519.Public_key_hash.pp g Ed25519.Public_key_hash.pp e) Data_encoding.(obj2 (req "expected" Ed25519.Public_key_hash.encoding) (req "provided" Ed25519.Public_key_hash.encoding)) (function Wrong_delegate (e, g) -> Some (e, g) | _ -> None) (fun (e, g) -> Wrong_delegate (e, g)) ; register_error_kind `Permanent ~id:"baking.cannot_pay_baking_bond" ~title:"Cannot pay baking bond" ~description: "Impossible to debit the required tokens on the baker's contract" ~pp:(fun ppf () -> Format.fprintf ppf "Cannot pay the baking bond") Data_encoding.unit (function Cannot_pay_baking_bond -> Some () | _ -> None) (fun () -> Cannot_pay_baking_bond) ; register_error_kind `Permanent ~id:"baking.cannot_pay_endorsement_bond" ~title:"Cannot pay endorsement bond" ~description: "Impossible to debit the required tokens on the endorser's contract" ~pp:(fun ppf () -> Format.fprintf ppf "Cannot pay the endorsement bond") Data_encoding.unit (function Cannot_pay_endorsement_bond -> Some () | _ -> None) (fun () -> Cannot_pay_endorsement_bond) let minimal_time c priority pred_timestamp = let priority = Int32.of_int priority in let rec cumsum_slot_durations acc durations p = if Compare.Int32.(<=) p 0l then ok acc else match durations with | [] -> cumsum_slot_durations 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_slot_durations acc durations p in Lwt.return (cumsum_slot_durations pred_timestamp (Constants.slot_durations c) (Int32.succ priority)) let check_timestamp c priority pred_timestamp = minimal_time c priority pred_timestamp >>=? fun minimal_time -> let timestamp = Tezos_context.Timestamp.current c in fail_unless Timestamp.(minimal_time <= timestamp) (Timestamp_too_early (minimal_time, timestamp)) let check_baking_rights c { Block_header.priority } pred_timestamp = let level = Level.current c in Roll.baking_rights_owner c level ~priority >>=? fun delegate -> check_timestamp c priority pred_timestamp >>=? fun () -> return delegate let pay_baking_bond c { Block_header.priority } id = if Compare.Int.(priority >= Constants.first_free_baking_slot c) then return c else Contract.spend c (Contract.default_contract id) Constants.baking_bond_cost |> trace Cannot_pay_baking_bond let pay_endorsement_bond c id = let bond = Constants.endorsement_bond_cost in Contract.spend c (Contract.default_contract id) bond |> trace Cannot_pay_endorsement_bond >>=? fun c -> return (c, bond) let check_signing_rights c slot delegate = fail_unless Compare.Int.(0 <= slot && slot <= Constants.max_signing_slot c) (Invalid_endorsement_slot (Constants.max_signing_slot c, slot)) >>=? fun () -> let level = Level.current c in Roll.endorsement_rights_owner c level ~slot >>=? fun owning_delegate -> fail_unless (Ed25519.Public_key_hash.equal owning_delegate delegate) (Wrong_delegate (owning_delegate, delegate)) let paying_priorities c = 0 --> Constants.first_free_baking_slot c let bond_and_reward = match Tez.(Constants.baking_bond_cost +? Constants.baking_reward) with | Ok v -> v | Error _ -> assert false let base_baking_reward c ~priority = if Compare.Int.(priority < Constants.first_free_baking_slot c) then bond_and_reward else Constants.baking_reward type error += Incorect_priority let endorsement_reward ~block_priority:prio = if Compare.Int.(prio >= 0) then Lwt.return Tez.(Constants.endorsement_reward /? (Int64.(succ (of_int prio)))) else fail Incorect_priority let baking_priorities c level = let rec f priority = Roll.baking_rights_owner c level ~priority >>=? fun delegate -> return (LCons (delegate, (fun () -> f (succ priority)))) in f 0 let endorsement_priorities c level = let rec f slot = Roll.endorsement_rights_owner c level ~slot >>=? fun delegate -> return (LCons (delegate, (fun () -> f (succ slot)))) in f 0 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 (pkh, t) = l in let acc = if Ed25519.Public_key_hash.equal delegate pkh 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 = Constants.first_free_baking_slot ctxt) delegate level = baking_priorities ctxt level >>=? fun delegate_list -> select_delegate delegate delegate_list max_priority let first_endorsement_slots ctxt ?(max_priority = Constants.max_signing_slot ctxt) delegate level = endorsement_priorities ctxt level >>=? fun delegate_list -> select_delegate delegate delegate_list max_priority let check_hash hash stamp_threshold = let bytes = Block_hash.to_string hash in let word = String.get_int64 bytes 0 in Compare.Uint64.(word < stamp_threshold) let check_header_hash header stamp_threshold = let hash = Block_header.hash header in check_hash hash stamp_threshold type error += | Invalid_signature | Invalid_stamp let check_proof_of_work_stamp ctxt block = let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in if check_header_hash block proof_of_work_threshold then return () else fail Invalid_stamp let check_signature ctxt block id = Delegates_pubkey.get ctxt id >>=? fun key -> let check_signature key { Block_header.proto ; shell ; signature } = let unsigned_header = Block_header.forge_unsigned shell proto in Ed25519.Signature.check key signature unsigned_header in if check_signature key block then return () else fail Invalid_signature let max_fitness_gap ctxt = let slots = Int64.of_int (Constants.max_signing_slot ctxt + 1) in Int64.add slots 1L let check_fitness_gap ctxt (block : Block_header.t) = let current_fitness = Fitness.current ctxt in Lwt.return (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 fail (Invalid_fitness_gap (max_fitness_gap ctxt, gap)) else return () let last_of_a_cycle ctxt l = Compare.Int32.(Int32.succ l.Level.cycle_position = Constants.cycle_length ctxt) let dawn_of_a_new_cycle ctxt = let level = Level.current ctxt in if last_of_a_cycle ctxt level then return (Some level.cycle) else return None