voting_period_repr.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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. *)
(* *)
(*****************************************************************************)
type kind = Proposal | Exploration | Cooldown | Promotion | Adoption
let string_of_kind = function
| Proposal -> "proposal"
| Exploration -> "exploration"
| Cooldown -> "cooldown"
| Promotion -> "promotion"
| Adoption -> "adoption"
let pp_kind ppf kind = Format.fprintf ppf "%s" @@ string_of_kind kind
let kind_encoding =
let open Data_encoding in
union
~tag_size:`Uint8
[
case
(Tag 0)
~title:"Proposal"
(constant "proposal")
(function Proposal -> Some () | _ -> None)
(fun () -> Proposal);
case
(Tag 1)
~title:"exploration"
(constant "exploration")
(function Exploration -> Some () | _ -> None)
(fun () -> Exploration);
case
(Tag 2)
~title:"Cooldown"
(constant "cooldown")
(function Cooldown -> Some () | _ -> None)
(fun () -> Cooldown);
case
(Tag 3)
~title:"Promotion"
(constant "promotion")
(function Promotion -> Some () | _ -> None)
(fun () -> Promotion);
case
(Tag 4)
~title:"Adoption"
(constant "adoption")
(function Adoption -> Some () | _ -> None)
(fun () -> Adoption);
]
let succ_kind = function
| Proposal -> Exploration
| Exploration -> Cooldown
| Cooldown -> Promotion
| Promotion -> Adoption
| Adoption -> Proposal
type voting_period = {index : int32; kind : kind; start_position : int32}
type t = voting_period
type info = {voting_period : t; position : int32; remaining : int32}
let root ~start_position = {index = 0l; kind = Proposal; start_position}
let pp ppf {index; kind; start_position} =
Format.fprintf
ppf
"@[<hv 2>index: %ld,@ kind:%a,@ start_position: %ld@]"
index
pp_kind
kind
start_position
let pp_info ppf {voting_period; position; remaining} =
Format.fprintf
ppf
"@[<hv 2>voting_period: %a,@ position:%ld,@ remaining: %ld@]"
pp
voting_period
position
remaining
let encoding =
let open Data_encoding in
conv
(fun {index; kind; start_position} -> (index, kind, start_position))
(fun (index, kind, start_position) -> {index; kind; start_position})
(obj3
(req
"index"
~description:
"The voting period's index. Starts at 0 with the first block of \
the Alpha family of protocols."
int32)
(req
~description:
"One of the several kinds of periods in the voting procedure."
"kind"
kind_encoding)
(req
~description:
"The relative position of the first level of the period with \
respect to the first level of the Alpha family of protocols."
"start_position"
int32))
let info_encoding =
let open Data_encoding in
conv
(fun {voting_period; position; remaining} ->
(voting_period, position, remaining))
(fun (voting_period, position, remaining) ->
{voting_period; position; remaining})
(obj3
(req
~description:"The voting period to which the block belongs."
"voting_period"
encoding)
(req
~description:"The position of the block within the voting period."
"position"
int32)
(req
~description:
"The number of blocks remaining till the end of the voting period."
"remaining"
int32))
include Compare.Make (struct
type nonrec t = t
let compare p p' = Compare.Int32.compare p.index p'.index
end)
let raw_reset period ~start_position =
let index = Int32.succ period.index in
let kind = Proposal in
{index; kind; start_position}
let raw_succ period ~start_position =
let index = Int32.succ period.index in
let kind = succ_kind period.kind in
{index; kind; start_position}
let position_since (level : Level_repr.t) (voting_period : t) =
Int32.(sub level.level_position voting_period.start_position)
let remaining_blocks (level : Level_repr.t) (voting_period : t)
~blocks_per_voting_period =
let position = position_since level voting_period in
Int32.(sub blocks_per_voting_period (succ position))