268 lines
9.5 KiB
OCaml
268 lines
9.5 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Copyright (c) 2014 - 2017. *)
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* 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
|
|
|