Protocol of Tezos in Coq Does compile

These are the sources of the protocol of Tezos imported to Coq by the current development version of coq-of-ocaml. Tezos is a crypto-currency with smart-contracts and an upgradable protocol. To see the valid generated Coq files, go on coq-of-ocaml/build-tezos/html/toc.html.

(2020-03-11) Compiling all the protocol! 🎉🐓

We show the original OCaml code on the left and the imported Coq code on the right. The imported code does compile. Warnings reported on the OCaml side are due to either various incompleteness in our tool, or to side-effects in the source code. Go on the Gitter chat for more information. Work currently made at Nomadic Labs.

To install the latest development version of coq-of-ocaml with opam:

opam repo add coq-released https://coq.inria.fr/opam/released
opam pin add https://github.com/clarus/coq-of-ocaml.git#master
  • OCaml size: 36294 lines
  • Coq size: 45535 lines (+25% compared to OCaml)
  • Warnings from coq-of-ocaml: 711
Minion mic drop

List of files

We add the warnings from coq-of-ocaml as annotations. They are not necessarly related to compilation bugs of the generated Coq files. These warnings are either due to unsupported features in coq-of-ocaml or to side-effects in the source code.


Alpha_context

  • OCaml size: 279 lines
  • Coq size: 457 lines (+63% compared to OCaml)
alpha_context.ml 2 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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 t = Raw_context.t

type context = t

module type BASIC_DATA = sig
  type t

  include Compare.S with type t := t

  val encoding : t Data_encoding.t

  val pp : Format.formatter -> t -> unit
end

module Tez = Tez_repr
module Period = Period_repr

module Timestamp = struct
  include Time_repr

  let current = Raw_context.current_timestamp
end

include Operation_repr

module Operation = struct
  type 'kind t = 'kind operation = {
    shell : Operation.shell_header;
    protocol_data : 'kind protocol_data;
  }

  type packed = packed_operation

  let unsigned_encoding = unsigned_operation_encoding

  include Operation_repr
end

module Block_header = Block_header_repr

module Vote = struct
  include Vote_repr
  include Vote_storage
end

module Raw_level = Raw_level_repr
module Cycle = Cycle_repr
module Script_int = Script_int_repr

module Script_timestamp = struct
  include Script_timestamp_repr

  let now ctxt =
    let {Constants_repr.time_between_blocks; _} = Raw_context.constants ctxt in
    match time_between_blocks with
    | [] ->
        failwith
          "Internal error: 'time_between_block' constants is an empty list."
    | first_delay :: _ ->
        let current_timestamp = Raw_context.predecessor_timestamp ctxt in
        Time.add current_timestamp (Period_repr.to_seconds first_delay)
        |> Timestamp.to_seconds |> of_int64
end

module Script = struct
  include Michelson_v1_primitives
  include Script_repr

  let force_decode_in_context ctxt lexpr =
    Lwt.return
      ( Script_repr.force_decode lexpr
      >>? fun (v, cost) ->
      Raw_context.consume_gas ctxt cost >|? fun ctxt -> (v, ctxt) )

  let force_bytes_in_context ctxt lexpr =
    Lwt.return
      ( Script_repr.force_bytes lexpr
      >>? fun (b, cost) ->
      Raw_context.consume_gas ctxt cost >|? fun ctxt -> (b, ctxt) )

  module Legacy_support = Legacy_script_support_repr
end

module Fees = Fees_storage

type public_key = Signature.Public_key.t

type public_key_hash = Signature.Public_key_hash.t

type signature = Signature.t

module Constants = struct
  include Constants_repr
  include Constants_storage
end

module Voting_period = Voting_period_repr

module Gas = struct
  include Gas_limit_repr

  type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high

  let check_limit = Raw_context.check_gas_limit

  let set_limit = Raw_context.set_gas_limit

  let set_unlimited = Raw_context.set_gas_unlimited

  let consume = Raw_context.consume_gas

  let check_enough = Raw_context.check_enough_gas

  let level = Raw_context.gas_level

  let consumed = Raw_context.gas_consumed

  let block_level = Raw_context.block_gas_level
end

module Level = struct
  include Level_repr
  include Level_storage
end

module Contract = struct
  include Contract_repr
  include Contract_storage

  let originate c contract ~balance ~script ~delegate =
    originate_raw c contract ~balance ~script ~delegate

  let init_origination_nonce = Raw_context.init_origination_nonce

  let unset_origination_nonce = Raw_context.unset_origination_nonce
end

module Big_map = struct
  type id = Z.t

  let fresh = Storage.Big_map.Next.incr

  let fresh_temporary = Raw_context.fresh_temporary_big_map

  let mem c m k = Storage.Big_map.Contents.mem (c, m) k

  let get_opt c m k = Storage.Big_map.Contents.get_option (c, m) k

  let rpc_arg = Storage.Big_map.rpc_arg

  let cleanup_temporary c =
    Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c
    >>= fun c -> Lwt.return (Raw_context.reset_temporary_big_map c)

  let exists c id =
    Lwt.return
      (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))
    >>=? fun c ->
    Storage.Big_map.Key_type.get_option c id
    >>=? fun kt ->
    match kt with
    | None ->
        return (c, None)
    | Some kt ->
        Storage.Big_map.Value_type.get c id
        >>=? fun kv -> return (c, Some (kt, kv))
end

module Delegate = Delegate_storage

module Roll = struct
  include Roll_repr
  include Roll_storage
end

module Nonce = Nonce_storage

module Seed = struct
  include Seed_repr
  include Seed_storage
end

module Fitness = struct
  include Fitness_repr
  include Fitness

  type fitness = t

  include Fitness_storage
end

module Bootstrap = Bootstrap_storage

module Commitment = struct
  include Commitment_repr
  include Commitment_storage
end

module Global = struct
  let get_block_priority = Storage.Block_priority.get

  let set_block_priority = Storage.Block_priority.set
end

let prepare_first_block = Init_storage.prepare_first_block

let prepare = Init_storage.prepare

let finalize ?commit_message:message c =
  let fitness = Fitness.from_int64 (Fitness.current c) in
  let context = Raw_context.recover c in
  {
    Updater.context;
    fitness;
    message;
    max_operations_ttl = 60;
    last_allowed_fork_level =
      Raw_level.to_int32 @@ Level.last_allowed_fork_level c;
  }

let activate = Raw_context.activate

let fork_test_chain = Raw_context.fork_test_chain

let record_endorsement = Raw_context.record_endorsement

let allowed_endorsements = Raw_context.allowed_endorsements

let init_endorsements = Raw_context.init_endorsements

let included_endorsements = Raw_context.included_endorsements

let reset_internal_nonce = Raw_context.reset_internal_nonce

let fresh_internal_nonce = Raw_context.fresh_internal_nonce

let record_internal_nonce = Raw_context.record_internal_nonce

let internal_nonce_already_recorded =
  Raw_context.internal_nonce_already_recorded

let add_deposit = Raw_context.add_deposit

let add_fees = Raw_context.add_fees

let add_rewards = Raw_context.add_rewards

let get_deposits = Raw_context.get_deposits

let get_fees = Raw_context.get_fees

let get_rewards = Raw_context.get_rewards

let description = Raw_context.description
Alpha_context.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Block_header_repr.
Require Tezos.Bootstrap_storage.
Require Tezos.Commitment_repr.
Require Tezos.Commitment_storage.
Require Tezos.Constants_repr.
Require Tezos.Constants_storage.
Require Tezos.Contract_repr.
Require Tezos.Contract_storage.
Require Tezos.Cycle_repr.
Require Tezos.Delegate_storage.
Require Tezos.Fees_storage.
Require Tezos.Fitness_repr.
Require Tezos.Fitness_storage.
Require Tezos.Gas_limit_repr.
Require Tezos.Init_storage.
Require Tezos.Legacy_script_support_repr.
Require Tezos.Level_repr.
Require Tezos.Level_storage.
Require Tezos.Michelson_v1_primitives.
Require Tezos.Nonce_storage.
Require Tezos.Operation_repr.
Require Tezos.Period_repr.
Require Tezos.Raw_context.
Require Tezos.Raw_level_repr.
Require Tezos.Roll_repr.
Require Tezos.Roll_storage.
Require Tezos.Script_int_repr.
Require Tezos.Script_repr.
Require Tezos.Script_timestamp_repr.
Require Tezos.Seed_repr.
Require Tezos.Seed_storage.
Require Tezos.Storage_mli. Module Storage := Storage_mli.
Require Tezos.Storage_description.
Require Tezos.Storage_sigs.
Require Tezos.Tez_repr.
Require Tezos.Time_repr.
Require Tezos.Vote_repr.
Require Tezos.Vote_storage.
Require Tezos.Voting_period_repr.

Definition t : Set := Raw_context.t.

Definition context : Set := t.

Module BASIC_DATA.
  Record signature {t : Set} : Set := {
    t := t;
    op_eq : t -> t -> bool;
    op_ltgt : t -> t -> bool;
    op_lt : t -> t -> bool;
    op_lteq : t -> t -> bool;
    op_gteq : t -> t -> bool;
    op_gt : t -> t -> bool;
    compare : t -> t -> int;
    equal : t -> t -> bool;
    max : t -> t -> t;
    min : t -> t -> t;
    encoding : Data_encoding.t t;
    pp : Format.formatter -> t -> unit;
  }.
End BASIC_DATA.

Module Tez := Tez_repr.

Module Period := Period_repr.

Module Timestamp.
  Include Time_repr.
  
  Definition current : Raw_context.context -> Time.t :=
    Raw_context.current_timestamp.
End Timestamp.

Include Operation_repr.

Module Operation.
  Definition t : Set := operation.
  
  Definition packed : Set := packed_operation.
  
  Definition unsigned_encoding
    : Data_encoding.t (Operation.shell_header * packed_contents_list) :=
    unsigned_operation_encoding.
  
  Include Operation_repr.
End Operation.

Module Block_header := Block_header_repr.

Module Vote.
  Include Vote_repr.
  
  Include Vote_storage.
End Vote.

Module Raw_level := Raw_level_repr.

Module Cycle := Cycle_repr.

Module Script_int := Script_int_repr.

Module Script_timestamp.
  Include Script_timestamp_repr.
  
  Definition now (ctxt : Raw_context.context) : t :=
    let '{|
      Constants_repr.parametric.time_between_blocks := time_between_blocks
        |} := Raw_context.constants ctxt in
    match time_between_blocks with
    | [] =>
      Pervasives.failwith
        "Internal error: 'time_between_block' constants is an empty list."
    | cons first_delay _ =>
      let current_timestamp := Raw_context.predecessor_timestamp ctxt in
      of_int64
        (Timestamp.to_seconds
          (Time.add current_timestamp (Period_repr.to_seconds first_delay)))
    end.
End Script_timestamp.

Module Script.
  Include Michelson_v1_primitives.
  
  Include Script_repr.
  
  Definition force_decode_in_context
    (ctxt : Raw_context.context) (lexpr : Script_repr.lazy_expr)
    : Lwt.t (Error_monad.tzresult (Script_repr.expr * Raw_context.context)) :=
    Lwt.__return
      (let? '(v, cost) := Script_repr.force_decode lexpr in
      Error_monad.op_gtpipequestion (Raw_context.consume_gas ctxt cost)
        (fun ctxt => (v, ctxt))).
  
  Definition force_bytes_in_context
    (ctxt : Raw_context.context) (lexpr : Script_repr.lazy_expr)
    : Lwt.t (Error_monad.tzresult (MBytes.t * Raw_context.context)) :=
    Lwt.__return
      (let? '(__b_value, cost) := Script_repr.force_bytes lexpr in
      Error_monad.op_gtpipequestion (Raw_context.consume_gas ctxt cost)
        (fun ctxt => (__b_value, ctxt))).
  
  Module Legacy_support := Legacy_script_support_repr.
End Script.

Module Fees := Fees_storage.

Definition public_key : Set := (|Signature.Public_key|).(S.SPublic_key.t).

Definition public_key_hash : Set :=
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t).

Definition signature : Set := Signature.t.

Module Constants.
  Include Constants_repr.
  
  Include Constants_storage.
End Constants.

Module Voting_period := Voting_period_repr.

Module Gas.
  Include Gas_limit_repr.
  
  (* ❌ Structure item `typext` not handled. *)
  (* type_extension *)
  
  Definition check_limit : Raw_context.t -> Z.t -> Error_monad.tzresult unit :=
    Raw_context.check_gas_limit.
  
  Definition set_limit : Raw_context.t -> Z.t -> Raw_context.t :=
    Raw_context.set_gas_limit.
  
  Definition set_unlimited : Raw_context.t -> Raw_context.t :=
    Raw_context.set_gas_unlimited.
  
  Definition consume
    : Raw_context.context -> Gas_limit_repr.cost ->
    Error_monad.tzresult Raw_context.context := Raw_context.consume_gas.
  
  Definition check_enough
    : Raw_context.context -> Gas_limit_repr.cost -> Error_monad.tzresult unit :=
    Raw_context.check_enough_gas.
  
  Definition level : Raw_context.t -> Gas_limit_repr.t := Raw_context.gas_level.
  
  Definition consumed : Raw_context.t -> Raw_context.t -> Z.t :=
    Raw_context.gas_consumed.
  
  Definition block_level : Raw_context.t -> Z.t := Raw_context.block_gas_level.
End Gas.

Module Level.
  Include Level_repr.
  
  Include Level_storage.
End Level.

Module Contract.
  Include Contract_repr.
  
  Include Contract_storage.
  
  Definition originate
    (c : Raw_context.t) (contract : Contract_repr.t) (balance : Tez_repr.t)
    (script : Script_repr.t * option big_map_diff)
    (delegate : option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
    : Lwt.t (Error_monad.tzresult Raw_context.t) :=
    originate_raw c None contract balance script delegate.
  
  Definition init_origination_nonce
    : Raw_context.t -> (|Operation_hash|).(S.HASH.t) -> Raw_context.t :=
    Raw_context.init_origination_nonce.
  
  Definition unset_origination_nonce : Raw_context.t -> Raw_context.t :=
    Raw_context.unset_origination_nonce.
End Contract.

Module Big_map.
  Definition id : Set := Z.t.
  
  Definition fresh
    : Raw_context.t -> Lwt.t (Error_monad.tzresult (Raw_context.t * Z.t)) :=
    Storage.Big_map.Next.incr.
  
  Definition fresh_temporary
    : Raw_context.context -> Raw_context.context * Z.t :=
    Raw_context.fresh_temporary_big_map.
  
  Definition mem
    (c : Raw_context.t) (m : Z.t)
    (k :
      (|Storage.Big_map.Contents|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.key))
    : Lwt.t (Error_monad.tzresult (Raw_context.t * bool)) :=
    (|Storage.Big_map.Contents|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.mem)
      (c, m) k.
  
  Definition get_opt
    (c : Raw_context.t) (m : Z.t)
    (k :
      (|Storage.Big_map.Contents|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.key))
    : Lwt.t
      (Error_monad.tzresult
        (Raw_context.t *
          option
            (|Storage.Big_map.Contents|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.value))) :=
    (|Storage.Big_map.Contents|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.get_option)
      (c, m) k.
  
  Definition rpc_arg : RPC_arg.t Z.t := Storage.Big_map.rpc_arg.
  
  Definition cleanup_temporary (c : Raw_context.context)
    : Lwt.t Raw_context.context :=
    let= c := Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c in
    Lwt.__return (Raw_context.reset_temporary_big_map c).
  
  Definition __exists
    (c : Raw_context.context)
    (id : (|Storage.Big_map.Key_type|).(Storage_sigs.Indexed_data_storage.key))
    : Lwt.t
      (Error_monad.tzresult
        (Raw_context.context *
          option
            ((|Storage.Big_map.Key_type|).(Storage_sigs.Indexed_data_storage.value)
              *
              (|Storage.Big_map.Value_type|).(Storage_sigs.Indexed_data_storage.value)))) :=
    let=? c :=
      Lwt.__return
        (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)) in
    let=? kt :=
      (|Storage.Big_map.Key_type|).(Storage_sigs.Indexed_data_storage.get_option)
        c id in
    match kt with
    | None => Error_monad.__return (c, None)
    | Some kt =>
      let=? kv :=
        (|Storage.Big_map.Value_type|).(Storage_sigs.Indexed_data_storage.get) c
          id in
      Error_monad.__return (c, (Some (kt, kv)))
    end.
End Big_map.

Module Delegate := Delegate_storage.

Module Roll.
  Include Roll_repr.
  
  Include Roll_storage.
End Roll.

Module Nonce := Nonce_storage.

Module Seed.
  Include Seed_repr.
  
  Include Seed_storage.
End Seed.

Module Fitness.
  Include Fitness_repr.
  
  Definition t := (|Fitness|).(S.T.t).
  
  Definition op_eq := (|Fitness|).(S.T.op_eq).
  
  Definition op_ltgt := (|Fitness|).(S.T.op_ltgt).
  
  Definition op_lt := (|Fitness|).(S.T.op_lt).
  
  Definition op_lteq := (|Fitness|).(S.T.op_lteq).
  
  Definition op_gteq := (|Fitness|).(S.T.op_gteq).
  
  Definition op_gt := (|Fitness|).(S.T.op_gt).
  
  Definition compare := (|Fitness|).(S.T.compare).
  
  Definition equal := (|Fitness|).(S.T.equal).
  
  Definition max := (|Fitness|).(S.T.max).
  
  Definition min := (|Fitness|).(S.T.min).
  
  Definition pp := (|Fitness|).(S.T.pp).
  
  Definition encoding := (|Fitness|).(S.T.encoding).
  
  Definition to_bytes := (|Fitness|).(S.T.to_bytes).
  
  Definition of_bytes := (|Fitness|).(S.T.of_bytes).
  
  Definition fitness : Set := t.
  
  Include Fitness_storage.
End Fitness.

Module Bootstrap := Bootstrap_storage.

Module Commitment.
  Include Commitment_repr.
  
  Include Commitment_storage.
End Commitment.

Module Global.
  Definition get_block_priority
    : Raw_context.t -> Lwt.t (Error_monad.tzresult int) :=
    Storage.Block_priority.get.
  
  Definition set_block_priority
    : Raw_context.t -> int -> Lwt.t (Error_monad.tzresult Raw_context.t) :=
    Storage.Block_priority.set.
End Global.

Definition prepare_first_block
  : Context.t ->
  (Raw_context.t -> Script_repr.t ->
  Lwt.t
    (Error_monad.tzresult
      ((Script_repr.t * option Contract_storage.big_map_diff) * Raw_context.t)))
  -> int32 -> Time.t -> (|Fitness|).(S.T.t) ->
  Lwt.t (Error_monad.tzresult Raw_context.t) := Init_storage.prepare_first_block.

Definition prepare
  : Context.t -> Int32.t -> Time.t -> Time.t -> (|Fitness|).(S.T.t) ->
  Lwt.t (Error_monad.tzresult Raw_context.context) := Init_storage.prepare.

Definition finalize (message : option string) (c : Raw_context.context)
  : Updater.validation_result :=
  let fitness := Fitness.from_int64 (Fitness.current c) in
  let context := Raw_context.recover c in
  {| Updater.validation_result.context := context;
    Updater.validation_result.fitness := fitness;
    Updater.validation_result.message := message;
    Updater.validation_result.max_operations_ttl := 60;
    Updater.validation_result.last_allowed_fork_level :=
      Raw_level.to_int32 (Level.last_allowed_fork_level c) |}.

Definition activate
  : Raw_context.context -> (|Protocol_hash|).(S.HASH.t) -> Lwt.t Raw_context.t :=
  Raw_context.activate.

Definition fork_test_chain
  : Raw_context.context -> (|Protocol_hash|).(S.HASH.t) -> Time.t ->
  Lwt.t Raw_context.t := Raw_context.fork_test_chain.

Definition record_endorsement
  : Raw_context.context ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> Raw_context.context :=
  Raw_context.record_endorsement.

Definition allowed_endorsements
  : Raw_context.context ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.t)
    ((|Signature.Public_key|).(S.SPublic_key.t) * list int * bool) :=
  Raw_context.allowed_endorsements.

Definition init_endorsements
  : Raw_context.context ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.t)
    ((|Signature.Public_key|).(S.SPublic_key.t) * list int * bool) ->
  Raw_context.context := Raw_context.init_endorsements.

Definition included_endorsements : Raw_context.context -> int :=
  Raw_context.included_endorsements.

Definition reset_internal_nonce : Raw_context.context -> Raw_context.context :=
  Raw_context.reset_internal_nonce.

Definition fresh_internal_nonce
  : Raw_context.context -> Error_monad.tzresult (Raw_context.context * int) :=
  Raw_context.fresh_internal_nonce.

Definition record_internal_nonce
  : Raw_context.context -> int -> Raw_context.context :=
  Raw_context.record_internal_nonce.

Definition internal_nonce_already_recorded
  : Raw_context.context -> int -> bool :=
  Raw_context.internal_nonce_already_recorded.

Definition add_deposit
  : Raw_context.context ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> Tez_repr.t ->
  Lwt.t (Error_monad.tzresult Raw_context.context) := Raw_context.add_deposit.

Definition add_fees
  : Raw_context.context -> Tez_repr.t ->
  Lwt.t (Error_monad.tzresult Raw_context.context) := Raw_context.add_fees.

Definition add_rewards
  : Raw_context.context -> Tez_repr.t ->
  Lwt.t (Error_monad.tzresult Raw_context.context) := Raw_context.add_rewards.

Definition get_deposits
  : Raw_context.context ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.t)
    Tez_repr.t := Raw_context.get_deposits.

Definition get_fees : Raw_context.context -> Tez_repr.t := Raw_context.get_fees.

Definition get_rewards : Raw_context.context -> Tez_repr.t :=
  Raw_context.get_rewards.

Definition description : Storage_description.t Raw_context.context :=
  Raw_context.description.

Alpha_context_mli

  • OCaml size: 1393 lines
  • Coq size: 2558 lines (+83% compared to OCaml)
alpha_context.mli 15 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module type BASIC_DATA = sig
  type t

  include Compare.S with type t := t

  val encoding : t Data_encoding.t

  val pp : Format.formatter -> t -> unit
end

type t

type context = t

type public_key = Signature.Public_key.t

type public_key_hash = Signature.Public_key_hash.t

type signature = Signature.t

module Tez : sig
  include BASIC_DATA with type t = Tez_repr.t

  type tez = t

  val zero : tez

  val one_mutez : tez

  val one_cent : tez

  val fifty_cents : tez

  val one : tez

  val ( -? ) : tez -> tez -> tez tzresult

  val ( +? ) : tez -> tez -> tez tzresult

  val ( *? ) : tez -> int64 -> tez tzresult

  val ( /? ) : tez -> int64 -> tez tzresult

  val of_string : string -> tez option

  val to_string : tez -> string

  val of_mutez : int64 -> tez option

  val to_mutez : tez -> int64
end

module Period : sig
  include BASIC_DATA

  type period = t

  val rpc_arg : period RPC_arg.arg

  val of_seconds : int64 -> period tzresult

  val to_seconds : period -> int64

  val mult : int32 -> period -> period tzresult

  val zero : period

  val one_second : period

  val one_minute : period

  val one_hour : period
end

module Timestamp : sig
  include BASIC_DATA with type t = Time.t

  type time = t

  val ( +? ) : time -> Period.t -> time tzresult

  val ( -? ) : time -> time -> Period.t tzresult

  val of_notation : string -> time option

  val to_notation : time -> string

  val of_seconds_string : string -> time option

  val to_seconds_string : time -> string

  val current : context -> time
end

module Raw_level : sig
  include BASIC_DATA

  type raw_level = t

  val rpc_arg : raw_level RPC_arg.arg

  val diff : raw_level -> raw_level -> int32

  val root : raw_level

  val succ : raw_level -> raw_level

  val pred : raw_level -> raw_level option

  val to_int32 : raw_level -> int32

  val of_int32 : int32 -> raw_level tzresult
end

module Cycle : sig
  include BASIC_DATA

  type cycle = t

  val rpc_arg : cycle RPC_arg.arg

  val root : cycle

  val succ : cycle -> cycle

  val pred : cycle -> cycle option

  val add : cycle -> int -> cycle

  val sub : cycle -> int -> cycle option

  val to_int32 : cycle -> int32

  module Map : S.MAP with type key = cycle
end

module Gas : sig
  type t = private Unaccounted | Limited of {remaining : Z.t}

  val encoding : t Data_encoding.encoding

  val pp : Format.formatter -> t -> unit

  type cost

  val cost_encoding : cost Data_encoding.encoding

  val pp_cost : Format.formatter -> cost -> unit

  type error += Block_quota_exceeded (* `Temporary *)

  type error += Operation_quota_exceeded (* `Temporary *)

  type error += Gas_limit_too_high (* `Permanent *)

  val free : cost

  val atomic_step_cost : int -> cost

  val step_cost : int -> cost

  val alloc_cost : int -> cost

  val alloc_bytes_cost : int -> cost

  val alloc_mbytes_cost : int -> cost

  val alloc_bits_cost : int -> cost

  val read_bytes_cost : Z.t -> cost

  val write_bytes_cost : Z.t -> cost

  val ( *@ ) : int -> cost -> cost

  val ( +@ ) : cost -> cost -> cost

  val check_limit : context -> Z.t -> unit tzresult

  val set_limit : context -> Z.t -> context

  val set_unlimited : context -> context

  val consume : context -> cost -> context tzresult

  val check_enough : context -> cost -> unit tzresult

  val level : context -> t

  val consumed : since:context -> until:context -> Z.t

  val block_level : context -> Z.t
end

module Script_int = Script_int_repr

module Script_timestamp : sig
  open Script_int

  type t

  val compare : t -> t -> int

  val to_string : t -> string

  val to_notation : t -> string option

  val to_num_str : t -> string

  val of_string : string -> t option

  val diff : t -> t -> num

  val add_delta : t -> num -> t

  val sub_delta : t -> num -> t

  val now : context -> t

  val to_zint : t -> Z.t

  val of_zint : Z.t -> t
end

module Script : sig
  type prim = Michelson_v1_primitives.prim =
    | K_parameter
    | K_storage
    | K_code
    | D_False
    | D_Elt
    | D_Left
    | D_None
    | D_Pair
    | D_Right
    | D_Some
    | D_True
    | D_Unit
    | I_PACK
    | I_UNPACK
    | I_BLAKE2B
    | I_SHA256
    | I_SHA512
    | I_ABS
    | I_ADD
    | I_AMOUNT
    | I_AND
    | I_BALANCE
    | I_CAR
    | I_CDR
    | I_CHAIN_ID
    | I_CHECK_SIGNATURE
    | I_COMPARE
    | I_CONCAT
    | I_CONS
    | I_CREATE_ACCOUNT
    | I_CREATE_CONTRACT
    | I_IMPLICIT_ACCOUNT
    | I_DIP
    | I_DROP
    | I_DUP
    | I_EDIV
    | I_EMPTY_BIG_MAP
    | I_EMPTY_MAP
    | I_EMPTY_SET
    | I_EQ
    | I_EXEC
    | I_APPLY
    | I_FAILWITH
    | I_GE
    | I_GET
    | I_GT
    | I_HASH_KEY
    | I_IF
    | I_IF_CONS
    | I_IF_LEFT
    | I_IF_NONE
    | I_INT
    | I_LAMBDA
    | I_LE
    | I_LEFT
    | I_LOOP
    | I_LSL
    | I_LSR
    | I_LT
    | I_MAP
    | I_MEM
    | I_MUL
    | I_NEG
    | I_NEQ
    | I_NIL
    | I_NONE
    | I_NOT
    | I_NOW
    | I_OR
    | I_PAIR
    | I_PUSH
    | I_RIGHT
    | I_SIZE
    | I_SOME
    | I_SOURCE
    | I_SENDER
    | I_SELF
    | I_SLICE
    | I_STEPS_TO_QUOTA
    | I_SUB
    | I_SWAP
    | I_TRANSFER_TOKENS
    | I_SET_DELEGATE
    | I_UNIT
    | I_UPDATE
    | I_XOR
    | I_ITER
    | I_LOOP_LEFT
    | I_ADDRESS
    | I_CONTRACT
    | I_ISNAT
    | I_CAST
    | I_RENAME
    | I_DIG
    | I_DUG
    | T_bool
    | T_contract
    | T_int
    | T_key
    | T_key_hash
    | T_lambda
    | T_list
    | T_map
    | T_big_map
    | T_nat
    | T_option
    | T_or
    | T_pair
    | T_set
    | T_signature
    | T_string
    | T_bytes
    | T_mutez
    | T_timestamp
    | T_unit
    | T_operation
    | T_address
    | T_chain_id

  type location = Micheline.canonical_location

  type annot = Micheline.annot

  type expr = prim Micheline.canonical

  type lazy_expr = expr Data_encoding.lazy_t

  val lazy_expr : expr -> lazy_expr

  type node = (location, prim) Micheline.node

  type t = {code : lazy_expr; storage : lazy_expr}

  val location_encoding : location Data_encoding.t

  val expr_encoding : expr Data_encoding.t

  val prim_encoding : prim Data_encoding.t

  val encoding : t Data_encoding.t

  val lazy_expr_encoding : lazy_expr Data_encoding.t

  val deserialized_cost : expr -> Gas.cost

  val serialized_cost : MBytes.t -> Gas.cost

  val traversal_cost : node -> Gas.cost

  val node_cost : node -> Gas.cost

  val int_node_cost : Z.t -> Gas.cost

  val int_node_cost_of_numbits : int -> Gas.cost

  val string_node_cost : string -> Gas.cost

  val string_node_cost_of_length : int -> Gas.cost

  val bytes_node_cost : MBytes.t -> Gas.cost

  val bytes_node_cost_of_length : int -> Gas.cost

  val prim_node_cost_nonrec : expr list -> annot -> Gas.cost

  val prim_node_cost_nonrec_of_length : int -> annot -> Gas.cost

  val seq_node_cost_nonrec : expr list -> Gas.cost

  val seq_node_cost_nonrec_of_length : int -> Gas.cost

  val minimal_deserialize_cost : lazy_expr -> Gas.cost

  val force_decode_in_context :
    context -> lazy_expr -> (expr * context) tzresult Lwt.t

  val force_bytes_in_context :
    context -> lazy_expr -> (MBytes.t * context) tzresult Lwt.t

  val unit_parameter : lazy_expr

  module Legacy_support : sig
    val manager_script_code : lazy_expr

    val add_do :
      manager_pkh:Signature.Public_key_hash.t ->
      script_code:lazy_expr ->
      script_storage:lazy_expr ->
      (lazy_expr * lazy_expr) tzresult Lwt.t

    val add_set_delegate :
      manager_pkh:Signature.Public_key_hash.t ->
      script_code:lazy_expr ->
      script_storage:lazy_expr ->
      (lazy_expr * lazy_expr) tzresult Lwt.t

    val has_default_entrypoint : lazy_expr -> bool

    val add_root_entrypoint : script_code:lazy_expr -> lazy_expr tzresult Lwt.t
  end
end

module Constants : sig
  (** Fixed constants *)
  type fixed = {
    proof_of_work_nonce_size : int;
    nonce_length : int;
    max_revelations_per_block : int;
    max_operation_data_length : int;
    max_proposals_per_delegate : int;
  }

  val fixed_encoding : fixed Data_encoding.t

  val fixed : fixed

  val proof_of_work_nonce_size : int

  val nonce_length : int

  val max_revelations_per_block : int

  val max_operation_data_length : int

  val max_proposals_per_delegate : int

  (** Constants parameterized by context *)
  type parametric = {
    preserved_cycles : int;
    blocks_per_cycle : int32;
    blocks_per_commitment : int32;
    blocks_per_roll_snapshot : int32;
    blocks_per_voting_period : int32;
    time_between_blocks : Period.t list;
    endorsers_per_block : int;
    hard_gas_limit_per_operation : Z.t;
    hard_gas_limit_per_block : Z.t;
    proof_of_work_threshold : int64;
    tokens_per_roll : Tez.t;
    michelson_maximum_type_size : int;
    seed_nonce_revelation_tip : Tez.t;
    origination_size : int;
    block_security_deposit : Tez.t;
    endorsement_security_deposit : Tez.t;
    block_reward : Tez.t;
    endorsement_reward : Tez.t;
    cost_per_byte : Tez.t;
    hard_storage_limit_per_operation : Z.t;
    test_chain_duration : int64;
    quorum_min : int32;
    quorum_max : int32;
    min_proposal_quorum : int32;
    initial_endorsers : int;
    delay_per_missing_endorsement : Period.t;
  }

  val parametric_encoding : parametric Data_encoding.t

  val parametric : context -> parametric

  val preserved_cycles : context -> int

  val blocks_per_cycle : context -> int32

  val blocks_per_commitment : context -> int32

  val blocks_per_roll_snapshot : context -> int32

  val blocks_per_voting_period : context -> int32

  val time_between_blocks : context -> Period.t list

  val endorsers_per_block : context -> int

  val initial_endorsers : context -> int

  val delay_per_missing_endorsement : context -> Period.t

  val hard_gas_limit_per_operation : context -> Z.t

  val hard_gas_limit_per_block : context -> Z.t

  val cost_per_byte : context -> Tez.t

  val hard_storage_limit_per_operation : context -> Z.t

  val proof_of_work_threshold : context -> int64

  val tokens_per_roll : context -> Tez.t

  val michelson_maximum_type_size : context -> int

  val block_reward : context -> Tez.t

  val endorsement_reward : context -> Tez.t

  val seed_nonce_revelation_tip : context -> Tez.t

  val origination_size : context -> int

  val block_security_deposit : context -> Tez.t

  val endorsement_security_deposit : context -> Tez.t

  val test_chain_duration : context -> int64

  val quorum_min : context -> int32

  val quorum_max : context -> int32

  val min_proposal_quorum : context -> int32

  (** All constants: fixed and parametric *)
  type t = {fixed : fixed; parametric : parametric}

  val encoding : t Data_encoding.t
end

module Voting_period : sig
  include BASIC_DATA

  type voting_period = t

  val rpc_arg : voting_period RPC_arg.arg

  val root : voting_period

  val succ : voting_period -> voting_period

  type kind = Proposal | Testing_vote | Testing | Promotion_vote

  val kind_encoding : kind Data_encoding.encoding

  val to_int32 : voting_period -> int32
end

module Level : sig
  type t = private {
    level : Raw_level.t;
    level_position : int32;
    cycle : Cycle.t;
    cycle_position : int32;
    voting_period : Voting_period.t;
    voting_period_position : int32;
    expected_commitment : bool;
  }

  include BASIC_DATA with type t := t

  val pp_full : Format.formatter -> t -> unit

  type level = t

  val root : context -> level

  val succ : context -> level -> level

  val pred : context -> level -> level option

  val from_raw : context -> ?offset:int32 -> Raw_level.t -> level

  val diff : level -> level -> int32

  val current : context -> level

  val last_level_in_cycle : context -> Cycle.t -> level

  val levels_in_cycle : context -> Cycle.t -> level list

  val levels_in_current_cycle : context -> ?offset:int32 -> unit -> level list

  val last_allowed_fork_level : context -> Raw_level.t
end

module Fitness : sig
  include module type of Fitness

  type fitness = t

  val increase : ?gap:int -> context -> context

  val current : context -> int64

  val to_int64 : fitness -> int64 tzresult
end

module Nonce : sig
  type t = Nonce_storage.t

  type nonce = t

  val encoding : nonce Data_encoding.t

  type unrevealed = Storage.unrevealed_nonce

  val record_hash : context -> unrevealed -> context tzresult Lwt.t

  val reveal : context -> Level.t -> nonce -> context tzresult Lwt.t

  type status = Storage.nonce_status

  val get : context -> Level.t -> status tzresult Lwt.t

  val of_bytes : MBytes.t -> nonce tzresult

  val hash : nonce -> Nonce_hash.t

  val check_hash : nonce -> Nonce_hash.t -> bool
end

module Seed : sig
  type seed

  type error +=
    | Unknown of {oldest : Cycle.t; cycle : Cycle.t; latest : Cycle.t}

  val for_cycle : context -> Cycle.t -> seed tzresult Lwt.t

  val cycle_end :
    context -> Cycle.t -> (context * Nonce.unrevealed list) tzresult Lwt.t

  val seed_encoding : seed Data_encoding.t
end

module Big_map : sig
  type id = Z.t

  val fresh : context -> (context * id) tzresult Lwt.t

  val fresh_temporary : context -> context * id

  val mem :
    context -> id -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t

  val get_opt :
    context ->
    id ->
    Script_expr_hash.t ->
    (context * Script.expr option) tzresult Lwt.t

  val rpc_arg : id RPC_arg.t

  val cleanup_temporary : context -> context Lwt.t

  val exists :
    context ->
    id ->
    (context * (Script.expr * Script.expr) option) tzresult Lwt.t
end

module Contract : sig
  include BASIC_DATA

  type contract = t

  val rpc_arg : contract RPC_arg.arg

  val to_b58check : contract -> string

  val of_b58check : string -> contract tzresult

  val implicit_contract : public_key_hash -> contract

  val is_implicit : contract -> public_key_hash option

  val exists : context -> contract -> bool tzresult Lwt.t

  val must_exist : context -> contract -> unit tzresult Lwt.t

  val allocated : context -> contract -> bool tzresult Lwt.t

  val must_be_allocated : context -> contract -> unit tzresult Lwt.t

  val list : context -> contract list Lwt.t

  val get_manager_key : context -> public_key_hash -> public_key tzresult Lwt.t

  val is_manager_key_revealed :
    context -> public_key_hash -> bool tzresult Lwt.t

  val reveal_manager_key :
    context -> public_key_hash -> public_key -> context tzresult Lwt.t

  val get_script_code :
    context -> contract -> (context * Script.lazy_expr option) tzresult Lwt.t

  val get_script :
    context -> contract -> (context * Script.t option) tzresult Lwt.t

  val get_storage :
    context -> contract -> (context * Script.expr option) tzresult Lwt.t

  val get_counter : context -> public_key_hash -> Z.t tzresult Lwt.t

  val get_balance : context -> contract -> Tez.t tzresult Lwt.t

  val init_origination_nonce : context -> Operation_hash.t -> context

  val unset_origination_nonce : context -> context

  val fresh_contract_from_current_nonce :
    context -> (context * t) tzresult Lwt.t

  val originated_from_current_nonce :
    since:context -> until:context -> contract list tzresult Lwt.t

  type big_map_diff_item =
    | Update of {
        big_map : Big_map.id;
        diff_key : Script.expr;
        diff_key_hash : Script_expr_hash.t;
        diff_value : Script.expr option;
      }
    | Clear of Big_map.id
    | Copy of Big_map.id * Big_map.id
    | Alloc of {
        big_map : Big_map.id;
        key_type : Script.expr;
        value_type : Script.expr;
      }

  type big_map_diff = big_map_diff_item list

  val big_map_diff_encoding : big_map_diff Data_encoding.t

  val originate :
    context ->
    contract ->
    balance:Tez.t ->
    script:Script.t * big_map_diff option ->
    delegate:public_key_hash option ->
    context tzresult Lwt.t

  type error += Balance_too_low of contract * Tez.t * Tez.t

  val spend : context -> contract -> Tez.t -> context tzresult Lwt.t

  val credit : context -> contract -> Tez.t -> context tzresult Lwt.t

  val update_script_storage :
    context ->
    contract ->
    Script.expr ->
    big_map_diff option ->
    context tzresult Lwt.t

  val used_storage_space : context -> t -> Z.t tzresult Lwt.t

  val increment_counter : context -> public_key_hash -> context tzresult Lwt.t

  val check_counter_increment :
    context -> public_key_hash -> Z.t -> unit tzresult Lwt.t

  (**/**)

  (* Only for testing *)
  type origination_nonce

  val initial_origination_nonce : Operation_hash.t -> origination_nonce

  val originated_contract : origination_nonce -> contract
end

module Delegate : sig
  type balance =
    | Contract of Contract.t
    | Rewards of Signature.Public_key_hash.t * Cycle.t
    | Fees of Signature.Public_key_hash.t * Cycle.t
    | Deposits of Signature.Public_key_hash.t * Cycle.t

  type balance_update = Debited of Tez.t | Credited of Tez.t

  type balance_updates = (balance * balance_update) list

  val balance_updates_encoding : balance_updates Data_encoding.t

  val cleanup_balance_updates : balance_updates -> balance_updates

  val get : context -> Contract.t -> public_key_hash option tzresult Lwt.t

  val set :
    context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t

  val fold :
    context -> init:'a -> f:(public_key_hash -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  val list : context -> public_key_hash list Lwt.t

  val freeze_deposit :
    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t

  val freeze_rewards :
    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t

  val freeze_fees :
    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t

  val cycle_end :
    context ->
    Cycle.t ->
    Nonce.unrevealed list ->
    (context * balance_updates * Signature.Public_key_hash.t list) tzresult
    Lwt.t

  type frozen_balance = {deposit : Tez.t; fees : Tez.t; rewards : Tez.t}

  val punish :
    context ->
    public_key_hash ->
    Cycle.t ->
    (context * frozen_balance) tzresult Lwt.t

  val full_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t

  val has_frozen_balance :
    context -> public_key_hash -> Cycle.t -> bool tzresult Lwt.t

  val frozen_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t

  val frozen_balance_encoding : frozen_balance Data_encoding.t

  val frozen_balance_by_cycle_encoding :
    frozen_balance Cycle.Map.t Data_encoding.t

  val frozen_balance_by_cycle :
    context -> Signature.Public_key_hash.t -> frozen_balance Cycle.Map.t Lwt.t

  val staking_balance :
    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t

  val delegated_contracts :
    context -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t

  val delegated_balance :
    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t

  val deactivated :
    context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

  val grace_period :
    context -> Signature.Public_key_hash.t -> Cycle.t tzresult Lwt.t
end

module Vote : sig
  type proposal = Protocol_hash.t

  val record_proposal :
    context -> Protocol_hash.t -> public_key_hash -> context tzresult Lwt.t

  val get_proposals : context -> int32 Protocol_hash.Map.t tzresult Lwt.t

  val clear_proposals : context -> context Lwt.t

  val recorded_proposal_count_for_delegate :
    context -> public_key_hash -> int tzresult Lwt.t

  val listings_encoding :
    (Signature.Public_key_hash.t * int32) list Data_encoding.t

  val freeze_listings : context -> context tzresult Lwt.t

  val clear_listings : context -> context tzresult Lwt.t

  val listing_size : context -> int32 tzresult Lwt.t

  val in_listings : context -> public_key_hash -> bool Lwt.t

  val get_listings : context -> (public_key_hash * int32) list Lwt.t

  type ballot = Yay | Nay | Pass

  val ballot_encoding : ballot Data_encoding.t

  type ballots = {yay : int32; nay : int32; pass : int32}

  val ballots_encoding : ballots Data_encoding.t

  val has_recorded_ballot : context -> public_key_hash -> bool Lwt.t

  val record_ballot :
    context -> public_key_hash -> ballot -> context tzresult Lwt.t

  val get_ballots : context -> ballots tzresult Lwt.t

  val get_ballot_list :
    context -> (Signature.Public_key_hash.t * ballot) list Lwt.t

  val clear_ballots : context -> context Lwt.t

  val get_current_period_kind : context -> Voting_period.kind tzresult Lwt.t

  val set_current_period_kind :
    context -> Voting_period.kind -> context tzresult Lwt.t

  val get_current_quorum : context -> int32 tzresult Lwt.t

  val get_participation_ema : context -> int32 tzresult Lwt.t

  val set_participation_ema : context -> int32 -> context tzresult Lwt.t

  val get_current_proposal : context -> proposal tzresult Lwt.t

  val init_current_proposal : context -> proposal -> context tzresult Lwt.t

  val clear_current_proposal : context -> context tzresult Lwt.t
end

module Block_header : sig
  type contents = Block_header_repr.contents = {
    priority : int;
    seed_nonce_hash : Nonce_hash.t option;
    proof_of_work_nonce : MBytes.t;
  }

  type protocol_data = Block_header_repr.protocol_data = {
    contents : contents;
    signature : Signature.t;
  }

  type block_header = Block_header_repr.block_header = {
    shell : Block_header.shell_header;
    protocol_data : protocol_data;
  }

  type raw = Block_header.t

  type shell_header = Block_header.shell_header

  val raw : block_header -> raw

  val hash : block_header -> Block_hash.t

  val hash_raw : raw -> Block_hash.t

  val encoding : block_header Data_encoding.encoding

  val raw_encoding : raw Data_encoding.t

  val contents_encoding : contents Data_encoding.t

  val unsigned_encoding : (shell_header * contents) Data_encoding.t

  val protocol_data_encoding : protocol_data Data_encoding.encoding

  val shell_header_encoding : shell_header Data_encoding.encoding

  (** The maximum size of block headers in bytes *)
  val max_header_length : int
end

module Kind : sig
  type seed_nonce_revelation = Seed_nonce_revelation_kind

  type double_endorsement_evidence = Double_endorsement_evidence_kind

  type double_baking_evidence = Double_baking_evidence_kind

  type activate_account = Activate_account_kind

  type endorsement = Endorsement_kind

  type proposals = Proposals_kind

  type ballot = Ballot_kind

  type reveal = Reveal_kind

  type transaction = Transaction_kind

  type origination = Origination_kind

  type delegation = Delegation_kind

  type 'a manager =
    | Reveal_manager_kind : reveal manager
    | Transaction_manager_kind : transaction manager
    | Origination_manager_kind : origination manager
    | Delegation_manager_kind : delegation manager
end

type _ contents_list =
  | Single : 'kind contents -> 'kind contents_list
  | Cons :
      'kind Kind.manager contents * 'rest Kind.manager contents_list
      -> ('kind * 'rest) Kind.manager contents_list

and 'kind protocol_data = {
  contents : 'kind contents_list;
  signature : Signature.t option;
}

and 'kind operation = {
  shell : Operation.shell_header;
  protocol_data : 'kind protocol_data;
}

and _ contents =
  | Endorsement : {level : Raw_level.t} -> Kind.endorsement contents
  | Seed_nonce_revelation : {
      level : Raw_level.t;
      nonce : Nonce.t;
    }
      -> Kind.seed_nonce_revelation contents
  | Double_endorsement_evidence : {
      op1 : Kind.endorsement operation;
      op2 : Kind.endorsement operation;
    }
      -> Kind.double_endorsement_evidence contents
  | Double_baking_evidence : {
      bh1 : Block_header.block_header;
      bh2 : Block_header.block_header;
    }
      -> Kind.double_baking_evidence contents
  | Activate_account : {
      id : Ed25519.Public_key_hash.t;
      activation_code : Blinded_public_key_hash.activation_code;
    }
      -> Kind.activate_account contents
  | Proposals : {
      source : Signature.Public_key_hash.t;
      period : Voting_period.t;
      proposals : Protocol_hash.t list;
    }
      -> Kind.proposals contents
  | Ballot : {
      source : Signature.Public_key_hash.t;
      period : Voting_period.t;
      proposal : Protocol_hash.t;
      ballot : Vote.ballot;
    }
      -> Kind.ballot contents
  | Manager_operation : {
      source : Signature.Public_key_hash.t;
      fee : Tez.tez;
      counter : counter;
      operation : 'kind manager_operation;
      gas_limit : Z.t;
      storage_limit : Z.t;
    }
      -> 'kind Kind.manager contents

and _ manager_operation =
  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
  | Transaction : {
      amount : Tez.tez;
      parameters : Script.lazy_expr;
      entrypoint : string;
      destination : Contract.contract;
    }
      -> Kind.transaction manager_operation
  | Origination : {
      delegate : Signature.Public_key_hash.t option;
      script : Script.t;
      credit : Tez.tez;
      preorigination : Contract.t option;
    }
      -> Kind.origination manager_operation
  | Delegation :
      Signature.Public_key_hash.t option
      -> Kind.delegation manager_operation

and counter = Z.t

type 'kind internal_operation = {
  source : Contract.contract;
  operation : 'kind manager_operation;
  nonce : int;
}

type packed_manager_operation =
  | Manager : 'kind manager_operation -> packed_manager_operation

type packed_contents = Contents : 'kind contents -> packed_contents

type packed_contents_list =
  | Contents_list : 'kind contents_list -> packed_contents_list

type packed_protocol_data =
  | Operation_data : 'kind protocol_data -> packed_protocol_data

type packed_operation = {
  shell : Operation.shell_header;
  protocol_data : packed_protocol_data;
}

type packed_internal_operation =
  | Internal_operation : 'kind internal_operation -> packed_internal_operation

val manager_kind : 'kind manager_operation -> 'kind Kind.manager

module Fees : sig
  val origination_burn : context -> (context * Tez.t) tzresult Lwt.t

  val record_paid_storage_space :
    context -> Contract.t -> (context * Z.t * Z.t * Tez.t) tzresult Lwt.t

  val start_counting_storage_fees : context -> context

  val burn_storage_fees :
    context -> storage_limit:Z.t -> payer:Contract.t -> context tzresult Lwt.t

  type error += Cannot_pay_storage_fee (* `Temporary *)

  type error += Operation_quota_exceeded (* `Temporary *)

  type error += Storage_limit_too_high (* `Permanent *)

  val check_storage_limit : context -> storage_limit:Z.t -> unit tzresult
end

module Operation : sig
  type nonrec 'kind contents = 'kind contents

  type nonrec packed_contents = packed_contents

  val contents_encoding : packed_contents Data_encoding.t

  type nonrec 'kind protocol_data = 'kind protocol_data

  type nonrec packed_protocol_data = packed_protocol_data

  val protocol_data_encoding : packed_protocol_data Data_encoding.t

  val unsigned_encoding :
    (Operation.shell_header * packed_contents_list) Data_encoding.t

  type raw = Operation.t

  val raw_encoding : raw Data_encoding.t

  val contents_list_encoding : packed_contents_list Data_encoding.t

  type 'kind t = 'kind operation = {
    shell : Operation.shell_header;
    protocol_data : 'kind protocol_data;
  }

  type nonrec packed = packed_operation

  val encoding : packed Data_encoding.t

  val raw : _ operation -> raw

  val hash : _ operation -> Operation_hash.t

  val hash_raw : raw -> Operation_hash.t

  val hash_packed : packed_operation -> Operation_hash.t

  val acceptable_passes : packed_operation -> int list

  type error += Missing_signature (* `Permanent *)

  type error += Invalid_signature (* `Permanent *)

  val check_signature :
    public_key -> Chain_id.t -> _ operation -> unit tzresult Lwt.t

  val check_signature_sync :
    public_key -> Chain_id.t -> _ operation -> unit tzresult

  val internal_operation_encoding : packed_internal_operation Data_encoding.t

  val pack : 'kind operation -> packed_operation

  type ('a, 'b) eq = Eq : ('a, 'a) eq

  val equal : 'a operation -> 'b operation -> ('a, 'b) eq option

  module Encoding : sig
    type 'b case =
      | Case : {
          tag : int;
          name : string;
          encoding : 'a Data_encoding.t;
          select : packed_contents -> 'b contents option;
          proj : 'b contents -> 'a;
          inj : 'a -> 'b contents;
        }
          -> 'b case
    [@@coq_force_gadt]

    val endorsement_case : Kind.endorsement case

    val seed_nonce_revelation_case : Kind.seed_nonce_revelation case

    val double_endorsement_evidence_case :
      Kind.double_endorsement_evidence case

    val double_baking_evidence_case : Kind.double_baking_evidence case

    val activate_account_case : Kind.activate_account case

    val proposals_case : Kind.proposals case

    val ballot_case : Kind.ballot case

    val reveal_case : Kind.reveal Kind.manager case

    val transaction_case : Kind.transaction Kind.manager case

    val origination_case : Kind.origination Kind.manager case

    val delegation_case : Kind.delegation Kind.manager case

    module Manager_operations : sig
      type 'kind case =
        | MCase : {
            tag : int;
            name : string;
            encoding : 'a Data_encoding.t;
            select :
              packed_manager_operation -> 'kind manager_operation option;
            proj : 'kind manager_operation -> 'a;
            inj : 'a -> 'kind manager_operation;
          }
            -> 'kind case
      [@@coq_force_gadt]

      val reveal_case : Kind.reveal case

      val transaction_case : Kind.transaction case

      val origination_case : Kind.origination case

      val delegation_case : Kind.delegation case
    end
  end

  val of_list : packed_contents list -> packed_contents_list

  val to_list : packed_contents_list -> packed_contents list
end

module Roll : sig
  type t = private int32

  type roll = t

  val encoding : roll Data_encoding.t

  val snapshot_rolls : context -> context tzresult Lwt.t

  val cycle_end : context -> Cycle.t -> context tzresult Lwt.t

  val baking_rights_owner :
    context -> Level.t -> priority:int -> public_key tzresult Lwt.t

  val endorsement_rights_owner :
    context -> Level.t -> slot:int -> public_key tzresult Lwt.t

  val delegate_pubkey : context -> public_key_hash -> public_key tzresult Lwt.t

  val get_rolls :
    context -> Signature.Public_key_hash.t -> roll list tzresult Lwt.t

  val get_change :
    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t
end

module Commitment : sig
  type t = {
    blinded_public_key_hash : Blinded_public_key_hash.t;
    amount : Tez.tez;
  }

  val get_opt :
    context -> Blinded_public_key_hash.t -> Tez.t option tzresult Lwt.t

  val delete : context -> Blinded_public_key_hash.t -> context tzresult Lwt.t
end

module Bootstrap : sig
  val cycle_end : context -> Cycle.t -> context tzresult Lwt.t
end

module Global : sig
  val get_block_priority : context -> int tzresult Lwt.t

  val set_block_priority : context -> int -> context tzresult Lwt.t
end

val prepare_first_block :
  Context.t ->
  typecheck:(context ->
            Script.t ->
            ((Script.t * Contract.big_map_diff option) * context) tzresult
            Lwt.t) ->
  level:Int32.t ->
  timestamp:Time.t ->
  fitness:Fitness.t ->
  context tzresult Lwt.t

val prepare :
  Context.t ->
  level:Int32.t ->
  predecessor_timestamp:Time.t ->
  timestamp:Time.t ->
  fitness:Fitness.t ->
  context tzresult Lwt.t

val finalize : ?commit_message:string -> context -> Updater.validation_result

val activate : context -> Protocol_hash.t -> context Lwt.t

val fork_test_chain : context -> Protocol_hash.t -> Time.t -> context Lwt.t

val record_endorsement : context -> Signature.Public_key_hash.t -> context

val allowed_endorsements :
  context ->
  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t

val init_endorsements :
  context ->
  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->
  context

val included_endorsements : context -> int

val reset_internal_nonce : context -> context

val fresh_internal_nonce : context -> (context * int) tzresult

val record_internal_nonce : context -> int -> context

val internal_nonce_already_recorded : context -> int -> bool

val add_fees : context -> Tez.t -> context tzresult Lwt.t

val add_rewards : context -> Tez.t -> context tzresult Lwt.t

val add_deposit :
  context -> Signature.Public_key_hash.t -> Tez.t -> context tzresult Lwt.t

val get_fees : context -> Tez.t

val get_rewards : context -> Tez.t

val get_deposits : context -> Tez.t Signature.Public_key_hash.Map.t

val description : context Storage_description.t
Alpha_context_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Blinded_public_key_hash.
Require Tezos.Block_header_repr.
Require Tezos.Contract_repr.
Require Tezos.Michelson_v1_primitives.
Require Tezos.Nonce_hash.
Require Tezos.Nonce_storage.
Require Tezos.Script_expr_hash.
Require Tezos.Script_int_repr.
Require Tezos.Storage_mli. Module Storage := Storage_mli.
Require Tezos.Storage_description.
Require Tezos.Tez_repr.

Module BASIC_DATA.
  Record signature {t : Set} : Set := {
    t := t;
    op_eq : t -> t -> bool;
    op_ltgt : t -> t -> bool;
    op_lt : t -> t -> bool;
    op_lteq : t -> t -> bool;
    op_gteq : t -> t -> bool;
    op_gt : t -> t -> bool;
    compare : t -> t -> int;
    equal : t -> t -> bool;
    max : t -> t -> t;
    min : t -> t -> t;
    encoding : Data_encoding.t t;
    pp : Format.formatter -> t -> unit;
  }.
End BASIC_DATA.

Parameter t : Set.

Definition context : Set := t.

Definition public_key : Set := (|Signature.Public_key|).(S.SPublic_key.t).

Definition public_key_hash : Set :=
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t).

Definition signature : Set := Signature.t.

Module Tez.
  Parameter Included_BASIC_DATA :
    {_ : unit & BASIC_DATA.signature (t := Tez_repr.t)}.
  
  Definition t := (|Included_BASIC_DATA|).(BASIC_DATA.t).
  
  Definition op_eq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_eq).
  
  Definition op_ltgt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_ltgt).
  
  Definition op_lt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lt).
  
  Definition op_lteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lteq).
  
  Definition op_gteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gteq).
  
  Definition op_gt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gt).
  
  Definition compare : t -> t -> int :=
    (|Included_BASIC_DATA|).(BASIC_DATA.compare).
  
  Definition equal : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.equal).
  
  Definition max : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.max).
  
  Definition min : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.min).
  
  Definition encoding : Data_encoding.t t :=
    (|Included_BASIC_DATA|).(BASIC_DATA.encoding).
  
  Definition pp : Format.formatter -> t -> unit :=
    (|Included_BASIC_DATA|).(BASIC_DATA.pp).
  
  Definition tez : Set := t.
  
  Parameter zero : tez.
  
  Parameter one_mutez : tez.
  
  Parameter one_cent : tez.
  
  Parameter fifty_cents : tez.
  
  Parameter one : tez.
  
  Parameter op_minusquestion : tez -> tez -> Error_monad.tzresult tez.
  
  Parameter op_plusquestion : tez -> tez -> Error_monad.tzresult tez.
  
  Parameter op_starquestion : tez -> int64 -> Error_monad.tzresult tez.
  
  Parameter op_divquestion : tez -> int64 -> Error_monad.tzresult tez.
  
  Parameter of_string : string -> option tez.
  
  Parameter to_string : tez -> string.
  
  Parameter of_mutez : int64 -> option tez.
  
  Parameter to_mutez : tez -> int64.
End Tez.

Module Period.
  Parameter Included_BASIC_DATA : {t : Set & BASIC_DATA.signature (t := t)}.
  
  Definition t := (|Included_BASIC_DATA|).(BASIC_DATA.t).
  
  Definition op_eq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_eq).
  
  Definition op_ltgt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_ltgt).
  
  Definition op_lt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lt).
  
  Definition op_lteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lteq).
  
  Definition op_gteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gteq).
  
  Definition op_gt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gt).
  
  Definition compare : t -> t -> int :=
    (|Included_BASIC_DATA|).(BASIC_DATA.compare).
  
  Definition equal : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.equal).
  
  Definition max : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.max).
  
  Definition min : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.min).
  
  Definition encoding : Data_encoding.t t :=
    (|Included_BASIC_DATA|).(BASIC_DATA.encoding).
  
  Definition pp : Format.formatter -> t -> unit :=
    (|Included_BASIC_DATA|).(BASIC_DATA.pp).
  
  Definition period : Set := t.
  
  Parameter rpc_arg : RPC_arg.arg period.
  
  Parameter of_seconds : int64 -> Error_monad.tzresult period.
  
  Parameter to_seconds : period -> int64.
  
  Parameter mult : int32 -> period -> Error_monad.tzresult period.
  
  Parameter zero : period.
  
  Parameter one_second : period.
  
  Parameter one_minute : period.
  
  Parameter one_hour : period.
End Period.

Module Timestamp.
  Parameter Included_BASIC_DATA :
    {_ : unit & BASIC_DATA.signature (t := Time.t)}.
  
  Definition t := (|Included_BASIC_DATA|).(BASIC_DATA.t).
  
  Definition op_eq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_eq).
  
  Definition op_ltgt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_ltgt).
  
  Definition op_lt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lt).
  
  Definition op_lteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lteq).
  
  Definition op_gteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gteq).
  
  Definition op_gt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gt).
  
  Definition compare : t -> t -> int :=
    (|Included_BASIC_DATA|).(BASIC_DATA.compare).
  
  Definition equal : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.equal).
  
  Definition max : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.max).
  
  Definition min : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.min).
  
  Definition encoding : Data_encoding.t t :=
    (|Included_BASIC_DATA|).(BASIC_DATA.encoding).
  
  Definition pp : Format.formatter -> t -> unit :=
    (|Included_BASIC_DATA|).(BASIC_DATA.pp).
  
  Definition time : Set := t.
  
  Parameter op_plusquestion : time -> Period.t -> Error_monad.tzresult time.
  
  Parameter op_minusquestion : time -> time -> Error_monad.tzresult Period.t.
  
  Parameter of_notation : string -> option time.
  
  Parameter to_notation : time -> string.
  
  Parameter of_seconds_string : string -> option time.
  
  Parameter to_seconds_string : time -> string.
  
  Parameter current : context -> time.
End Timestamp.

Module Raw_level.
  Parameter Included_BASIC_DATA : {t : Set & BASIC_DATA.signature (t := t)}.
  
  Definition t := (|Included_BASIC_DATA|).(BASIC_DATA.t).
  
  Definition op_eq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_eq).
  
  Definition op_ltgt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_ltgt).
  
  Definition op_lt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lt).
  
  Definition op_lteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lteq).
  
  Definition op_gteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gteq).
  
  Definition op_gt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gt).
  
  Definition compare : t -> t -> int :=
    (|Included_BASIC_DATA|).(BASIC_DATA.compare).
  
  Definition equal : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.equal).
  
  Definition max : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.max).
  
  Definition min : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.min).
  
  Definition encoding : Data_encoding.t t :=
    (|Included_BASIC_DATA|).(BASIC_DATA.encoding).
  
  Definition pp : Format.formatter -> t -> unit :=
    (|Included_BASIC_DATA|).(BASIC_DATA.pp).
  
  Definition raw_level : Set := t.
  
  Parameter rpc_arg : RPC_arg.arg raw_level.
  
  Parameter diff : raw_level -> raw_level -> int32.
  
  Parameter root : raw_level.
  
  Parameter succ : raw_level -> raw_level.
  
  Parameter pred : raw_level -> option raw_level.
  
  Parameter to_int32 : raw_level -> int32.
  
  Parameter of_int32 : int32 -> Error_monad.tzresult raw_level.
End Raw_level.

Module Cycle.
  Parameter Included_BASIC_DATA : {t : Set & BASIC_DATA.signature (t := t)}.
  
  Definition t := (|Included_BASIC_DATA|).(BASIC_DATA.t).
  
  Definition op_eq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_eq).
  
  Definition op_ltgt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_ltgt).
  
  Definition op_lt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lt).
  
  Definition op_lteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lteq).
  
  Definition op_gteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gteq).
  
  Definition op_gt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gt).
  
  Definition compare : t -> t -> int :=
    (|Included_BASIC_DATA|).(BASIC_DATA.compare).
  
  Definition equal : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.equal).
  
  Definition max : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.max).
  
  Definition min : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.min).
  
  Definition encoding : Data_encoding.t t :=
    (|Included_BASIC_DATA|).(BASIC_DATA.encoding).
  
  Definition pp : Format.formatter -> t -> unit :=
    (|Included_BASIC_DATA|).(BASIC_DATA.pp).
  
  Definition cycle : Set := t.
  
  Parameter rpc_arg : RPC_arg.arg cycle.
  
  Parameter root : cycle.
  
  Parameter succ : cycle -> cycle.
  
  Parameter pred : cycle -> option cycle.
  
  Parameter add : cycle -> int -> cycle.
  
  Parameter sub : cycle -> int -> option cycle.
  
  Parameter to_int32 : cycle -> int32.
  
  Parameter Map : {t : Set -> Set & S.MAP.signature (key := cycle) (t := t)}.
End Cycle.

Module Gas.
  Module ConstructorRecords_t.
    Module t.
      Module Limited.
        Record record {remaining : Set} : Set := Build {
          remaining : remaining }.
        Arguments record : clear implicits.
        Definition with_remaining {t_remaining} remaining
          (r : record t_remaining) :=
          Build t_remaining remaining.
      End Limited.
      Definition Limited_skeleton := Limited.record.
    End t.
  End ConstructorRecords_t.
  Import ConstructorRecords_t.
  
  Reserved Notation "'t.Limited".
  
  Inductive t : Set :=
  | Unaccounted : t
  | Limited : 't.Limited -> t
  
  where "'t.Limited" := (t.Limited_skeleton Z.t).
  
  Module t.
    Include ConstructorRecords_t.t.
    Definition Limited := 't.Limited.
  End t.
  
  Parameter encoding : Data_encoding.encoding t.
  
  Parameter pp : Format.formatter -> t -> unit.
  
  Parameter cost : Set.
  
  Parameter cost_encoding : Data_encoding.encoding cost.
  
  Parameter pp_cost : Format.formatter -> cost -> unit.
  
  (* extensible_type_definition `error` *)
  
  (* extensible_type_definition `error` *)
  
  (* extensible_type_definition `error` *)
  
  Parameter free : cost.
  
  Parameter atomic_step_cost : int -> cost.
  
  Parameter step_cost : int -> cost.
  
  Parameter alloc_cost : int -> cost.
  
  Parameter alloc_bytes_cost : int -> cost.
  
  Parameter alloc_mbytes_cost : int -> cost.
  
  Parameter alloc_bits_cost : int -> cost.
  
  Parameter read_bytes_cost : Z.t -> cost.
  
  Parameter write_bytes_cost : Z.t -> cost.
  
  Parameter op_starat : int -> cost -> cost.
  
  Parameter op_plusat : cost -> cost -> cost.
  
  Parameter check_limit : context -> Z.t -> Error_monad.tzresult unit.
  
  Parameter set_limit : context -> Z.t -> context.
  
  Parameter set_unlimited : context -> context.
  
  Parameter consume : context -> cost -> Error_monad.tzresult context.
  
  Parameter check_enough : context -> cost -> Error_monad.tzresult unit.
  
  Parameter level : context -> t.
  
  Parameter consumed : context -> context -> Z.t.
  
  Parameter block_level : context -> Z.t.
End Gas.

Module Script_int := Script_int_repr.

Module Script_timestamp.
  Import Script_int.
  
  Parameter t : Set.
  
  Parameter compare : t -> t -> int.
  
  Parameter to_string : t -> string.
  
  Parameter to_notation : t -> option string.
  
  Parameter to_num_str : t -> string.
  
  Parameter of_string : string -> option t.
  
  Parameter diff : t -> t -> Script_int.num.
  
  Parameter add_delta : t -> Script_int.num -> t.
  
  Parameter sub_delta : t -> Script_int.num -> t.
  
  Parameter now : context -> t.
  
  Parameter to_zint : t -> Z.t.
  
  Parameter of_zint : Z.t -> t.
End Script_timestamp.

Module Script.
  Definition prim : Set := Michelson_v1_primitives.prim.
  
  Definition location : Set := Micheline.canonical_location.
  
  Definition annot : Set := Micheline.annot.
  
  Definition expr : Set := Micheline.canonical prim.
  
  Definition lazy_expr : Set := Data_encoding.lazy_t expr.
  
  Parameter __lazy_expr_value : expr -> lazy_expr.
  
  Definition node : Set := Micheline.node location prim.
  
  Module t.
    Record record : Set := Build {
      code : lazy_expr;
      storage : lazy_expr }.
    Definition with_code code (r : record) :=
      Build code r.(storage).
    Definition with_storage storage (r : record) :=
      Build r.(code) storage.
  End t.
  Definition t := t.record.
  
  Parameter location_encoding : Data_encoding.t location.
  
  Parameter expr_encoding : Data_encoding.t expr.
  
  Parameter prim_encoding : Data_encoding.t prim.
  
  Parameter encoding : Data_encoding.t t.
  
  Parameter lazy_expr_encoding : Data_encoding.t lazy_expr.
  
  Parameter deserialized_cost : expr -> Gas.cost.
  
  Parameter serialized_cost : MBytes.t -> Gas.cost.
  
  Parameter traversal_cost : node -> Gas.cost.
  
  Parameter node_cost : node -> Gas.cost.
  
  Parameter int_node_cost : Z.t -> Gas.cost.
  
  Parameter int_node_cost_of_numbits : int -> Gas.cost.
  
  Parameter string_node_cost : string -> Gas.cost.
  
  Parameter string_node_cost_of_length : int -> Gas.cost.
  
  Parameter bytes_node_cost : MBytes.t -> Gas.cost.
  
  Parameter bytes_node_cost_of_length : int -> Gas.cost.
  
  Parameter prim_node_cost_nonrec : list expr -> annot -> Gas.cost.
  
  Parameter prim_node_cost_nonrec_of_length : int -> annot -> Gas.cost.
  
  Parameter seq_node_cost_nonrec : list expr -> Gas.cost.
  
  Parameter seq_node_cost_nonrec_of_length : int -> Gas.cost.
  
  Parameter minimal_deserialize_cost : lazy_expr -> Gas.cost.
  
  Parameter force_decode_in_context :
    context -> lazy_expr -> Lwt.t (Error_monad.tzresult (expr * context)).
  
  Parameter force_bytes_in_context :
    context -> lazy_expr -> Lwt.t (Error_monad.tzresult (MBytes.t * context)).
  
  Parameter unit_parameter : lazy_expr.
  
  Module Legacy_support.
    Parameter manager_script_code : lazy_expr.
    
    Parameter add_do :
      (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> lazy_expr ->
      lazy_expr -> Lwt.t (Error_monad.tzresult (lazy_expr * lazy_expr)).
    
    Parameter add_set_delegate :
      (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> lazy_expr ->
      lazy_expr -> Lwt.t (Error_monad.tzresult (lazy_expr * lazy_expr)).
    
    Parameter has_default_entrypoint : lazy_expr -> bool.
    
    Parameter add_root_entrypoint :
      lazy_expr -> Lwt.t (Error_monad.tzresult lazy_expr).
  End Legacy_support.
End Script.

Module Constants.
  Module fixed.
    Record record : Set := Build {
      proof_of_work_nonce_size : int;
      nonce_length : int;
      max_revelations_per_block : int;
      max_operation_data_length : int;
      max_proposals_per_delegate : int }.
    Definition with_proof_of_work_nonce_size proof_of_work_nonce_size
      (r : record) :=
      Build proof_of_work_nonce_size r.(nonce_length)
        r.(max_revelations_per_block) r.(max_operation_data_length)
        r.(max_proposals_per_delegate).
    Definition with_nonce_length nonce_length (r : record) :=
      Build r.(proof_of_work_nonce_size) nonce_length
        r.(max_revelations_per_block) r.(max_operation_data_length)
        r.(max_proposals_per_delegate).
    Definition with_max_revelations_per_block max_revelations_per_block
      (r : record) :=
      Build r.(proof_of_work_nonce_size) r.(nonce_length)
        max_revelations_per_block r.(max_operation_data_length)
        r.(max_proposals_per_delegate).
    Definition with_max_operation_data_length max_operation_data_length
      (r : record) :=
      Build r.(proof_of_work_nonce_size) r.(nonce_length)
        r.(max_revelations_per_block) max_operation_data_length
        r.(max_proposals_per_delegate).
    Definition with_max_proposals_per_delegate max_proposals_per_delegate
      (r : record) :=
      Build r.(proof_of_work_nonce_size) r.(nonce_length)
        r.(max_revelations_per_block) r.(max_operation_data_length)
        max_proposals_per_delegate.
  End fixed.
  Definition fixed := fixed.record.
  
  Parameter fixed_encoding : Data_encoding.t fixed.
  
  Parameter __fixed_value : fixed.
  
  Parameter proof_of_work_nonce_size : int.
  
  Parameter nonce_length : int.
  
  Parameter max_revelations_per_block : int.
  
  Parameter max_operation_data_length : int.
  
  Parameter max_proposals_per_delegate : int.
  
  Module parametric.
    Record record : Set := Build {
      preserved_cycles : int;
      blocks_per_cycle : int32;
      blocks_per_commitment : int32;
      blocks_per_roll_snapshot : int32;
      blocks_per_voting_period : int32;
      time_between_blocks : list Period.t;
      endorsers_per_block : int;
      hard_gas_limit_per_operation : Z.t;
      hard_gas_limit_per_block : Z.t;
      proof_of_work_threshold : int64;
      tokens_per_roll : Tez.t;
      michelson_maximum_type_size : int;
      seed_nonce_revelation_tip : Tez.t;
      origination_size : int;
      block_security_deposit : Tez.t;
      endorsement_security_deposit : Tez.t;
      block_reward : Tez.t;
      endorsement_reward : Tez.t;
      cost_per_byte : Tez.t;
      hard_storage_limit_per_operation : Z.t;
      test_chain_duration : int64;
      quorum_min : int32;
      quorum_max : int32;
      min_proposal_quorum : int32;
      initial_endorsers : int;
      delay_per_missing_endorsement : Period.t }.
    Definition with_preserved_cycles preserved_cycles (r : record) :=
      Build preserved_cycles r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_blocks_per_cycle blocks_per_cycle (r : record) :=
      Build r.(preserved_cycles) blocks_per_cycle r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_blocks_per_commitment blocks_per_commitment (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) blocks_per_commitment
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_blocks_per_roll_snapshot blocks_per_roll_snapshot
      (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        blocks_per_roll_snapshot r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_blocks_per_voting_period blocks_per_voting_period
      (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) blocks_per_voting_period
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_time_between_blocks time_between_blocks (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        time_between_blocks r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_endorsers_per_block endorsers_per_block (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) endorsers_per_block
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_hard_gas_limit_per_operation hard_gas_limit_per_operation
      (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        hard_gas_limit_per_operation r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_hard_gas_limit_per_block hard_gas_limit_per_block
      (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) hard_gas_limit_per_block
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_proof_of_work_threshold proof_of_work_threshold
      (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        proof_of_work_threshold r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_tokens_per_roll tokens_per_roll (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) tokens_per_roll
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_michelson_maximum_type_size michelson_maximum_type_size
      (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        michelson_maximum_type_size r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_seed_nonce_revelation_tip seed_nonce_revelation_tip
      (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) seed_nonce_revelation_tip
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_origination_size origination_size (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        origination_size r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_block_security_deposit block_security_deposit
      (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) block_security_deposit
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_endorsement_security_deposit endorsement_security_deposit
      (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        endorsement_security_deposit r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_block_reward block_reward (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) block_reward r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_endorsement_reward endorsement_reward (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) endorsement_reward
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_cost_per_byte cost_per_byte (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        cost_per_byte r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_hard_storage_limit_per_operation
      hard_storage_limit_per_operation (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) hard_storage_limit_per_operation
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_test_chain_duration test_chain_duration (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        test_chain_duration r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_quorum_min quorum_min (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) quorum_min r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_quorum_max quorum_max (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) quorum_max
        r.(min_proposal_quorum) r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_min_proposal_quorum min_proposal_quorum (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        min_proposal_quorum r.(initial_endorsers)
        r.(delay_per_missing_endorsement).
    Definition with_initial_endorsers initial_endorsers (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) initial_endorsers
        r.(delay_per_missing_endorsement).
    Definition with_delay_per_missing_endorsement delay_per_missing_endorsement
      (r : record) :=
      Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
        r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
        r.(time_between_blocks) r.(endorsers_per_block)
        r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
        r.(proof_of_work_threshold) r.(tokens_per_roll)
        r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
        r.(origination_size) r.(block_security_deposit)
        r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
        r.(cost_per_byte) r.(hard_storage_limit_per_operation)
        r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
        r.(min_proposal_quorum) r.(initial_endorsers)
        delay_per_missing_endorsement.
  End parametric.
  Definition parametric := parametric.record.
  
  Parameter parametric_encoding : Data_encoding.t parametric.
  
  Parameter __parametric_value : context -> parametric.
  
  Parameter preserved_cycles : context -> int.
  
  Parameter blocks_per_cycle : context -> int32.
  
  Parameter blocks_per_commitment : context -> int32.
  
  Parameter blocks_per_roll_snapshot : context -> int32.
  
  Parameter blocks_per_voting_period : context -> int32.
  
  Parameter time_between_blocks : context -> list Period.t.
  
  Parameter endorsers_per_block : context -> int.
  
  Parameter initial_endorsers : context -> int.
  
  Parameter delay_per_missing_endorsement : context -> Period.t.
  
  Parameter hard_gas_limit_per_operation : context -> Z.t.
  
  Parameter hard_gas_limit_per_block : context -> Z.t.
  
  Parameter cost_per_byte : context -> Tez.t.
  
  Parameter hard_storage_limit_per_operation : context -> Z.t.
  
  Parameter proof_of_work_threshold : context -> int64.
  
  Parameter tokens_per_roll : context -> Tez.t.
  
  Parameter michelson_maximum_type_size : context -> int.
  
  Parameter block_reward : context -> Tez.t.
  
  Parameter endorsement_reward : context -> Tez.t.
  
  Parameter seed_nonce_revelation_tip : context -> Tez.t.
  
  Parameter origination_size : context -> int.
  
  Parameter block_security_deposit : context -> Tez.t.
  
  Parameter endorsement_security_deposit : context -> Tez.t.
  
  Parameter test_chain_duration : context -> int64.
  
  Parameter quorum_min : context -> int32.
  
  Parameter quorum_max : context -> int32.
  
  Parameter min_proposal_quorum : context -> int32.
  
  Module t.
    Record record : Set := Build {
      fixed : fixed;
      parametric : parametric }.
    Definition with_fixed fixed (r : record) :=
      Build fixed r.(parametric).
    Definition with_parametric parametric (r : record) :=
      Build r.(fixed) parametric.
  End t.
  Definition t := t.record.
  
  Parameter encoding : Data_encoding.t t.
End Constants.

Module Voting_period.
  Parameter Included_BASIC_DATA : {t : Set & BASIC_DATA.signature (t := t)}.
  
  Definition t := (|Included_BASIC_DATA|).(BASIC_DATA.t).
  
  Definition op_eq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_eq).
  
  Definition op_ltgt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_ltgt).
  
  Definition op_lt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lt).
  
  Definition op_lteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lteq).
  
  Definition op_gteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gteq).
  
  Definition op_gt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gt).
  
  Definition compare : t -> t -> int :=
    (|Included_BASIC_DATA|).(BASIC_DATA.compare).
  
  Definition equal : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.equal).
  
  Definition max : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.max).
  
  Definition min : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.min).
  
  Definition encoding : Data_encoding.t t :=
    (|Included_BASIC_DATA|).(BASIC_DATA.encoding).
  
  Definition pp : Format.formatter -> t -> unit :=
    (|Included_BASIC_DATA|).(BASIC_DATA.pp).
  
  Definition voting_period : Set := t.
  
  Parameter rpc_arg : RPC_arg.arg voting_period.
  
  Parameter root : voting_period.
  
  Parameter succ : voting_period -> voting_period.
  
  Inductive kind : Set :=
  | Proposal : kind
  | Testing_vote : kind
  | Testing : kind
  | Promotion_vote : kind.
  
  Parameter kind_encoding : Data_encoding.encoding kind.
  
  Parameter to_int32 : voting_period -> int32.
End Voting_period.

Module Level.
  Module t.
    Record record : Set := Build {
      level : Raw_level.t;
      level_position : int32;
      cycle : Cycle.t;
      cycle_position : int32;
      voting_period : Voting_period.t;
      voting_period_position : int32;
      expected_commitment : bool }.
    Definition with_level level (r : record) :=
      Build level r.(level_position) r.(cycle) r.(cycle_position)
        r.(voting_period) r.(voting_period_position) r.(expected_commitment).
    Definition with_level_position level_position (r : record) :=
      Build r.(level) level_position r.(cycle) r.(cycle_position)
        r.(voting_period) r.(voting_period_position) r.(expected_commitment).
    Definition with_cycle cycle (r : record) :=
      Build r.(level) r.(level_position) cycle r.(cycle_position)
        r.(voting_period) r.(voting_period_position) r.(expected_commitment).
    Definition with_cycle_position cycle_position (r : record) :=
      Build r.(level) r.(level_position) r.(cycle) cycle_position
        r.(voting_period) r.(voting_period_position) r.(expected_commitment).
    Definition with_voting_period voting_period (r : record) :=
      Build r.(level) r.(level_position) r.(cycle) r.(cycle_position)
        voting_period r.(voting_period_position) r.(expected_commitment).
    Definition with_voting_period_position voting_period_position
      (r : record) :=
      Build r.(level) r.(level_position) r.(cycle) r.(cycle_position)
        r.(voting_period) voting_period_position r.(expected_commitment).
    Definition with_expected_commitment expected_commitment (r : record) :=
      Build r.(level) r.(level_position) r.(cycle) r.(cycle_position)
        r.(voting_period) r.(voting_period_position) expected_commitment.
  End t.
  Definition t := t.record.
  
  Parameter Included_BASIC_DATA : {_ : unit & BASIC_DATA.signature (t := t)}.
  
  Definition op_eq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_eq).
  
  Definition op_ltgt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_ltgt).
  
  Definition op_lt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lt).
  
  Definition op_lteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lteq).
  
  Definition op_gteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gteq).
  
  Definition op_gt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gt).
  
  Definition compare : t -> t -> int :=
    (|Included_BASIC_DATA|).(BASIC_DATA.compare).
  
  Definition equal : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.equal).
  
  Definition max : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.max).
  
  Definition min : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.min).
  
  Definition encoding : Data_encoding.t t :=
    (|Included_BASIC_DATA|).(BASIC_DATA.encoding).
  
  Definition pp : Format.formatter -> t -> unit :=
    (|Included_BASIC_DATA|).(BASIC_DATA.pp).
  
  Parameter pp_full : Format.formatter -> t -> unit.
  
  Definition level : Set := t.
  
  Parameter root : context -> level.
  
  Parameter succ : context -> level -> level.
  
  Parameter pred : context -> level -> option level.
  
  Parameter from_raw : context -> option int32 -> Raw_level.t -> level.
  
  Parameter diff : level -> level -> int32.
  
  Parameter current : context -> level.
  
  Parameter last_level_in_cycle : context -> Cycle.t -> level.
  
  Parameter levels_in_cycle : context -> Cycle.t -> list level.
  
  Parameter levels_in_current_cycle :
    context -> option int32 -> unit -> list level.
  
  Parameter last_allowed_fork_level : context -> Raw_level.t.
End Level.

Module Fitness.
  Parameter t : Set.
  
  Parameter op_eq : t -> t -> bool.
  
  Parameter op_ltgt : t -> t -> bool.
  
  Parameter op_lt : t -> t -> bool.
  
  Parameter op_lteq : t -> t -> bool.
  
  Parameter op_gteq : t -> t -> bool.
  
  Parameter op_gt : t -> t -> bool.
  
  Parameter compare : t -> t -> int.
  
  Parameter equal : t -> t -> bool.
  
  Parameter max : t -> t -> t.
  
  Parameter min : t -> t -> t.
  
  Parameter pp : Format.formatter -> t -> unit.
  
  Parameter encoding : Data_encoding.t t.
  
  Parameter to_bytes : t -> MBytes.t.
  
  Parameter of_bytes : MBytes.t -> option t.
  
  Definition fitness : Set := t.
  
  Parameter increase : option int -> context -> context.
  
  Parameter current : context -> int64.
  
  Parameter to_int64 : fitness -> Error_monad.tzresult int64.
End Fitness.

Module Nonce.
  Definition t : Set := Nonce_storage.t.
  
  Definition nonce : Set := t.
  
  Parameter encoding : Data_encoding.t nonce.
  
  Definition unrevealed : Set := Storage.unrevealed_nonce.
  
  Parameter record_hash :
    context -> unrevealed -> Lwt.t (Error_monad.tzresult context).
  
  Parameter reveal :
    context -> Level.t -> nonce -> Lwt.t (Error_monad.tzresult context).
  
  Definition status : Set := Storage.nonce_status.
  
  Parameter get : context -> Level.t -> Lwt.t (Error_monad.tzresult status).
  
  Parameter of_bytes : MBytes.t -> Error_monad.tzresult nonce.
  
  Parameter __hash_value : nonce -> Nonce_hash.t.
  
  Parameter check_hash : nonce -> Nonce_hash.t -> bool.
End Nonce.

Module Seed.
  Parameter seed : Set.
  
  (* extensible_type_definition `error` *)
  
  Parameter for_cycle : context -> Cycle.t -> Lwt.t (Error_monad.tzresult seed).
  
  Parameter cycle_end :
    context -> Cycle.t ->
    Lwt.t (Error_monad.tzresult (context * list Nonce.unrevealed)).
  
  Parameter seed_encoding : Data_encoding.t seed.
End Seed.

Module Big_map.
  Definition id : Set := Z.t.
  
  Parameter fresh : context -> Lwt.t (Error_monad.tzresult (context * id)).
  
  Parameter fresh_temporary : context -> context * id.
  
  Parameter mem :
    context -> id -> Script_expr_hash.t ->
    Lwt.t (Error_monad.tzresult (context * bool)).
  
  Parameter get_opt :
    context -> id -> Script_expr_hash.t ->
    Lwt.t (Error_monad.tzresult (context * option Script.expr)).
  
  Parameter rpc_arg : RPC_arg.t id.
  
  Parameter cleanup_temporary : context -> Lwt.t context.
  
  Parameter __exists :
    context -> id ->
    Lwt.t (Error_monad.tzresult (context * option (Script.expr * Script.expr))).
End Big_map.

Module Contract.
  Parameter Included_BASIC_DATA : {t : Set & BASIC_DATA.signature (t := t)}.
  
  Definition t := (|Included_BASIC_DATA|).(BASIC_DATA.t).
  
  Definition op_eq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_eq).
  
  Definition op_ltgt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_ltgt).
  
  Definition op_lt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lt).
  
  Definition op_lteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_lteq).
  
  Definition op_gteq : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gteq).
  
  Definition op_gt : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.op_gt).
  
  Definition compare : t -> t -> int :=
    (|Included_BASIC_DATA|).(BASIC_DATA.compare).
  
  Definition equal : t -> t -> bool :=
    (|Included_BASIC_DATA|).(BASIC_DATA.equal).
  
  Definition max : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.max).
  
  Definition min : t -> t -> t := (|Included_BASIC_DATA|).(BASIC_DATA.min).
  
  Definition encoding : Data_encoding.t t :=
    (|Included_BASIC_DATA|).(BASIC_DATA.encoding).
  
  Definition pp : Format.formatter -> t -> unit :=
    (|Included_BASIC_DATA|).(BASIC_DATA.pp).
  
  Definition contract : Set := t.
  
  Parameter rpc_arg : RPC_arg.arg contract.
  
  Parameter to_b58check : contract -> string.
  
  Parameter of_b58check : string -> Error_monad.tzresult contract.
  
  Parameter implicit_contract : public_key_hash -> contract.
  
  Parameter is_implicit : contract -> option public_key_hash.
  
  Parameter __exists : context -> contract -> Lwt.t (Error_monad.tzresult bool).
  
  Parameter must_exist :
    context -> contract -> Lwt.t (Error_monad.tzresult unit).
  
  Parameter allocated :
    context -> contract -> Lwt.t (Error_monad.tzresult bool).
  
  Parameter must_be_allocated :
    context -> contract -> Lwt.t (Error_monad.tzresult unit).
  
  Parameter __list_value : context -> Lwt.t (list contract).
  
  Parameter get_manager_key :
    context -> public_key_hash -> Lwt.t (Error_monad.tzresult public_key).
  
  Parameter is_manager_key_revealed :
    context -> public_key_hash -> Lwt.t (Error_monad.tzresult bool).
  
  Parameter reveal_manager_key :
    context -> public_key_hash -> public_key ->
    Lwt.t (Error_monad.tzresult context).
  
  Parameter get_script_code :
    context -> contract ->
    Lwt.t (Error_monad.tzresult (context * option Script.lazy_expr)).
  
  Parameter get_script :
    context -> contract ->
    Lwt.t (Error_monad.tzresult (context * option Script.t)).
  
  Parameter get_storage :
    context -> contract ->
    Lwt.t (Error_monad.tzresult (context * option Script.expr)).
  
  Parameter get_counter :
    context -> public_key_hash -> Lwt.t (Error_monad.tzresult Z.t).
  
  Parameter get_balance :
    context -> contract -> Lwt.t (Error_monad.tzresult Tez.t).
  
  Parameter init_origination_nonce :
    context -> (|Operation_hash|).(S.HASH.t) -> context.
  
  Parameter unset_origination_nonce : context -> context.
  
  Parameter fresh_contract_from_current_nonce :
    context -> Lwt.t (Error_monad.tzresult (context * t)).
  
  Parameter originated_from_current_nonce :
    context -> context -> Lwt.t (Error_monad.tzresult (list contract)).
  
  Module ConstructorRecords_big_map_diff_item.
    Module big_map_diff_item.
      Module Update.
        Record record {big_map diff_key diff_key_hash diff_value : Set} : Set := Build {
          big_map : big_map;
          diff_key : diff_key;
          diff_key_hash : diff_key_hash;
          diff_value : diff_value }.
        Arguments record : clear implicits.
        Definition with_big_map
          {t_big_map t_diff_key t_diff_key_hash t_diff_value} big_map
          (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
          Build t_big_map t_diff_key t_diff_key_hash t_diff_value big_map
            r.(diff_key) r.(diff_key_hash) r.(diff_value).
        Definition with_diff_key
          {t_big_map t_diff_key t_diff_key_hash t_diff_value} diff_key
          (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
          Build t_big_map t_diff_key t_diff_key_hash t_diff_value r.(big_map)
            diff_key r.(diff_key_hash) r.(diff_value).
        Definition with_diff_key_hash
          {t_big_map t_diff_key t_diff_key_hash t_diff_value} diff_key_hash
          (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
          Build t_big_map t_diff_key t_diff_key_hash t_diff_value r.(big_map)
            r.(diff_key) diff_key_hash r.(diff_value).
        Definition with_diff_value
          {t_big_map t_diff_key t_diff_key_hash t_diff_value} diff_value
          (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
          Build t_big_map t_diff_key t_diff_key_hash t_diff_value r.(big_map)
            r.(diff_key) r.(diff_key_hash) diff_value.
      End Update.
      Definition Update_skeleton := Update.record.
      
      Module Alloc.
        Record record {big_map key_type value_type : Set} : Set := Build {
          big_map : big_map;
          key_type : key_type;
          value_type : value_type }.
        Arguments record : clear implicits.
        Definition with_big_map {t_big_map t_key_type t_value_type} big_map
          (r : record t_big_map t_key_type t_value_type) :=
          Build t_big_map t_key_type t_value_type big_map r.(key_type)
            r.(value_type).
        Definition with_key_type {t_big_map t_key_type t_value_type} key_type
          (r : record t_big_map t_key_type t_value_type) :=
          Build t_big_map t_key_type t_value_type r.(big_map) key_type
            r.(value_type).
        Definition with_value_type {t_big_map t_key_type t_value_type}
          value_type (r : record t_big_map t_key_type t_value_type) :=
          Build t_big_map t_key_type t_value_type r.(big_map) r.(key_type)
            value_type.
      End Alloc.
      Definition Alloc_skeleton := Alloc.record.
    End big_map_diff_item.
  End ConstructorRecords_big_map_diff_item.
  Import ConstructorRecords_big_map_diff_item.
  
  Reserved Notation "'big_map_diff_item.Update".
  Reserved Notation "'big_map_diff_item.Alloc".
  
  Inductive big_map_diff_item : Set :=
  | Update : 'big_map_diff_item.Update -> big_map_diff_item
  | Clear : Big_map.id -> big_map_diff_item
  | Copy : Big_map.id -> Big_map.id -> big_map_diff_item
  | Alloc : 'big_map_diff_item.Alloc -> big_map_diff_item
  
  where "'big_map_diff_item.Update" :=
    (big_map_diff_item.Update_skeleton Big_map.id Script.expr Script_expr_hash.t
      (option Script.expr))
  and "'big_map_diff_item.Alloc" :=
    (big_map_diff_item.Alloc_skeleton Big_map.id Script.expr Script.expr).
  
  Module big_map_diff_item.
    Include ConstructorRecords_big_map_diff_item.big_map_diff_item.
    Definition Update := 'big_map_diff_item.Update.
    Definition Alloc := 'big_map_diff_item.Alloc.
  End big_map_diff_item.
  
  Definition big_map_diff : Set := list big_map_diff_item.
  
  Parameter big_map_diff_encoding : Data_encoding.t big_map_diff.
  
  Parameter originate :
    context -> contract -> Tez.t -> Script.t * option big_map_diff ->
    option public_key_hash -> Lwt.t (Error_monad.tzresult context).
  
  (* extensible_type_definition `error` *)
  
  Parameter spend :
    context -> contract -> Tez.t -> Lwt.t (Error_monad.tzresult context).
  
  Parameter credit :
    context -> contract -> Tez.t -> Lwt.t (Error_monad.tzresult context).
  
  Parameter update_script_storage :
    context -> contract -> Script.expr -> option big_map_diff ->
    Lwt.t (Error_monad.tzresult context).
  
  Parameter used_storage_space :
    context -> t -> Lwt.t (Error_monad.tzresult Z.t).
  
  Parameter increment_counter :
    context -> public_key_hash -> Lwt.t (Error_monad.tzresult context).
  
  Parameter check_counter_increment :
    context -> public_key_hash -> Z.t -> Lwt.t (Error_monad.tzresult unit).
  
  Parameter origination_nonce : Set.
  
  Parameter initial_origination_nonce :
    (|Operation_hash|).(S.HASH.t) -> origination_nonce.
  
  Parameter originated_contract : origination_nonce -> contract.
End Contract.

Module Delegate.
  Inductive balance : Set :=
  | Contract : Contract.t -> balance
  | Rewards :
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> Cycle.t -> balance
  | Fees :
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> Cycle.t -> balance
  | Deposits :
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> Cycle.t -> balance.
  
  Inductive balance_update : Set :=
  | Debited : Tez.t -> balance_update
  | Credited : Tez.t -> balance_update.
  
  Definition balance_updates : Set := list (balance * balance_update).
  
  Parameter balance_updates_encoding : Data_encoding.t balance_updates.
  
  Parameter cleanup_balance_updates : balance_updates -> balance_updates.
  
  Parameter get :
    context -> Contract.t ->
    Lwt.t (Error_monad.tzresult (option public_key_hash)).
  
  Parameter set :
    context -> Contract.t -> option public_key_hash ->
    Lwt.t (Error_monad.tzresult context).
  
  Parameter fold : forall {a : Set},
    context -> a -> (public_key_hash -> a -> Lwt.t a) -> Lwt.t a.
  
  Parameter __list_value : context -> Lwt.t (list public_key_hash).
  
  Parameter freeze_deposit :
    context -> public_key_hash -> Tez.t -> Lwt.t (Error_monad.tzresult context).
  
  Parameter freeze_rewards :
    context -> public_key_hash -> Tez.t -> Lwt.t (Error_monad.tzresult context).
  
  Parameter freeze_fees :
    context -> public_key_hash -> Tez.t -> Lwt.t (Error_monad.tzresult context).
  
  Parameter cycle_end :
    context -> Cycle.t -> list Nonce.unrevealed ->
    Lwt.t
      (Error_monad.tzresult
        (context * balance_updates *
          list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))).
  
  Module frozen_balance.
    Record record : Set := Build {
      deposit : Tez.t;
      fees : Tez.t;
      rewards : Tez.t }.
    Definition with_deposit deposit (r : record) :=
      Build deposit r.(fees) r.(rewards).
    Definition with_fees fees (r : record) :=
      Build r.(deposit) fees r.(rewards).
    Definition with_rewards rewards (r : record) :=
      Build r.(deposit) r.(fees) rewards.
  End frozen_balance.
  Definition frozen_balance := frozen_balance.record.
  
  Parameter punish :
    context -> public_key_hash -> Cycle.t ->
    Lwt.t (Error_monad.tzresult (context * frozen_balance)).
  
  Parameter full_balance :
    context -> public_key_hash -> Lwt.t (Error_monad.tzresult Tez.t).
  
  Parameter has_frozen_balance :
    context -> public_key_hash -> Cycle.t -> Lwt.t (Error_monad.tzresult bool).
  
  Parameter __frozen_balance_value :
    context -> public_key_hash -> Lwt.t (Error_monad.tzresult Tez.t).
  
  Parameter frozen_balance_encoding : Data_encoding.t frozen_balance.
  
  Parameter frozen_balance_by_cycle_encoding :
    Data_encoding.t ((|Cycle.Map|).(S.MAP.t) frozen_balance).
  
  Parameter frozen_balance_by_cycle :
    context -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
    Lwt.t ((|Cycle.Map|).(S.MAP.t) frozen_balance).
  
  Parameter staking_balance :
    context -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
    Lwt.t (Error_monad.tzresult Tez.t).
  
  Parameter delegated_contracts :
    context -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
    Lwt.t (list Contract_repr.t).
  
  Parameter delegated_balance :
    context -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
    Lwt.t (Error_monad.tzresult Tez.t).
  
  Parameter deactivated :
    context -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
    Lwt.t (Error_monad.tzresult bool).
  
  Parameter grace_period :
    context -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
    Lwt.t (Error_monad.tzresult Cycle.t).
End Delegate.

Module Vote.
  Definition proposal : Set := (|Protocol_hash|).(S.HASH.t).
  
  Parameter record_proposal :
    context -> (|Protocol_hash|).(S.HASH.t) -> public_key_hash ->
    Lwt.t (Error_monad.tzresult context).
  
  Parameter get_proposals :
    context ->
    Lwt.t
      (Error_monad.tzresult
        ((|Protocol_hash|).(S.HASH.Map).(S.INDEXES_Map.t) int32)).
  
  Parameter clear_proposals : context -> Lwt.t context.
  
  Parameter recorded_proposal_count_for_delegate :
    context -> public_key_hash -> Lwt.t (Error_monad.tzresult int).
  
  Parameter listings_encoding :
    Data_encoding.t
      (list ((|Signature.Public_key_hash|).(S.SPublic_key_hash.t) * int32)).
  
  Parameter freeze_listings : context -> Lwt.t (Error_monad.tzresult context).
  
  Parameter clear_listings : context -> Lwt.t (Error_monad.tzresult context).
  
  Parameter listing_size : context -> Lwt.t (Error_monad.tzresult int32).
  
  Parameter in_listings : context -> public_key_hash -> Lwt.t bool.
  
  Parameter get_listings : context -> Lwt.t (list (public_key_hash * int32)).
  
  Inductive ballot : Set :=
  | Yay : ballot
  | Nay : ballot
  | Pass : ballot.
  
  Parameter ballot_encoding : Data_encoding.t ballot.
  
  Module ballots.
    Record record : Set := Build {
      yay : int32;
      nay : int32;
      pass : int32 }.
    Definition with_yay yay (r : record) :=
      Build yay r.(nay) r.(pass).
    Definition with_nay nay (r : record) :=
      Build r.(yay) nay r.(pass).
    Definition with_pass pass (r : record) :=
      Build r.(yay) r.(nay) pass.
  End ballots.
  Definition ballots := ballots.record.
  
  Parameter ballots_encoding : Data_encoding.t ballots.
  
  Parameter has_recorded_ballot : context -> public_key_hash -> Lwt.t bool.
  
  Parameter record_ballot :
    context -> public_key_hash -> ballot -> Lwt.t (Error_monad.tzresult context).
  
  Parameter get_ballots : context -> Lwt.t (Error_monad.tzresult ballots).
  
  Parameter get_ballot_list :
    context ->
    Lwt.t (list ((|Signature.Public_key_hash|).(S.SPublic_key_hash.t) * ballot)).
  
  Parameter clear_ballots : context -> Lwt.t context.
  
  Parameter get_current_period_kind :
    context -> Lwt.t (Error_monad.tzresult Voting_period.kind).
  
  Parameter set_current_period_kind :
    context -> Voting_period.kind -> Lwt.t (Error_monad.tzresult context).
  
  Parameter get_current_quorum : context -> Lwt.t (Error_monad.tzresult int32).
  
  Parameter get_participation_ema :
    context -> Lwt.t (Error_monad.tzresult int32).
  
  Parameter set_participation_ema :
    context -> int32 -> Lwt.t (Error_monad.tzresult context).
  
  Parameter get_current_proposal :
    context -> Lwt.t (Error_monad.tzresult proposal).
  
  Parameter init_current_proposal :
    context -> proposal -> Lwt.t (Error_monad.tzresult context).
  
  Parameter clear_current_proposal :
    context -> Lwt.t (Error_monad.tzresult context).
End Vote.

Module Block_header.
  Definition contents : Set := Block_header_repr.contents.
  
  Definition protocol_data : Set := Block_header_repr.protocol_data.
  
  Definition block_header : Set := Block_header_repr.block_header.
  
  Definition raw : Set := Block_header.t.
  
  Definition shell_header : Set := Block_header.shell_header.
  
  Parameter __raw_value : block_header -> raw.
  
  Parameter __hash_value : block_header -> (|Block_hash|).(S.HASH.t).
  
  Parameter hash_raw : raw -> (|Block_hash|).(S.HASH.t).
  
  Parameter encoding : Data_encoding.encoding block_header.
  
  Parameter raw_encoding : Data_encoding.t raw.
  
  Parameter contents_encoding : Data_encoding.t contents.
  
  Parameter unsigned_encoding : Data_encoding.t (shell_header * contents).
  
  Parameter protocol_data_encoding : Data_encoding.encoding protocol_data.
  
  Parameter shell_header_encoding : Data_encoding.encoding shell_header.
  
  Parameter max_header_length : int.
End Block_header.

Module Kind.
  Inductive seed_nonce_revelation : Set :=
  | Seed_nonce_revelation_kind : seed_nonce_revelation.
  
  Inductive double_endorsement_evidence : Set :=
  | Double_endorsement_evidence_kind : double_endorsement_evidence.
  
  Inductive double_baking_evidence : Set :=
  | Double_baking_evidence_kind : double_baking_evidence.
  
  Inductive activate_account : Set :=
  | Activate_account_kind : activate_account.
  
  Inductive endorsement : Set :=
  | Endorsement_kind : endorsement.
  
  Inductive proposals : Set :=
  | Proposals_kind : proposals.
  
  Inductive ballot : Set :=
  | Ballot_kind : ballot.
  
  Inductive reveal : Set :=
  | Reveal_kind : reveal.
  
  Inductive transaction : Set :=
  | Transaction_kind : transaction.
  
  Inductive origination : Set :=
  | Origination_kind : origination.
  
  Inductive delegation : Set :=
  | Delegation_kind : delegation.
  
  Inductive manager : Set :=
  | Reveal_manager_kind : manager
  | Transaction_manager_kind : manager
  | Origination_manager_kind : manager
  | Delegation_manager_kind : manager.
End Kind.

Module ConstructorRecords_contents_list_contents_manager_operation.
  Module contents.
    Module Endorsement.
      Record record {level : Set} : Set := Build {
        level : level }.
      Arguments record : clear implicits.
      Definition with_level {t_level} level (r : record t_level) :=
        Build t_level level.
    End Endorsement.
    Definition Endorsement_skeleton := Endorsement.record.
    
    Module Seed_nonce_revelation.
      Record record {level nonce : Set} : Set := Build {
        level : level;
        nonce : nonce }.
      Arguments record : clear implicits.
      Definition with_level {t_level t_nonce} level
        (r : record t_level t_nonce) :=
        Build t_level t_nonce level r.(nonce).
      Definition with_nonce {t_level t_nonce} nonce
        (r : record t_level t_nonce) :=
        Build t_level t_nonce r.(level) nonce.
    End Seed_nonce_revelation.
    Definition Seed_nonce_revelation_skeleton := Seed_nonce_revelation.record.
    
    Module Double_endorsement_evidence.
      Record record {op1 op2 : Set} : Set := Build {
        op1 : op1;
        op2 : op2 }.
      Arguments record : clear implicits.
      Definition with_op1 {t_op1 t_op2} op1 (r : record t_op1 t_op2) :=
        Build t_op1 t_op2 op1 r.(op2).
      Definition with_op2 {t_op1 t_op2} op2 (r : record t_op1 t_op2) :=
        Build t_op1 t_op2 r.(op1) op2.
    End Double_endorsement_evidence.
    Definition Double_endorsement_evidence_skeleton :=
      Double_endorsement_evidence.record.
    
    Module Double_baking_evidence.
      Record record {bh1 bh2 : Set} : Set := Build {
        bh1 : bh1;
        bh2 : bh2 }.
      Arguments record : clear implicits.
      Definition with_bh1 {t_bh1 t_bh2} bh1 (r : record t_bh1 t_bh2) :=
        Build t_bh1 t_bh2 bh1 r.(bh2).
      Definition with_bh2 {t_bh1 t_bh2} bh2 (r : record t_bh1 t_bh2) :=
        Build t_bh1 t_bh2 r.(bh1) bh2.
    End Double_baking_evidence.
    Definition Double_baking_evidence_skeleton := Double_baking_evidence.record.
    
    Module Activate_account.
      Record record {id activation_code : Set} : Set := Build {
        id : id;
        activation_code : activation_code }.
      Arguments record : clear implicits.
      Definition with_id {t_id t_activation_code} id
        (r : record t_id t_activation_code) :=
        Build t_id t_activation_code id r.(activation_code).
      Definition with_activation_code {t_id t_activation_code} activation_code
        (r : record t_id t_activation_code) :=
        Build t_id t_activation_code r.(id) activation_code.
    End Activate_account.
    Definition Activate_account_skeleton := Activate_account.record.
    
    Module Proposals.
      Record record {source period proposals : Set} : Set := Build {
        source : source;
        period : period;
        proposals : proposals }.
      Arguments record : clear implicits.
      Definition with_source {t_source t_period t_proposals} source
        (r : record t_source t_period t_proposals) :=
        Build t_source t_period t_proposals source r.(period) r.(proposals).
      Definition with_period {t_source t_period t_proposals} period
        (r : record t_source t_period t_proposals) :=
        Build t_source t_period t_proposals r.(source) period r.(proposals).
      Definition with_proposals {t_source t_period t_proposals} proposals
        (r : record t_source t_period t_proposals) :=
        Build t_source t_period t_proposals r.(source) r.(period) proposals.
    End Proposals.
    Definition Proposals_skeleton := Proposals.record.
    
    Module Ballot.
      Record record {source period proposal ballot : Set} : Set := Build {
        source : source;
        period : period;
        proposal : proposal;
        ballot : ballot }.
      Arguments record : clear implicits.
      Definition with_source {t_source t_period t_proposal t_ballot} source
        (r : record t_source t_period t_proposal t_ballot) :=
        Build t_source t_period t_proposal t_ballot source r.(period)
          r.(proposal) r.(ballot).
      Definition with_period {t_source t_period t_proposal t_ballot} period
        (r : record t_source t_period t_proposal t_ballot) :=
        Build t_source t_period t_proposal t_ballot r.(source) period
          r.(proposal) r.(ballot).
      Definition with_proposal {t_source t_period t_proposal t_ballot} proposal
        (r : record t_source t_period t_proposal t_ballot) :=
        Build t_source t_period t_proposal t_ballot r.(source) r.(period)
          proposal r.(ballot).
      Definition with_ballot {t_source t_period t_proposal t_ballot} ballot
        (r : record t_source t_period t_proposal t_ballot) :=
        Build t_source t_period t_proposal t_ballot r.(source) r.(period)
          r.(proposal) ballot.
    End Ballot.
    Definition Ballot_skeleton := Ballot.record.
    
    Module Manager_operation.
      Record record {source fee counter operation gas_limit storage_limit : Set} :
        Set := Build {
        source : source;
        fee : fee;
        counter : counter;
        operation : operation;
        gas_limit : gas_limit;
        storage_limit : storage_limit }.
      Arguments record : clear implicits.
      Definition with_source
        {t_source t_fee t_counter t_operation t_gas_limit t_storage_limit}
        source
        (r :
          record t_source t_fee t_counter t_operation t_gas_limit
            t_storage_limit) :=
        Build t_source t_fee t_counter t_operation t_gas_limit t_storage_limit
          source r.(fee) r.(counter) r.(operation) r.(gas_limit)
          r.(storage_limit).
      Definition with_fee
        {t_source t_fee t_counter t_operation t_gas_limit t_storage_limit} fee
        (r :
          record t_source t_fee t_counter t_operation t_gas_limit
            t_storage_limit) :=
        Build t_source t_fee t_counter t_operation t_gas_limit t_storage_limit
          r.(source) fee r.(counter) r.(operation) r.(gas_limit)
          r.(storage_limit).
      Definition with_counter
        {t_source t_fee t_counter t_operation t_gas_limit t_storage_limit}
        counter
        (r :
          record t_source t_fee t_counter t_operation t_gas_limit
            t_storage_limit) :=
        Build t_source t_fee t_counter t_operation t_gas_limit t_storage_limit
          r.(source) r.(fee) counter r.(operation) r.(gas_limit)
          r.(storage_limit).
      Definition with_operation
        {t_source t_fee t_counter t_operation t_gas_limit t_storage_limit}
        operation
        (r :
          record t_source t_fee t_counter t_operation t_gas_limit
            t_storage_limit) :=
        Build t_source t_fee t_counter t_operation t_gas_limit t_storage_limit
          r.(source) r.(fee) r.(counter) operation r.(gas_limit)
          r.(storage_limit).
      Definition with_gas_limit
        {t_source t_fee t_counter t_operation t_gas_limit t_storage_limit}
        gas_limit
        (r :
          record t_source t_fee t_counter t_operation t_gas_limit
            t_storage_limit) :=
        Build t_source t_fee t_counter t_operation t_gas_limit t_storage_limit
          r.(source) r.(fee) r.(counter) r.(operation) gas_limit
          r.(storage_limit).
      Definition with_storage_limit
        {t_source t_fee t_counter t_operation t_gas_limit t_storage_limit}
        storage_limit
        (r :
          record t_source t_fee t_counter t_operation t_gas_limit
            t_storage_limit) :=
        Build t_source t_fee t_counter t_operation t_gas_limit t_storage_limit
          r.(source) r.(fee) r.(counter) r.(operation) r.(gas_limit)
          storage_limit.
    End Manager_operation.
    Definition Manager_operation_skeleton := Manager_operation.record.
  End contents.
  Module manager_operation.
    Module Transaction.
      Record record {amount parameters entrypoint destination : Set} : Set := Build {
        amount : amount;
        parameters : parameters;
        entrypoint : entrypoint;
        destination : destination }.
      Arguments record : clear implicits.
      Definition with_amount {t_amount t_parameters t_entrypoint t_destination}
        amount (r : record t_amount t_parameters t_entrypoint t_destination) :=
        Build t_amount t_parameters t_entrypoint t_destination amount
          r.(parameters) r.(entrypoint) r.(destination).
      Definition with_parameters
        {t_amount t_parameters t_entrypoint t_destination} parameters
        (r : record t_amount t_parameters t_entrypoint t_destination) :=
        Build t_amount t_parameters t_entrypoint t_destination r.(amount)
          parameters r.(entrypoint) r.(destination).
      Definition with_entrypoint
        {t_amount t_parameters t_entrypoint t_destination} entrypoint
        (r : record t_amount t_parameters t_entrypoint t_destination) :=
        Build t_amount t_parameters t_entrypoint t_destination r.(amount)
          r.(parameters) entrypoint r.(destination).
      Definition with_destination
        {t_amount t_parameters t_entrypoint t_destination} destination
        (r : record t_amount t_parameters t_entrypoint t_destination) :=
        Build t_amount t_parameters t_entrypoint t_destination r.(amount)
          r.(parameters) r.(entrypoint) destination.
    End Transaction.
    Definition Transaction_skeleton := Transaction.record.
    
    Module Origination.
      Record record {delegate script credit preorigination : Set} : Set := Build {
        delegate : delegate;
        script : script;
        credit : credit;
        preorigination : preorigination }.
      Arguments record : clear implicits.
      Definition with_delegate {t_delegate t_script t_credit t_preorigination}
        delegate (r : record t_delegate t_script t_credit t_preorigination) :=
        Build t_delegate t_script t_credit t_preorigination delegate r.(script)
          r.(credit) r.(preorigination).
      Definition with_script {t_delegate t_script t_credit t_preorigination}
        script (r : record t_delegate t_script t_credit t_preorigination) :=
        Build t_delegate t_script t_credit t_preorigination r.(delegate) script
          r.(credit) r.(preorigination).
      Definition with_credit {t_delegate t_script t_credit t_preorigination}
        credit (r : record t_delegate t_script t_credit t_preorigination) :=
        Build t_delegate t_script t_credit t_preorigination r.(delegate)
          r.(script) credit r.(preorigination).
      Definition with_preorigination
        {t_delegate t_script t_credit t_preorigination} preorigination
        (r : record t_delegate t_script t_credit t_preorigination) :=
        Build t_delegate t_script t_credit t_preorigination r.(delegate)
          r.(script) r.(credit) preorigination.
    End Origination.
    Definition Origination_skeleton := Origination.record.
  End manager_operation.
End ConstructorRecords_contents_list_contents_manager_operation.
Import ConstructorRecords_contents_list_contents_manager_operation.

Module operation.
  Record record {shell protocol_data : Set} : Set := Build {
    shell : shell;
    protocol_data : protocol_data }.
  Arguments record : clear implicits.
  Definition with_shell {t_shell t_protocol_data} shell
    (r : record t_shell t_protocol_data) :=
    Build t_shell t_protocol_data shell r.(protocol_data).
  Definition with_protocol_data {t_shell t_protocol_data} protocol_data
    (r : record t_shell t_protocol_data) :=
    Build t_shell t_protocol_data r.(shell) protocol_data.
End operation.
Definition operation_skeleton := operation.record.

Module protocol_data.
  Record record {contents signature : Set} : Set := Build {
    contents : contents;
    signature : signature }.
  Arguments record : clear implicits.
  Definition with_contents {t_contents t_signature} contents
    (r : record t_contents t_signature) :=
    Build t_contents t_signature contents r.(signature).
  Definition with_signature {t_contents t_signature} signature
    (r : record t_contents t_signature) :=
    Build t_contents t_signature r.(contents) signature.
End protocol_data.
Definition protocol_data_skeleton := protocol_data.record.

Reserved Notation "'contents.Endorsement".
Reserved Notation "'contents.Seed_nonce_revelation".
Reserved Notation "'contents.Double_endorsement_evidence".
Reserved Notation "'contents.Double_baking_evidence".
Reserved Notation "'contents.Activate_account".
Reserved Notation "'contents.Proposals".
Reserved Notation "'contents.Ballot".
Reserved Notation "'contents.Manager_operation".
Reserved Notation "'manager_operation.Transaction".
Reserved Notation "'manager_operation.Origination".
Reserved Notation "'protocol_data".
Reserved Notation "'operation".
Reserved Notation "'counter".

Inductive contents_list : Set :=
| Single : contents -> contents_list
| Cons : contents -> contents_list -> contents_list

with contents : Set :=
| Endorsement : 'contents.Endorsement -> contents
| Seed_nonce_revelation : 'contents.Seed_nonce_revelation -> contents
| Double_endorsement_evidence :
  'contents.Double_endorsement_evidence -> contents
| Double_baking_evidence : 'contents.Double_baking_evidence -> contents
| Activate_account : 'contents.Activate_account -> contents
| Proposals : 'contents.Proposals -> contents
| Ballot : 'contents.Ballot -> contents
| Manager_operation : 'contents.Manager_operation -> contents

with manager_operation : Set :=
| Reveal : (|Signature.Public_key|).(S.SPublic_key.t) -> manager_operation
| Transaction : 'manager_operation.Transaction -> manager_operation
| Origination : 'manager_operation.Origination -> manager_operation
| Delegation :
  option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  manager_operation

where "'protocol_data" :=
  (protocol_data_skeleton contents_list (option Signature.t))
and "'operation" := (operation_skeleton Operation.shell_header 'protocol_data)
and "'counter" := (Z.t)
and "'contents.Endorsement" := (contents.Endorsement_skeleton Raw_level.t)
and "'contents.Seed_nonce_revelation" :=
  (contents.Seed_nonce_revelation_skeleton Raw_level.t Nonce.t)
and "'contents.Double_endorsement_evidence" :=
  (contents.Double_endorsement_evidence_skeleton 'operation 'operation)
and "'contents.Double_baking_evidence" :=
  (contents.Double_baking_evidence_skeleton Block_header.block_header
    Block_header.block_header)
and "'contents.Activate_account" :=
  (contents.Activate_account_skeleton
    (|Ed25519|).(S.SIGNATURE.Public_key_hash).(S.SPublic_key_hash.t)
    Blinded_public_key_hash.activation_code)
and "'contents.Proposals" :=
  (contents.Proposals_skeleton
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) Voting_period.t
    (list (|Protocol_hash|).(S.HASH.t)))
and "'contents.Ballot" :=
  (contents.Ballot_skeleton (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)
    Voting_period.t (|Protocol_hash|).(S.HASH.t) Vote.ballot)
and "'contents.Manager_operation" :=
  (contents.Manager_operation_skeleton
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) Tez.tez 'counter
    manager_operation Z.t Z.t)
and "'manager_operation.Transaction" :=
  (manager_operation.Transaction_skeleton Tez.tez Script.lazy_expr string
    Contract.contract)
and "'manager_operation.Origination" :=
  (manager_operation.Origination_skeleton
    (option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) Script.t
    Tez.tez (option Contract.t)).

Module contents.
  Include ConstructorRecords_contents_list_contents_manager_operation.contents.
  Definition Endorsement := 'contents.Endorsement.
  Definition Seed_nonce_revelation := 'contents.Seed_nonce_revelation.
  Definition Double_endorsement_evidence :=
    'contents.Double_endorsement_evidence.
  Definition Double_baking_evidence := 'contents.Double_baking_evidence.
  Definition Activate_account := 'contents.Activate_account.
  Definition Proposals := 'contents.Proposals.
  Definition Ballot := 'contents.Ballot.
  Definition Manager_operation := 'contents.Manager_operation.
End contents.
Module manager_operation.
  Include ConstructorRecords_contents_list_contents_manager_operation.manager_operation.
  Definition Transaction := 'manager_operation.Transaction.
  Definition Origination := 'manager_operation.Origination.
End manager_operation.

Definition protocol_data := 'protocol_data.
Definition operation := 'operation.
Definition counter := 'counter.

Module internal_operation.
  Record record : Set := Build {
    source : Contract.contract;
    operation : manager_operation;
    nonce : int }.
  Definition with_source source (r : record) :=
    Build source r.(operation) r.(nonce).
  Definition with_operation operation (r : record) :=
    Build r.(source) operation r.(nonce).
  Definition with_nonce nonce (r : record) :=
    Build r.(source) r.(operation) nonce.
End internal_operation.
Definition internal_operation := internal_operation.record.

Inductive packed_manager_operation : Set :=
| Manager : manager_operation -> packed_manager_operation.

Inductive packed_contents : Set :=
| Contents : contents -> packed_contents.

Inductive packed_contents_list : Set :=
| Contents_list : contents_list -> packed_contents_list.

Inductive packed_protocol_data : Set :=
| Operation_data : protocol_data -> packed_protocol_data.

Module packed_operation.
  Record record : Set := Build {
    shell : Operation.shell_header;
    protocol_data : packed_protocol_data }.
  Definition with_shell shell (r : record) :=
    Build shell r.(protocol_data).
  Definition with_protocol_data protocol_data (r : record) :=
    Build r.(shell) protocol_data.
End packed_operation.
Definition packed_operation := packed_operation.record.

Inductive packed_internal_operation : Set :=
| Internal_operation : internal_operation -> packed_internal_operation.

Parameter manager_kind : manager_operation -> Kind.manager.

Module Fees.
  Parameter origination_burn :
    context -> Lwt.t (Error_monad.tzresult (context * Tez.t)).
  
  Parameter record_paid_storage_space :
    context -> Contract.t ->
    Lwt.t (Error_monad.tzresult (context * Z.t * Z.t * Tez.t)).
  
  Parameter start_counting_storage_fees : context -> context.
  
  Parameter burn_storage_fees :
    context -> Z.t -> Contract.t -> Lwt.t (Error_monad.tzresult context).
  
  (* extensible_type_definition `error` *)
  
  (* extensible_type_definition `error` *)
  
  (* extensible_type_definition `error` *)
  
  Parameter check_storage_limit : context -> Z.t -> Error_monad.tzresult unit.
End Fees.

Module Operation.
  Definition contents : Set := contents.
  
  Definition packed_contents : Set := packed_contents.
  
  Parameter contents_encoding : Data_encoding.t packed_contents.
  
  Definition protocol_data : Set := protocol_data.
  
  Definition packed_protocol_data : Set := packed_protocol_data.
  
  Parameter protocol_data_encoding : Data_encoding.t packed_protocol_data.
  
  Parameter unsigned_encoding :
    Data_encoding.t (Operation.shell_header * packed_contents_list).
  
  Definition raw : Set := Operation.t.
  
  Parameter raw_encoding : Data_encoding.t raw.
  
  Parameter contents_list_encoding : Data_encoding.t packed_contents_list.
  
  Definition t : Set := operation.
  
  Definition packed : Set := packed_operation.
  
  Parameter encoding : Data_encoding.t packed.
  
  Parameter __raw_value : operation -> raw.
  
  Parameter __hash_value : operation -> (|Operation_hash|).(S.HASH.t).
  
  Parameter hash_raw : raw -> (|Operation_hash|).(S.HASH.t).
  
  Parameter hash_packed : packed_operation -> (|Operation_hash|).(S.HASH.t).
  
  Parameter acceptable_passes : packed_operation -> list int.
  
  (* extensible_type_definition `error` *)
  
  (* extensible_type_definition `error` *)
  
  Parameter check_signature :
    public_key -> (|Chain_id|).(S.HASH.t) -> operation ->
    Lwt.t (Error_monad.tzresult unit).
  
  Parameter check_signature_sync :
    public_key -> (|Chain_id|).(S.HASH.t) -> operation ->
    Error_monad.tzresult unit.
  
  Parameter internal_operation_encoding :
    Data_encoding.t packed_internal_operation.
  
  Parameter __pack : operation -> packed_operation.
  
  Inductive eq : Set :=
  | Eq : eq.
  
  Parameter equal : operation -> operation -> option eq.
  
  Module Encoding.
    Module ConstructorRecords_case.
      Module case.
        Module Case.
          Record record {tag name encoding select proj inj : Set} : Set := Build {
            tag : tag;
            name : name;
            encoding : encoding;
            select : select;
            proj : proj;
            inj : inj }.
          Arguments record : clear implicits.
          Definition with_tag {t_tag t_name t_encoding t_select t_proj t_inj}
            tag (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
            Build t_tag t_name t_encoding t_select t_proj t_inj tag r.(name)
              r.(encoding) r.(select) r.(proj) r.(inj).
          Definition with_name {t_tag t_name t_encoding t_select t_proj t_inj}
            name (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
            Build t_tag t_name t_encoding t_select t_proj t_inj r.(tag) name
              r.(encoding) r.(select) r.(proj) r.(inj).
          Definition with_encoding
            {t_tag t_name t_encoding t_select t_proj t_inj} encoding
            (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
            Build t_tag t_name t_encoding t_select t_proj t_inj r.(tag) r.(name)
              encoding r.(select) r.(proj) r.(inj).
          Definition with_select {t_tag t_name t_encoding t_select t_proj t_inj}
            select (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
            Build t_tag t_name t_encoding t_select t_proj t_inj r.(tag) r.(name)
              r.(encoding) select r.(proj) r.(inj).
          Definition with_proj {t_tag t_name t_encoding t_select t_proj t_inj}
            proj (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
            Build t_tag t_name t_encoding t_select t_proj t_inj r.(tag) r.(name)
              r.(encoding) r.(select) proj r.(inj).
          Definition with_inj {t_tag t_name t_encoding t_select t_proj t_inj}
            inj (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
            Build t_tag t_name t_encoding t_select t_proj t_inj r.(tag) r.(name)
              r.(encoding) r.(select) r.(proj) inj.
        End Case.
        Definition Case_skeleton := Case.record.
      End case.
    End ConstructorRecords_case.
    Import ConstructorRecords_case.
    
    Reserved Notation "'case.Case".
    
    Inductive case : Set :=
    | Case : forall {a : Set}, 'case.Case a -> case
    
    where "'case.Case" := (fun (t_a : Set) =>
      case.Case_skeleton int string (Data_encoding.t t_a)
        (packed_contents -> option contents) (contents -> t_a) (t_a -> contents)).
    
    Module case.
      Include ConstructorRecords_case.case.
      Definition Case := 'case.Case.
    End case.
    
    Parameter endorsement_case : case.
    
    Parameter seed_nonce_revelation_case : case.
    
    Parameter double_endorsement_evidence_case : case.
    
    Parameter double_baking_evidence_case : case.
    
    Parameter activate_account_case : case.
    
    Parameter proposals_case : case.
    
    Parameter ballot_case : case.
    
    Parameter reveal_case : case.
    
    Parameter transaction_case : case.
    
    Parameter origination_case : case.
    
    Parameter delegation_case : case.
    
    Module Manager_operations.
      Module ConstructorRecords_case.
        Module case.
          Module MCase.
            Record record {tag name encoding select proj inj : Set} : Set := Build {
              tag : tag;
              name : name;
              encoding : encoding;
              select : select;
              proj : proj;
              inj : inj }.
            Arguments record : clear implicits.
            Definition with_tag {t_tag t_name t_encoding t_select t_proj t_inj}
              tag (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
              Build t_tag t_name t_encoding t_select t_proj t_inj tag r.(name)
                r.(encoding) r.(select) r.(proj) r.(inj).
            Definition with_name {t_tag t_name t_encoding t_select t_proj t_inj}
              name (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
              Build t_tag t_name t_encoding t_select t_proj t_inj r.(tag) name
                r.(encoding) r.(select) r.(proj) r.(inj).
            Definition with_encoding
              {t_tag t_name t_encoding t_select t_proj t_inj} encoding
              (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
              Build t_tag t_name t_encoding t_select t_proj t_inj r.(tag)
                r.(name) encoding r.(select) r.(proj) r.(inj).
            Definition with_select
              {t_tag t_name t_encoding t_select t_proj t_inj} select
              (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
              Build t_tag t_name t_encoding t_select t_proj t_inj r.(tag)
                r.(name) r.(encoding) select r.(proj) r.(inj).
            Definition with_proj {t_tag t_name t_encoding t_select t_proj t_inj}
              proj (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
              Build t_tag t_name t_encoding t_select t_proj t_inj r.(tag)
                r.(name) r.(encoding) r.(select) proj r.(inj).
            Definition with_inj {t_tag t_name t_encoding t_select t_proj t_inj}
              inj (r : record t_tag t_name t_encoding t_select t_proj t_inj) :=
              Build t_tag t_name t_encoding t_select t_proj t_inj r.(tag)
                r.(name) r.(encoding) r.(select) r.(proj) inj.
          End MCase.
          Definition MCase_skeleton := MCase.record.
        End case.
      End ConstructorRecords_case.
      Import ConstructorRecords_case.
      
      Reserved Notation "'case.MCase".
      
      Inductive case : Set :=
      | MCase : forall {a : Set}, 'case.MCase a -> case
      
      where "'case.MCase" := (fun (t_a : Set) =>
        case.MCase_skeleton int string (Data_encoding.t t_a)
          (packed_manager_operation -> option manager_operation)
          (manager_operation -> t_a) (t_a -> manager_operation)).
      
      Module case.
        Include ConstructorRecords_case.case.
        Definition MCase := 'case.MCase.
      End case.
      
      Parameter reveal_case : case.
      
      Parameter transaction_case : case.
      
      Parameter origination_case : case.
      
      Parameter delegation_case : case.
    End Manager_operations.
  End Encoding.
  
  Parameter of_list : list packed_contents -> packed_contents_list.
  
  Parameter to_list : packed_contents_list -> list packed_contents.
End Operation.

Module Roll.
  Definition t : Set := int32.
  
  Definition roll : Set := t.
  
  Parameter encoding : Data_encoding.t roll.
  
  Parameter snapshot_rolls : context -> Lwt.t (Error_monad.tzresult context).
  
  Parameter cycle_end :
    context -> Cycle.t -> Lwt.t (Error_monad.tzresult context).
  
  Parameter baking_rights_owner :
    context -> Level.t -> int -> Lwt.t (Error_monad.tzresult public_key).
  
  Parameter endorsement_rights_owner :
    context -> Level.t -> int -> Lwt.t (Error_monad.tzresult public_key).
  
  Parameter delegate_pubkey :
    context -> public_key_hash -> Lwt.t (Error_monad.tzresult public_key).
  
  Parameter get_rolls :
    context -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
    Lwt.t (Error_monad.tzresult (list roll)).
  
  Parameter get_change :
    context -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
    Lwt.t (Error_monad.tzresult Tez.t).
End Roll.

Module Commitment.
  Module t.
    Record record : Set := Build {
      blinded_public_key_hash : Blinded_public_key_hash.t;
      amount : Tez.tez }.
    Definition with_blinded_public_key_hash blinded_public_key_hash
      (r : record) :=
      Build blinded_public_key_hash r.(amount).
    Definition with_amount amount (r : record) :=
      Build r.(blinded_public_key_hash) amount.
  End t.
  Definition t := t.record.
  
  Parameter get_opt :
    context -> Blinded_public_key_hash.t ->
    Lwt.t (Error_monad.tzresult (option Tez.t)).
  
  Parameter delete :
    context -> Blinded_public_key_hash.t -> Lwt.t (Error_monad.tzresult context).
End Commitment.

Module Bootstrap.
  Parameter cycle_end :
    context -> Cycle.t -> Lwt.t (Error_monad.tzresult context).
End Bootstrap.

Module Global.
  Parameter get_block_priority : context -> Lwt.t (Error_monad.tzresult int).
  
  Parameter set_block_priority :
    context -> int -> Lwt.t (Error_monad.tzresult context).
End Global.

Parameter prepare_first_block :
  Context.t ->
  (context -> Script.t ->
  Lwt.t
    (Error_monad.tzresult ((Script.t * option Contract.big_map_diff) * context)))
  -> Int32.t -> Time.t -> Fitness.t -> Lwt.t (Error_monad.tzresult context).

Parameter prepare :
  Context.t -> Int32.t -> Time.t -> Time.t -> Fitness.t ->
  Lwt.t (Error_monad.tzresult context).

Parameter finalize : option string -> context -> Updater.validation_result.

Parameter activate : context -> (|Protocol_hash|).(S.HASH.t) -> Lwt.t context.

Parameter fork_test_chain :
  context -> (|Protocol_hash|).(S.HASH.t) -> Time.t -> Lwt.t context.

Parameter record_endorsement :
  context -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> context.

Parameter allowed_endorsements :
  context ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.t)
    ((|Signature.Public_key|).(S.SPublic_key.t) * list int * bool).

Parameter init_endorsements :
  context ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.t)
    ((|Signature.Public_key|).(S.SPublic_key.t) * list int * bool) -> context.

Parameter included_endorsements : context -> int.

Parameter reset_internal_nonce : context -> context.

Parameter fresh_internal_nonce :
  context -> Error_monad.tzresult (context * int).

Parameter record_internal_nonce : context -> int -> context.

Parameter internal_nonce_already_recorded : context -> int -> bool.

Parameter add_fees : context -> Tez.t -> Lwt.t (Error_monad.tzresult context).

Parameter add_rewards :
  context -> Tez.t -> Lwt.t (Error_monad.tzresult context).

Parameter add_deposit :
  context -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> Tez.t ->
  Lwt.t (Error_monad.tzresult context).

Parameter get_fees : context -> Tez.t.

Parameter get_rewards : context -> Tez.t.

Parameter get_deposits :
  context ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.t) Tez.t.

Parameter description : Storage_description.t context.

Alpha_services

  • OCaml size: 117 lines
  • Coq size: 152 lines (+29% compared to OCaml)
alpha_services.ml 6 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

let custom_root = RPC_path.open_root

module Seed = struct
  module S = struct
    open Data_encoding

    let seed =
      RPC_service.post_service
        ~description:"Seed of the cycle to which the block belongs."
        ~query:RPC_query.empty
        ~input:empty
        ~output:Seed.seed_encoding
        RPC_path.(custom_root / "context" / "seed")
  end

  let () =
    let open Services_registration in
    register0 S.seed (fun ctxt () () ->
        let l = Level.current ctxt in
        Seed.for_cycle ctxt l.cycle)

  let get ctxt block = RPC_context.make_call0 S.seed ctxt block () ()
end

module Nonce = struct
  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten

  let info_encoding =
    let open Data_encoding in
    union
      [ case
          (Tag 0)
          ~title:"Revealed"
          (obj1 (req "nonce" Nonce.encoding))
          (function Revealed nonce -> Some nonce | _ -> None)
          (fun nonce -> Revealed nonce);
        case
          (Tag 1)
          ~title:"Missing"
          (obj1 (req "hash" Nonce_hash.encoding))
          (function Missing nonce -> Some nonce | _ -> None)
          (fun nonce -> Missing nonce);
        case
          (Tag 2)
          ~title:"Forgotten"
          empty
          (function Forgotten -> Some () | _ -> None)
          (fun () -> Forgotten) ]

  module S = struct
    let get =
      RPC_service.get_service
        ~description:"Info about the nonce of a previous block."
        ~query:RPC_query.empty
        ~output:info_encoding
        RPC_path.(custom_root / "context" / "nonces" /: Raw_level.rpc_arg)
  end

  let register () =
    let open Services_registration in
    register1 S.get (fun ctxt raw_level () () ->
        let level = Level.from_raw ctxt raw_level in
        Nonce.get ctxt level
        >>= function
        | Ok (Storage.Revealed nonce) ->
            return (Revealed nonce)
        | Ok (Storage.Unrevealed {nonce_hash; _}) ->
            return (Missing nonce_hash)
        | Error _ ->
            return Forgotten)

  let get ctxt block level =
    RPC_context.make_call1 S.get ctxt block level () ()
end

module Contract = Contract_services
module Constants = Constants_services
module Delegate = Delegate_services
module Helpers = Helpers_services
module Forge = Helpers_services.Forge
module Parse = Helpers_services.Parse
module Voting = Voting_services

let register () =
  Contract.register () ;
  Constants.register () ;
  Delegate.register () ;
  Helpers.register () ;
  Nonce.register () ;
  Voting.register ()
Alpha_services.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Constants_services.
Require Tezos.Contract_services.
Require Tezos.Delegate_services.
Require Tezos.Helpers_services.
Require Tezos.Nonce_hash.
Require Tezos.Seed_repr.
Require Tezos.Services_registration.
Require Tezos.Storage_mli. Module Storage := Storage_mli.
Require Tezos.Voting_services.

Import Alpha_context.

Definition custom_root {A : Set} : RPC_path.context A := RPC_path.open_root.

Module Seed.
  Module S.
    Import Data_encoding.
    
    Definition __seed_value
      : RPC_service.service Updater.rpc_context Updater.rpc_context unit unit
        Alpha_context.Seed.seed :=
      RPC_service.post_service
        (Some "Seed of the cycle to which the block belongs.") RPC_query.empty
        Data_encoding.empty Alpha_context.Seed.seed_encoding
        (RPC_path.op_div (RPC_path.op_div custom_root "context") "seed").
  End S.
  
  (* ❌ Top-level evaluations are ignored *)
  (* top_level_evaluation *)
  
  Definition get {A : Set} (ctxt : RPC_context.simple A) (block : A)
    : Lwt.t (Error_monad.shell_tzresult Alpha_context.Seed.seed) :=
    RPC_context.make_call0 S.__seed_value ctxt block tt tt.
End Seed.

Module Nonce.
  Inductive info : Set :=
  | Revealed : Alpha_context.Nonce.t -> info
  | Missing : Nonce_hash.t -> info
  | Forgotten : info.
  
  Definition info_encoding : Data_encoding.encoding info :=
    Data_encoding.union None
      [
        Data_encoding.__case_value "Revealed" None (Data_encoding.Tag 0)
          (Data_encoding.obj1
            (Data_encoding.req None None "nonce"
              Alpha_context.Nonce.encoding))
          (fun function_parameter =>
            match function_parameter with
            | Revealed __nonce_value => Some __nonce_value
            | _ => None
            end) (fun __nonce_value => Revealed __nonce_value);
        Data_encoding.__case_value "Missing" None (Data_encoding.Tag 1)
          (Data_encoding.obj1
            (Data_encoding.req None None "hash" Nonce_hash.encoding))
          (fun function_parameter =>
            match function_parameter with
            | Missing __nonce_value => Some __nonce_value
            | _ => None
            end) (fun __nonce_value => Missing __nonce_value);
        Data_encoding.__case_value "Forgotten" None (Data_encoding.Tag 2)
          Data_encoding.empty
          (fun function_parameter =>
            match function_parameter with
            | Forgotten => Some tt
            | _ => None
            end)
          (fun function_parameter =>
            let '_ := function_parameter in
            Forgotten)
      ].
  
  Module S.
    Definition get
      : RPC_service.service Updater.rpc_context
        (Updater.rpc_context * Alpha_context.Raw_level.raw_level) unit unit info :=
      RPC_service.get_service (Some "Info about the nonce of a previous block.")
        RPC_query.empty info_encoding
        (RPC_path.op_divcolon
          (RPC_path.op_div (RPC_path.op_div custom_root "context") "nonces")
          Alpha_context.Raw_level.rpc_arg).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let '_ := function_parameter in
    Services_registration.register1 S.get
      (fun ctxt =>
        fun raw_level =>
          fun function_parameter =>
            let '_ := function_parameter in
            fun function_parameter =>
              let '_ := function_parameter in
              let level := Alpha_context.Level.from_raw ctxt None raw_level in
              let= function_parameter := Alpha_context.Nonce.get ctxt level in
              match function_parameter with
              | Pervasives.Ok (Storage.Revealed __nonce_value) =>
                Error_monad.__return (Revealed __nonce_value)
              |
                Pervasives.Ok
                  (Storage.Unrevealed {|
                    Storage.unrevealed_nonce.nonce_hash := nonce_hash |}) =>
                Error_monad.__return (Missing nonce_hash)
              | Pervasives.Error _ => Error_monad.__return Forgotten
              end).
  
  Definition get {A : Set}
    (ctxt : RPC_context.simple A) (block : A)
    (level : Alpha_context.Raw_level.raw_level)
    : Lwt.t (Error_monad.shell_tzresult info) :=
    RPC_context.make_call1 S.get ctxt block level tt tt.
End Nonce.

Module Contract := Contract_services.

Module Constants := Constants_services.

Module Delegate := Delegate_services.

Module Helpers := Helpers_services.

Module Forge := Helpers_services.Forge.

Module Parse := Helpers_services.Parse.

Module Voting := Voting_services.

Definition register (function_parameter : unit) : unit :=
  let '_ := function_parameter in
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  Voting.register tt.

Alpha_services_mli

  • OCaml size: 47 lines
  • Coq size: 53 lines (+12% compared to OCaml)
alpha_services.mli success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

module Seed : sig
  val get : 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t
end

module Nonce : sig
  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten

  val get :
    'a #RPC_context.simple -> 'a -> Raw_level.t -> info shell_tzresult Lwt.t
end

module Contract = Contract_services
module Constants = Constants_services
module Delegate = Delegate_services
module Helpers = Helpers_services
module Forge = Helpers_services.Forge
module Parse = Helpers_services.Parse
module Voting = Voting_services

val register : unit -> unit
Alpha_services_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Constants_services.
Require Tezos.Contract_services.
Require Tezos.Delegate_services.
Require Tezos.Helpers_services.
Require Tezos.Nonce_hash.
Require Tezos.Voting_services.

Import Alpha_context.

Module Seed.
  Parameter get : forall {a : Set},
    RPC_context.simple a -> a ->
    Lwt.t (Error_monad.shell_tzresult Alpha_context.Seed.seed).
End Seed.

Module Nonce.
  Inductive info : Set :=
  | Revealed : Alpha_context.Nonce.t -> info
  | Missing : Nonce_hash.t -> info
  | Forgotten : info.
  
  Parameter get : forall {a : Set},
    RPC_context.simple a -> a -> Alpha_context.Raw_level.t ->
    Lwt.t (Error_monad.shell_tzresult info).
End Nonce.

Module Contract := Contract_services.

Module Constants := Constants_services.

Module Delegate := Delegate_services.

Module Helpers := Helpers_services.

Module Forge := Helpers_services.Forge.

Module Parse := Helpers_services.Parse.

Module Voting := Voting_services.

Parameter register : unit -> unit.

Amendment

  • OCaml size: 323 lines
  • Coq size: 262 lines (-19% compared to OCaml)
amendment.ml 11 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

(** Returns the proposal submitted by the most delegates.
    Returns None in case of a tie, if proposal quorum is below required
    minimum or if there are no proposals. *)
let select_winning_proposal ctxt =
  Vote.get_proposals ctxt
  >>=? fun proposals ->
  let merge proposal vote winners =
    match winners with
    | None ->
        Some ([proposal], vote)
    | Some (winners, winners_vote) as previous ->
        if Compare.Int32.(vote = winners_vote) then
          Some (proposal :: winners, winners_vote)
        else if Compare.Int32.(vote > winners_vote) then Some ([proposal], vote)
        else previous
  in
  match Protocol_hash.Map.fold merge proposals None with
  | Some ([proposal], vote) ->
      Vote.listing_size ctxt
      >>=? fun max_vote ->
      let min_proposal_quorum = Constants.min_proposal_quorum ctxt in
      let min_vote_to_pass =
        Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l
      in
      if Compare.Int32.(vote >= min_vote_to_pass) then return_some proposal
      else return_none
  | _ ->
      return_none

(* in case of a tie, let's do nothing. *)

(** A proposal is approved if it has supermajority and the participation reaches
    the current quorum.
    Supermajority means the yays are more 8/10 of casted votes.
    The participation is the ratio of all received votes, including passes, with
    respect to the number of possible votes.
    The participation EMA (exponential moving average) uses the last
    participation EMA and the current participation./
    The expected quorum is calculated using the last participation EMA, capped
    by the min/max quorum protocol constants. *)
let check_approval_and_update_participation_ema ctxt =
  Vote.get_ballots ctxt
  >>=? fun ballots ->
  Vote.listing_size ctxt
  >>=? fun maximum_vote ->
  Vote.get_participation_ema ctxt
  >>=? fun participation_ema ->
  Vote.get_current_quorum ctxt
  >>=? fun expected_quorum ->
  (* Note overflows: considering a maximum of 8e8 tokens, with roll size as
     small as 1e3, there is a maximum of 8e5 rolls and thus votes.
     In 'participation' an Int64 is used because in the worst case 'all_votes is
     8e5 and after the multiplication is 8e9, making it potentially overflow a
     signed Int32 which is 2e9. *)
  let casted_votes = Int32.add ballots.yay ballots.nay in
  let all_votes = Int32.add casted_votes ballots.pass in
  let supermajority = Int32.div (Int32.mul 8l casted_votes) 10l in
  let participation =
    (* in centile of percentage *)
    Int64.(
      to_int32 (div (mul (of_int32 all_votes) 100_00L) (of_int32 maximum_vote)))
  in
  let outcome =
    Compare.Int32.(
      participation >= expected_quorum && ballots.yay >= supermajority)
  in
  let new_participation_ema =
    Int32.(div (add (mul 8l participation_ema) (mul 2l participation)) 10l)
  in
  Vote.set_participation_ema ctxt new_participation_ema
  >>=? fun ctxt -> return (ctxt, outcome)

(** Implements the state machine of the amendment procedure.
    Note that [freeze_listings], that computes the vote weight of each delegate,
    is run at the beginning of each voting period.
*)
let start_new_voting_period ctxt =
  Vote.get_current_period_kind ctxt
  >>=? function
  | Proposal -> (
      select_winning_proposal ctxt
      >>=? fun proposal ->
      Vote.clear_proposals ctxt
      >>= fun ctxt ->
      Vote.clear_listings ctxt
      >>=? fun ctxt ->
      match proposal with
      | None ->
          Vote.freeze_listings ctxt >>=? fun ctxt -> return ctxt
      | Some proposal ->
          Vote.init_current_proposal ctxt proposal
          >>=? fun ctxt ->
          Vote.freeze_listings ctxt
          >>=? fun ctxt ->
          Vote.set_current_period_kind ctxt Testing_vote
          >>=? fun ctxt -> return ctxt )
  | Testing_vote ->
      check_approval_and_update_participation_ema ctxt
      >>=? fun (ctxt, approved) ->
      Vote.clear_ballots ctxt
      >>= fun ctxt ->
      Vote.clear_listings ctxt
      >>=? fun ctxt ->
      if approved then
        let expiration =
          (* in two days maximum... *)
          Time.add
            (Timestamp.current ctxt)
            (Constants.test_chain_duration ctxt)
        in
        Vote.get_current_proposal ctxt
        >>=? fun proposal ->
        fork_test_chain ctxt proposal expiration
        >>= fun ctxt ->
        Vote.set_current_period_kind ctxt Testing >>=? fun ctxt -> return ctxt
      else
        Vote.clear_current_proposal ctxt
        >>=? fun ctxt ->
        Vote.freeze_listings ctxt
        >>=? fun ctxt ->
        Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt
  | Testing ->
      Vote.freeze_listings ctxt
      >>=? fun ctxt ->
      Vote.set_current_period_kind ctxt Promotion_vote
      >>=? fun ctxt -> return ctxt
  | Promotion_vote ->
      check_approval_and_update_participation_ema ctxt
      >>=? fun (ctxt, approved) ->
      ( if approved then
        Vote.get_current_proposal ctxt
        >>=? fun proposal -> activate ctxt proposal >>= fun ctxt -> return ctxt
      else return ctxt )
      >>=? fun ctxt ->
      Vote.clear_ballots ctxt
      >>= fun ctxt ->
      Vote.clear_listings ctxt
      >>=? fun ctxt ->
      Vote.clear_current_proposal ctxt
      >>=? fun ctxt ->
      Vote.freeze_listings ctxt
      >>=? fun ctxt ->
      Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt

type error +=
  | (* `Branch *)
      Invalid_proposal
  | Unexpected_proposal
  | Unauthorized_proposal
  | Too_many_proposals
  | Empty_proposal
  | Unexpected_ballot
  | Unauthorized_ballot

let () =
  let open Data_encoding in
  (* Invalid proposal *)
  register_error_kind
    `Branch
    ~id:"invalid_proposal"
    ~title:"Invalid proposal"
    ~description:"Ballot provided for a proposal that is not the current one."
    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid proposal")
    empty
    (function Invalid_proposal -> Some () | _ -> None)
    (fun () -> Invalid_proposal) ;
  (* Unexpected proposal *)
  register_error_kind
    `Branch
    ~id:"unexpected_proposal"
    ~title:"Unexpected proposal"
    ~description:"Proposal recorded outside of a proposal period."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected proposal")
    empty
    (function Unexpected_proposal -> Some () | _ -> None)
    (fun () -> Unexpected_proposal) ;
  (* Unauthorized proposal *)
  register_error_kind
    `Branch
    ~id:"unauthorized_proposal"
    ~title:"Unauthorized proposal"
    ~description:
      "The delegate provided for the proposal is not in the voting listings."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized proposal")
    empty
    (function Unauthorized_proposal -> Some () | _ -> None)
    (fun () -> Unauthorized_proposal) ;
  (* Unexpected ballot *)
  register_error_kind
    `Branch
    ~id:"unexpected_ballot"
    ~title:"Unexpected ballot"
    ~description:"Ballot recorded outside of a voting period."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected ballot")
    empty
    (function Unexpected_ballot -> Some () | _ -> None)
    (fun () -> Unexpected_ballot) ;
  (* Unauthorized ballot *)
  register_error_kind
    `Branch
    ~id:"unauthorized_ballot"
    ~title:"Unauthorized ballot"
    ~description:
      "The delegate provided for the ballot is not in the voting listings."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized ballot")
    empty
    (function Unauthorized_ballot -> Some () | _ -> None)
    (fun () -> Unauthorized_ballot) ;
  (* Too many proposals *)
  register_error_kind
    `Branch
    ~id:"too_many_proposals"
    ~title:"Too many proposals"
    ~description:
      "The delegate reached the maximum number of allowed proposals."
    ~pp:(fun ppf () -> Format.fprintf ppf "Too many proposals")
    empty
    (function Too_many_proposals -> Some () | _ -> None)
    (fun () -> Too_many_proposals) ;
  (* Empty proposal *)
  register_error_kind
    `Branch
    ~id:"empty_proposal"
    ~title:"Empty proposal"
    ~description:"Proposal lists cannot be empty."
    ~pp:(fun ppf () -> Format.fprintf ppf "Empty proposal")
    empty
    (function Empty_proposal -> Some () | _ -> None)
    (fun () -> Empty_proposal)

(* @return [true] if [List.length l] > [n] w/o computing length *)
let rec longer_than l n =
  if Compare.Int.(n < 0) then assert false
  else
    match l with
    | [] ->
        false
    | _ :: rest ->
        if Compare.Int.(n = 0) then true
        else (* n > 0 *)
          longer_than rest (n - 1)

let record_proposals ctxt delegate proposals =
  (match proposals with [] -> fail Empty_proposal | _ :: _ -> return_unit)
  >>=? fun () ->
  Vote.get_current_period_kind ctxt
  >>=? function
  | Proposal ->
      Vote.in_listings ctxt delegate
      >>= fun in_listings ->
      if in_listings then
        Vote.recorded_proposal_count_for_delegate ctxt delegate
        >>=? fun count ->
        fail_when
          (longer_than proposals (Constants.max_proposals_per_delegate - count))
          Too_many_proposals
        >>=? fun () ->
        fold_left_s
          (fun ctxt proposal -> Vote.record_proposal ctxt proposal delegate)
          ctxt
          proposals
        >>=? fun ctxt -> return ctxt
      else fail Unauthorized_proposal
  | Testing_vote | Testing | Promotion_vote ->
      fail Unexpected_proposal

let record_ballot ctxt delegate proposal ballot =
  Vote.get_current_period_kind ctxt
  >>=? function
  | Testing_vote | Promotion_vote ->
      Vote.get_current_proposal ctxt
      >>=? fun current_proposal ->
      fail_unless
        (Protocol_hash.equal proposal current_proposal)
        Invalid_proposal
      >>=? fun () ->
      Vote.has_recorded_ballot ctxt delegate
      >>= fun has_ballot ->
      fail_when has_ballot Unauthorized_ballot
      >>=? fun () ->
      Vote.in_listings ctxt delegate
      >>= fun in_listings ->
      if in_listings then Vote.record_ballot ctxt delegate ballot
      else fail Unauthorized_ballot
  | Testing | Proposal ->
      fail Unexpected_ballot

let last_of_a_voting_period ctxt l =
  Compare.Int32.(
    Int32.succ l.Level.voting_period_position
    = Constants.blocks_per_voting_period ctxt)

let may_start_new_voting_period ctxt =
  let level = Level.current ctxt in
  if last_of_a_voting_period ctxt level then start_new_voting_period ctxt
  else return ctxt
Amendment.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.

Import Alpha_context.

Definition select_winning_proposal (ctxt : Alpha_context.context)
  : Lwt.t
    (Error_monad.tzresult
      (option (|Protocol_hash|).(S.HASH.Map).(S.INDEXES_Map.key))) :=
  let=? proposals := Alpha_context.Vote.get_proposals ctxt in
  let merge {A : Set}
    (proposal : A) (vote : (|Compare.Int32|).(Compare.S.t))
    (winners : option (list A * (|Compare.Int32|).(Compare.S.t)))
    : option (list A * (|Compare.Int32|).(Compare.S.t)) :=
    match winners with
    | None => Some ([ proposal ], vote)
    | (Some (winners, winners_vote)) as previous =>
      if (|Compare.Int32|).(Compare.S.op_eq) vote winners_vote then
        Some ((cons proposal winners), winners_vote)
      else
        if (|Compare.Int32|).(Compare.S.op_gt) vote winners_vote then
          Some ([ proposal ], vote)
        else
          previous
    end in
  match (|Protocol_hash|).(S.HASH.Map).(S.INDEXES_Map.fold) merge proposals None
    with
  | Some (cons proposal [], vote) =>
    let=? max_vote := Alpha_context.Vote.listing_size ctxt in
    let min_proposal_quorum := Alpha_context.Constants.min_proposal_quorum ctxt
      in
    let min_vote_to_pass :=
      Int32.div (Int32.mul min_proposal_quorum max_vote)
        (* ❌ Constant of type int32 is converted to int *)
        10000 in
    if (|Compare.Int32|).(Compare.S.op_gteq) vote min_vote_to_pass then
      Error_monad.return_some proposal
    else
      Error_monad.return_none
  | _ => Error_monad.return_none
  end.

Definition check_approval_and_update_participation_ema
  (ctxt : Alpha_context.context)
  : Lwt.t (Error_monad.tzresult (Alpha_context.context * bool)) :=
  let=? ballots := Alpha_context.Vote.get_ballots ctxt in
  let=? maximum_vote := Alpha_context.Vote.listing_size ctxt in
  let=? participation_ema := Alpha_context.Vote.get_participation_ema ctxt in
  let=? expected_quorum := Alpha_context.Vote.get_current_quorum ctxt in
  let casted_votes :=
    Int32.add ballots.(Alpha_context.Vote.ballots.yay)
      ballots.(Alpha_context.Vote.ballots.nay) in
  let all_votes :=
    Int32.add casted_votes ballots.(Alpha_context.Vote.ballots.pass) in
  let supermajority :=
    Int32.div
      (Int32.mul
        (* ❌ Constant of type int32 is converted to int *)
        8 casted_votes)
      (* ❌ Constant of type int32 is converted to int *)
      10 in
  let participation :=
    Int64.to_int32
      (Int64.div
        (Int64.mul (Int64.of_int32 all_votes)
          (* ❌ Constant of type int64 is converted to int *)
          10000) (Int64.of_int32 maximum_vote)) in
  let outcome :=
    Pervasives.op_andand
      ((|Compare.Int32|).(Compare.S.op_gteq) participation expected_quorum)
      ((|Compare.Int32|).(Compare.S.op_gteq)
        ballots.(Alpha_context.Vote.ballots.yay) supermajority) in
  let new_participation_ema :=
    Int32.div
      (Int32.add
        (Int32.mul
          (* ❌ Constant of type int32 is converted to int *)
          8 participation_ema)
        (Int32.mul
          (* ❌ Constant of type int32 is converted to int *)
          2 participation))
      (* ❌ Constant of type int32 is converted to int *)
      10 in
  let=? ctxt :=
    Alpha_context.Vote.set_participation_ema ctxt new_participation_ema in
  Error_monad.__return (ctxt, outcome).

Definition start_new_voting_period (ctxt : Alpha_context.context)
  : Lwt.t (Error_monad.tzresult Alpha_context.context) :=
  let=? function_parameter := Alpha_context.Vote.get_current_period_kind ctxt in
  match function_parameter with
  | Alpha_context.Voting_period.Proposal =>
    let=? proposal := select_winning_proposal ctxt in
    let= ctxt := Alpha_context.Vote.clear_proposals ctxt in
    let=? ctxt := Alpha_context.Vote.clear_listings ctxt in
    match proposal with
    | None =>
      let=? ctxt := Alpha_context.Vote.freeze_listings ctxt in
      Error_monad.__return ctxt
    | Some proposal =>
      let=? ctxt := Alpha_context.Vote.init_current_proposal ctxt proposal in
      let=? ctxt := Alpha_context.Vote.freeze_listings ctxt in
      let=? ctxt :=
        Alpha_context.Vote.set_current_period_kind ctxt
          Alpha_context.Voting_period.Testing_vote in
      Error_monad.__return ctxt
    end
  | Alpha_context.Voting_period.Testing_vote =>
    let=? '(ctxt, approved) := check_approval_and_update_participation_ema ctxt
      in
    let= ctxt := Alpha_context.Vote.clear_ballots ctxt in
    let=? ctxt := Alpha_context.Vote.clear_listings ctxt in
    if approved then
      let expiration :=
        Time.add (Alpha_context.Timestamp.current ctxt)
          (Alpha_context.Constants.test_chain_duration ctxt) in
      let=? proposal := Alpha_context.Vote.get_current_proposal ctxt in
      let= ctxt := Alpha_context.fork_test_chain ctxt proposal expiration in
      let=? ctxt :=
        Alpha_context.Vote.set_current_period_kind ctxt
          Alpha_context.Voting_period.Testing in
      Error_monad.__return ctxt
    else
      let=? ctxt := Alpha_context.Vote.clear_current_proposal ctxt in
      let=? ctxt := Alpha_context.Vote.freeze_listings ctxt in
      let=? ctxt :=
        Alpha_context.Vote.set_current_period_kind ctxt
          Alpha_context.Voting_period.Proposal in
      Error_monad.__return ctxt
  | Alpha_context.Voting_period.Testing =>
    let=? ctxt := Alpha_context.Vote.freeze_listings ctxt in
    let=? ctxt :=
      Alpha_context.Vote.set_current_period_kind ctxt
        Alpha_context.Voting_period.Promotion_vote in
    Error_monad.__return ctxt
  | Alpha_context.Voting_period.Promotion_vote =>
    let=? '(ctxt, approved) := check_approval_and_update_participation_ema ctxt
      in
    let=? ctxt :=
      if approved then
        let=? proposal := Alpha_context.Vote.get_current_proposal ctxt in
        let= ctxt := Alpha_context.activate ctxt proposal in
        Error_monad.__return ctxt
      else
        Error_monad.__return ctxt in
    let= ctxt := Alpha_context.Vote.clear_ballots ctxt in
    let=? ctxt := Alpha_context.Vote.clear_listings ctxt in
    let=? ctxt := Alpha_context.Vote.clear_current_proposal ctxt in
    let=? ctxt := Alpha_context.Vote.freeze_listings ctxt in
    let=? ctxt :=
      Alpha_context.Vote.set_current_period_kind ctxt
        Alpha_context.Voting_period.Proposal in
    Error_monad.__return ctxt
  end.

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Top-level evaluations are ignored *)
(* top_level_evaluation *)

Fixpoint longer_than {A : Set} (l : list A) (n : (|Compare.Int|).(Compare.S.t))
  : bool :=
  if (|Compare.Int|).(Compare.S.op_lt) n 0 then
    (* ❌ Assert instruction is not handled. *)
    assert bool false
  else
    match l with
    | [] => false
    | cons _ rest =>
      if (|Compare.Int|).(Compare.S.op_eq) n 0 then
        true
      else
        longer_than rest (Pervasives.op_minus n 1)
    end.

Definition record_proposals
  (ctxt : Alpha_context.context) (delegate : Alpha_context.public_key_hash)
  (proposals : list (|Protocol_hash|).(S.HASH.t))
  : Lwt.t (Error_monad.tzresult Alpha_context.context) :=
  let=? '_ :=
    match proposals with
    | [] => Error_monad.fail extensible_type_value
    | cons _ _ => Error_monad.return_unit
    end in
  let=? function_parameter := Alpha_context.Vote.get_current_period_kind ctxt in
  match function_parameter with
  | Alpha_context.Voting_period.Proposal =>
    let= in_listings := Alpha_context.Vote.in_listings ctxt delegate in
    if in_listings then
      let=? count :=
        Alpha_context.Vote.recorded_proposal_count_for_delegate ctxt delegate in
      let=? '_ :=
        Error_monad.fail_when
          (longer_than proposals
            (Pervasives.op_minus
              Alpha_context.Constants.max_proposals_per_delegate count))
          extensible_type_value in
      let=? ctxt :=
        Error_monad.fold_left_s
          (fun ctxt =>
            fun proposal =>
              Alpha_context.Vote.record_proposal ctxt proposal delegate) ctxt
          proposals in
      Error_monad.__return ctxt
    else
      Error_monad.fail extensible_type_value
  |
    (Alpha_context.Voting_period.Testing_vote |
    Alpha_context.Voting_period.Testing |
    Alpha_context.Voting_period.Promotion_vote) =>
    Error_monad.fail extensible_type_value
  end.

Definition record_ballot
  (ctxt : Alpha_context.context) (delegate : Alpha_context.public_key_hash)
  (proposal : (|Protocol_hash|).(S.HASH.t)) (ballot : Alpha_context.Vote.ballot)
  : Lwt.t (Error_monad.tzresult Alpha_context.context) :=
  let=? function_parameter := Alpha_context.Vote.get_current_period_kind ctxt in
  match function_parameter with
  |
    (Alpha_context.Voting_period.Testing_vote |
    Alpha_context.Voting_period.Promotion_vote) =>
    let=? current_proposal := Alpha_context.Vote.get_current_proposal ctxt in
    let=? '_ :=
      Error_monad.fail_unless
        ((|Protocol_hash|).(S.HASH.equal) proposal current_proposal)
        extensible_type_value in
    let= has_ballot := Alpha_context.Vote.has_recorded_ballot ctxt delegate in
    let=? '_ := Error_monad.fail_when has_ballot extensible_type_value in
    let= in_listings := Alpha_context.Vote.in_listings ctxt delegate in
    if in_listings then
      Alpha_context.Vote.record_ballot ctxt delegate ballot
    else
      Error_monad.fail extensible_type_value
  | (Alpha_context.Voting_period.Testing | Alpha_context.Voting_period.Proposal)
    => Error_monad.fail extensible_type_value
  end.

Definition last_of_a_voting_period
  (ctxt : Alpha_context.context) (l : Alpha_context.Level.t) : bool :=
  (|Compare.Int32|).(Compare.S.op_eq)
    (Int32.succ l.(Alpha_context.Level.t.voting_period_position))
    (Alpha_context.Constants.blocks_per_voting_period ctxt).

Definition may_start_new_voting_period (ctxt : Alpha_context.context)
  : Lwt.t (Error_monad.tzresult Alpha_context.context) :=
  let level := Alpha_context.Level.current ctxt in
  if last_of_a_voting_period ctxt level then
    start_new_voting_period ctxt
  else
    Error_monad.__return ctxt.

Amendment_mli

  • OCaml size: 75 lines
  • Coq size: 31 lines (-59% compared to OCaml)
amendment.mli 2 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(**
   Only delegates with at least one roll take part in the amendment procedure.
   It works as follows:
   - Proposal period: delegates can submit protocol amendment proposals using
     the proposal operation. At the end of a proposal period, the proposal with
     most supporters is selected and we move to a testing_vote period.
     If there are no proposals, or a tie between proposals, a new proposal
     period starts.
   - Testing_vote period: delegates can cast votes to test or not the winning
     proposal using the ballot operation.
     At the end of a testing_vote period if participation reaches the quorum
     and the proposal has a supermajority in favor, we proceed to a testing
     period. Otherwise we go back to a proposal period.
     In any case, if there is enough participation the quorum is updated.
   - Testing period: a test chain is forked for the lengh of the period.
     At the end of a testing period we move to a promotion_vote period.
   - Promotion_vote period: delegates can cast votes to promote or not the
     tested proposal using the ballot operation.
     At the end of a promotion_vote period if participation reaches the quorum
     and the tested proposal has a supermajority in favor, it is activated as
     the new protocol. Otherwise we go back to a proposal period.
     In any case, if there is enough participation the quorum is updated.
*)

open Alpha_context

(** If at the end of a voting period, moves to the next one following
    the state machine of the amendment procedure. *)
val may_start_new_voting_period : context -> context tzresult Lwt.t

type error +=
  | Unexpected_proposal
  | Unauthorized_proposal
  | Too_many_proposals
  | Empty_proposal

(** Records a list of proposals for a delegate.
    @raise Unexpected_proposal if [ctxt] is not in a proposal period.
    @raise Unauthorized_proposal if [delegate] is not in the listing. *)
val record_proposals :
  context -> public_key_hash -> Protocol_hash.t list -> context tzresult Lwt.t

type error += Invalid_proposal | Unexpected_ballot | Unauthorized_ballot

val record_ballot :
  context ->
  public_key_hash ->
  Protocol_hash.t ->
  Vote.ballot ->
  context tzresult Lwt.t
Amendment_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.

Import Alpha_context.

Parameter may_start_new_voting_period :
  Alpha_context.context -> Lwt.t (Error_monad.tzresult Alpha_context.context).

(* extensible_type_definition `error` *)

Parameter record_proposals :
  Alpha_context.context -> Alpha_context.public_key_hash ->
  list (|Protocol_hash|).(S.HASH.t) ->
  Lwt.t (Error_monad.tzresult Alpha_context.context).

(* extensible_type_definition `error` *)

Parameter record_ballot :
  Alpha_context.context -> Alpha_context.public_key_hash ->
  (|Protocol_hash|).(S.HASH.t) -> Alpha_context.Vote.ballot ->
  Lwt.t (Error_monad.tzresult Alpha_context.context).

Apply

  • OCaml size: 1493 lines
  • Coq size: 1359 lines (-9% compared to OCaml)
apply.ml 51 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Main Entry Points *)

open Alpha_context

type error += Wrong_voting_period of Voting_period.t * Voting_period.t

(* `Temporary *)

type error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t

(* `Temporary *)

type error += Duplicate_endorsement of Signature.Public_key_hash.t

(* `Branch *)

type error += Invalid_endorsement_level

type error += Invalid_commitment of {expected : bool}

type error += Internal_operation_replay of packed_internal_operation

type error += Invalid_double_endorsement_evidence (* `Permanent *)

type error +=
  | Inconsistent_double_endorsement_evidence of {
      delegate1 : Signature.Public_key_hash.t;
      delegate2 : Signature.Public_key_hash.t;
    }

(* `Permanent *)

type error += Unrequired_double_endorsement_evidence (* `Branch*)

type error +=
  | Too_early_double_endorsement_evidence of {
      level : Raw_level.t;
      current : Raw_level.t;
    }

(* `Temporary *)

type error +=
  | Outdated_double_endorsement_evidence of {
      level : Raw_level.t;
      last : Raw_level.t;
    }

(* `Permanent *)

type error +=
  | Invalid_double_baking_evidence of {
      hash1 : Block_hash.t;
      level1 : Int32.t;
      hash2 : Block_hash.t;
      level2 : Int32.t;
    }

(* `Permanent *)

type error +=
  | Inconsistent_double_baking_evidence of {
      delegate1 : Signature.Public_key_hash.t;
      delegate2 : Signature.Public_key_hash.t;
    }

(* `Permanent *)

type error += Unrequired_double_baking_evidence (* `Branch*)

type error +=
  | Too_early_double_baking_evidence of {
      level : Raw_level.t;
      current : Raw_level.t;
    }

(* `Temporary *)

type error +=
  | Outdated_double_baking_evidence of {
      level : Raw_level.t;
      last : Raw_level.t;
    }

(* `Permanent *)

type error += Invalid_activation of {pkh : Ed25519.Public_key_hash.t}

type error += Multiple_revelation

type error += Gas_quota_exceeded_init_deserialize (* Permanent *)

type error +=
  | Not_enough_endorsements_for_priority of {
      required : int;
      priority : int;
      endorsements : int;
      timestamp : Time.t;
    }

let () =
  register_error_kind
    `Temporary
    ~id:"operation.wrong_endorsement_predecessor"
    ~title:"Wrong endorsement predecessor"
    ~description:
      "Trying to include an endorsement in a block that is not the successor \
       of the endorsed one"
    ~pp:(fun ppf (e, p) ->
      Format.fprintf
        ppf
        "Wrong predecessor %a, expected %a"
        Block_hash.pp
        p
        Block_hash.pp
        e)
    Data_encoding.(
      obj2
        (req "expected" Block_hash.encoding)
        (req "provided" Block_hash.encoding))
    (function
      | Wrong_endorsement_predecessor (e, p) -> Some (e, p) | _ -> None)
    (fun (e, p) -> Wrong_endorsement_predecessor (e, p)) ;
  register_error_kind
    `Temporary
    ~id:"operation.wrong_voting_period"
    ~title:"Wrong voting period"
    ~description:
      "Trying to onclude a proposal or ballot meant for another voting period"
    ~pp:(fun ppf (e, p) ->
      Format.fprintf
        ppf
        "Wrong voting period %a, current is %a"
        Voting_period.pp
        p
        Voting_period.pp
        e)
    Data_encoding.(
      obj2
        (req "current" Voting_period.encoding)
        (req "provided" Voting_period.encoding))
    (function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None)
    (fun (e, p) -> Wrong_voting_period (e, p)) ;
  register_error_kind
    `Branch
    ~id:"operation.duplicate_endorsement"
    ~title:"Duplicate endorsement"
    ~description:"Two endorsements received from same delegate"
    ~pp:(fun ppf k ->
      Format.fprintf
        ppf
        "Duplicate endorsement from delegate %a (possible replay attack)."
        Signature.Public_key_hash.pp_short
        k)
    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
    (function Duplicate_endorsement k -> Some k | _ -> None)
    (fun k -> Duplicate_endorsement k) ;
  register_error_kind
    `Temporary
    ~id:"operation.invalid_endorsement_level"
    ~title:"Unexpected level in endorsement"
    ~description:
      "The level of an endorsement is inconsistent with the  provided block \
       hash."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected level in endorsement.")
    Data_encoding.unit
    (function Invalid_endorsement_level -> Some () | _ -> None)
    (fun () -> Invalid_endorsement_level) ;
  register_error_kind
    `Permanent
    ~id:"block.invalid_commitment"
    ~title:"Invalid commitment in block header"
    ~description:"The block header has invalid commitment."
    ~pp:(fun ppf expected ->
      if expected then
        Format.fprintf ppf "Missing seed's nonce commitment in block header."
      else
        Format.fprintf
          ppf
          "Unexpected seed's nonce commitment in block header.")
    Data_encoding.(obj1 (req "expected" bool))
    (function Invalid_commitment {expected} -> Some expected | _ -> None)
    (fun expected -> Invalid_commitment {expected}) ;
  register_error_kind
    `Permanent
    ~id:"internal_operation_replay"
    ~title:"Internal operation replay"
    ~description:"An internal operation was emitted twice by a script"
    ~pp:(fun ppf (Internal_operation {nonce; _}) ->
      Format.fprintf
        ppf
        "Internal operation %d was emitted twice by a script"
        nonce)
    Operation.internal_operation_encoding
    (function Internal_operation_replay op -> Some op | _ -> None)
    (fun op -> Internal_operation_replay op) ;
  register_error_kind
    `Permanent
    ~id:"block.invalid_double_endorsement_evidence"
    ~title:"Invalid double endorsement evidence"
    ~description:"A double-endorsement evidence is malformed"
    ~pp:(fun ppf () ->
      Format.fprintf ppf "Malformed double-endorsement evidence")
    Data_encoding.empty
    (function Invalid_double_endorsement_evidence -> Some () | _ -> None)
    (fun () -> Invalid_double_endorsement_evidence) ;
  register_error_kind
    `Permanent
    ~id:"block.inconsistent_double_endorsement_evidence"
    ~title:"Inconsistent double endorsement evidence"
    ~description:
      "A double-endorsement evidence is inconsistent  (two distinct delegates)"
    ~pp:(fun ppf (delegate1, delegate2) ->
      Format.fprintf
        ppf
        "Inconsistent double-endorsement evidence  (distinct delegate: %a and \
         %a)"
        Signature.Public_key_hash.pp_short
        delegate1
        Signature.Public_key_hash.pp_short
        delegate2)
    Data_encoding.(
      obj2
        (req "delegate1" Signature.Public_key_hash.encoding)
        (req "delegate2" Signature.Public_key_hash.encoding))
    (function
      | Inconsistent_double_endorsement_evidence {delegate1; delegate2} ->
          Some (delegate1, delegate2)
      | _ ->
          None)
    (fun (delegate1, delegate2) ->
      Inconsistent_double_endorsement_evidence {delegate1; delegate2}) ;
  register_error_kind
    `Branch
    ~id:"block.unrequired_double_endorsement_evidence"
    ~title:"Unrequired double endorsement evidence"
    ~description:"A double-endorsement evidence is unrequired"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "A valid double-endorsement operation cannot  be applied: the \
         associated delegate  has previously been denunciated in this cycle.")
    Data_encoding.empty
    (function Unrequired_double_endorsement_evidence -> Some () | _ -> None)
    (fun () -> Unrequired_double_endorsement_evidence) ;
  register_error_kind
    `Temporary
    ~id:"block.too_early_double_endorsement_evidence"
    ~title:"Too early double endorsement evidence"
    ~description:"A double-endorsement evidence is in the future"
    ~pp:(fun ppf (level, current) ->
      Format.fprintf
        ppf
        "A double-endorsement evidence is in the future  (current level: %a, \
         endorsement level: %a)"
        Raw_level.pp
        current
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "current" Raw_level.encoding))
    (function
      | Too_early_double_endorsement_evidence {level; current} ->
          Some (level, current)
      | _ ->
          None)
    (fun (level, current) ->
      Too_early_double_endorsement_evidence {level; current}) ;
  register_error_kind
    `Permanent
    ~id:"block.outdated_double_endorsement_evidence"
    ~title:"Outdated double endorsement evidence"
    ~description:"A double-endorsement evidence is outdated."
    ~pp:(fun ppf (level, last) ->
      Format.fprintf
        ppf
        "A double-endorsement evidence is outdated  (last acceptable level: \
         %a, endorsement level: %a)"
        Raw_level.pp
        last
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "last" Raw_level.encoding))
    (function
      | Outdated_double_endorsement_evidence {level; last} ->
          Some (level, last)
      | _ ->
          None)
    (fun (level, last) -> Outdated_double_endorsement_evidence {level; last}) ;
  register_error_kind
    `Permanent
    ~id:"block.invalid_double_baking_evidence"
    ~title:"Invalid double baking evidence"
    ~description:
      "A double-baking evidence is inconsistent  (two distinct level)"
    ~pp:(fun ppf (hash1, level1, hash2, level2) ->
      Format.fprintf
        ppf
        "Invalid double-baking evidence (hash: %a and %a, levels: %ld and %ld)"
        Block_hash.pp
        hash1
        Block_hash.pp
        hash2
        level1
        level2)
    Data_encoding.(
      obj4
        (req "hash1" Block_hash.encoding)
        (req "level1" int32)
        (req "hash2" Block_hash.encoding)
        (req "level2" int32))
    (function
      | Invalid_double_baking_evidence {hash1; level1; hash2; level2} ->
          Some (hash1, level1, hash2, level2)
      | _ ->
          None)
    (fun (hash1, level1, hash2, level2) ->
      Invalid_double_baking_evidence {hash1; level1; hash2; level2}) ;
  register_error_kind
    `Permanent
    ~id:"block.inconsistent_double_baking_evidence"
    ~title:"Inconsistent double baking evidence"
    ~description:
      "A double-baking evidence is inconsistent  (two distinct delegates)"
    ~pp:(fun ppf (delegate1, delegate2) ->
      Format.fprintf
        ppf
        "Inconsistent double-baking evidence  (distinct delegate: %a and %a)"
        Signature.Public_key_hash.pp_short
        delegate1
        Signature.Public_key_hash.pp_short
        delegate2)
    Data_encoding.(
      obj2
        (req "delegate1" Signature.Public_key_hash.encoding)
        (req "delegate2" Signature.Public_key_hash.encoding))
    (function
      | Inconsistent_double_baking_evidence {delegate1; delegate2} ->
          Some (delegate1, delegate2)
      | _ ->
          None)
    (fun (delegate1, delegate2) ->
      Inconsistent_double_baking_evidence {delegate1; delegate2}) ;
  register_error_kind
    `Branch
    ~id:"block.unrequired_double_baking_evidence"
    ~title:"Unrequired double baking evidence"
    ~description:"A double-baking evidence is unrequired"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "A valid double-baking operation cannot  be applied: the associated \
         delegate  has previously been denunciated in this cycle.")
    Data_encoding.empty
    (function Unrequired_double_baking_evidence -> Some () | _ -> None)
    (fun () -> Unrequired_double_baking_evidence) ;
  register_error_kind
    `Temporary
    ~id:"block.too_early_double_baking_evidence"
    ~title:"Too early double baking evidence"
    ~description:"A double-baking evidence is in the future"
    ~pp:(fun ppf (level, current) ->
      Format.fprintf
        ppf
        "A double-baking evidence is in the future  (current level: %a, \
         baking level: %a)"
        Raw_level.pp
        current
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "current" Raw_level.encoding))
    (function
      | Too_early_double_baking_evidence {level; current} ->
          Some (level, current)
      | _ ->
          None)
    (fun (level, current) -> Too_early_double_baking_evidence {level; current}) ;
  register_error_kind
    `Permanent
    ~id:"block.outdated_double_baking_evidence"
    ~title:"Outdated double baking evidence"
    ~description:"A double-baking evidence is outdated."
    ~pp:(fun ppf (level, last) ->
      Format.fprintf
        ppf
        "A double-baking evidence is outdated  (last acceptable level: %a, \
         baking level: %a)"
        Raw_level.pp
        last
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "last" Raw_level.encoding))
    (function
      | Outdated_double_baking_evidence {level; last} ->
          Some (level, last)
      | _ ->
          None)
    (fun (level, last) -> Outdated_double_baking_evidence {level; last}) ;
  register_error_kind
    `Permanent
    ~id:"operation.invalid_activation"
    ~title:"Invalid activation"
    ~description:
      "The given key and secret do not correspond to any existing \
       preallocated contract"
    ~pp:(fun ppf pkh ->
      Format.fprintf
        ppf
        "Invalid activation. The public key %a does not match any commitment."
        Ed25519.Public_key_hash.pp
        pkh)
    Data_encoding.(obj1 (req "pkh" Ed25519.Public_key_hash.encoding))
    (function Invalid_activation {pkh} -> Some pkh | _ -> None)
    (fun pkh -> Invalid_activation {pkh}) ;
  register_error_kind
    `Permanent
    ~id:"block.multiple_revelation"
    ~title:"Multiple revelations were included in a manager operation"
    ~description:
      "A manager operation should not contain more than one revelation"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "Multiple revelations were included in a manager operation")
    Data_encoding.empty
    (function Multiple_revelation -> Some () | _ -> None)
    (fun () -> Multiple_revelation) ;
  register_error_kind
    `Permanent
    ~id:"gas_exhausted.init_deserialize"
    ~title:"Not enough gas for initial deserialization of script expresions"
    ~description:
      "Gas limit was not high enough to deserialize the transaction \
       parameters or origination script code or initial storage, making the \
       operation impossible to parse within the provided gas bounds."
    Data_encoding.empty
    (function Gas_quota_exceeded_init_deserialize -> Some () | _ -> None)
    (fun () -> Gas_quota_exceeded_init_deserialize) ;
  register_error_kind
    `Permanent
    ~id:"operation.not_enought_endorsements_for_priority"
    ~title:"Not enough endorsements for priority"
    ~description:
      "The block being validated does not include the required minimum number \
       of endorsements for this priority."
    ~pp:(fun ppf (required, endorsements, priority, timestamp) ->
      Format.fprintf
        ppf
        "Wrong number of endorsements (%i) for priority (%i), %i are expected \
         at %a"
        endorsements
        priority
        required
        Time.pp_hum
        timestamp)
    Data_encoding.(
      obj4
        (req "required" int31)
        (req "endorsements" int31)
        (req "priority" int31)
        (req "timestamp" Time.encoding))
    (function
      | Not_enough_endorsements_for_priority
          {required; endorsements; priority; timestamp} ->
          Some (required, endorsements, priority, timestamp)
      | _ ->
          None)
    (fun (required, endorsements, priority, timestamp) ->
      Not_enough_endorsements_for_priority
        {required; endorsements; priority; timestamp})

open Apply_results

let apply_manager_operation_content :
    type kind.
    Alpha_context.t ->
    Script_ir_translator.unparsing_mode ->
    payer:Contract.t ->
    source:Contract.t ->
    chain_id:Chain_id.t ->
    internal:bool ->
    kind manager_operation ->
    ( context
    * kind successful_manager_operation_result
    * packed_internal_operation list )
    tzresult
    Lwt.t =
 fun ctxt mode ~payer ~source ~chain_id ~internal operation ->
  let before_operation =
    (* This context is not used for backtracking. Only to compute
         gas consumption and originations for the operation result. *)
    ctxt
  in
  Contract.must_exist ctxt source
  >>=? fun () ->
  Lwt.return (Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation)
  >>=? fun ctxt ->
  match operation with
  | Reveal _ ->
      return
        (* No-op: action already performed by `precheck_manager_contents`. *)
        ( ctxt,
          ( Reveal_result
              {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt}
            : kind successful_manager_operation_result ),
          [] )
  | Transaction {amount; parameters; destination; entrypoint} -> (
      Contract.spend ctxt source amount
      >>=? fun ctxt ->
      ( match Contract.is_implicit destination with
      | None ->
          return (ctxt, [], false)
      | Some _ -> (
          Contract.allocated ctxt destination
          >>=? function
          | true ->
              return (ctxt, [], false)
          | false ->
              Fees.origination_burn ctxt
              >>=? fun (ctxt, origination_burn) ->
              return
                ( ctxt,
                  [(Delegate.Contract payer, Delegate.Debited origination_burn)],
                  true ) ) )
      >>=? fun (ctxt, maybe_burn_balance_update, allocated_destination_contract)
               ->
      Contract.credit ctxt destination amount
      >>=? fun ctxt ->
      Contract.get_script ctxt destination
      >>=? fun (ctxt, script) ->
      match script with
      | None ->
          ( match entrypoint with
          | "default" ->
              return ()
          | entrypoint ->
              fail (Script_tc_errors.No_such_entrypoint entrypoint) )
          >>=? (fun () ->
                 Script.force_decode_in_context ctxt parameters
                 >>=? fun (arg, ctxt) ->
                 (* see [note] *)
                 (* [note]: for toplevel ops, cost is nil since the
               lazy value has already been forced at precheck, so
               we compute and consume the full cost again *)
                 let cost_arg = Script.deserialized_cost arg in
                 Lwt.return (Gas.consume ctxt cost_arg)
                 >>=? fun ctxt ->
                 match Micheline.root arg with
                 | Prim (_, D_Unit, [], _) ->
                     (* Allow [Unit] parameter to non-scripted contracts. *)
                     return ctxt
                 | _ ->
                     fail
                       (Script_interpreter.Bad_contract_parameter destination))
          >>=? fun ctxt ->
          let result =
            Transaction_result
              {
                storage = None;
                big_map_diff = None;
                balance_updates =
                  Delegate.cleanup_balance_updates
                    ( [ (Delegate.Contract source, Delegate.Debited amount);
                        (Contract destination, Credited amount) ]
                    @ maybe_burn_balance_update );
                originated_contracts = [];
                consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
                storage_size = Z.zero;
                paid_storage_size_diff = Z.zero;
                allocated_destination_contract;
              }
          in
          return (ctxt, result, [])
      | Some script ->
          Script.force_decode_in_context ctxt parameters
          >>=? fun (parameter, ctxt) ->
          (* see [note] *)
          let cost_parameter = Script.deserialized_cost parameter in
          Lwt.return (Gas.consume ctxt cost_parameter)
          >>=? fun ctxt ->
          let step_constants =
            let open Script_interpreter in
            {source; payer; self = destination; amount; chain_id}
          in
          Script_interpreter.execute_wrapper
            ctxt
            mode
            step_constants
            ~script
            ~parameter
            ~entrypoint
          >>=? fun {ctxt; storage; big_map_diff; operations} ->
          Contract.update_script_storage ctxt destination storage big_map_diff
          >>=? fun ctxt ->
          Fees.record_paid_storage_space ctxt destination
          >>=? fun (ctxt, new_size, paid_storage_size_diff, fees) ->
          Contract.originated_from_current_nonce
            ~since:before_operation
            ~until:ctxt
          >>=? fun originated_contracts ->
          let result =
            Transaction_result
              {
                storage = Some storage;
                big_map_diff;
                balance_updates =
                  Delegate.cleanup_balance_updates
                    [ (Contract payer, Debited fees);
                      (Contract source, Debited amount);
                      (Contract destination, Credited amount) ];
                originated_contracts;
                consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
                storage_size = new_size;
                paid_storage_size_diff;
                allocated_destination_contract;
              }
          in
          return (ctxt, result, operations) )
  | Origination {delegate; script; preorigination; credit} ->
      Script.force_decode_in_context ctxt script.storage
      >>=? fun (unparsed_storage, ctxt) ->
      (* see [note] *)
      Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage))
      >>=? fun ctxt ->
      Script.force_decode_in_context ctxt script.code
      >>=? fun (unparsed_code, ctxt) ->
      (* see [note] *)
      Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code))
      >>=? fun ctxt ->
      Script_ir_translator.parse_script ctxt ~legacy:false script
      >>=? fun (Ex_script parsed_script, ctxt) ->
      Script_ir_translator.collect_big_maps
        ctxt
        parsed_script.storage_type
        parsed_script.storage
      >>=? fun (to_duplicate, ctxt) ->
      let to_update = Script_ir_translator.no_big_map_id in
      Script_ir_translator.extract_big_map_diff
        ctxt
        Optimized
        parsed_script.storage_type
        parsed_script.storage
        ~to_duplicate
        ~to_update
        ~temporary:false
      >>=? fun (storage, big_map_diff, ctxt) ->
      Script_ir_translator.unparse_data
        ctxt
        Optimized
        parsed_script.storage_type
        storage
      >>=? fun (storage, ctxt) ->
      let storage = Script.lazy_expr (Micheline.strip_locations storage) in
      let script = {script with storage} in
      Contract.spend ctxt source credit
      >>=? fun ctxt ->
      ( match preorigination with
      | Some contract ->
          assert internal ;
          (* The preorigination field is only used to early return
                 the address of an originated contract in Michelson.
                 It cannot come from the outside. *)
          return (ctxt, contract)
      | None ->
          Contract.fresh_contract_from_current_nonce ctxt )
      >>=? fun (ctxt, contract) ->
      Contract.originate
        ctxt
        contract
        ~delegate
        ~balance:credit
        ~script:(script, big_map_diff)
      >>=? fun ctxt ->
      Fees.origination_burn ctxt
      >>=? fun (ctxt, origination_burn) ->
      Fees.record_paid_storage_space ctxt contract
      >>=? fun (ctxt, size, paid_storage_size_diff, fees) ->
      let result =
        Origination_result
          {
            big_map_diff;
            balance_updates =
              Delegate.cleanup_balance_updates
                [ (Contract payer, Debited fees);
                  (Contract payer, Debited origination_burn);
                  (Contract source, Debited credit);
                  (Contract contract, Credited credit) ];
            originated_contracts = [contract];
            consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
            storage_size = size;
            paid_storage_size_diff;
          }
      in
      return (ctxt, result, [])
  | Delegation delegate ->
      Delegate.set ctxt source delegate
      >>=? fun ctxt ->
      return
        ( ctxt,
          Delegation_result
            {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt},
          [] )

type success_or_failure = Success of t | Failure

let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops =
  let rec apply ctxt applied worklist =
    match worklist with
    | [] ->
        Lwt.return (Success ctxt, List.rev applied)
    | Internal_operation ({source; operation; nonce} as op) :: rest -> (
        ( if internal_nonce_already_recorded ctxt nonce then
          fail (Internal_operation_replay (Internal_operation op))
        else
          let ctxt = record_internal_nonce ctxt nonce in
          apply_manager_operation_content
            ctxt
            mode
            ~source
            ~payer
            ~chain_id
            ~internal:true
            operation )
        >>= function
        | Error errors ->
            let result =
              Internal_operation_result
                (op, Failed (manager_kind op.operation, errors))
            in
            let skipped =
              List.rev_map
                (fun (Internal_operation op) ->
                  Internal_operation_result
                    (op, Skipped (manager_kind op.operation)))
                rest
            in
            Lwt.return (Failure, List.rev (skipped @ (result :: applied)))
        | Ok (ctxt, result, emitted) ->
            apply
              ctxt
              (Internal_operation_result (op, Applied result) :: applied)
              (rest @ emitted) )
  in
  apply ctxt [] ops

let precheck_manager_contents (type kind) ctxt chain_id raw_operation
    (op : kind Kind.manager contents) : context tzresult Lwt.t =
  match[@coq_match_with_default] op with
  | Manager_operation
      {source; fee; counter; operation; gas_limit; storage_limit} ->
      Lwt.return (Gas.check_limit ctxt gas_limit)
      >>=? fun () ->
      let ctxt = Gas.set_limit ctxt gas_limit in
      Lwt.return (Fees.check_storage_limit ctxt storage_limit)
      >>=? fun () ->
      Contract.must_be_allocated ctxt (Contract.implicit_contract source)
      >>=? fun () ->
      Contract.check_counter_increment ctxt source counter
      >>=? fun () ->
      ( match operation with
      | Reveal pk ->
          Contract.reveal_manager_key ctxt source pk
      | Transaction {parameters; _} ->
          (* Fail quickly if not enough gas for minimal deserialization cost *)
          Lwt.return
          @@ record_trace Gas_quota_exceeded_init_deserialize
          @@ Gas.check_enough ctxt (Script.minimal_deserialize_cost parameters)
          >>=? fun () ->
          (* Fail if not enough gas for complete deserialization cost *)
          trace Gas_quota_exceeded_init_deserialize
          @@ Script.force_decode_in_context ctxt parameters
          >>|? fun (_arg, ctxt) -> ctxt
      | Origination {script; _} ->
          (* Fail quickly if not enough gas for minimal deserialization cost *)
          Lwt.return
          @@ record_trace Gas_quota_exceeded_init_deserialize
          @@ ( Gas.consume ctxt (Script.minimal_deserialize_cost script.code)
             >>? fun ctxt ->
             Gas.check_enough
               ctxt
               (Script.minimal_deserialize_cost script.storage) )
          >>=? fun () ->
          (* Fail if not enough gas for complete deserialization cost *)
          trace Gas_quota_exceeded_init_deserialize
          @@ Script.force_decode_in_context ctxt script.code
          >>=? fun (_code, ctxt) ->
          trace Gas_quota_exceeded_init_deserialize
          @@ Script.force_decode_in_context ctxt script.storage
          >>|? fun (_storage, ctxt) -> ctxt
      | _ ->
          return ctxt )
      >>=? fun ctxt ->
      Contract.get_manager_key ctxt source
      >>=? fun public_key ->
      (* Currently, the `raw_operation` only contains one signature, so
     all operations are required to be from the same manager. This may
     change in the future, allowing several managers to group-sign a
     sequence of transactions.  *)
      Operation.check_signature public_key chain_id raw_operation
      >>=? fun () ->
      Contract.increment_counter ctxt source
      >>=? fun ctxt ->
      Contract.spend ctxt (Contract.implicit_contract source) fee
      >>=? fun ctxt -> add_fees ctxt fee >>=? fun ctxt -> return ctxt

let apply_manager_contents (type kind) ctxt mode chain_id
    (op : kind Kind.manager contents) :
    ( success_or_failure
    * kind manager_operation_result
    * packed_internal_operation_result list )
    Lwt.t =
  match[@coq_match_with_default] op with
  | Manager_operation {source; operation; gas_limit; storage_limit} -> (
      let ctxt = Gas.set_limit ctxt gas_limit in
      let ctxt = Fees.start_counting_storage_fees ctxt in
      let source = Contract.implicit_contract source in
      apply_manager_operation_content
        ctxt
        mode
        ~source
        ~payer:source
        ~internal:false
        ~chain_id
        operation
      >>= function
      | Ok (ctxt, operation_results, internal_operations) -> (
          apply_internal_manager_operations
            ctxt
            mode
            ~payer:source
            ~chain_id
            internal_operations
          >>= function
          | (Success ctxt, internal_operations_results) -> (
              Fees.burn_storage_fees ctxt ~storage_limit ~payer:source
              >>= function
              | Ok ctxt ->
                  Lwt.return
                    ( Success ctxt,
                      Applied operation_results,
                      internal_operations_results )
              | Error errors ->
                  Lwt.return
                    ( Failure,
                      Backtracked (operation_results, Some errors),
                      internal_operations_results ) )
          | (Failure, internal_operations_results) ->
              Lwt.return
                ( Failure,
                  Applied operation_results,
                  internal_operations_results ) )
      | Error errors ->
          Lwt.return (Failure, Failed (manager_kind operation, errors), []) )

let skipped_operation_result :
    type kind. kind manager_operation -> kind manager_operation_result =
  function
  | operation -> (
    match operation with
    | Reveal _ ->
        Applied
          ( Reveal_result {consumed_gas = Z.zero}
            : kind successful_manager_operation_result )
    | _ ->
        Skipped (manager_kind operation) )

let rec mark_skipped :
    type kind.
    baker:Signature.Public_key_hash.t ->
    Level.t ->
    kind Kind.manager contents_list ->
    kind Kind.manager contents_result_list =
 fun ~baker level -> function[@coq_match_with_default]
  | Single (Manager_operation {source; fee; operation}) ->
      let source = Contract.implicit_contract source in
      Single_result
        (Manager_operation_result
           {
             balance_updates =
               Delegate.cleanup_balance_updates
                 [ (Contract source, Debited fee);
                   (Fees (baker, level.cycle), Credited fee) ];
             operation_result = skipped_operation_result operation;
             internal_operation_results = [];
           })
  | Cons (Manager_operation {source; fee; operation}, rest) ->
      let source = Contract.implicit_contract source in
      Cons_result
        ( Manager_operation_result
            {
              balance_updates =
                Delegate.cleanup_balance_updates
                  [ (Contract source, Debited fee);
                    (Fees (baker, level.cycle), Credited fee) ];
              operation_result = skipped_operation_result operation;
              internal_operation_results = [];
            },
          mark_skipped ~baker level rest )

let rec precheck_manager_contents_list :
    type kind.
    Alpha_context.t ->
    Chain_id.t ->
    _ Operation.t ->
    kind Kind.manager contents_list ->
    context tzresult Lwt.t =
 fun ctxt chain_id raw_operation contents_list ->
  match[@coq_match_with_default] contents_list with
  | Single (Manager_operation _ as op) ->
      precheck_manager_contents ctxt chain_id raw_operation op
  | Cons ((Manager_operation _ as op), rest) ->
      precheck_manager_contents ctxt chain_id raw_operation op
      >>=? fun ctxt ->
      precheck_manager_contents_list ctxt chain_id raw_operation rest

let rec apply_manager_contents_list_rec :
    type kind.
    Alpha_context.t ->
    Script_ir_translator.unparsing_mode ->
    public_key_hash ->
    Chain_id.t ->
    kind Kind.manager contents_list ->
    (success_or_failure * kind Kind.manager contents_result_list) Lwt.t =
 fun ctxt mode baker chain_id contents_list ->
  let level = Level.current ctxt in
  match[@coq_match_with_default] contents_list with
  | Single (Manager_operation {source; fee; _} as op) ->
      let source = Contract.implicit_contract source in
      apply_manager_contents ctxt mode chain_id op
      >>= fun (ctxt_result, operation_result, internal_operation_results) ->
      let result =
        Manager_operation_result
          {
            balance_updates =
              Delegate.cleanup_balance_updates
                [ (Contract source, Debited fee);
                  (Fees (baker, level.cycle), Credited fee) ];
            operation_result;
            internal_operation_results;
          }
      in
      Lwt.return (ctxt_result, Single_result result)
  | Cons ((Manager_operation {source; fee; _} as op), rest) -> (
      let source = Contract.implicit_contract source in
      apply_manager_contents ctxt mode chain_id op
      >>= function
      | (Failure, operation_result, internal_operation_results) ->
          let result =
            Manager_operation_result
              {
                balance_updates =
                  Delegate.cleanup_balance_updates
                    [ (Contract source, Debited fee);
                      (Fees (baker, level.cycle), Credited fee) ];
                operation_result;
                internal_operation_results;
              }
          in
          Lwt.return
            (Failure, Cons_result (result, mark_skipped ~baker level rest))
      | (Success ctxt, operation_result, internal_operation_results) ->
          let result =
            Manager_operation_result
              {
                balance_updates =
                  Delegate.cleanup_balance_updates
                    [ (Contract source, Debited fee);
                      (Fees (baker, level.cycle), Credited fee) ];
                operation_result;
                internal_operation_results;
              }
          in
          apply_manager_contents_list_rec ctxt mode baker chain_id rest
          >>= fun (ctxt_result, results) ->
          Lwt.return (ctxt_result, Cons_result (result, results)) )

let mark_backtracked results =
  let mark_manager_operation_result :
      type kind. kind manager_operation_result -> kind manager_operation_result
      = function
    | (Failed _ | Skipped _ | Backtracked _) as result ->
        result
    | Applied (Reveal_result _) as result ->
        result
    | Applied result ->
        Backtracked (result, None)
  in
  let mark_internal_operation_results
      (Internal_operation_result (kind, result)) =
    Internal_operation_result (kind, mark_manager_operation_result result)
  in
  let rec mark_contents_list :
      type kind.
      kind Kind.manager contents_result_list ->
      kind Kind.manager contents_result_list =
    function[@coq_match_with_default]
    | Single_result (Manager_operation_result op) ->
        Single_result
          (Manager_operation_result
             {
               balance_updates = op.balance_updates;
               operation_result =
                 mark_manager_operation_result op.operation_result;
               internal_operation_results =
                 List.map
                   mark_internal_operation_results
                   op.internal_operation_results;
             })
    | Cons_result (Manager_operation_result op, rest) ->
        Cons_result
          ( Manager_operation_result
              {
                balance_updates = op.balance_updates;
                operation_result =
                  mark_manager_operation_result op.operation_result;
                internal_operation_results =
                  List.map
                    mark_internal_operation_results
                    op.internal_operation_results;
              },
            mark_contents_list rest )
  in
  mark_contents_list results

let apply_manager_contents_list ctxt mode baker chain_id contents_list =
  apply_manager_contents_list_rec ctxt mode baker chain_id contents_list
  >>= fun (ctxt_result, results) ->
  match ctxt_result with
  | Failure ->
      Lwt.return (ctxt (* backtracked *), mark_backtracked results)
  | Success ctxt ->
      Big_map.cleanup_temporary ctxt >>= fun ctxt -> Lwt.return (ctxt, results)

let apply_contents_list (type kind) ctxt chain_id mode pred_block baker
    (operation : kind operation) (contents_list : kind contents_list) :
    (context * kind contents_result_list) tzresult Lwt.t =
  match[@coq_match_with_default] contents_list with
  | Single (Endorsement {level}) ->
      let block = operation.shell.branch in
      fail_unless
        (Block_hash.equal block pred_block)
        (Wrong_endorsement_predecessor (pred_block, block))
      >>=? fun () ->
      let current_level = (Level.current ctxt).level in
      fail_unless
        Raw_level.(succ level = current_level)
        Invalid_endorsement_level
      >>=? fun () ->
      Baking.check_endorsement_rights ctxt chain_id operation
      >>=? fun (delegate, slots, used) ->
      if used then fail (Duplicate_endorsement delegate)
      else
        let ctxt = record_endorsement ctxt delegate in
        let gap = List.length slots in
        Lwt.return
          Tez.(Constants.endorsement_security_deposit ctxt *? Int64.of_int gap)
        >>=? fun deposit ->
        Delegate.freeze_deposit ctxt delegate deposit
        >>=? fun ctxt ->
        Global.get_block_priority ctxt
        >>=? fun block_priority ->
        Baking.endorsing_reward ctxt ~block_priority gap
        >>=? fun reward ->
        Delegate.freeze_rewards ctxt delegate reward
        >>=? fun ctxt ->
        let level = Level.from_raw ctxt level in
        return
          ( ctxt,
            Single_result
              (Endorsement_result
                 {
                   balance_updates =
                     Delegate.cleanup_balance_updates
                       [ ( Contract (Contract.implicit_contract delegate),
                           Debited deposit );
                         (Deposits (delegate, level.cycle), Credited deposit);
                         (Rewards (delegate, level.cycle), Credited reward) ];
                   delegate;
                   slots;
                 }) )
  | Single (Seed_nonce_revelation {level; nonce}) ->
      let level = Level.from_raw ctxt level in
      Nonce.reveal ctxt level nonce
      >>=? fun ctxt ->
      let seed_nonce_revelation_tip =
        Constants.seed_nonce_revelation_tip ctxt
      in
      add_rewards ctxt seed_nonce_revelation_tip
      >>=? fun ctxt ->
      return
        ( ctxt,
          Single_result
            (Seed_nonce_revelation_result
               [ ( Rewards (baker, level.cycle),
                   Credited seed_nonce_revelation_tip ) ]) )
  | Single (Double_endorsement_evidence {op1; op2}) -> (
    match (op1.protocol_data.contents, op2.protocol_data.contents) with
    | (Single (Endorsement e1), Single (Endorsement e2))
      when Raw_level.(e1.level = e2.level)
           && not (Block_hash.equal op1.shell.branch op2.shell.branch) ->
        let level = Level.from_raw ctxt e1.level in
        let oldest_level = Level.last_allowed_fork_level ctxt in
        fail_unless
          Level.(level < Level.current ctxt)
          (Too_early_double_endorsement_evidence
             {level = level.level; current = (Level.current ctxt).level})
        >>=? fun () ->
        fail_unless
          Raw_level.(oldest_level <= level.level)
          (Outdated_double_endorsement_evidence
             {level = level.level; last = oldest_level})
        >>=? fun () ->
        Baking.check_endorsement_rights ctxt chain_id op1
        >>=? fun (delegate1, _, _) ->
        Baking.check_endorsement_rights ctxt chain_id op2
        >>=? fun (delegate2, _, _) ->
        fail_unless
          (Signature.Public_key_hash.equal delegate1 delegate2)
          (Inconsistent_double_endorsement_evidence {delegate1; delegate2})
        >>=? fun () ->
        Delegate.has_frozen_balance ctxt delegate1 level.cycle
        >>=? fun valid ->
        fail_unless valid Unrequired_double_endorsement_evidence
        >>=? fun () ->
        Delegate.punish ctxt delegate1 level.cycle
        >>=? fun (ctxt, balance) ->
        Lwt.return Tez.(balance.deposit +? balance.fees)
        >>=? fun burned ->
        let reward =
          match Tez.(burned /? 2L) with Ok v -> v | Error _ -> Tez.zero
        in
        add_rewards ctxt reward
        >>=? fun ctxt ->
        let current_cycle = (Level.current ctxt).cycle in
        return
          ( ctxt,
            Single_result
              (Double_endorsement_evidence_result
                 (Delegate.cleanup_balance_updates
                    [ ( Deposits (delegate1, level.cycle),
                        Debited balance.deposit );
                      (Fees (delegate1, level.cycle), Debited balance.fees);
                      ( Rewards (delegate1, level.cycle),
                        Debited balance.rewards );
                      (Rewards (baker, current_cycle), Credited reward) ])) )
    | (_, _) ->
        fail Invalid_double_endorsement_evidence )
  | Single (Double_baking_evidence {bh1; bh2}) ->
      let hash1 = Block_header.hash bh1 in
      let hash2 = Block_header.hash bh2 in
      fail_unless
        ( Compare.Int32.(bh1.shell.level = bh2.shell.level)
        && not (Block_hash.equal hash1 hash2) )
        (Invalid_double_baking_evidence
           {hash1; level1 = bh1.shell.level; hash2; level2 = bh2.shell.level})
      >>=? fun () ->
      Lwt.return (Raw_level.of_int32 bh1.shell.level)
      >>=? fun raw_level ->
      let oldest_level = Level.last_allowed_fork_level ctxt in
      fail_unless
        Raw_level.(raw_level < (Level.current ctxt).level)
        (Too_early_double_baking_evidence
           {level = raw_level; current = (Level.current ctxt).level})
      >>=? fun () ->
      fail_unless
        Raw_level.(oldest_level <= raw_level)
        (Outdated_double_baking_evidence
           {level = raw_level; last = oldest_level})
      >>=? fun () ->
      let level = Level.from_raw ctxt raw_level in
      Roll.baking_rights_owner
        ctxt
        level
        ~priority:bh1.protocol_data.contents.priority
      >>=? fun delegate1 ->
      Baking.check_signature bh1 chain_id delegate1
      >>=? fun () ->
      Roll.baking_rights_owner
        ctxt
        level
        ~priority:bh2.protocol_data.contents.priority
      >>=? fun delegate2 ->
      Baking.check_signature bh2 chain_id delegate2
      >>=? fun () ->
      fail_unless
        (Signature.Public_key.equal delegate1 delegate2)
        (Inconsistent_double_baking_evidence
           {
             delegate1 = Signature.Public_key.hash delegate1;
             delegate2 = Signature.Public_key.hash delegate2;
           })
      >>=? fun () ->
      let delegate = Signature.Public_key.hash delegate1 in
      Delegate.has_frozen_balance ctxt delegate level.cycle
      >>=? fun valid ->
      fail_unless valid Unrequired_double_baking_evidence
      >>=? fun () ->
      Delegate.punish ctxt delegate level.cycle
      >>=? fun (ctxt, balance) ->
      Lwt.return Tez.(balance.deposit +? balance.fees)
      >>=? fun burned ->
      let reward =
        match Tez.(burned /? 2L) with Ok v -> v | Error _ -> Tez.zero
      in
      add_rewards ctxt reward
      >>=? fun ctxt ->
      let current_cycle = (Level.current ctxt).cycle in
      return
        ( ctxt,
          Single_result
            (Double_baking_evidence_result
               (Delegate.cleanup_balance_updates
                  [ (Deposits (delegate, level.cycle), Debited balance.deposit);
                    (Fees (delegate, level.cycle), Debited balance.fees);
                    (Rewards (delegate, level.cycle), Debited balance.rewards);
                    (Rewards (baker, current_cycle), Credited reward) ])) )
  | Single (Activate_account {id = pkh; activation_code}) -> (
      let blinded_pkh =
        Blinded_public_key_hash.of_ed25519_pkh activation_code pkh
      in
      Commitment.get_opt ctxt blinded_pkh
      >>=? function
      | None ->
          fail (Invalid_activation {pkh})
      | Some amount ->
          Commitment.delete ctxt blinded_pkh
          >>=? fun ctxt ->
          let contract =
            Contract.implicit_contract (Signature.Ed25519Hash pkh)
          in
          Contract.(credit ctxt contract amount)
          >>=? fun ctxt ->
          return
            ( ctxt,
              Single_result
                (Activate_account_result [(Contract contract, Credited amount)])
            ) )
  | Single (Proposals {source; period; proposals}) ->
      Roll.delegate_pubkey ctxt source
      >>=? fun delegate ->
      Operation.check_signature delegate chain_id operation
      >>=? fun () ->
      let level = Level.current ctxt in
      fail_unless
        Voting_period.(level.voting_period = period)
        (Wrong_voting_period (level.voting_period, period))
      >>=? fun () ->
      Amendment.record_proposals ctxt source proposals
      >>=? fun ctxt -> return (ctxt, Single_result Proposals_result)
  | Single (Ballot {source; period; proposal; ballot}) ->
      Roll.delegate_pubkey ctxt source
      >>=? fun delegate ->
      Operation.check_signature delegate chain_id operation
      >>=? fun () ->
      let level = Level.current ctxt in
      fail_unless
        Voting_period.(level.voting_period = period)
        (Wrong_voting_period (level.voting_period, period))
      >>=? fun () ->
      Amendment.record_ballot ctxt source proposal ballot
      >>=? fun ctxt -> return (ctxt, Single_result Ballot_result)
  | Single (Manager_operation _) as op ->
      precheck_manager_contents_list ctxt chain_id operation op
      >>=? fun ctxt ->
      apply_manager_contents_list ctxt mode baker chain_id op
      >>= fun (ctxt, result) -> return (ctxt, result)
  | Cons (Manager_operation _, _) as op ->
      precheck_manager_contents_list ctxt chain_id operation op
      >>=? fun ctxt ->
      apply_manager_contents_list ctxt mode baker chain_id op
      >>= fun (ctxt, result) -> return (ctxt, result)

let apply_operation ctxt chain_id mode pred_block baker hash operation =
  let ctxt = Contract.init_origination_nonce ctxt hash in
  apply_contents_list
    ctxt
    chain_id
    mode
    pred_block
    baker
    operation
    operation.protocol_data.contents
  >>=? fun (ctxt, result) ->
  let ctxt = Gas.set_unlimited ctxt in
  let ctxt = Contract.unset_origination_nonce ctxt in
  return (ctxt, {contents = result})

let may_snapshot_roll ctxt =
  let level = Alpha_context.Level.current ctxt in
  let blocks_per_roll_snapshot = Constants.blocks_per_roll_snapshot ctxt in
  if
    Compare.Int32.equal
      (Int32.rem level.cycle_position blocks_per_roll_snapshot)
      (Int32.pred blocks_per_roll_snapshot)
  then Alpha_context.Roll.snapshot_rolls ctxt >>=? fun ctxt -> return ctxt
  else return ctxt

let may_start_new_cycle ctxt =
  Baking.dawn_of_a_new_cycle ctxt
  >>=? function
  | None ->
      return (ctxt, [], [])
  | Some last_cycle ->
      Seed.cycle_end ctxt last_cycle
      >>=? fun (ctxt, unrevealed) ->
      Roll.cycle_end ctxt last_cycle
      >>=? fun ctxt ->
      Delegate.cycle_end ctxt last_cycle unrevealed
      >>=? fun (ctxt, update_balances, deactivated) ->
      Bootstrap.cycle_end ctxt last_cycle
      >>=? fun ctxt -> return (ctxt, update_balances, deactivated)

let begin_full_construction ctxt pred_timestamp protocol_data =
  Alpha_context.Global.set_block_priority
    ctxt
    protocol_data.Block_header_repr.priority
  >>=? fun ctxt ->
  Baking.check_baking_rights ctxt protocol_data pred_timestamp
  >>=? fun (delegate_pk, block_delay) ->
  let ctxt = Fitness.increase ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None ->
      assert false (* genesis *)
  | Some pred_level ->
      Baking.endorsement_rights ctxt pred_level
      >>=? fun rights ->
      let ctxt = init_endorsements ctxt rights in
      return (ctxt, protocol_data, delegate_pk, block_delay)

let begin_partial_construction ctxt =
  let ctxt = Fitness.increase ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None ->
      assert false (* genesis *)
  | Some pred_level ->
      Baking.endorsement_rights ctxt pred_level
      >>=? fun rights ->
      let ctxt = init_endorsements ctxt rights in
      return ctxt

let begin_application ctxt chain_id block_header pred_timestamp =
  Alpha_context.Global.set_block_priority
    ctxt
    block_header.Block_header_repr.protocol_data.contents.priority
  >>=? fun ctxt ->
  let current_level = Alpha_context.Level.current ctxt in
  Baking.check_proof_of_work_stamp ctxt block_header
  >>=? fun () ->
  Baking.check_fitness_gap ctxt block_header
  >>=? fun () ->
  Baking.check_baking_rights
    ctxt
    block_header.protocol_data.contents
    pred_timestamp
  >>=? fun (delegate_pk, block_delay) ->
  Baking.check_signature block_header chain_id delegate_pk
  >>=? fun () ->
  let has_commitment =
    match block_header.protocol_data.contents.seed_nonce_hash with
    | None ->
        false
    | Some _ ->
        true
  in
  fail_unless
    Compare.Bool.(has_commitment = current_level.expected_commitment)
    (Invalid_commitment {expected = current_level.expected_commitment})
  >>=? fun () ->
  let ctxt = Fitness.increase ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None ->
      assert false (* genesis *)
  | Some pred_level ->
      Baking.endorsement_rights ctxt pred_level
      >>=? fun rights ->
      let ctxt = init_endorsements ctxt rights in
      return (ctxt, delegate_pk, block_delay)

let check_minimum_endorsements ctxt protocol_data block_delay
    included_endorsements =
  let minimum = Baking.minimum_allowed_endorsements ctxt ~block_delay in
  let timestamp = Timestamp.current ctxt in
  fail_unless
    Compare.Int.(included_endorsements >= minimum)
    (Not_enough_endorsements_for_priority
       {
         required = minimum;
         priority = protocol_data.Block_header_repr.priority;
         endorsements = included_endorsements;
         timestamp;
       })

let finalize_application ctxt protocol_data delegate ~block_delay =
  let included_endorsements = included_endorsements ctxt in
  check_minimum_endorsements
    ctxt
    protocol_data
    block_delay
    included_endorsements
  >>=? fun () ->
  let deposit = Constants.block_security_deposit ctxt in
  add_deposit ctxt delegate deposit
  >>=? fun ctxt ->
  Baking.baking_reward
    ctxt
    ~block_priority:protocol_data.priority
    ~included_endorsements
  >>=? fun reward ->
  add_rewards ctxt reward
  >>=? fun ctxt ->
  Signature.Public_key_hash.Map.fold
    (fun delegate deposit ctxt ->
      ctxt >>=? fun ctxt -> Delegate.freeze_deposit ctxt delegate deposit)
    (get_deposits ctxt)
    (return ctxt)
  >>=? fun ctxt ->
  (* end of level (from this point nothing should fail) *)
  let fees = Alpha_context.get_fees ctxt in
  Delegate.freeze_fees ctxt delegate fees
  >>=? fun ctxt ->
  let rewards = Alpha_context.get_rewards ctxt in
  Delegate.freeze_rewards ctxt delegate rewards
  >>=? fun ctxt ->
  ( match protocol_data.Block_header_repr.seed_nonce_hash with
  | None ->
      return ctxt
  | Some nonce_hash ->
      Nonce.record_hash ctxt {nonce_hash; delegate; rewards; fees} )
  >>=? fun ctxt ->
  (* end of cycle *)
  may_snapshot_roll ctxt
  >>=? fun ctxt ->
  may_start_new_cycle ctxt
  >>=? fun (ctxt, balance_updates, deactivated) ->
  Amendment.may_start_new_voting_period ctxt
  >>=? fun ctxt ->
  let cycle = (Level.current ctxt).cycle in
  let balance_updates =
    Delegate.(
      cleanup_balance_updates
        ( [ (Contract (Contract.implicit_contract delegate), Debited deposit);
            (Deposits (delegate, cycle), Credited deposit);
            (Rewards (delegate, cycle), Credited reward) ]
        @ balance_updates ))
  in
  let consumed_gas =
    Z.sub
      (Constants.hard_gas_limit_per_block ctxt)
      (Alpha_context.Gas.block_level ctxt)
  in
  Alpha_context.Vote.get_current_period_kind ctxt
  >>=? fun voting_period_kind ->
  let receipt =
    Apply_results.
      {
        baker = delegate;
        level = Level.current ctxt;
        voting_period_kind;
        nonce_hash = protocol_data.seed_nonce_hash;
        consumed_gas;
        deactivated;
        balance_updates;
      }
  in
  return (ctxt, receipt)
Apply.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Unset Guard Checking.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Amendment.
Require Tezos.Apply_results.
Require Tezos.Baking.
Require Tezos.Blinded_public_key_hash.
Require Tezos.Block_header_repr.
Require Tezos.Michelson_v1_gas.
Require Tezos.Nonce_hash.
Require Tezos.Script_interpreter.
Require Tezos.Script_ir_translator.
Require Tezos.Script_typed_ir.
Require Tezos.Storage_mli. Module Storage := Storage_mli.

Import Alpha_context.

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Top-level evaluations are ignored *)
(* top_level_evaluation *)

Import Apply_results.

Definition apply_manager_operation_content
  (ctxt : Alpha_context.t) (mode : Script_ir_translator.unparsing_mode)
  (payer : Alpha_context.Contract.t) (source : Alpha_context.Contract.t)
  (chain_id : (|Chain_id|).(S.HASH.t)) (internal : bool)
  (operation : Alpha_context.manager_operation)
  : Lwt.t
    (Error_monad.tzresult
      (Alpha_context.context * Apply_results.successful_manager_operation_result
        * list Alpha_context.packed_internal_operation)) :=
  let before_operation := ctxt in
  let=? '_ := Alpha_context.Contract.must_exist ctxt source in
  let=? ctxt :=
    Lwt.__return
      (Alpha_context.Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation)
    in
  match operation with
  | Alpha_context.Reveal _ =>
    Error_monad.__return
      (ctxt,
        (Apply_results.Reveal_result
          {|
            Apply_results.successful_manager_operation_result.Reveal_result.consumed_gas :=
              Alpha_context.Gas.consumed before_operation ctxt |}), nil)
  |
    Alpha_context.Transaction {|
      Alpha_context.manager_operation.Transaction.amount := amount;
        Alpha_context.manager_operation.Transaction.parameters := parameters;
        Alpha_context.manager_operation.Transaction.entrypoint := entrypoint;
        Alpha_context.manager_operation.Transaction.destination := destination
        |} =>
    let=? ctxt := Alpha_context.Contract.spend ctxt source amount in
    let=? '(ctxt, maybe_burn_balance_update, allocated_destination_contract) :=
      match Alpha_context.Contract.is_implicit destination with
      | None => Error_monad.__return (ctxt, nil, false)
      | Some _ =>
        let=? function_parameter :=
          Alpha_context.Contract.allocated ctxt destination in
        match function_parameter with
        | true => Error_monad.__return (ctxt, nil, false)
        | false =>
          let=? '(ctxt, origination_burn) :=
            Alpha_context.Fees.origination_burn ctxt in
          Error_monad.__return
            (ctxt,
              [
                ((Alpha_context.Delegate.Contract payer),
                  (Alpha_context.Delegate.Debited origination_burn))
              ], true)
        end
      end in
    let=? ctxt := Alpha_context.Contract.credit ctxt destination amount in
    let=? '(ctxt, script) := Alpha_context.Contract.get_script ctxt destination
      in
    match script with
    | None =>
      let=? ctxt :=
        let=? '_ :=
          match entrypoint with
          | "default" => Error_monad.__return tt
          | entrypoint => Error_monad.fail extensible_type_value
          end in
        let=? '(arg, ctxt) :=
          Alpha_context.Script.force_decode_in_context ctxt parameters in
        let cost_arg := Alpha_context.Script.deserialized_cost arg in
        let=? ctxt := Lwt.__return (Alpha_context.Gas.consume ctxt cost_arg) in
        match Micheline.root arg with
        | Micheline.Prim _ Alpha_context.Script.D_Unit [] _ =>
          Error_monad.__return ctxt
        | _ => Error_monad.fail extensible_type_value
        end in
      let __result_value :=
        Apply_results.Transaction_result
          {|
            Apply_results.successful_manager_operation_result.Transaction_result.storage :=
              None;
            Apply_results.successful_manager_operation_result.Transaction_result.big_map_diff :=
              None;
            Apply_results.successful_manager_operation_result.Transaction_result.balance_updates :=
              Alpha_context.Delegate.cleanup_balance_updates
                (Pervasives.op_at
                  [
                    ((Alpha_context.Delegate.Contract source),
                      (Alpha_context.Delegate.Debited amount));
                    ((Alpha_context.Delegate.Contract destination),
                      (Alpha_context.Delegate.Credited amount))
                  ] maybe_burn_balance_update);
            Apply_results.successful_manager_operation_result.Transaction_result.originated_contracts :=
              nil;
            Apply_results.successful_manager_operation_result.Transaction_result.consumed_gas :=
              Alpha_context.Gas.consumed before_operation ctxt;
            Apply_results.successful_manager_operation_result.Transaction_result.storage_size :=
              Z.zero;
            Apply_results.successful_manager_operation_result.Transaction_result.paid_storage_size_diff :=
              Z.zero;
            Apply_results.successful_manager_operation_result.Transaction_result.allocated_destination_contract :=
              allocated_destination_contract |} in
      Error_monad.__return (ctxt, __result_value, nil)
    | Some script =>
      let=? '(parameter, ctxt) :=
        Alpha_context.Script.force_decode_in_context ctxt parameters in
      let cost_parameter := Alpha_context.Script.deserialized_cost parameter in
      let=? ctxt := Lwt.__return (Alpha_context.Gas.consume ctxt cost_parameter)
        in
      let step_constants :=
        {| Script_interpreter.step_constants.source := source;
          Script_interpreter.step_constants.payer := payer;
          Script_interpreter.step_constants.self := destination;
          Script_interpreter.step_constants.amount := amount;
          Script_interpreter.step_constants.chain_id := chain_id |} in
      let=? '{|
        Script_interpreter.execution_result.ctxt := ctxt;
          Script_interpreter.execution_result.storage := storage;
          Script_interpreter.execution_result.big_map_diff := big_map_diff;
          Script_interpreter.execution_result.operations := operations
          |} :=
        Script_interpreter.execute_wrapper ctxt mode step_constants script
          entrypoint parameter in
      let=? ctxt :=
        Alpha_context.Contract.update_script_storage ctxt destination storage
          big_map_diff in
      let=? '(ctxt, new_size, paid_storage_size_diff, fees) :=
        Alpha_context.Fees.record_paid_storage_space ctxt destination in
      let=? originated_contracts :=
        Alpha_context.Contract.originated_from_current_nonce before_operation
          ctxt in
      let __result_value :=
        Apply_results.Transaction_result
          {|
            Apply_results.successful_manager_operation_result.Transaction_result.storage :=
              Some storage;
            Apply_results.successful_manager_operation_result.Transaction_result.big_map_diff :=
              big_map_diff;
            Apply_results.successful_manager_operation_result.Transaction_result.balance_updates :=
              Alpha_context.Delegate.cleanup_balance_updates
                [
                  ((Alpha_context.Delegate.Contract payer),
                    (Alpha_context.Delegate.Debited fees));
                  ((Alpha_context.Delegate.Contract source),
                    (Alpha_context.Delegate.Debited amount));
                  ((Alpha_context.Delegate.Contract destination),
                    (Alpha_context.Delegate.Credited amount))
                ];
            Apply_results.successful_manager_operation_result.Transaction_result.originated_contracts :=
              originated_contracts;
            Apply_results.successful_manager_operation_result.Transaction_result.consumed_gas :=
              Alpha_context.Gas.consumed before_operation ctxt;
            Apply_results.successful_manager_operation_result.Transaction_result.storage_size :=
              new_size;
            Apply_results.successful_manager_operation_result.Transaction_result.paid_storage_size_diff :=
              paid_storage_size_diff;
            Apply_results.successful_manager_operation_result.Transaction_result.allocated_destination_contract :=
              allocated_destination_contract |} in
      Error_monad.__return (ctxt, __result_value, operations)
    end
  |
    Alpha_context.Origination {|
      Alpha_context.manager_operation.Origination.delegate := delegate;
        Alpha_context.manager_operation.Origination.script := script;
        Alpha_context.manager_operation.Origination.credit := credit;
        Alpha_context.manager_operation.Origination.preorigination :=
          preorigination
        |} =>
    let=? '(unparsed_storage, ctxt) :=
      Alpha_context.Script.force_decode_in_context ctxt
        script.(Alpha_context.Script.t.storage) in
    let=? ctxt :=
      Lwt.__return
        (Alpha_context.Gas.consume ctxt
          (Alpha_context.Script.deserialized_cost unparsed_storage)) in
    let=? '(unparsed_code, ctxt) :=
      Alpha_context.Script.force_decode_in_context ctxt
        script.(Alpha_context.Script.t.code) in
    let=? ctxt :=
      Lwt.__return
        (Alpha_context.Gas.consume ctxt
          (Alpha_context.Script.deserialized_cost unparsed_code)) in
    let=? '(Script_ir_translator.Ex_script parsed_script, ctxt) :=
      Script_ir_translator.parse_script None ctxt false script in
    let 'existT _ __Ex_script_'b [parsed_script, ctxt] :=
      existT (A := Set)
        (fun __Ex_script_'b =>
          [Script_typed_ir.script __Ex_script_'b ** Alpha_context.context]) _
        [parsed_script, ctxt] in
    let=? '(to_duplicate, ctxt) :=
      Script_ir_translator.collect_big_maps ctxt
        parsed_script.(Script_typed_ir.script.storage_type)
        parsed_script.(Script_typed_ir.script.storage) in
    let to_update := Script_ir_translator.no_big_map_id in
    let=? '(storage, big_map_diff, ctxt) :=
      Script_ir_translator.extract_big_map_diff ctxt
        Script_ir_translator.Optimized false to_duplicate to_update
        parsed_script.(Script_typed_ir.script.storage_type)
        parsed_script.(Script_typed_ir.script.storage) in
    let=? '(storage, ctxt) :=
      Script_ir_translator.unparse_data ctxt Script_ir_translator.Optimized
        parsed_script.(Script_typed_ir.script.storage_type) storage in
    let storage :=
      Alpha_context.Script.__lazy_expr_value (Micheline.strip_locations storage)
      in
    let script := Alpha_context.Script.t.with_storage storage script in
    let=? ctxt := Alpha_context.Contract.spend ctxt source credit in
    let=? '(ctxt, contract) :=
      match preorigination with
      | Some contract =>
        (* ❌ Sequences of instructions are ignored (operator ";") *)
        (* ❌ instruction_sequence ";" *)
        Error_monad.__return (ctxt, contract)
      | None => Alpha_context.Contract.fresh_contract_from_current_nonce ctxt
      end in
    let=? ctxt :=
      Alpha_context.Contract.originate ctxt contract credit
        (script, big_map_diff) delegate in
    let=? '(ctxt, origination_burn) := Alpha_context.Fees.origination_burn ctxt
      in
    let=? '(ctxt, size, paid_storage_size_diff, fees) :=
      Alpha_context.Fees.record_paid_storage_space ctxt contract in
    let __result_value :=
      Apply_results.Origination_result
        {|
          Apply_results.successful_manager_operation_result.Origination_result.big_map_diff :=
            big_map_diff;
          Apply_results.successful_manager_operation_result.Origination_result.balance_updates :=
            Alpha_context.Delegate.cleanup_balance_updates
              [
                ((Alpha_context.Delegate.Contract payer),
                  (Alpha_context.Delegate.Debited fees));
                ((Alpha_context.Delegate.Contract payer),
                  (Alpha_context.Delegate.Debited origination_burn));
                ((Alpha_context.Delegate.Contract source),
                  (Alpha_context.Delegate.Debited credit));
                ((Alpha_context.Delegate.Contract contract),
                  (Alpha_context.Delegate.Credited credit))
              ];
          Apply_results.successful_manager_operation_result.Origination_result.originated_contracts :=
            [ contract ];
          Apply_results.successful_manager_operation_result.Origination_result.consumed_gas :=
            Alpha_context.Gas.consumed before_operation ctxt;
          Apply_results.successful_manager_operation_result.Origination_result.storage_size :=
            size;
          Apply_results.successful_manager_operation_result.Origination_result.paid_storage_size_diff :=
            paid_storage_size_diff |} in
    Error_monad.__return (ctxt, __result_value, nil)
  | Alpha_context.Delegation delegate =>
    let=? ctxt := Alpha_context.Delegate.set ctxt source delegate in
    Error_monad.__return
      (ctxt,
        (Apply_results.Delegation_result
          {|
            Apply_results.successful_manager_operation_result.Delegation_result.consumed_gas :=
              Alpha_context.Gas.consumed before_operation ctxt |}), nil)
  end.

Inductive success_or_failure : Set :=
| Success : Alpha_context.t -> success_or_failure
| Failure : success_or_failure.

Definition apply_internal_manager_operations
  (ctxt : Alpha_context.t) (mode : Script_ir_translator.unparsing_mode)
  (payer : Alpha_context.Contract.t) (chain_id : (|Chain_id|).(S.HASH.t))
  (ops : list Alpha_context.packed_internal_operation)
  : Lwt.t
    (success_or_failure * list Apply_results.packed_internal_operation_result) :=
  let fix apply
    (ctxt : Alpha_context.t)
    (applied : list Apply_results.packed_internal_operation_result)
    (worklist : list Alpha_context.packed_internal_operation) {struct ctxt}
    : Lwt.t
      (success_or_failure * list Apply_results.packed_internal_operation_result) :=
    match worklist with
    | [] => Lwt.__return ((Success ctxt), (List.rev applied))
    |
      cons
        (Alpha_context.Internal_operation
          ({|
            Alpha_context.internal_operation.source := source;
              Alpha_context.internal_operation.operation := operation;
              Alpha_context.internal_operation.nonce := __nonce_value
              |} as op)) rest =>
      let= function_parameter :=
        if Alpha_context.internal_nonce_already_recorded ctxt __nonce_value then
          Error_monad.fail extensible_type_value
        else
          let ctxt := Alpha_context.record_internal_nonce ctxt __nonce_value in
          apply_manager_operation_content ctxt mode payer source chain_id true
            operation in
      match function_parameter with
      | Pervasives.Error errors =>
        let __result_value :=
          Apply_results.Internal_operation_result op
            (Apply_results.Failed
              (Alpha_context.manager_kind
                op.(Alpha_context.internal_operation.operation)) errors) in
        let skipped :=
          List.rev_map
            (fun function_parameter =>
              let 'Alpha_context.Internal_operation op := function_parameter in
              Apply_results.Internal_operation_result op
                (Apply_results.Skipped
                  (Alpha_context.manager_kind
                    op.(Alpha_context.internal_operation.operation)))) rest in
        Lwt.__return
          (Failure,
            (List.rev (Pervasives.op_at skipped (cons __result_value applied))))
      | Pervasives.Ok (ctxt, __result_value, emitted) =>
        apply ctxt
          (cons
            (Apply_results.Internal_operation_result op
              (Apply_results.Applied __result_value)) applied)
          (Pervasives.op_at rest emitted)
      end
    end in
  apply ctxt nil ops.

Definition precheck_manager_contents
  (ctxt : Alpha_context.context) (chain_id : (|Chain_id|).(S.HASH.t))
  (raw_operation : Alpha_context.operation) (op : Alpha_context.contents)
  : Lwt.t (Error_monad.tzresult Alpha_context.context) :=
  match op with
  |
    Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.source := source;
        Alpha_context.contents.Manager_operation.fee := fee;
        Alpha_context.contents.Manager_operation.counter := counter;
        Alpha_context.contents.Manager_operation.operation := operation;
        Alpha_context.contents.Manager_operation.gas_limit := gas_limit;
        Alpha_context.contents.Manager_operation.storage_limit := storage_limit
        |} =>
    let=? '_ := Lwt.__return (Alpha_context.Gas.check_limit ctxt gas_limit) in
    let ctxt := Alpha_context.Gas.set_limit ctxt gas_limit in
    let=? '_ :=
      Lwt.__return (Alpha_context.Fees.check_storage_limit ctxt storage_limit)
      in
    let=? '_ :=
      Alpha_context.Contract.must_be_allocated ctxt
        (Alpha_context.Contract.implicit_contract source) in
    let=? '_ :=
      Alpha_context.Contract.check_counter_increment ctxt source counter in
    let=? ctxt :=
      match operation with
      | Alpha_context.Reveal pk =>
        Alpha_context.Contract.reveal_manager_key ctxt source pk
      |
        Alpha_context.Transaction {|
          Alpha_context.manager_operation.Transaction.parameters := parameters
            |} =>
        let=? '_ :=
          Lwt.__return
            ((Error_monad.record_trace extensible_type_value)
              (Alpha_context.Gas.check_enough ctxt
                (Alpha_context.Script.minimal_deserialize_cost parameters))) in
        Error_monad.op_gtgtpipequestion
          ((Error_monad.trace extensible_type_value)
            (Alpha_context.Script.force_decode_in_context ctxt parameters))
          (fun function_parameter =>
            let '(_arg, ctxt) := function_parameter in
            ctxt)
      |
        Alpha_context.Origination {|
          Alpha_context.manager_operation.Origination.script := script |} =>
        let=? '_ :=
          Lwt.__return
            ((Error_monad.record_trace extensible_type_value)
              (let? ctxt :=
                Alpha_context.Gas.consume ctxt
                  (Alpha_context.Script.minimal_deserialize_cost
                    script.(Alpha_context.Script.t.code)) in
              Alpha_context.Gas.check_enough ctxt
                (Alpha_context.Script.minimal_deserialize_cost
                  script.(Alpha_context.Script.t.storage)))) in
        let=? '(_code, ctxt) :=
          (Error_monad.trace extensible_type_value)
            (Alpha_context.Script.force_decode_in_context ctxt
              script.(Alpha_context.Script.t.code)) in
        Error_monad.op_gtgtpipequestion
          ((Error_monad.trace extensible_type_value)
            (Alpha_context.Script.force_decode_in_context ctxt
              script.(Alpha_context.Script.t.storage)))
          (fun function_parameter =>
            let '(_storage, ctxt) := function_parameter in
            ctxt)
      | _ => Error_monad.__return ctxt
      end in
    let=? public_key := Alpha_context.Contract.get_manager_key ctxt source in
    let=? '_ :=
      Alpha_context.Operation.check_signature public_key chain_id raw_operation
      in
    let=? ctxt := Alpha_context.Contract.increment_counter ctxt source in
    let=? ctxt :=
      Alpha_context.Contract.spend ctxt
        (Alpha_context.Contract.implicit_contract source) fee in
    let=? ctxt := Alpha_context.add_fees ctxt fee in
    Error_monad.__return ctxt
  | _ => unreachable_gadt_branch
  end.

Definition apply_manager_contents
  (ctxt : Alpha_context.context) (mode : Script_ir_translator.unparsing_mode)
  (chain_id : (|Chain_id|).(S.HASH.t)) (op : Alpha_context.contents)
  : Lwt.t
    (success_or_failure * Apply_results.manager_operation_result *
      list Apply_results.packed_internal_operation_result) :=
  match op with
  |
    Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.source := source;
        Alpha_context.contents.Manager_operation.operation := operation;
        Alpha_context.contents.Manager_operation.gas_limit := gas_limit;
        Alpha_context.contents.Manager_operation.storage_limit := storage_limit
        |} =>
    let ctxt := Alpha_context.Gas.set_limit ctxt gas_limit in
    let ctxt := Alpha_context.Fees.start_counting_storage_fees ctxt in
    let source := Alpha_context.Contract.implicit_contract source in
    let= function_parameter :=
      apply_manager_operation_content ctxt mode source source chain_id false
        operation in
    match function_parameter with
    | Pervasives.Ok (ctxt, operation_results, internal_operations) =>
      let= function_parameter :=
        apply_internal_manager_operations ctxt mode source chain_id
          internal_operations in
      match function_parameter with
      | (Success ctxt, internal_operations_results) =>
        let= function_parameter :=
          Alpha_context.Fees.burn_storage_fees ctxt storage_limit source in
        match function_parameter with
        | Pervasives.Ok ctxt =>
          Lwt.__return
            ((Success ctxt), (Apply_results.Applied operation_results),
              internal_operations_results)
        | Pervasives.Error errors =>
          Lwt.__return
            (Failure,
              (Apply_results.Backtracked operation_results (Some errors)),
              internal_operations_results)
        end
      | (Failure, internal_operations_results) =>
        Lwt.__return
          (Failure, (Apply_results.Applied operation_results),
            internal_operations_results)
      end
    | Pervasives.Error errors =>
      Lwt.__return
        (Failure,
          (Apply_results.Failed (Alpha_context.manager_kind operation) errors),
          nil)
    end
  | _ => unreachable_gadt_branch
  end.

Definition skipped_operation_result
  (operation : Alpha_context.manager_operation)
  : Apply_results.manager_operation_result :=
  match operation with
  | Alpha_context.Reveal _ =>
    Apply_results.Applied
      (Apply_results.Reveal_result
        {|
          Apply_results.successful_manager_operation_result.Reveal_result.consumed_gas :=
            Z.zero |})
  | _ => Apply_results.Skipped (Alpha_context.manager_kind operation)
  end.

Fixpoint mark_skipped
  (baker : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (level : Alpha_context.Level.t)
  (function_parameter : Alpha_context.contents_list) {struct baker}
  : Apply_results.contents_result_list :=
  match function_parameter with
  |
    Alpha_context.Single
      (Alpha_context.Manager_operation {|
        Alpha_context.contents.Manager_operation.source := source;
          Alpha_context.contents.Manager_operation.fee := fee;
          Alpha_context.contents.Manager_operation.operation := operation
          |}) =>
    let source := Alpha_context.Contract.implicit_contract source in
    Apply_results.Single_result
      (Apply_results.Manager_operation_result
        {|
          Apply_results.contents_result.Manager_operation_result.balance_updates :=
            Alpha_context.Delegate.cleanup_balance_updates
              [
                ((Alpha_context.Delegate.Contract source),
                  (Alpha_context.Delegate.Debited fee));
                ((Alpha_context.Delegate.Fees baker
                  level.(Alpha_context.Level.t.cycle)),
                  (Alpha_context.Delegate.Credited fee))
              ];
          Apply_results.contents_result.Manager_operation_result.operation_result :=
            skipped_operation_result operation;
          Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
            nil |})
  |
    Alpha_context.Cons
      (Alpha_context.Manager_operation {|
        Alpha_context.contents.Manager_operation.source := source;
          Alpha_context.contents.Manager_operation.fee := fee;
          Alpha_context.contents.Manager_operation.operation := operation
          |}) rest =>
    let source := Alpha_context.Contract.implicit_contract source in
    Apply_results.Cons_result
      (Apply_results.Manager_operation_result
        {|
          Apply_results.contents_result.Manager_operation_result.balance_updates :=
            Alpha_context.Delegate.cleanup_balance_updates
              [
                ((Alpha_context.Delegate.Contract source),
                  (Alpha_context.Delegate.Debited fee));
                ((Alpha_context.Delegate.Fees baker
                  level.(Alpha_context.Level.t.cycle)),
                  (Alpha_context.Delegate.Credited fee))
              ];
          Apply_results.contents_result.Manager_operation_result.operation_result :=
            skipped_operation_result operation;
          Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
            nil |}) (mark_skipped baker level rest)
  | _ => unreachable_gadt_branch
  end.

Fixpoint precheck_manager_contents_list
  (ctxt : Alpha_context.t) (chain_id : (|Chain_id|).(S.HASH.t))
  (raw_operation : Alpha_context.Operation.t)
  (contents_list : Alpha_context.contents_list) {struct ctxt}
  : Lwt.t (Error_monad.tzresult Alpha_context.context) :=
  match contents_list with
  | Alpha_context.Single ((Alpha_context.Manager_operation _) as op) =>
    precheck_manager_contents ctxt chain_id raw_operation op
  | Alpha_context.Cons ((Alpha_context.Manager_operation _) as op) rest =>
    let=? ctxt := precheck_manager_contents ctxt chain_id raw_operation op in
    precheck_manager_contents_list ctxt chain_id raw_operation rest
  | _ => unreachable_gadt_branch
  end.

Fixpoint apply_manager_contents_list_rec
  (ctxt : Alpha_context.t) (mode : Script_ir_translator.unparsing_mode)
  (baker : Alpha_context.public_key_hash) (chain_id : (|Chain_id|).(S.HASH.t))
  (contents_list : Alpha_context.contents_list) {struct ctxt}
  : Lwt.t (success_or_failure * Apply_results.contents_result_list) :=
  let level := Alpha_context.Level.current ctxt in
  match contents_list with
  |
    Alpha_context.Single
      ((Alpha_context.Manager_operation {|
        Alpha_context.contents.Manager_operation.source := source;
          Alpha_context.contents.Manager_operation.fee := fee
          |}) as op) =>
    let source := Alpha_context.Contract.implicit_contract source in
    let= '(ctxt_result, operation_result, internal_operation_results) :=
      apply_manager_contents ctxt mode chain_id op in
    let __result_value :=
      Apply_results.Manager_operation_result
        {|
          Apply_results.contents_result.Manager_operation_result.balance_updates :=
            Alpha_context.Delegate.cleanup_balance_updates
              [
                ((Alpha_context.Delegate.Contract source),
                  (Alpha_context.Delegate.Debited fee));
                ((Alpha_context.Delegate.Fees baker
                  level.(Alpha_context.Level.t.cycle)),
                  (Alpha_context.Delegate.Credited fee))
              ];
          Apply_results.contents_result.Manager_operation_result.operation_result :=
            operation_result;
          Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
            internal_operation_results |} in
    Lwt.__return (ctxt_result, (Apply_results.Single_result __result_value))
  |
    Alpha_context.Cons
      ((Alpha_context.Manager_operation {|
        Alpha_context.contents.Manager_operation.source := source;
          Alpha_context.contents.Manager_operation.fee := fee
          |}) as op) rest =>
    let source := Alpha_context.Contract.implicit_contract source in
    let= function_parameter := apply_manager_contents ctxt mode chain_id op in
    match function_parameter with
    | (Failure, operation_result, internal_operation_results) =>
      let __result_value :=
        Apply_results.Manager_operation_result
          {|
            Apply_results.contents_result.Manager_operation_result.balance_updates :=
              Alpha_context.Delegate.cleanup_balance_updates
                [
                  ((Alpha_context.Delegate.Contract source),
                    (Alpha_context.Delegate.Debited fee));
                  ((Alpha_context.Delegate.Fees baker
                    level.(Alpha_context.Level.t.cycle)),
                    (Alpha_context.Delegate.Credited fee))
                ];
            Apply_results.contents_result.Manager_operation_result.operation_result :=
              operation_result;
            Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
              internal_operation_results |} in
      Lwt.__return
        (Failure,
          (Apply_results.Cons_result __result_value
            (mark_skipped baker level rest)))
    | (Success ctxt, operation_result, internal_operation_results) =>
      let __result_value :=
        Apply_results.Manager_operation_result
          {|
            Apply_results.contents_result.Manager_operation_result.balance_updates :=
              Alpha_context.Delegate.cleanup_balance_updates
                [
                  ((Alpha_context.Delegate.Contract source),
                    (Alpha_context.Delegate.Debited fee));
                  ((Alpha_context.Delegate.Fees baker
                    level.(Alpha_context.Level.t.cycle)),
                    (Alpha_context.Delegate.Credited fee))
                ];
            Apply_results.contents_result.Manager_operation_result.operation_result :=
              operation_result;
            Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
              internal_operation_results |} in
      let= '(ctxt_result, results) :=
        apply_manager_contents_list_rec ctxt mode baker chain_id rest in
      Lwt.__return
        (ctxt_result, (Apply_results.Cons_result __result_value results))
    end
  | _ => unreachable_gadt_branch
  end.

Definition mark_backtracked (results : Apply_results.contents_result_list)
  : Apply_results.contents_result_list :=
  let mark_manager_operation_result
    (function_parameter : Apply_results.manager_operation_result)
    : Apply_results.manager_operation_result :=
    match function_parameter with
    |
      (Apply_results.Failed _ _ | Apply_results.Skipped _ |
      Apply_results.Backtracked _ _) as __result_value => __result_value
    | (Apply_results.Applied (Apply_results.Reveal_result _)) as __result_value
      => __result_value
    | Apply_results.Applied __result_value =>
      Apply_results.Backtracked __result_value None
    end in
  let mark_internal_operation_results
    (function_parameter : Apply_results.packed_internal_operation_result)
    : Apply_results.packed_internal_operation_result :=
    let 'Apply_results.Internal_operation_result kind __result_value :=
      function_parameter in
    Apply_results.Internal_operation_result kind
      (mark_manager_operation_result __result_value) in
  let fix mark_contents_list
    (function_parameter : Apply_results.contents_result_list)
    {struct function_parameter} : Apply_results.contents_result_list :=
    match function_parameter with
    | Apply_results.Single_result (Apply_results.Manager_operation_result op) =>
      Apply_results.Single_result
        (Apply_results.Manager_operation_result
          {|
            Apply_results.contents_result.Manager_operation_result.balance_updates :=
              op.(Apply_results.contents_result.Manager_operation_result.balance_updates);
            Apply_results.contents_result.Manager_operation_result.operation_result :=
              mark_manager_operation_result
                op.(Apply_results.contents_result.Manager_operation_result.operation_result);
            Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
              List.map mark_internal_operation_results
                op.(Apply_results.contents_result.Manager_operation_result.internal_operation_results)
            |})
    | Apply_results.Cons_result (Apply_results.Manager_operation_result op) rest
      =>
      Apply_results.Cons_result
        (Apply_results.Manager_operation_result
          {|
            Apply_results.contents_result.Manager_operation_result.balance_updates :=
              op.(Apply_results.contents_result.Manager_operation_result.balance_updates);
            Apply_results.contents_result.Manager_operation_result.operation_result :=
              mark_manager_operation_result
                op.(Apply_results.contents_result.Manager_operation_result.operation_result);
            Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
              List.map mark_internal_operation_results
                op.(Apply_results.contents_result.Manager_operation_result.internal_operation_results)
            |}) (mark_contents_list rest)
    | _ => unreachable_gadt_branch
    end in
  mark_contents_list results.

Definition apply_manager_contents_list
  (ctxt : Alpha_context.t) (mode : Script_ir_translator.unparsing_mode)
  (baker : Alpha_context.public_key_hash) (chain_id : (|Chain_id|).(S.HASH.t))
  (contents_list : Alpha_context.contents_list)
  : Lwt.t (Alpha_context.t * Apply_results.contents_result_list) :=
  let= '(ctxt_result, results) :=
    apply_manager_contents_list_rec ctxt mode baker chain_id contents_list in
  match ctxt_result with
  | Failure => Lwt.__return (ctxt, (mark_backtracked results))
  | Success ctxt =>
    let= ctxt := Alpha_context.Big_map.cleanup_temporary ctxt in
    Lwt.__return (ctxt, results)
  end.

Definition apply_contents_list
  (ctxt : Alpha_context.context) (chain_id : (|Chain_id|).(S.HASH.t))
  (mode : Script_ir_translator.unparsing_mode)
  (pred_block : (|Block_hash|).(S.HASH.t))
  (baker : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (operation : Alpha_context.operation)
  (contents_list : Alpha_context.contents_list)
  : Lwt.t
    (Error_monad.tzresult
      (Alpha_context.context * Apply_results.contents_result_list)) :=
  match contents_list with
  |
    Alpha_context.Single
      (Alpha_context.Endorsement {|
        Alpha_context.contents.Endorsement.level := level |}) =>
    let block :=
      operation.(Alpha_context.operation.shell).(Operation.shell_header.branch)
      in
    let=? '_ :=
      Error_monad.fail_unless ((|Block_hash|).(S.HASH.equal) block pred_block)
        extensible_type_value in
    let current_level :=
      (Alpha_context.Level.current ctxt).(Alpha_context.Level.t.level) in
    let=? '_ :=
      Error_monad.fail_unless
        (Alpha_context.Raw_level.op_eq (Alpha_context.Raw_level.succ level)
          current_level) extensible_type_value in
    let=? '(delegate, slots, used) :=
      Baking.check_endorsement_rights ctxt chain_id operation in
    if used then
      Error_monad.fail extensible_type_value
    else
      let ctxt := Alpha_context.record_endorsement ctxt delegate in
      let gap := List.length slots in
      let=? deposit :=
        Lwt.__return
          (Alpha_context.Tez.op_starquestion
            (Alpha_context.Constants.endorsement_security_deposit ctxt)
            (Int64.of_int gap)) in
      let=? ctxt := Alpha_context.Delegate.freeze_deposit ctxt delegate deposit
        in
      let=? block_priority := Alpha_context.Global.get_block_priority ctxt in
      let=? reward := Baking.endorsing_reward ctxt block_priority gap in
      let=? ctxt := Alpha_context.Delegate.freeze_rewards ctxt delegate reward
        in
      let level := Alpha_context.Level.from_raw ctxt None level in
      Error_monad.__return
        (ctxt,
          (Apply_results.Single_result
            (Apply_results.Endorsement_result
              {|
                Apply_results.contents_result.Endorsement_result.balance_updates :=
                  Alpha_context.Delegate.cleanup_balance_updates
                    [
                      ((Alpha_context.Delegate.Contract
                        (Alpha_context.Contract.implicit_contract
                          delegate)),
                        (Alpha_context.Delegate.Debited
                          deposit));
                      ((Alpha_context.Delegate.Deposits delegate
                        level.(Alpha_context.Level.t.cycle)),
                        (Alpha_context.Delegate.Credited
                          deposit));
                      ((Alpha_context.Delegate.Rewards delegate
                        level.(Alpha_context.Level.t.cycle)),
                        (Alpha_context.Delegate.Credited
                          reward))
                    ];
                Apply_results.contents_result.Endorsement_result.delegate :=
                  delegate;
                Apply_results.contents_result.Endorsement_result.slots := slots
                |})))
  |
    Alpha_context.Single
      (Alpha_context.Seed_nonce_revelation {|
        Alpha_context.contents.Seed_nonce_revelation.level := level;
          Alpha_context.contents.Seed_nonce_revelation.nonce := __nonce_value
          |}) =>
    let level := Alpha_context.Level.from_raw ctxt None level in
    let=? ctxt := Alpha_context.Nonce.reveal ctxt level __nonce_value in
    let seed_nonce_revelation_tip :=
      Alpha_context.Constants.seed_nonce_revelation_tip ctxt in
    let=? ctxt := Alpha_context.add_rewards ctxt seed_nonce_revelation_tip in
    Error_monad.__return
      (ctxt,
        (Apply_results.Single_result
          (Apply_results.Seed_nonce_revelation_result
            [
              ((Alpha_context.Delegate.Rewards baker
                level.(Alpha_context.Level.t.cycle)),
                (Alpha_context.Delegate.Credited
                  seed_nonce_revelation_tip))
            ])))
  |
    Alpha_context.Single
      (Alpha_context.Double_endorsement_evidence {|
        Alpha_context.contents.Double_endorsement_evidence.op1 := op1;
          Alpha_context.contents.Double_endorsement_evidence.op2 := op2
          |}) =>
    match
      ((op1.(Alpha_context.operation.protocol_data).(Alpha_context.protocol_data.contents),
        op2.(Alpha_context.operation.protocol_data).(Alpha_context.protocol_data.contents)),
        match
          (op1.(Alpha_context.operation.protocol_data).(Alpha_context.protocol_data.contents),
            op2.(Alpha_context.operation.protocol_data).(Alpha_context.protocol_data.contents))
          with
        |
          (Alpha_context.Single (Alpha_context.Endorsement e1),
            Alpha_context.Single (Alpha_context.Endorsement e2)) =>
          Pervasives.op_andand
            (Alpha_context.Raw_level.op_eq
              e1.(Alpha_context.contents.Endorsement.level)
              e2.(Alpha_context.contents.Endorsement.level))
            (Pervasives.not
              ((|Block_hash|).(S.HASH.equal)
                op1.(Alpha_context.operation.shell).(Operation.shell_header.branch)
                op2.(Alpha_context.operation.shell).(Operation.shell_header.branch)))
        | _ => false
        end) with
    |
      ((Alpha_context.Single (Alpha_context.Endorsement e1),
        Alpha_context.Single (Alpha_context.Endorsement e2)), true) =>
      let level :=
        Alpha_context.Level.from_raw ctxt None
          e1.(Alpha_context.contents.Endorsement.level) in
      let oldest_level := Alpha_context.Level.last_allowed_fork_level ctxt in
      let=? '_ :=
        Error_monad.fail_unless
          (Alpha_context.Level.op_lt level (Alpha_context.Level.current ctxt))
          extensible_type_value in
      let=? '_ :=
        Error_monad.fail_unless
          (Alpha_context.Raw_level.op_lteq oldest_level
            level.(Alpha_context.Level.t.level)) extensible_type_value in
      let=? '(delegate1, _, _) :=
        Baking.check_endorsement_rights ctxt chain_id op1 in
      let=? '(delegate2, _, _) :=
        Baking.check_endorsement_rights ctxt chain_id op2 in
      let=? '_ :=
        Error_monad.fail_unless
          ((|Signature.Public_key_hash|).(S.SPublic_key_hash.equal) delegate1
            delegate2) extensible_type_value in
      let=? valid :=
        Alpha_context.Delegate.has_frozen_balance ctxt delegate1
          level.(Alpha_context.Level.t.cycle) in
      let=? '_ := Error_monad.fail_unless valid extensible_type_value in
      let=? '(ctxt, balance) :=
        Alpha_context.Delegate.punish ctxt delegate1
          level.(Alpha_context.Level.t.cycle) in
      let=? burned :=
        Lwt.__return
          (Alpha_context.Tez.op_plusquestion
            balance.(Alpha_context.Delegate.frozen_balance.deposit)
            balance.(Alpha_context.Delegate.frozen_balance.fees)) in
      let reward :=
        match
          Alpha_context.Tez.op_divquestion burned
            (* ❌ Constant of type int64 is converted to int *)
            2 with
        | Pervasives.Ok v => v
        | Pervasives.Error _ => Alpha_context.Tez.zero
        end in
      let=? ctxt := Alpha_context.add_rewards ctxt reward in
      let current_cycle :=
        (Alpha_context.Level.current ctxt).(Alpha_context.Level.t.cycle) in
      Error_monad.__return
        (ctxt,
          (Apply_results.Single_result
            (Apply_results.Double_endorsement_evidence_result
              (Alpha_context.Delegate.cleanup_balance_updates
                [
                  ((Alpha_context.Delegate.Deposits delegate1
                    level.(Alpha_context.Level.t.cycle)),
                    (Alpha_context.Delegate.Debited
                      balance.(Alpha_context.Delegate.frozen_balance.deposit)));
                  ((Alpha_context.Delegate.Fees delegate1
                    level.(Alpha_context.Level.t.cycle)),
                    (Alpha_context.Delegate.Debited
                      balance.(Alpha_context.Delegate.frozen_balance.fees)));
                  ((Alpha_context.Delegate.Rewards delegate1
                    level.(Alpha_context.Level.t.cycle)),
                    (Alpha_context.Delegate.Debited
                      balance.(Alpha_context.Delegate.frozen_balance.rewards)));
                  ((Alpha_context.Delegate.Rewards baker current_cycle),
                    (Alpha_context.Delegate.Credited reward))
                ]))))
    | ((_, _), _) => Error_monad.fail extensible_type_value
    end
  |
    Alpha_context.Single
      (Alpha_context.Double_baking_evidence {|
        Alpha_context.contents.Double_baking_evidence.bh1 := bh1;
          Alpha_context.contents.Double_baking_evidence.bh2 := bh2
          |}) =>
    let hash1 := Alpha_context.Block_header.__hash_value bh1 in
    let hash2 := Alpha_context.Block_header.__hash_value bh2 in
    let=? '_ :=
      Error_monad.fail_unless
        (Pervasives.op_andand
          ((|Compare.Int32|).(Compare.S.op_eq)
            bh1.(Alpha_context.Block_header.block_header.shell).(Block_header.shell_header.level)
            bh2.(Alpha_context.Block_header.block_header.shell).(Block_header.shell_header.level))
          (Pervasives.not ((|Block_hash|).(S.HASH.equal) hash1 hash2)))
        extensible_type_value in
    let=? raw_level :=
      Lwt.__return
        (Alpha_context.Raw_level.of_int32
          bh1.(Alpha_context.Block_header.block_header.shell).(Block_header.shell_header.level))
      in
    let oldest_level := Alpha_context.Level.last_allowed_fork_level ctxt in
    let=? '_ :=
      Error_monad.fail_unless
        (Alpha_context.Raw_level.op_lt raw_level
          (Alpha_context.Level.current ctxt).(Alpha_context.Level.t.level))
        extensible_type_value in
    let=? '_ :=
      Error_monad.fail_unless
        (Alpha_context.Raw_level.op_lteq oldest_level raw_level)
        extensible_type_value in
    let level := Alpha_context.Level.from_raw ctxt None raw_level in
    let=? delegate1 :=
      Alpha_context.Roll.baking_rights_owner ctxt level
        bh1.(Alpha_context.Block_header.block_header.protocol_data).(Alpha_context.Block_header.protocol_data.contents).(Alpha_context.Block_header.contents.priority)
      in
    let=? '_ := Baking.check_signature bh1 chain_id delegate1 in
    let=? delegate2 :=
      Alpha_context.Roll.baking_rights_owner ctxt level
        bh2.(Alpha_context.Block_header.block_header.protocol_data).(Alpha_context.Block_header.protocol_data.contents).(Alpha_context.Block_header.contents.priority)
      in
    let=? '_ := Baking.check_signature bh2 chain_id delegate2 in
    let=? '_ :=
      Error_monad.fail_unless
        ((|Signature.Public_key|).(S.SPublic_key.equal) delegate1 delegate2)
        extensible_type_value in
    let delegate :=
      (|Signature.Public_key|).(S.SPublic_key.__hash_value) delegate1 in
    let=? valid :=
      Alpha_context.Delegate.has_frozen_balance ctxt delegate
        level.(Alpha_context.Level.t.cycle) in
    let=? '_ := Error_monad.fail_unless valid extensible_type_value in
    let=? '(ctxt, balance) :=
      Alpha_context.Delegate.punish ctxt delegate
        level.(Alpha_context.Level.t.cycle) in
    let=? burned :=
      Lwt.__return
        (Alpha_context.Tez.op_plusquestion
          balance.(Alpha_context.Delegate.frozen_balance.deposit)
          balance.(Alpha_context.Delegate.frozen_balance.fees)) in
    let reward :=
      match
        Alpha_context.Tez.op_divquestion burned
          (* ❌ Constant of type int64 is converted to int *)
          2 with
      | Pervasives.Ok v => v
      | Pervasives.Error _ => Alpha_context.Tez.zero
      end in
    let=? ctxt := Alpha_context.add_rewards ctxt reward in
    let current_cycle :=
      (Alpha_context.Level.current ctxt).(Alpha_context.Level.t.cycle) in
    Error_monad.__return
      (ctxt,
        (Apply_results.Single_result
          (Apply_results.Double_baking_evidence_result
            (Alpha_context.Delegate.cleanup_balance_updates
              [
                ((Alpha_context.Delegate.Deposits delegate
                  level.(Alpha_context.Level.t.cycle)),
                  (Alpha_context.Delegate.Debited
                    balance.(Alpha_context.Delegate.frozen_balance.deposit)));
                ((Alpha_context.Delegate.Fees delegate
                  level.(Alpha_context.Level.t.cycle)),
                  (Alpha_context.Delegate.Debited
                    balance.(Alpha_context.Delegate.frozen_balance.fees)));
                ((Alpha_context.Delegate.Rewards delegate
                  level.(Alpha_context.Level.t.cycle)),
                  (Alpha_context.Delegate.Debited
                    balance.(Alpha_context.Delegate.frozen_balance.rewards)));
                ((Alpha_context.Delegate.Rewards baker current_cycle),
                  (Alpha_context.Delegate.Credited reward))
              ]))))
  |
    Alpha_context.Single
      (Alpha_context.Activate_account {|
        Alpha_context.contents.Activate_account.id := pkh;
          Alpha_context.contents.Activate_account.activation_code :=
            activation_code
          |}) =>
    let blinded_pkh :=
      Blinded_public_key_hash.of_ed25519_pkh activation_code pkh in
    let=? function_parameter :=
      Alpha_context.Commitment.get_opt ctxt blinded_pkh in
    match function_parameter with
    | None => Error_monad.fail extensible_type_value
    | Some amount =>
      let=? ctxt := Alpha_context.Commitment.delete ctxt blinded_pkh in
      let contract :=
        Alpha_context.Contract.implicit_contract (Signature.Ed25519Hash pkh) in
      let=? ctxt := Alpha_context.Contract.credit ctxt contract amount in
      Error_monad.__return
        (ctxt,
          (Apply_results.Single_result
            (Apply_results.Activate_account_result
              [
                ((Alpha_context.Delegate.Contract contract),
                  (Alpha_context.Delegate.Credited amount))
              ])))
    end
  |
    Alpha_context.Single
      (Alpha_context.Proposals {|
        Alpha_context.contents.Proposals.source := source;
          Alpha_context.contents.Proposals.period := period;
          Alpha_context.contents.Proposals.proposals := proposals
          |}) =>
    let=? delegate := Alpha_context.Roll.delegate_pubkey ctxt source in
    let=? '_ :=
      Alpha_context.Operation.check_signature delegate chain_id operation in
    let level := Alpha_context.Level.current ctxt in
    let=? '_ :=
      Error_monad.fail_unless
        (Alpha_context.Voting_period.op_eq
          level.(Alpha_context.Level.t.voting_period) period)
        extensible_type_value in
    let=? ctxt := Amendment.record_proposals ctxt source proposals in
    Error_monad.__return
      (ctxt, (Apply_results.Single_result Apply_results.Proposals_result))
  |
    Alpha_context.Single
      (Alpha_context.Ballot {|
        Alpha_context.contents.Ballot.source := source;
          Alpha_context.contents.Ballot.period := period;
          Alpha_context.contents.Ballot.proposal := proposal;
          Alpha_context.contents.Ballot.ballot := ballot
          |}) =>
    let=? delegate := Alpha_context.Roll.delegate_pubkey ctxt source in
    let=? '_ :=
      Alpha_context.Operation.check_signature delegate chain_id operation in
    let level := Alpha_context.Level.current ctxt in
    let=? '_ :=
      Error_monad.fail_unless
        (Alpha_context.Voting_period.op_eq
          level.(Alpha_context.Level.t.voting_period) period)
        extensible_type_value in
    let=? ctxt := Amendment.record_ballot ctxt source proposal ballot in
    Error_monad.__return
      (ctxt, (Apply_results.Single_result Apply_results.Ballot_result))
  | (Alpha_context.Single (Alpha_context.Manager_operation _)) as op =>
    let=? ctxt := precheck_manager_contents_list ctxt chain_id operation op in
    let= '(ctxt, __result_value) :=
      apply_manager_contents_list ctxt mode baker chain_id op in
    Error_monad.__return (ctxt, __result_value)
  | (Alpha_context.Cons (Alpha_context.Manager_operation _) _) as op =>
    let=? ctxt := precheck_manager_contents_list ctxt chain_id operation op in
    let= '(ctxt, __result_value) :=
      apply_manager_contents_list ctxt mode baker chain_id op in
    Error_monad.__return (ctxt, __result_value)
  | _ => unreachable_gadt_branch
  end.

Definition apply_operation
  (ctxt : Alpha_context.context) (chain_id : (|Chain_id|).(S.HASH.t))
  (mode : Script_ir_translator.unparsing_mode)
  (pred_block : (|Block_hash|).(S.HASH.t))
  (baker : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (__hash_value : (|Operation_hash|).(S.HASH.t))
  (operation : Alpha_context.operation)
  : Lwt.t
    (Error_monad.tzresult
      (Alpha_context.context * Apply_results.operation_metadata)) :=
  let ctxt := Alpha_context.Contract.init_origination_nonce ctxt __hash_value in
  let=? '(ctxt, __result_value) :=
    apply_contents_list ctxt chain_id mode pred_block baker operation
      operation.(Alpha_context.operation.protocol_data).(Alpha_context.protocol_data.contents)
    in
  let ctxt := Alpha_context.Gas.set_unlimited ctxt in
  let ctxt := Alpha_context.Contract.unset_origination_nonce ctxt in
  Error_monad.__return
    (ctxt, {| Apply_results.operation_metadata.contents := __result_value |}).

Definition may_snapshot_roll (ctxt : Alpha_context.context)
  : Lwt.t (Error_monad.tzresult Alpha_context.context) :=
  let level := Alpha_context.Level.current ctxt in
  let blocks_per_roll_snapshot :=
    Alpha_context.Constants.blocks_per_roll_snapshot ctxt in
  if
    (|Compare.Int32|).(Compare.S.equal)
      (Int32.rem level.(Alpha_context.Level.t.cycle_position)
        blocks_per_roll_snapshot) (Int32.pred blocks_per_roll_snapshot) then
    let=? ctxt := Alpha_context.Roll.snapshot_rolls ctxt in
    Error_monad.__return ctxt
  else
    Error_monad.__return ctxt.

Definition may_start_new_cycle (ctxt : Alpha_context.context)
  : Lwt.t
    (Error_monad.tzresult
      (Alpha_context.context * Alpha_context.Delegate.balance_updates *
        list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))) :=
  let=? function_parameter := Baking.dawn_of_a_new_cycle ctxt in
  match function_parameter with
  | None => Error_monad.__return (ctxt, nil, nil)
  | Some last_cycle =>
    let=? '(ctxt, unrevealed) := Alpha_context.Seed.cycle_end ctxt last_cycle in
    let=? ctxt := Alpha_context.Roll.cycle_end ctxt last_cycle in
    let=? '(ctxt, update_balances, deactivated) :=
      Alpha_context.Delegate.cycle_end ctxt last_cycle unrevealed in
    let=? ctxt := Alpha_context.Bootstrap.cycle_end ctxt last_cycle in
    Error_monad.__return (ctxt, update_balances, deactivated)
  end.

Definition begin_full_construction
  (ctxt : Alpha_context.context) (pred_timestamp : Time.t)
  (protocol_data : Block_header_repr.contents)
  : Lwt.t
    (Error_monad.tzresult
      (Alpha_context.context * Block_header_repr.contents *
        Alpha_context.public_key * Alpha_context.Period.t)) :=
  let=? ctxt :=
    Alpha_context.Global.set_block_priority ctxt
      protocol_data.(Block_header_repr.contents.priority) in
  let=? '(delegate_pk, block_delay) :=
    Baking.check_baking_rights ctxt protocol_data pred_timestamp in
  let ctxt := Alpha_context.Fitness.increase None ctxt in
  match Alpha_context.Level.pred ctxt (Alpha_context.Level.current ctxt) with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert
      (Lwt.t
        (Error_monad.tzresult
          (Alpha_context.context * Block_header_repr.contents *
            Alpha_context.public_key * Alpha_context.Period.t))) false
  | Some pred_level =>
    let=? rights := Baking.endorsement_rights ctxt pred_level in
    let ctxt := Alpha_context.init_endorsements ctxt rights in
    Error_monad.__return (ctxt, protocol_data, delegate_pk, block_delay)
  end.

Definition begin_partial_construction (ctxt : Alpha_context.context)
  : Lwt.t (Error_monad.tzresult Alpha_context.context) :=
  let ctxt := Alpha_context.Fitness.increase None ctxt in
  match Alpha_context.Level.pred ctxt (Alpha_context.Level.current ctxt) with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert (Lwt.t (Error_monad.tzresult Alpha_context.context)) false
  | Some pred_level =>
    let=? rights := Baking.endorsement_rights ctxt pred_level in
    let ctxt := Alpha_context.init_endorsements ctxt rights in
    Error_monad.__return ctxt
  end.

Definition begin_application
  (ctxt : Alpha_context.context) (chain_id : (|Chain_id|).(S.HASH.t))
  (block_header : Block_header_repr.block_header) (pred_timestamp : Time.t)
  : Lwt.t
    (Error_monad.tzresult
      (Alpha_context.context * Alpha_context.public_key * Alpha_context.Period.t)) :=
  let=? ctxt :=
    Alpha_context.Global.set_block_priority ctxt
      block_header.(Block_header_repr.block_header.protocol_data).(Block_header_repr.protocol_data.contents).(Block_header_repr.contents.priority)
    in
  let current_level := Alpha_context.Level.current ctxt in
  let=? '_ := Baking.check_proof_of_work_stamp ctxt block_header in
  let=? '_ := Baking.check_fitness_gap ctxt block_header in
  let=? '(delegate_pk, block_delay) :=
    Baking.check_baking_rights ctxt
      block_header.(Block_header_repr.block_header.protocol_data).(Block_header_repr.protocol_data.contents)
      pred_timestamp in
  let=? '_ := Baking.check_signature block_header chain_id delegate_pk in
  let has_commitment :=
    match
      block_header.(Block_header_repr.block_header.protocol_data).(Block_header_repr.protocol_data.contents).(Block_header_repr.contents.seed_nonce_hash)
      with
    | None => false
    | Some _ => true
    end in
  let=? '_ :=
    Error_monad.fail_unless
      ((|Compare.Bool|).(Compare.S.op_eq) has_commitment
        current_level.(Alpha_context.Level.t.expected_commitment))
      extensible_type_value in
  let ctxt := Alpha_context.Fitness.increase None ctxt in
  match Alpha_context.Level.pred ctxt (Alpha_context.Level.current ctxt) with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert
      (Lwt.t
        (Error_monad.tzresult
          (Alpha_context.context * Alpha_context.public_key *
            Alpha_context.Period.t))) false
  | Some pred_level =>
    let=? rights := Baking.endorsement_rights ctxt pred_level in
    let ctxt := Alpha_context.init_endorsements ctxt rights in
    Error_monad.__return (ctxt, delegate_pk, block_delay)
  end.

Definition check_minimum_endorsements
  (ctxt : Alpha_context.context) (protocol_data : Block_header_repr.contents)
  (block_delay : Alpha_context.Period.t)
  (included_endorsements : (|Compare.Int|).(Compare.S.t))
  : Lwt.t (Error_monad.tzresult unit) :=
  let minimum := Baking.minimum_allowed_endorsements ctxt block_delay in
  let timestamp := Alpha_context.Timestamp.current ctxt in
  Error_monad.fail_unless
    ((|Compare.Int|).(Compare.S.op_gteq) included_endorsements minimum)
    extensible_type_value.

Definition finalize_application
  (ctxt : Alpha_context.context) (protocol_data : Block_header_repr.contents)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (block_delay : Alpha_context.Period.t)
  : Lwt.t
    (Error_monad.tzresult (Alpha_context.context * Apply_results.block_metadata)) :=
  let included_endorsements := Alpha_context.included_endorsements ctxt in
  let=? '_ :=
    check_minimum_endorsements ctxt protocol_data block_delay
      included_endorsements in
  let deposit := Alpha_context.Constants.block_security_deposit ctxt in
  let=? ctxt := Alpha_context.add_deposit ctxt delegate deposit in
  let=? reward :=
    Baking.baking_reward ctxt
      protocol_data.(Block_header_repr.contents.priority) included_endorsements
    in
  let=? ctxt := Alpha_context.add_rewards ctxt reward in
  let=? ctxt :=
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.fold)
      (fun delegate =>
        fun deposit =>
          fun ctxt =>
            let=? ctxt := ctxt in
            Alpha_context.Delegate.freeze_deposit ctxt delegate deposit)
      (Alpha_context.get_deposits ctxt) (Error_monad.__return ctxt) in
  let fees := Alpha_context.get_fees ctxt in
  let=? ctxt := Alpha_context.Delegate.freeze_fees ctxt delegate fees in
  let rewards := Alpha_context.get_rewards ctxt in
  let=? ctxt := Alpha_context.Delegate.freeze_rewards ctxt delegate rewards in
  let=? ctxt :=
    match protocol_data.(Block_header_repr.contents.seed_nonce_hash) with
    | None => Error_monad.__return ctxt
    | Some nonce_hash =>
      Alpha_context.Nonce.record_hash ctxt
        {| Storage.unrevealed_nonce.nonce_hash := nonce_hash;
          Storage.unrevealed_nonce.delegate := delegate;
          Storage.unrevealed_nonce.rewards := rewards;
          Storage.unrevealed_nonce.fees := fees |}
    end in
  let=? ctxt := may_snapshot_roll ctxt in
  let=? '(ctxt, balance_updates, deactivated) := may_start_new_cycle ctxt in
  let=? ctxt := Amendment.may_start_new_voting_period ctxt in
  let cycle := (Alpha_context.Level.current ctxt).(Alpha_context.Level.t.cycle)
    in
  let balance_updates :=
    Alpha_context.Delegate.cleanup_balance_updates
      (Pervasives.op_at
        [
          ((Alpha_context.Delegate.Contract
            (Alpha_context.Contract.implicit_contract delegate)),
            (Alpha_context.Delegate.Debited deposit));
          ((Alpha_context.Delegate.Deposits delegate cycle),
            (Alpha_context.Delegate.Credited deposit));
          ((Alpha_context.Delegate.Rewards delegate cycle),
            (Alpha_context.Delegate.Credited reward))
        ] balance_updates) in
  let consumed_gas :=
    Z.sub (Alpha_context.Constants.hard_gas_limit_per_block ctxt)
      (Alpha_context.Gas.block_level ctxt) in
  let=? voting_period_kind := Alpha_context.Vote.get_current_period_kind ctxt in
  let receipt :=
    {| Apply_results.block_metadata.baker := delegate;
      Apply_results.block_metadata.level := Alpha_context.Level.current ctxt;
      Apply_results.block_metadata.voting_period_kind := voting_period_kind;
      Apply_results.block_metadata.nonce_hash :=
        protocol_data.(Block_header_repr.contents.seed_nonce_hash);
      Apply_results.block_metadata.consumed_gas := consumed_gas;
      Apply_results.block_metadata.deactivated := deactivated;
      Apply_results.block_metadata.balance_updates := balance_updates |} in
  Error_monad.__return (ctxt, receipt).

Apply_results

  • OCaml size: 1198 lines
  • Coq size: 2135 lines (+78% compared to OCaml)
apply_results.ml 7 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Data_encoding

let error_encoding =
  def
    "error"
    ~description:
      "The full list of RPC errors would be too long to include.\n\
       It is available at RPC `/errors` (GET).\n\
       Errors specific to protocol Alpha have an id that starts with \
       `proto.alpha`."
  @@ splitted
       ~json:
         (conv
            (fun err ->
              Data_encoding.Json.construct Error_monad.error_encoding err)
            (fun json ->
              Data_encoding.Json.destruct Error_monad.error_encoding json)
            json)
       ~binary:Error_monad.error_encoding

type _ successful_manager_operation_result =
  | Reveal_result : {
      consumed_gas : Z.t;
    }
      -> Kind.reveal successful_manager_operation_result
  | Transaction_result : {
      storage : Script.expr option;
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
      allocated_destination_contract : bool;
    }
      -> Kind.transaction successful_manager_operation_result
  | Origination_result : {
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
    }
      -> Kind.origination successful_manager_operation_result
  | Delegation_result : {
      consumed_gas : Z.t;
    }
      -> Kind.delegation successful_manager_operation_result

type packed_successful_manager_operation_result =
  | Successful_manager_result :
      'kind successful_manager_operation_result
      -> packed_successful_manager_operation_result

type 'kind manager_operation_result =
  | Applied of 'kind successful_manager_operation_result
  | Backtracked of
      'kind successful_manager_operation_result * error list option
  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result
[@@coq_force_gadt]

type packed_internal_operation_result =
  | Internal_operation_result :
      'kind internal_operation * 'kind manager_operation_result
      -> packed_internal_operation_result

module Manager_result = struct
  type 'kind case =
    | MCase : {
        op_case : 'kind Operation.Encoding.Manager_operations.case;
        encoding : 'a Data_encoding.t;
        kind : 'kind Kind.manager;
        iselect :
          packed_internal_operation_result ->
          ('kind internal_operation * 'kind manager_operation_result) option;
        select :
          packed_successful_manager_operation_result ->
          'kind successful_manager_operation_result option;
        proj : 'kind successful_manager_operation_result -> 'a;
        inj : 'a -> 'kind successful_manager_operation_result;
        t : 'kind manager_operation_result Data_encoding.t;
      }
        -> 'kind case
  [@@coq_force_gadt]

  let make ~op_case ~encoding ~kind ~iselect ~select ~proj ~inj =
    let (Operation.Encoding.Manager_operations.MCase {name; _}) = op_case in
    let t =
      def (Format.asprintf "operation.alpha.operation_result.%s" name)
      @@ union
           ~tag_size:`Uint8
           [ case
               (Tag 0)
               ~title:"Applied"
               (merge_objs (obj1 (req "status" (constant "applied"))) encoding)
               (fun o ->
                 match o with
                 | Skipped _ | Failed _ | Backtracked _ ->
                     None
                 | Applied o -> (
                   match select (Successful_manager_result o) with
                   | None ->
                       None
                   | Some o ->
                       Some ((), proj o) ))
               (fun ((), x) -> Applied (inj x));
             case
               (Tag 1)
               ~title:"Failed"
               (obj2
                  (req "status" (constant "failed"))
                  (req "errors" (list error_encoding)))
               (function Failed (_, errs) -> Some ((), errs) | _ -> None)
               (fun ((), errs) -> Failed (kind, errs));
             case
               (Tag 2)
               ~title:"Skipped"
               (obj1 (req "status" (constant "skipped")))
               (function Skipped _ -> Some () | _ -> None)
               (fun () -> Skipped kind);
             case
               (Tag 3)
               ~title:"Backtracked"
               (merge_objs
                  (obj2
                     (req "status" (constant "backtracked"))
                     (opt "errors" (list error_encoding)))
                  encoding)
               (fun o ->
                 match o with
                 | Skipped _ | Failed _ | Applied _ ->
                     None
                 | Backtracked (o, errs) -> (
                   match select (Successful_manager_result o) with
                   | None ->
                       None
                   | Some o ->
                       Some (((), errs), proj o) ))
               (fun (((), errs), x) -> Backtracked (inj x, errs)) ]
    in
    MCase {op_case; encoding; kind; iselect; select; proj; inj; t}

  let reveal_case : Kind.reveal case =
    make
      ~op_case:Operation.Encoding.Manager_operations.reveal_case
      ~encoding:Data_encoding.(obj1 (dft "consumed_gas" z Z.zero))
      ~iselect:(function
        | Internal_operation_result (({operation = Reveal _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Reveal_result _ as op) ->
            Some op
        | _ ->
            None)
      ~kind:Kind.Reveal_manager_kind
      ~proj:(function[@coq_match_with_default]
        | Reveal_result {consumed_gas} -> consumed_gas)
      ~inj:(fun consumed_gas -> Reveal_result {consumed_gas})

  let transaction_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.transaction_case
      ~encoding:
        (obj8
           (opt "storage" Script.expr_encoding)
           (opt "big_map_diff" Contract.big_map_diff_encoding)
           (dft "balance_updates" Delegate.balance_updates_encoding [])
           (dft "originated_contracts" (list Contract.encoding) [])
           (dft "consumed_gas" z Z.zero)
           (dft "storage_size" z Z.zero)
           (dft "paid_storage_size_diff" z Z.zero)
           (dft "allocated_destination_contract" bool false))
      ~iselect:(function
        | Internal_operation_result
            (({operation = Transaction _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Transaction_result _ as op) ->
            Some op
        | _ ->
            None)
      ~kind:Kind.Transaction_manager_kind
      ~proj:(function[@coq_match_with_default]
        | Transaction_result
            { storage;
              big_map_diff;
              balance_updates;
              originated_contracts;
              consumed_gas;
              storage_size;
              paid_storage_size_diff;
              allocated_destination_contract } ->
            ( storage,
              big_map_diff,
              balance_updates,
              originated_contracts,
              consumed_gas,
              storage_size,
              paid_storage_size_diff,
              allocated_destination_contract ))
      ~inj:
        (fun ( storage,
               big_map_diff,
               balance_updates,
               originated_contracts,
               consumed_gas,
               storage_size,
               paid_storage_size_diff,
               allocated_destination_contract ) ->
        Transaction_result
          {
            storage;
            big_map_diff;
            balance_updates;
            originated_contracts;
            consumed_gas;
            storage_size;
            paid_storage_size_diff;
            allocated_destination_contract;
          })

  let origination_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.origination_case
      ~encoding:
        (obj6
           (opt "big_map_diff" Contract.big_map_diff_encoding)
           (dft "balance_updates" Delegate.balance_updates_encoding [])
           (dft "originated_contracts" (list Contract.encoding) [])
           (dft "consumed_gas" z Z.zero)
           (dft "storage_size" z Z.zero)
           (dft "paid_storage_size_diff" z Z.zero))
      ~iselect:(function
        | Internal_operation_result
            (({operation = Origination _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Origination_result _ as op) ->
            Some op
        | _ ->
            None)
      ~proj:(function[@coq_match_with_default]
        | Origination_result
            { big_map_diff;
              balance_updates;
              originated_contracts;
              consumed_gas;
              storage_size;
              paid_storage_size_diff } ->
            ( big_map_diff,
              balance_updates,
              originated_contracts,
              consumed_gas,
              storage_size,
              paid_storage_size_diff ))
      ~kind:Kind.Origination_manager_kind
      ~inj:
        (fun ( big_map_diff,
               balance_updates,
               originated_contracts,
               consumed_gas,
               storage_size,
               paid_storage_size_diff ) ->
        Origination_result
          {
            big_map_diff;
            balance_updates;
            originated_contracts;
            consumed_gas;
            storage_size;
            paid_storage_size_diff;
          })

  let delegation_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.delegation_case
      ~encoding:Data_encoding.(obj1 (dft "consumed_gas" z Z.zero))
      ~iselect:(function
        | Internal_operation_result (({operation = Delegation _; _} as op), res)
          ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Delegation_result _ as op) ->
            Some op
        | _ ->
            None)
      ~kind:Kind.Delegation_manager_kind
      ~proj:(function[@coq_match_with_default]
        | Delegation_result {consumed_gas} -> consumed_gas)
      ~inj:(fun consumed_gas -> Delegation_result {consumed_gas})
end

let internal_operation_result_encoding :
    packed_internal_operation_result Data_encoding.t =
  let make (type kind)
      (Manager_result.MCase res_case : kind Manager_result.case) =
    let (Operation.Encoding.Manager_operations.MCase op_case) =
      res_case.op_case
    in
    case
      (Tag op_case.tag)
      ~title:op_case.name
      (merge_objs
         (obj3
            (req "kind" (constant op_case.name))
            (req "source" Contract.encoding)
            (req "nonce" uint16))
         (merge_objs op_case.encoding (obj1 (req "result" res_case.t))))
      (fun op ->
        match res_case.iselect op with
        | Some (op, res) ->
            Some (((), op.source, op.nonce), (op_case.proj op.operation, res))
        | None ->
            None)
      (fun (((), source, nonce), (op, res)) ->
        let op = {source; operation = op_case.inj op; nonce} in
        Internal_operation_result (op, res))
  in
  def "operation.alpha.internal_operation_result"
  @@ union
       [ make Manager_result.reveal_case;
         make Manager_result.transaction_case;
         make Manager_result.origination_case;
         make Manager_result.delegation_case ]

type 'kind contents_result =
  | Endorsement_result : {
      balance_updates : Delegate.balance_updates;
      delegate : Signature.Public_key_hash.t;
      slots : int list;
    }
      -> Kind.endorsement contents_result
  | Seed_nonce_revelation_result :
      Delegate.balance_updates
      -> Kind.seed_nonce_revelation contents_result
  | Double_endorsement_evidence_result :
      Delegate.balance_updates
      -> Kind.double_endorsement_evidence contents_result
  | Double_baking_evidence_result :
      Delegate.balance_updates
      -> Kind.double_baking_evidence contents_result
  | Activate_account_result :
      Delegate.balance_updates
      -> Kind.activate_account contents_result
  | Proposals_result : Kind.proposals contents_result
  | Ballot_result : Kind.ballot contents_result
  | Manager_operation_result : {
      balance_updates : Delegate.balance_updates;
      operation_result : 'kind manager_operation_result;
      internal_operation_results : packed_internal_operation_result list;
    }
      -> 'kind Kind.manager contents_result

type packed_contents_result =
  | Contents_result : 'kind contents_result -> packed_contents_result

type packed_contents_and_result =
  | Contents_and_result :
      'kind Operation.contents * 'kind contents_result
      -> packed_contents_and_result

type ('a, 'b) eq = Eq : ('a, 'a) eq

let equal_manager_kind :
    type a b. a Kind.manager -> b Kind.manager -> (a, b) eq option =
 fun ka kb ->
  match (ka, kb) with
  | (Kind.Reveal_manager_kind, Kind.Reveal_manager_kind) ->
      Some Eq
  | (Kind.Reveal_manager_kind, _) ->
      None
  | (Kind.Transaction_manager_kind, Kind.Transaction_manager_kind) ->
      Some Eq
  | (Kind.Transaction_manager_kind, _) ->
      None
  | (Kind.Origination_manager_kind, Kind.Origination_manager_kind) ->
      Some Eq
  | (Kind.Origination_manager_kind, _) ->
      None
  | (Kind.Delegation_manager_kind, Kind.Delegation_manager_kind) ->
      Some Eq
  | (Kind.Delegation_manager_kind, _) ->
      None

module Encoding = struct
  type 'kind case =
    | Case : {
        op_case : 'kind Operation.Encoding.case;
        encoding : 'a Data_encoding.t;
        select : packed_contents_result -> 'kind contents_result option;
        mselect :
          packed_contents_and_result ->
          ('kind contents * 'kind contents_result) option;
        proj : 'kind contents_result -> 'a;
        inj : 'a -> 'kind contents_result;
      }
        -> 'kind case
  [@@coq_force_gadt]

  let tagged_case tag name args proj inj =
    let open Data_encoding in
    case
      tag
      ~title:(String.capitalize_ascii name)
      (merge_objs (obj1 (req "kind" (constant name))) args)
      (fun x -> match proj x with None -> None | Some x -> Some ((), x))
      (fun ((), x) -> inj x)

  let endorsement_case =
    Case
      {
        op_case = Operation.Encoding.endorsement_case;
        encoding =
          obj3
            (req "balance_updates" Delegate.balance_updates_encoding)
            (req "delegate" Signature.Public_key_hash.encoding)
            (req "slots" (list uint8));
        select =
          (function
          | Contents_result (Endorsement_result _ as op) -> Some op | _ -> None);
        mselect =
          (function
          | Contents_and_result ((Endorsement _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj =
          (function[@coq_match_with_default]
          | Endorsement_result {balance_updates; delegate; slots} ->
              (balance_updates, delegate, slots));
        inj =
          (fun (balance_updates, delegate, slots) ->
            Endorsement_result {balance_updates; delegate; slots});
      }

  let seed_nonce_revelation_case =
    Case
      {
        op_case = Operation.Encoding.seed_nonce_revelation_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Seed_nonce_revelation_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Seed_nonce_revelation _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj =
          (fun [@coq_match_with_default] (Seed_nonce_revelation_result bus) ->
            bus);
        inj = (fun bus -> Seed_nonce_revelation_result bus);
      }

  let double_endorsement_evidence_case =
    Case
      {
        op_case = Operation.Encoding.double_endorsement_evidence_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Double_endorsement_evidence_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Double_endorsement_evidence _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj =
          (fun [@coq_match_with_default] (Double_endorsement_evidence_result
                                           bus) ->
            bus);
        inj = (fun bus -> Double_endorsement_evidence_result bus);
      }

  let double_baking_evidence_case =
    Case
      {
        op_case = Operation.Encoding.double_baking_evidence_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Double_baking_evidence_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Double_baking_evidence _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj =
          (fun [@coq_match_with_default] (Double_baking_evidence_result bus) ->
            bus);
        inj = (fun bus -> Double_baking_evidence_result bus);
      }

  let activate_account_case =
    Case
      {
        op_case = Operation.Encoding.activate_account_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Activate_account_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Activate_account _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj =
          (fun [@coq_match_with_default] (Activate_account_result bus) -> bus);
        inj = (fun bus -> Activate_account_result bus);
      }

  let proposals_case =
    Case
      {
        op_case = Operation.Encoding.proposals_case;
        encoding = Data_encoding.empty;
        select =
          (function
          | Contents_result (Proposals_result as op) -> Some op | _ -> None);
        mselect =
          (function
          | Contents_and_result ((Proposals _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun [@coq_match_with_default] Proposals_result -> ());
        inj = (fun () -> Proposals_result);
      }

  let ballot_case =
    Case
      {
        op_case = Operation.Encoding.ballot_case;
        encoding = Data_encoding.empty;
        select =
          (function
          | Contents_result (Ballot_result as op) -> Some op | _ -> None);
        mselect =
          (function
          | Contents_and_result ((Ballot _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun [@coq_match_with_default] Ballot_result -> ());
        inj = (fun () -> Ballot_result);
      }

  let make_manager_case (type kind)
      (Operation.Encoding.Case op_case :
        kind Kind.manager Operation.Encoding.case)
      (Manager_result.MCase res_case : kind Manager_result.case) mselect =
    Case
      {
        op_case = Operation.Encoding.Case op_case;
        encoding =
          obj3
            (req "balance_updates" Delegate.balance_updates_encoding)
            (req "operation_result" res_case.t)
            (dft
               "internal_operation_results"
               (list internal_operation_result_encoding)
               []);
        select =
          (function
          | Contents_result
              (Manager_operation_result
                ({operation_result = Applied res; _} as op)) -> (
            match res_case.select (Successful_manager_result res) with
            | Some res ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Applied res})
            | None ->
                None )
          | Contents_result
              (Manager_operation_result
                ({operation_result = Backtracked (res, errs); _} as op)) -> (
            match res_case.select (Successful_manager_result res) with
            | Some res ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Backtracked (res, errs)})
            | None ->
                None )
          | Contents_result
              (Manager_operation_result
                ({operation_result = Skipped kind; _} as op)) -> (
            match equal_manager_kind kind res_case.kind with
            | None ->
                None
            | Some Eq ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Skipped kind}) )
          | Contents_result
              (Manager_operation_result
                ({operation_result = Failed (kind, errs); _} as op)) -> (
            match equal_manager_kind kind res_case.kind with
            | None ->
                None
            | Some Eq ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Failed (kind, errs)}) )
          | Contents_result Ballot_result ->
              None
          | Contents_result (Endorsement_result _) ->
              None
          | Contents_result (Seed_nonce_revelation_result _) ->
              None
          | Contents_result (Double_endorsement_evidence_result _) ->
              None
          | Contents_result (Double_baking_evidence_result _) ->
              None
          | Contents_result (Activate_account_result _) ->
              None
          | Contents_result Proposals_result ->
              None);
        mselect;
        proj =
          (fun [@coq_match_with_default] (Manager_operation_result
                                           { balance_updates = bus;
                                             operation_result = r;
                                             internal_operation_results = rs }) ->
            (bus, r, rs));
        inj =
          (fun (bus, r, rs) ->
            Manager_operation_result
              {
                balance_updates = bus;
                operation_result = r;
                internal_operation_results = rs;
              });
      }

  let reveal_case =
    make_manager_case
      Operation.Encoding.reveal_case
      Manager_result.reveal_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Reveal _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)

  let transaction_case =
    make_manager_case
      Operation.Encoding.transaction_case
      Manager_result.transaction_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Transaction _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)

  let origination_case =
    make_manager_case
      Operation.Encoding.origination_case
      Manager_result.origination_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Origination _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)

  let delegation_case =
    make_manager_case
      Operation.Encoding.delegation_case
      Manager_result.delegation_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Delegation _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
end

let contents_result_encoding =
  let make
      (Encoding.Case
        { op_case = Operation.Encoding.Case {tag; name; _};
          encoding;
          mselect = _;
          select;
          proj;
          inj }) =
    let proj x =
      match select x with None -> None | Some x -> Some (proj x)
    in
    let inj x = Contents_result (inj x) in
    Encoding.tagged_case (Tag tag) name encoding proj inj
  in
  def "operation.alpha.contents_result"
  @@ union
       [ make Encoding.endorsement_case;
         make Encoding.seed_nonce_revelation_case;
         make Encoding.double_endorsement_evidence_case;
         make Encoding.double_baking_evidence_case;
         make Encoding.activate_account_case;
         make Encoding.proposals_case;
         make Encoding.ballot_case;
         make Encoding.reveal_case;
         make Encoding.transaction_case;
         make Encoding.origination_case;
         make Encoding.delegation_case ]

let contents_and_result_encoding =
  let make
      (Encoding.Case
        { op_case = Operation.Encoding.Case {tag; name; encoding; proj; inj; _};
          mselect;
          encoding = meta_encoding;
          proj = meta_proj;
          inj = meta_inj;
          _ }) =
    let proj c =
      match mselect c with
      | Some (op, res) ->
          Some (proj op, meta_proj res)
      | _ ->
          None
    in
    let inj (op, res) = Contents_and_result (inj op, meta_inj res) in
    let encoding = merge_objs encoding (obj1 (req "metadata" meta_encoding)) in
    Encoding.tagged_case (Tag tag) name encoding proj inj
  in
  def "operation.alpha.operation_contents_and_result"
  @@ union
       [ make Encoding.endorsement_case;
         make Encoding.seed_nonce_revelation_case;
         make Encoding.double_endorsement_evidence_case;
         make Encoding.double_baking_evidence_case;
         make Encoding.activate_account_case;
         make Encoding.proposals_case;
         make Encoding.ballot_case;
         make Encoding.reveal_case;
         make Encoding.transaction_case;
         make Encoding.origination_case;
         make Encoding.delegation_case ]

type 'kind contents_result_list =
  | Single_result : 'kind contents_result -> 'kind contents_result_list
  | Cons_result :
      'kind Kind.manager contents_result
      * 'rest Kind.manager contents_result_list
      -> ('kind * 'rest) Kind.manager contents_result_list

type packed_contents_result_list =
  | Contents_result_list :
      'kind contents_result_list
      -> packed_contents_result_list

let contents_result_list_encoding =
  let rec to_list = function
    | Contents_result_list (Single_result o) ->
        [Contents_result o]
    | Contents_result_list (Cons_result (o, os)) ->
        Contents_result o :: to_list (Contents_result_list os)
  in
  let rec of_list = function
    | [] ->
        Pervasives.failwith "cannot decode empty operation result"
    | [Contents_result o] ->
        Contents_result_list (Single_result o)
    | Contents_result o :: os -> (
        let (Contents_result_list os) = of_list os in
        match (o, os) with
        | ( Manager_operation_result _,
            Single_result (Manager_operation_result _) ) ->
            Contents_result_list (Cons_result (o, os))
        | (Manager_operation_result _, Cons_result _) ->
            Contents_result_list (Cons_result (o, os))
        | _ ->
            Pervasives.failwith "cannot decode ill-formed operation result" )
  in
  def "operation.alpha.contents_list_result"
  @@ conv to_list of_list (list contents_result_encoding)

type 'kind contents_and_result_list =
  | Single_and_result :
      'kind Alpha_context.contents * 'kind contents_result
      -> 'kind contents_and_result_list
  | Cons_and_result :
      'kind Kind.manager Alpha_context.contents
      * 'kind Kind.manager contents_result
      * 'rest Kind.manager contents_and_result_list
      -> ('kind * 'rest) Kind.manager contents_and_result_list

type packed_contents_and_result_list =
  | Contents_and_result_list :
      'kind contents_and_result_list
      -> packed_contents_and_result_list

let contents_and_result_list_encoding =
  let rec to_list = function
    | Contents_and_result_list (Single_and_result (op, res)) ->
        [Contents_and_result (op, res)]
    | Contents_and_result_list (Cons_and_result (op, res, rest)) ->
        Contents_and_result (op, res)
        :: to_list (Contents_and_result_list rest)
  in
  let rec of_list = function
    | [] ->
        Pervasives.failwith "cannot decode empty combined operation result"
    | [Contents_and_result (op, res)] ->
        Contents_and_result_list (Single_and_result (op, res))
    | Contents_and_result (op, res) :: rest -> (
        let (Contents_and_result_list rest) = of_list rest in
        match (op, rest) with
        | (Manager_operation _, Single_and_result (Manager_operation _, _)) ->
            Contents_and_result_list (Cons_and_result (op, res, rest))
        | (Manager_operation _, Cons_and_result (_, _, _)) ->
            Contents_and_result_list (Cons_and_result (op, res, rest))
        | _ ->
            Pervasives.failwith
              "cannot decode ill-formed combined operation result" )
  in
  conv to_list of_list (Variable.list contents_and_result_encoding)

type 'kind operation_metadata = {contents : 'kind contents_result_list}

type packed_operation_metadata =
  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
  | No_operation_metadata : packed_operation_metadata

let operation_metadata_encoding =
  def "operation.alpha.result"
  @@ union
       [ case
           (Tag 0)
           ~title:"Operation_metadata"
           contents_result_list_encoding
           (function
             | Operation_metadata {contents} ->
                 Some (Contents_result_list contents)
             | _ ->
                 None)
           (fun (Contents_result_list contents) ->
             Operation_metadata {contents});
         case
           (Tag 1)
           ~title:"No_operation_metadata"
           empty
           (function No_operation_metadata -> Some () | _ -> None)
           (fun () -> No_operation_metadata) ]

let kind_equal :
    type kind kind2.
    kind contents -> kind2 contents_result -> (kind, kind2) eq option =
 fun op res ->
  match (op, res) with
  | (Endorsement _, Endorsement_result _) ->
      Some Eq
  | (Endorsement _, _) ->
      None
  | (Seed_nonce_revelation _, Seed_nonce_revelation_result _) ->
      Some Eq
  | (Seed_nonce_revelation _, _) ->
      None
  | (Double_endorsement_evidence _, Double_endorsement_evidence_result _) ->
      Some Eq
  | (Double_endorsement_evidence _, _) ->
      None
  | (Double_baking_evidence _, Double_baking_evidence_result _) ->
      Some Eq
  | (Double_baking_evidence _, _) ->
      None
  | (Activate_account _, Activate_account_result _) ->
      Some Eq
  | (Activate_account _, _) ->
      None
  | (Proposals _, Proposals_result) ->
      Some Eq
  | (Proposals _, _) ->
      None
  | (Ballot _, Ballot_result) ->
      Some Eq
  | (Ballot _, _) ->
      None
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result {operation_result = Applied (Reveal_result _); _}
    ) ->
      Some Eq
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result
        {operation_result = Backtracked (Reveal_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result
        { operation_result = Failed (Alpha_context.Kind.Reveal_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result
        {operation_result = Skipped Alpha_context.Kind.Reveal_manager_kind; _}
    ) ->
      Some Eq
  | (Manager_operation {operation = Reveal _; _}, _) ->
      None
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        {operation_result = Applied (Transaction_result _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        {operation_result = Backtracked (Transaction_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        { operation_result =
            Failed (Alpha_context.Kind.Transaction_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        { operation_result = Skipped Alpha_context.Kind.Transaction_manager_kind;
          _ } ) ->
      Some Eq
  | (Manager_operation {operation = Transaction _; _}, _) ->
      None
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        {operation_result = Applied (Origination_result _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        {operation_result = Backtracked (Origination_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        { operation_result =
            Failed (Alpha_context.Kind.Origination_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        { operation_result = Skipped Alpha_context.Kind.Origination_manager_kind;
          _ } ) ->
      Some Eq
  | (Manager_operation {operation = Origination _; _}, _) ->
      None
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        {operation_result = Applied (Delegation_result _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        {operation_result = Backtracked (Delegation_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        { operation_result =
            Failed (Alpha_context.Kind.Delegation_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        { operation_result = Skipped Alpha_context.Kind.Delegation_manager_kind;
          _ } ) ->
      Some Eq
  | (Manager_operation {operation = Delegation _; _}, _) ->
      None

let rec kind_equal_list :
    type kind kind2.
    kind contents_list -> kind2 contents_result_list -> (kind, kind2) eq option
    =
 fun contents res ->
  match (contents, res) with
  | (Single op, Single_result res) -> (
    match kind_equal op res with None -> None | Some Eq -> Some Eq )
  | (Cons (op, ops), Cons_result (res, ress)) -> (
    match kind_equal op res with
    | None ->
        None
    | Some Eq -> (
      match kind_equal_list ops ress with None -> None | Some Eq -> Some Eq ) )
  | _ ->
      None

let rec pack_contents_list :
    type kind.
    kind contents_list ->
    kind contents_result_list ->
    kind contents_and_result_list =
 fun contents res ->
  match[@coq_match_with_default] (contents, res) with
  | (Single op, Single_result res) ->
      Single_and_result (op, res)
  | (Cons (op, ops), Cons_result (res, ress)) ->
      Cons_and_result (op, res, pack_contents_list ops ress)
  | ( Single (Manager_operation _),
      Cons_result (Manager_operation_result _, Single_result _) ) ->
      .
  | ( Cons (_, _),
      Single_result (Manager_operation_result {operation_result = Failed _; _})
    ) ->
      .
  | ( Cons (_, _),
      Single_result
        (Manager_operation_result {operation_result = Skipped _; _}) ) ->
      .
  | ( Cons (_, _),
      Single_result
        (Manager_operation_result {operation_result = Applied _; _}) ) ->
      .
  | ( Cons (_, _),
      Single_result
        (Manager_operation_result {operation_result = Backtracked _; _}) ) ->
      .
  | (Single _, Cons_result _) ->
      .

let rec unpack_contents_list :
    type kind.
    kind contents_and_result_list ->
    kind contents_list * kind contents_result_list = function
  | Single_and_result (op, res) ->
      (Single op, Single_result res)
  | Cons_and_result (op, res, rest) ->
      let (ops, ress) = unpack_contents_list rest in
      (Cons (op, ops), Cons_result (res, ress))

let rec to_list = function
  | Contents_result_list (Single_result o) ->
      [Contents_result o]
  | Contents_result_list (Cons_result (o, os)) ->
      Contents_result o :: to_list (Contents_result_list os)

let rec of_list = function
  | [] ->
      assert false
  | [Contents_result o] ->
      Contents_result_list (Single_result o)
  | Contents_result o :: os -> (
      let (Contents_result_list os) = of_list os in
      match (o, os) with
      | (Manager_operation_result _, Single_result (Manager_operation_result _))
        ->
          Contents_result_list (Cons_result (o, os))
      | (Manager_operation_result _, Cons_result _) ->
          Contents_result_list (Cons_result (o, os))
      | _ ->
          Pervasives.failwith
            "Operation result list of length > 1 should only contains manager \
             operations result." )

let operation_data_and_metadata_encoding =
  def "operation.alpha.operation_with_metadata"
  @@ union
       [ case
           (Tag 0)
           ~title:"Operation_with_metadata"
           (obj2
              (req "contents" (dynamic_size contents_and_result_list_encoding))
              (opt "signature" Signature.encoding))
           (function
             | (Operation_data _, No_operation_metadata) ->
                 None
             | (Operation_data op, Operation_metadata res) -> (
               match kind_equal_list op.contents res.contents with
               | None ->
                   Pervasives.failwith
                     "cannot decode inconsistent combined operation result"
               | Some Eq ->
                   Some
                     ( Contents_and_result_list
                         (pack_contents_list op.contents res.contents),
                       op.signature ) ))
           (fun (Contents_and_result_list contents, signature) ->
             let (op_contents, res_contents) = unpack_contents_list contents in
             ( Operation_data {contents = op_contents; signature},
               Operation_metadata {contents = res_contents} ));
         case
           (Tag 1)
           ~title:"Operation_without_metadata"
           (obj2
              (req "contents" (dynamic_size Operation.contents_list_encoding))
              (opt "signature" Signature.encoding))
           (function
             | (Operation_data op, No_operation_metadata) ->
                 Some (Contents_list op.contents, op.signature)
             | (Operation_data _, Operation_metadata _) ->
                 None)
           (fun (Contents_list contents, signature) ->
             (Operation_data {contents; signature}, No_operation_metadata)) ]

type block_metadata = {
  baker : Signature.Public_key_hash.t;
  level : Level.t;
  voting_period_kind : Voting_period.kind;
  nonce_hash : Nonce_hash.t option;
  consumed_gas : Z.t;
  deactivated : Signature.Public_key_hash.t list;
  balance_updates : Delegate.balance_updates;
}

let block_metadata_encoding =
  let open Data_encoding in
  def "block_header.alpha.metadata"
  @@ conv
       (fun { baker;
              level;
              voting_period_kind;
              nonce_hash;
              consumed_gas;
              deactivated;
              balance_updates } ->
         ( baker,
           level,
           voting_period_kind,
           nonce_hash,
           consumed_gas,
           deactivated,
           balance_updates ))
       (fun ( baker,
              level,
              voting_period_kind,
              nonce_hash,
              consumed_gas,
              deactivated,
              balance_updates ) ->
         {
           baker;
           level;
           voting_period_kind;
           nonce_hash;
           consumed_gas;
           deactivated;
           balance_updates;
         })
       (obj7
          (req "baker" Signature.Public_key_hash.encoding)
          (req "level" Level.encoding)
          (req "voting_period_kind" Voting_period.kind_encoding)
          (req "nonce_hash" (option Nonce_hash.encoding))
          (req "consumed_gas" (check_size 10 n))
          (req "deactivated" (list Signature.Public_key_hash.encoding))
          (req "balance_updates" Delegate.balance_updates_encoding))
Apply_results.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Unset Guard Checking.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Nonce_hash.

Import Alpha_context.

Import Data_encoding.

Definition error_encoding : Data_encoding.encoding Error_monad.__error :=
  (let arg :=
    Data_encoding.def "error"
      (Some
        "The full list of RPC errors would be too long to include.\nIt is available at RPC `/errors` (GET).\nErrors specific to protocol Alpha have an id that starts with `proto.alpha`.")
    in
  fun eta => arg None eta)
    (Data_encoding.splitted
      (Data_encoding.conv
        (fun err => Data_encoding.Json.construct Error_monad.error_encoding err)
        (fun __json_value =>
          Data_encoding.Json.destruct Error_monad.error_encoding __json_value)
        None Data_encoding.__json_value) Error_monad.error_encoding).

Module ConstructorRecords_successful_manager_operation_result.
  Module successful_manager_operation_result.
    Module Reveal_result.
      Record record {consumed_gas : Set} : Set := Build {
        consumed_gas : consumed_gas }.
      Arguments record : clear implicits.
      Definition with_consumed_gas {t_consumed_gas} consumed_gas
        (r : record t_consumed_gas) :=
        Build t_consumed_gas consumed_gas.
    End Reveal_result.
    Definition Reveal_result_skeleton := Reveal_result.record.
    
    Module Transaction_result.
      Record record {storage big_map_diff balance_updates originated_contracts
        consumed_gas storage_size paid_storage_size_diff
        allocated_destination_contract : Set} : Set := Build {
        storage : storage;
        big_map_diff : big_map_diff;
        balance_updates : balance_updates;
        originated_contracts : originated_contracts;
        consumed_gas : consumed_gas;
        storage_size : storage_size;
        paid_storage_size_diff : paid_storage_size_diff;
        allocated_destination_contract : allocated_destination_contract }.
      Arguments record : clear implicits.
      Definition with_storage
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} storage
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract storage r.(big_map_diff)
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_big_map_diff
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} big_map_diff
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) big_map_diff
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_balance_updates
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} balance_updates
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          balance_updates r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_originated_contracts
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} originated_contracts
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          r.(balance_updates) originated_contracts r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_consumed_gas
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} consumed_gas
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          r.(balance_updates) r.(originated_contracts) consumed_gas
          r.(storage_size) r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_storage_size
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} storage_size
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          storage_size r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_paid_storage_size_diff
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} paid_storage_size_diff
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) paid_storage_size_diff
          r.(allocated_destination_contract).
      Definition with_allocated_destination_contract
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} allocated_destination_contract
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff)
          allocated_destination_contract.
    End Transaction_result.
    Definition Transaction_result_skeleton := Transaction_result.record.
    
    Module Origination_result.
      Record record {big_map_diff balance_updates originated_contracts
        consumed_gas storage_size paid_storage_size_diff : Set} : Set := Build {
        big_map_diff : big_map_diff;
        balance_updates : balance_updates;
        originated_contracts : originated_contracts;
        consumed_gas : consumed_gas;
        storage_size : storage_size;
        paid_storage_size_diff : paid_storage_size_diff }.
      Arguments record : clear implicits.
      Definition with_big_map_diff
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} big_map_diff
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff big_map_diff
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff).
      Definition with_balance_updates
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} balance_updates
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          r.(big_map_diff) balance_updates r.(originated_contracts)
          r.(consumed_gas) r.(storage_size) r.(paid_storage_size_diff).
      Definition with_originated_contracts
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} originated_contracts
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          r.(big_map_diff) r.(balance_updates) originated_contracts
          r.(consumed_gas) r.(storage_size) r.(paid_storage_size_diff).
      Definition with_consumed_gas
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} consumed_gas
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          r.(big_map_diff) r.(balance_updates) r.(originated_contracts)
          consumed_gas r.(storage_size) r.(paid_storage_size_diff).
      Definition with_storage_size
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} storage_size
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          r.(big_map_diff) r.(balance_updates) r.(originated_contracts)
          r.(consumed_gas) storage_size r.(paid_storage_size_diff).
      Definition with_paid_storage_size_diff
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} paid_storage_size_diff
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          r.(big_map_diff) r.(balance_updates) r.(originated_contracts)
          r.(consumed_gas) r.(storage_size) paid_storage_size_diff.
    End Origination_result.
    Definition Origination_result_skeleton := Origination_result.record.
    
    Module Delegation_result.
      Record record {consumed_gas : Set} : Set := Build {
        consumed_gas : consumed_gas }.
      Arguments record : clear implicits.
      Definition with_consumed_gas {t_consumed_gas} consumed_gas
        (r : record t_consumed_gas) :=
        Build t_consumed_gas consumed_gas.
    End Delegation_result.
    Definition Delegation_result_skeleton := Delegation_result.record.
  End successful_manager_operation_result.
End ConstructorRecords_successful_manager_operation_result.
Import ConstructorRecords_successful_manager_operation_result.

Reserved Notation "'successful_manager_operation_result.Reveal_result".
Reserved Notation "'successful_manager_operation_result.Transaction_result".
Reserved Notation "'successful_manager_operation_result.Origination_result".
Reserved Notation "'successful_manager_operation_result.Delegation_result".

Inductive successful_manager_operation_result : Set :=
| Reveal_result :
  'successful_manager_operation_result.Reveal_result ->
  successful_manager_operation_result
| Transaction_result :
  'successful_manager_operation_result.Transaction_result ->
  successful_manager_operation_result
| Origination_result :
  'successful_manager_operation_result.Origination_result ->
  successful_manager_operation_result
| Delegation_result :
  'successful_manager_operation_result.Delegation_result ->
  successful_manager_operation_result

where "'successful_manager_operation_result.Reveal_result" :=
  (successful_manager_operation_result.Reveal_result_skeleton Z.t)
and "'successful_manager_operation_result.Transaction_result" :=
  (successful_manager_operation_result.Transaction_result_skeleton
    (option Alpha_context.Script.expr)
    (option Alpha_context.Contract.big_map_diff)
    Alpha_context.Delegate.balance_updates (list Alpha_context.Contract.t) Z.t
    Z.t Z.t bool)
and "'successful_manager_operation_result.Origination_result" :=
  (successful_manager_operation_result.Origination_result_skeleton
    (option Alpha_context.Contract.big_map_diff)
    Alpha_context.Delegate.balance_updates (list Alpha_context.Contract.t) Z.t
    Z.t Z.t)
and "'successful_manager_operation_result.Delegation_result" :=
  (successful_manager_operation_result.Delegation_result_skeleton Z.t).

Module successful_manager_operation_result.
  Include ConstructorRecords_successful_manager_operation_result.successful_manager_operation_result.
  Definition Reveal_result :=
    'successful_manager_operation_result.Reveal_result.
  Definition Transaction_result :=
    'successful_manager_operation_result.Transaction_result.
  Definition Origination_result :=
    'successful_manager_operation_result.Origination_result.
  Definition Delegation_result :=
    'successful_manager_operation_result.Delegation_result.
End successful_manager_operation_result.

Inductive packed_successful_manager_operation_result : Set :=
| Successful_manager_result :
  successful_manager_operation_result ->
  packed_successful_manager_operation_result.

Inductive manager_operation_result : Set :=
| Applied : successful_manager_operation_result -> manager_operation_result
| Backtracked :
  successful_manager_operation_result -> option (list Error_monad.__error) ->
  manager_operation_result
| Failed :
  Alpha_context.Kind.manager -> list Error_monad.__error ->
  manager_operation_result
| Skipped : Alpha_context.Kind.manager -> manager_operation_result.

Inductive packed_internal_operation_result : Set :=
| Internal_operation_result :
  Alpha_context.internal_operation -> manager_operation_result ->
  packed_internal_operation_result.

Module Manager_result.
  Module ConstructorRecords_case.
    Module case.
      Module MCase.
        Record record {op_case encoding kind iselect select proj inj t : Set} :
          Set := Build {
          op_case : op_case;
          encoding : encoding;
          kind : kind;
          iselect : iselect;
          select : select;
          proj : proj;
          inj : inj;
          t : t }.
        Arguments record : clear implicits.
        Definition with_op_case
          {t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t}
          op_case
          (r :
            record t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj
              t_t) :=
          Build t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t
            op_case r.(encoding) r.(kind) r.(iselect) r.(select) r.(proj)
            r.(inj) r.(t).
        Definition with_encoding
          {t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t}
          encoding
          (r :
            record t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj
              t_t) :=
          Build t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t
            r.(op_case) encoding r.(kind) r.(iselect) r.(select) r.(proj)
            r.(inj) r.(t).
        Definition with_kind
          {t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t} kind
          (r :
            record t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj
              t_t) :=
          Build t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t
            r.(op_case) r.(encoding) kind r.(iselect) r.(select) r.(proj)
            r.(inj) r.(t).
        Definition with_iselect
          {t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t}
          iselect
          (r :
            record t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj
              t_t) :=
          Build t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t
            r.(op_case) r.(encoding) r.(kind) iselect r.(select) r.(proj)
            r.(inj) r.(t).
        Definition with_select
          {t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t}
          select
          (r :
            record t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj
              t_t) :=
          Build t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t
            r.(op_case) r.(encoding) r.(kind) r.(iselect) select r.(proj)
            r.(inj) r.(t).
        Definition with_proj
          {t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t} proj
          (r :
            record t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj
              t_t) :=
          Build t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t
            r.(op_case) r.(encoding) r.(kind) r.(iselect) r.(select) proj
            r.(inj) r.(t).
        Definition with_inj
          {t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t} inj
          (r :
            record t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj
              t_t) :=
          Build t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t
            r.(op_case) r.(encoding) r.(kind) r.(iselect) r.(select) r.(proj)
            inj r.(t).
        Definition with_t
          {t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t} t
          (r :
            record t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj
              t_t) :=
          Build t_op_case t_encoding t_kind t_iselect t_select t_proj t_inj t_t
            r.(op_case) r.(encoding) r.(kind) r.(iselect) r.(select) r.(proj)
            r.(inj) t.
      End MCase.
      Definition MCase_skeleton := MCase.record.
    End case.
  End ConstructorRecords_case.
  Import ConstructorRecords_case.
  
  Reserved Notation "'case.MCase".
  
  Inductive case : Set :=
  | MCase : forall {a : Set}, 'case.MCase a -> case
  
  where "'case.MCase" := (fun (t_a : Set) =>
    case.MCase_skeleton Alpha_context.Operation.Encoding.Manager_operations.case
      (Data_encoding.t t_a) Alpha_context.Kind.manager
      (packed_internal_operation_result ->
      option (Alpha_context.internal_operation * manager_operation_result))
      (packed_successful_manager_operation_result ->
      option successful_manager_operation_result)
      (successful_manager_operation_result -> t_a)
      (t_a -> successful_manager_operation_result)
      (Data_encoding.t manager_operation_result)).
  
  Module case.
    Include ConstructorRecords_case.case.
    Definition MCase := 'case.MCase.
  End case.
  
  Definition make {A : Set}
    (op_case : Alpha_context.Operation.Encoding.Manager_operations.case)
    (encoding : Data_encoding.encoding A) (kind : Alpha_context.Kind.manager)
    (iselect :
      packed_internal_operation_result ->
      option (Alpha_context.internal_operation * manager_operation_result))
    (select :
      packed_successful_manager_operation_result ->
      option successful_manager_operation_result)
    (proj : successful_manager_operation_result -> A)
    (inj : A -> successful_manager_operation_result) : case :=
    let
      'Alpha_context.Operation.Encoding.Manager_operations.MCase {|
        Alpha_context.Operation.Encoding.Manager_operations.case.MCase.name := name
          |} := op_case in
    let __t_value :=
      (let arg :=
        Data_encoding.def
          (Format.asprintf
            (CamlinternalFormatBasics.Format
              (CamlinternalFormatBasics.String_literal
                "operation.alpha.operation_result."
                (CamlinternalFormatBasics.String
                  CamlinternalFormatBasics.No_padding
                  CamlinternalFormatBasics.End_of_format))
              "operation.alpha.operation_result.%s") name) in
      fun eta => arg None None eta)
        (Data_encoding.union (Some Data_encoding.Uint8)
          [
            Data_encoding.__case_value "Applied" None (Data_encoding.Tag 0)
              (Data_encoding.merge_objs
                (Data_encoding.obj1
                  (Data_encoding.req None None "status"
                    (Data_encoding.constant
                      "applied")))
                encoding)
              (fun o =>
                match o with
                | (Skipped _ | Failed _ _ | Backtracked _ _) =>
                  None
                | Applied o =>
                  match
                    select
                      (Successful_manager_result
                        o) with
                  | None => None
                  | Some o => Some (tt, (proj o))
                  end
                end)
              (fun function_parameter =>
                let '(_, x) := function_parameter in
                Applied (inj x));
            Data_encoding.__case_value "Failed" None (Data_encoding.Tag 1)
              (Data_encoding.obj2
                (Data_encoding.req None None "status"
                  (Data_encoding.constant "failed"))
                (Data_encoding.req None None "errors"
                  (Data_encoding.__list_value None
                    error_encoding)))
              (fun function_parameter =>
                match function_parameter with
                | Failed _ errs => Some (tt, errs)
                | _ => None
                end)
              (fun function_parameter =>
                let '(_, errs) := function_parameter in
                Failed kind errs);
            Data_encoding.__case_value "Skipped" None (Data_encoding.Tag 2)
              (Data_encoding.obj1
                (Data_encoding.req None None "status"
                  (Data_encoding.constant "skipped")))
              (fun function_parameter =>
                match function_parameter with
                | Skipped _ => Some tt
                | _ => None
                end)
              (fun function_parameter =>
                let '_ := function_parameter in
                Skipped kind);
            Data_encoding.__case_value "Backtracked" None (Data_encoding.Tag 3)
              (Data_encoding.merge_objs
                (Data_encoding.obj2
                  (Data_encoding.req None None "status"
                    (Data_encoding.constant
                      "backtracked"))
                  (Data_encoding.opt None None "errors"
                    (Data_encoding.__list_value
                      None
                      error_encoding)))
                encoding)
              (fun o =>
                match o with
                | (Skipped _ | Failed _ _ | Applied _) => None
                | Backtracked o errs =>
                  match
                    select
                      (Successful_manager_result
                        o) with
                  | None => None
                  | Some o =>
                    Some ((tt, errs), (proj o))
                  end
                end)
              (fun function_parameter =>
                let '((_, errs), x) := function_parameter in
                Backtracked (inj x) errs)
          ]) in
    MCase
      {| case.MCase.op_case := op_case; case.MCase.encoding := encoding;
        case.MCase.kind := kind; case.MCase.iselect := iselect;
        case.MCase.select := select; case.MCase.proj := proj;
        case.MCase.inj := inj; case.MCase.t := __t_value |}.
  
  Definition reveal_case : case :=
    make Alpha_context.Operation.Encoding.Manager_operations.reveal_case
      (Data_encoding.obj1
        (Data_encoding.dft None None "consumed_gas" Data_encoding.z Z.zero))
      Alpha_context.Kind.Reveal_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              Alpha_context.internal_operation.operation := Alpha_context.Reveal _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Reveal_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        |
          Reveal_result {|
            successful_manager_operation_result.Reveal_result.consumed_gas := consumed_gas
              |} => consumed_gas
        | _ => unreachable_gadt_branch
        end)
      (fun consumed_gas =>
        Reveal_result
          {|
            successful_manager_operation_result.Reveal_result.consumed_gas :=
              consumed_gas |}).
  
  Definition transaction_case : case :=
    make Alpha_context.Operation.Encoding.Manager_operations.transaction_case
      (Data_encoding.obj8
        (Data_encoding.opt None None "storage"
          Alpha_context.Script.expr_encoding)
        (Data_encoding.opt None None "big_map_diff"
          Alpha_context.Contract.big_map_diff_encoding)
        (Data_encoding.dft None None "balance_updates"
          Alpha_context.Delegate.balance_updates_encoding nil)
        (Data_encoding.dft None None "originated_contracts"
          (Data_encoding.__list_value None Alpha_context.Contract.encoding) nil)
        (Data_encoding.dft None None "consumed_gas" Data_encoding.z Z.zero)
        (Data_encoding.dft None None "storage_size" Data_encoding.z Z.zero)
        (Data_encoding.dft None None "paid_storage_size_diff" Data_encoding.z
          Z.zero)
        (Data_encoding.dft None None "allocated_destination_contract"
          Data_encoding.__bool_value false))
      Alpha_context.Kind.Transaction_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              Alpha_context.internal_operation.operation := Alpha_context.Transaction _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Transaction_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        |
          Transaction_result {|
            successful_manager_operation_result.Transaction_result.storage := storage;
              successful_manager_operation_result.Transaction_result.big_map_diff
                := big_map_diff;
              successful_manager_operation_result.Transaction_result.balance_updates
                := balance_updates;
              successful_manager_operation_result.Transaction_result.originated_contracts
                := originated_contracts;
              successful_manager_operation_result.Transaction_result.consumed_gas
                := consumed_gas;
              successful_manager_operation_result.Transaction_result.storage_size
                := storage_size;
              successful_manager_operation_result.Transaction_result.paid_storage_size_diff
                := paid_storage_size_diff;
              successful_manager_operation_result.Transaction_result.allocated_destination_contract
                := allocated_destination_contract
              |} =>
          (storage, big_map_diff, balance_updates, originated_contracts,
            consumed_gas, storage_size, paid_storage_size_diff,
            allocated_destination_contract)
        | _ => unreachable_gadt_branch
        end)
      (fun function_parameter =>
        let
          '(storage, big_map_diff, balance_updates, originated_contracts,
            consumed_gas, storage_size, paid_storage_size_diff,
            allocated_destination_contract) := function_parameter in
        Transaction_result
          {|
            successful_manager_operation_result.Transaction_result.storage :=
              storage;
            successful_manager_operation_result.Transaction_result.big_map_diff :=
              big_map_diff;
            successful_manager_operation_result.Transaction_result.balance_updates :=
              balance_updates;
            successful_manager_operation_result.Transaction_result.originated_contracts :=
              originated_contracts;
            successful_manager_operation_result.Transaction_result.consumed_gas :=
              consumed_gas;
            successful_manager_operation_result.Transaction_result.storage_size :=
              storage_size;
            successful_manager_operation_result.Transaction_result.paid_storage_size_diff :=
              paid_storage_size_diff;
            successful_manager_operation_result.Transaction_result.allocated_destination_contract :=
              allocated_destination_contract |}).
  
  Definition origination_case : case :=
    make Alpha_context.Operation.Encoding.Manager_operations.origination_case
      (Data_encoding.obj6
        (Data_encoding.opt None None "big_map_diff"
          Alpha_context.Contract.big_map_diff_encoding)
        (Data_encoding.dft None None "balance_updates"
          Alpha_context.Delegate.balance_updates_encoding nil)
        (Data_encoding.dft None None "originated_contracts"
          (Data_encoding.__list_value None Alpha_context.Contract.encoding) nil)
        (Data_encoding.dft None None "consumed_gas" Data_encoding.z Z.zero)
        (Data_encoding.dft None None "storage_size" Data_encoding.z Z.zero)
        (Data_encoding.dft None None "paid_storage_size_diff" Data_encoding.z
          Z.zero)) Alpha_context.Kind.Origination_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              Alpha_context.internal_operation.operation := Alpha_context.Origination _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Origination_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        |
          Origination_result {|
            successful_manager_operation_result.Origination_result.big_map_diff :=
              big_map_diff;
              successful_manager_operation_result.Origination_result.balance_updates
                := balance_updates;
              successful_manager_operation_result.Origination_result.originated_contracts
                := originated_contracts;
              successful_manager_operation_result.Origination_result.consumed_gas
                := consumed_gas;
              successful_manager_operation_result.Origination_result.storage_size
                := storage_size;
              successful_manager_operation_result.Origination_result.paid_storage_size_diff
                := paid_storage_size_diff
              |} =>
          (big_map_diff, balance_updates, originated_contracts, consumed_gas,
            storage_size, paid_storage_size_diff)
        | _ => unreachable_gadt_branch
        end)
      (fun function_parameter =>
        let
          '(big_map_diff, balance_updates, originated_contracts, consumed_gas,
            storage_size, paid_storage_size_diff) := function_parameter in
        Origination_result
          {|
            successful_manager_operation_result.Origination_result.big_map_diff :=
              big_map_diff;
            successful_manager_operation_result.Origination_result.balance_updates :=
              balance_updates;
            successful_manager_operation_result.Origination_result.originated_contracts :=
              originated_contracts;
            successful_manager_operation_result.Origination_result.consumed_gas :=
              consumed_gas;
            successful_manager_operation_result.Origination_result.storage_size :=
              storage_size;
            successful_manager_operation_result.Origination_result.paid_storage_size_diff :=
              paid_storage_size_diff |}).
  
  Definition delegation_case : case :=
    make Alpha_context.Operation.Encoding.Manager_operations.delegation_case
      (Data_encoding.obj1
        (Data_encoding.dft None None "consumed_gas" Data_encoding.z Z.zero))
      Alpha_context.Kind.Delegation_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              Alpha_context.internal_operation.operation := Alpha_context.Delegation _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Delegation_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        |
          Delegation_result {|
            successful_manager_operation_result.Delegation_result.consumed_gas :=
              consumed_gas
              |} => consumed_gas
        | _ => unreachable_gadt_branch
        end)
      (fun consumed_gas =>
        Delegation_result
          {|
            successful_manager_operation_result.Delegation_result.consumed_gas :=
              consumed_gas |}).
End Manager_result.

Definition internal_operation_result_encoding
  : Data_encoding.t packed_internal_operation_result :=
  let make (function_parameter : Manager_result.case)
    : Data_encoding.case packed_internal_operation_result :=
    let 'Manager_result.MCase res_case := function_parameter in
    let 'existT _ __MCase_'a res_case :=
      existT (A := Set) (fun __MCase_'a => Manager_result.case.MCase __MCase_'a)
        _ res_case in
    let 'Alpha_context.Operation.Encoding.Manager_operations.MCase op_case :=
      res_case.(Manager_result.case.MCase.op_case) in
    let 'existT _ __MCase_'a1 op_case :=
      existT (A := Set)
        (fun __MCase_'a1 =>
          Alpha_context.Operation.Encoding.Manager_operations.case.MCase
            __MCase_'a1) _ op_case in
    Data_encoding.__case_value
      op_case.(Alpha_context.Operation.Encoding.Manager_operations.case.MCase.name)
      None
      (Data_encoding.Tag
        op_case.(Alpha_context.Operation.Encoding.Manager_operations.case.MCase.tag))
      (Data_encoding.merge_objs
        (Data_encoding.obj3
          (Data_encoding.req None None "kind"
            (Data_encoding.constant
              op_case.(Alpha_context.Operation.Encoding.Manager_operations.case.MCase.name)))
          (Data_encoding.req None None "source" Alpha_context.Contract.encoding)
          (Data_encoding.req None None "nonce" Data_encoding.uint16))
        (Data_encoding.merge_objs
          op_case.(Alpha_context.Operation.Encoding.Manager_operations.case.MCase.encoding)
          (Data_encoding.obj1
            (Data_encoding.req None None "result"
              res_case.(Manager_result.case.MCase.t)))))
      (fun op =>
        match res_case.(Manager_result.case.MCase.iselect) op with
        | Some (op, res) =>
          Some
            ((tt, op.(Alpha_context.internal_operation.source),
              op.(Alpha_context.internal_operation.nonce)),
              ((op_case.(Alpha_context.Operation.Encoding.Manager_operations.case.MCase.proj)
                op.(Alpha_context.internal_operation.operation)), res))
        | None => None
        end)
      (fun function_parameter =>
        let '((_, source, __nonce_value), (op, res)) := function_parameter in
        let op :=
          {| Alpha_context.internal_operation.source := source;
            Alpha_context.internal_operation.operation :=
              op_case.(Alpha_context.Operation.Encoding.Manager_operations.case.MCase.inj)
                op; Alpha_context.internal_operation.nonce := __nonce_value |}
          in
        Internal_operation_result op res) in
  (let arg := Data_encoding.def "operation.alpha.internal_operation_result" in
  fun eta => arg None None eta)
    (Data_encoding.union None
      [
        make Manager_result.reveal_case;
        make Manager_result.transaction_case;
        make Manager_result.origination_case;
        make Manager_result.delegation_case
      ]).

Module ConstructorRecords_contents_result.
  Module contents_result.
    Module Endorsement_result.
      Record record {balance_updates delegate slots : Set} : Set := Build {
        balance_updates : balance_updates;
        delegate : delegate;
        slots : slots }.
      Arguments record : clear implicits.
      Definition with_balance_updates {t_balance_updates t_delegate t_slots}
        balance_updates (r : record t_balance_updates t_delegate t_slots) :=
        Build t_balance_updates t_delegate t_slots balance_updates r.(delegate)
          r.(slots).
      Definition with_delegate {t_balance_updates t_delegate t_slots} delegate
        (r : record t_balance_updates t_delegate t_slots) :=
        Build t_balance_updates t_delegate t_slots r.(balance_updates) delegate
          r.(slots).
      Definition with_slots {t_balance_updates t_delegate t_slots} slots
        (r : record t_balance_updates t_delegate t_slots) :=
        Build t_balance_updates t_delegate t_slots r.(balance_updates)
          r.(delegate) slots.
    End Endorsement_result.
    Definition Endorsement_result_skeleton := Endorsement_result.record.
    
    Module Manager_operation_result.
      Record record {balance_updates operation_result internal_operation_results
        : Set} : Set := Build {
        balance_updates : balance_updates;
        operation_result : operation_result;
        internal_operation_results : internal_operation_results }.
      Arguments record : clear implicits.
      Definition with_balance_updates
        {t_balance_updates t_operation_result t_internal_operation_results}
        balance_updates
        (r :
          record t_balance_updates t_operation_result
            t_internal_operation_results) :=
        Build t_balance_updates t_operation_result t_internal_operation_results
          balance_updates r.(operation_result) r.(internal_operation_results).
      Definition with_operation_result
        {t_balance_updates t_operation_result t_internal_operation_results}
        operation_result
        (r :
          record t_balance_updates t_operation_result
            t_internal_operation_results) :=
        Build t_balance_updates t_operation_result t_internal_operation_results
          r.(balance_updates) operation_result r.(internal_operation_results).
      Definition with_internal_operation_results
        {t_balance_updates t_operation_result t_internal_operation_results}
        internal_operation_results
        (r :
          record t_balance_updates t_operation_result
            t_internal_operation_results) :=
        Build t_balance_updates t_operation_result t_internal_operation_results
          r.(balance_updates) r.(operation_result) internal_operation_results.
    End Manager_operation_result.
    Definition Manager_operation_result_skeleton :=
      Manager_operation_result.record.
  End contents_result.
End ConstructorRecords_contents_result.
Import ConstructorRecords_contents_result.

Reserved Notation "'contents_result.Endorsement_result".
Reserved Notation "'contents_result.Manager_operation_result".

Inductive contents_result : Set :=
| Endorsement_result : 'contents_result.Endorsement_result -> contents_result
| Seed_nonce_revelation_result :
  Alpha_context.Delegate.balance_updates -> contents_result
| Double_endorsement_evidence_result :
  Alpha_context.Delegate.balance_updates -> contents_result
| Double_baking_evidence_result :
  Alpha_context.Delegate.balance_updates -> contents_result
| Activate_account_result :
  Alpha_context.Delegate.balance_updates -> contents_result
| Proposals_result : contents_result
| Ballot_result : contents_result
| Manager_operation_result :
  'contents_result.Manager_operation_result -> contents_result

where "'contents_result.Endorsement_result" :=
  (contents_result.Endorsement_result_skeleton
    Alpha_context.Delegate.balance_updates
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) (list int))
and "'contents_result.Manager_operation_result" :=
  (contents_result.Manager_operation_result_skeleton
    Alpha_context.Delegate.balance_updates manager_operation_result
    (list packed_internal_operation_result)).

Module contents_result.
  Include ConstructorRecords_contents_result.contents_result.
  Definition Endorsement_result := 'contents_result.Endorsement_result.
  Definition Manager_operation_result :=
    'contents_result.Manager_operation_result.
End contents_result.

Inductive packed_contents_result : Set :=
| Contents_result : contents_result -> packed_contents_result.

Inductive packed_contents_and_result : Set :=
| Contents_and_result :
  Alpha_context.Operation.contents -> contents_result ->
  packed_contents_and_result.

Inductive eq : Set :=
| Eq : eq.

Definition equal_manager_kind
  (ka : Alpha_context.Kind.manager) (kb : Alpha_context.Kind.manager)
  : option eq :=
  match (ka, kb) with
  |
    (Alpha_context.Kind.Reveal_manager_kind,
      Alpha_context.Kind.Reveal_manager_kind) => Some Eq
  | (Alpha_context.Kind.Reveal_manager_kind, _) => None
  |
    (Alpha_context.Kind.Transaction_manager_kind,
      Alpha_context.Kind.Transaction_manager_kind) => Some Eq
  | (Alpha_context.Kind.Transaction_manager_kind, _) => None
  |
    (Alpha_context.Kind.Origination_manager_kind,
      Alpha_context.Kind.Origination_manager_kind) => Some Eq
  | (Alpha_context.Kind.Origination_manager_kind, _) => None
  |
    (Alpha_context.Kind.Delegation_manager_kind,
      Alpha_context.Kind.Delegation_manager_kind) => Some Eq
  | (Alpha_context.Kind.Delegation_manager_kind, _) => None
  end.

Module Encoding.
  Module ConstructorRecords_case.
    Module case.
      Module Case.
        Record record {op_case encoding select mselect proj inj : Set} : Set := Build {
          op_case : op_case;
          encoding : encoding;
          select : select;
          mselect : mselect;
          proj : proj;
          inj : inj }.
        Arguments record : clear implicits.
        Definition with_op_case
          {t_op_case t_encoding t_select t_mselect t_proj t_inj} op_case
          (r : record t_op_case t_encoding t_select t_mselect t_proj t_inj) :=
          Build t_op_case t_encoding t_select t_mselect t_proj t_inj op_case
            r.(encoding) r.(select) r.(mselect) r.(proj) r.(inj).
        Definition with_encoding
          {t_op_case t_encoding t_select t_mselect t_proj t_inj} encoding
          (r : record t_op_case t_encoding t_select t_mselect t_proj t_inj) :=
          Build t_op_case t_encoding t_select t_mselect t_proj t_inj r.(op_case)
            encoding r.(select) r.(mselect) r.(proj) r.(inj).
        Definition with_select
          {t_op_case t_encoding t_select t_mselect t_proj t_inj} select
          (r : record t_op_case t_encoding t_select t_mselect t_proj t_inj) :=
          Build t_op_case t_encoding t_select t_mselect t_proj t_inj r.(op_case)
            r.(encoding) select r.(mselect) r.(proj) r.(inj).
        Definition with_mselect
          {t_op_case t_encoding t_select t_mselect t_proj t_inj} mselect
          (r : record t_op_case t_encoding t_select t_mselect t_proj t_inj) :=
          Build t_op_case t_encoding t_select t_mselect t_proj t_inj r.(op_case)
            r.(encoding) r.(select) mselect r.(proj) r.(inj).
        Definition with_proj
          {t_op_case t_encoding t_select t_mselect t_proj t_inj} proj
          (r : record t_op_case t_encoding t_select t_mselect t_proj t_inj) :=
          Build t_op_case t_encoding t_select t_mselect t_proj t_inj r.(op_case)
            r.(encoding) r.(select) r.(mselect) proj r.(inj).
        Definition with_inj
          {t_op_case t_encoding t_select t_mselect t_proj t_inj} inj
          (r : record t_op_case t_encoding t_select t_mselect t_proj t_inj) :=
          Build t_op_case t_encoding t_select t_mselect t_proj t_inj r.(op_case)
            r.(encoding) r.(select) r.(mselect) r.(proj) inj.
      End Case.
      Definition Case_skeleton := Case.record.
    End case.
  End ConstructorRecords_case.
  Import ConstructorRecords_case.
  
  Reserved Notation "'case.Case".
  
  Inductive case : Set :=
  | Case : forall {a : Set}, 'case.Case a -> case
  
  where "'case.Case" := (fun (t_a : Set) =>
    case.Case_skeleton Alpha_context.Operation.Encoding.case
      (Data_encoding.t t_a) (packed_contents_result -> option contents_result)
      (packed_contents_and_result ->
      option (Alpha_context.contents * contents_result))
      (contents_result -> t_a) (t_a -> contents_result)).
  
  Module case.
    Include ConstructorRecords_case.case.
    Definition Case := 'case.Case.
  End case.
  
  Definition tagged_case {A B : Set}
    (tag : Data_encoding.case_tag) (name : string)
    (args : Data_encoding.encoding A) (proj : B -> option A) (inj : A -> B)
    : Data_encoding.case B :=
    Data_encoding.__case_value (String.capitalize_ascii name) None tag
      (Data_encoding.merge_objs
        (Data_encoding.obj1
          (Data_encoding.req None None "kind" (Data_encoding.constant name)))
        args)
      (fun x =>
        match proj x with
        | None => None
        | Some x => Some (tt, x)
        end)
      (fun function_parameter =>
        let '(_, x) := function_parameter in
        inj x).
  
  Definition endorsement_case : case :=
    Case
      {| case.Case.op_case := Alpha_context.Operation.Encoding.endorsement_case;
        case.Case.encoding :=
          Data_encoding.obj3
            (Data_encoding.req None None "balance_updates"
              Alpha_context.Delegate.balance_updates_encoding)
            (Data_encoding.req None None "delegate"
              (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding))
            (Data_encoding.req None None "slots"
              (Data_encoding.__list_value None Data_encoding.uint8));
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Endorsement_result _) as op) => Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            | Contents_and_result ((Alpha_context.Endorsement _) as op) res =>
              Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            match function_parameter with
            |
              Endorsement_result {|
                contents_result.Endorsement_result.balance_updates := balance_updates;
                  contents_result.Endorsement_result.delegate := delegate;
                  contents_result.Endorsement_result.slots := slots
                  |} => (balance_updates, delegate, slots)
            | _ => unreachable_gadt_branch
            end;
        case.Case.inj :=
          fun function_parameter =>
            let '(balance_updates, delegate, slots) := function_parameter in
            Endorsement_result
              {|
                contents_result.Endorsement_result.balance_updates :=
                  balance_updates;
                contents_result.Endorsement_result.delegate := delegate;
                contents_result.Endorsement_result.slots := slots |} |}.
  
  Definition seed_nonce_revelation_case : case :=
    Case
      {|
        case.Case.op_case :=
          Alpha_context.Operation.Encoding.seed_nonce_revelation_case;
        case.Case.encoding :=
          Data_encoding.obj1
            (Data_encoding.req None None "balance_updates"
              Alpha_context.Delegate.balance_updates_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Seed_nonce_revelation_result _) as op) =>
              Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Alpha_context.Seed_nonce_revelation _) as op) res =>
              Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            match function_parameter with
            | Seed_nonce_revelation_result bus => bus
            | _ => unreachable_gadt_branch
            end; case.Case.inj := fun bus => Seed_nonce_revelation_result bus |}.
  
  Definition double_endorsement_evidence_case : case :=
    Case
      {|
        case.Case.op_case :=
          Alpha_context.Operation.Encoding.double_endorsement_evidence_case;
        case.Case.encoding :=
          Data_encoding.obj1
            (Data_encoding.req None None "balance_updates"
              Alpha_context.Delegate.balance_updates_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Double_endorsement_evidence_result _) as op) =>
              Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Alpha_context.Double_endorsement_evidence _) as op) res =>
              Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            match function_parameter with
            | Double_endorsement_evidence_result bus => bus
            | _ => unreachable_gadt_branch
            end;
        case.Case.inj := fun bus => Double_endorsement_evidence_result bus |}.
  
  Definition double_baking_evidence_case : case :=
    Case
      {|
        case.Case.op_case :=
          Alpha_context.Operation.Encoding.double_baking_evidence_case;
        case.Case.encoding :=
          Data_encoding.obj1
            (Data_encoding.req None None "balance_updates"
              Alpha_context.Delegate.balance_updates_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Double_baking_evidence_result _) as op) =>
              Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Alpha_context.Double_baking_evidence _) as op) res =>
              Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            match function_parameter with
            | Double_baking_evidence_result bus => bus
            | _ => unreachable_gadt_branch
            end; case.Case.inj := fun bus => Double_baking_evidence_result bus
        |}.
  
  Definition activate_account_case : case :=
    Case
      {|
        case.Case.op_case :=
          Alpha_context.Operation.Encoding.activate_account_case;
        case.Case.encoding :=
          Data_encoding.obj1
            (Data_encoding.req None None "balance_updates"
              Alpha_context.Delegate.balance_updates_encoding);
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Activate_account_result _) as op) => Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            | Contents_and_result ((Alpha_context.Activate_account _) as op) res
              => Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            match function_parameter with
            | Activate_account_result bus => bus
            | _ => unreachable_gadt_branch
            end; case.Case.inj := fun bus => Activate_account_result bus |}.
  
  Definition proposals_case : case :=
    Case
      {| case.Case.op_case := Alpha_context.Operation.Encoding.proposals_case;
        case.Case.encoding := Data_encoding.empty;
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result (Proposals_result as op) => Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            | Contents_and_result ((Alpha_context.Proposals _) as op) res =>
              Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            match function_parameter with
            | Proposals_result => tt
            | _ => unreachable_gadt_branch
            end;
        case.Case.inj :=
          fun function_parameter =>
            let '_ := function_parameter in
            Proposals_result |}.
  
  Definition ballot_case : case :=
    Case
      {| case.Case.op_case := Alpha_context.Operation.Encoding.ballot_case;
        case.Case.encoding := Data_encoding.empty;
        case.Case.select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result (Ballot_result as op) => Some op
            | _ => None
            end;
        case.Case.mselect :=
          fun function_parameter =>
            match function_parameter with
            | Contents_and_result ((Alpha_context.Ballot _) as op) res =>
              Some (op, res)
            | _ => None
            end;
        case.Case.proj :=
          fun function_parameter =>
            match function_parameter with
            | Ballot_result => tt
            | _ => unreachable_gadt_branch
            end;
        case.Case.inj :=
          fun function_parameter =>
            let '_ := function_parameter in
            Ballot_result |}.
  
  Definition make_manager_case
    (function_parameter : Alpha_context.Operation.Encoding.case)
    : Manager_result.case ->
    (packed_contents_and_result ->
    option (Alpha_context.contents * contents_result)) -> case :=
    let 'Alpha_context.Operation.Encoding.Case op_case := function_parameter in
    let 'existT _ __Case_'a op_case :=
      existT (A := Set)
        (fun __Case_'a => Alpha_context.Operation.Encoding.case.Case __Case_'a)
        _ op_case in
    fun function_parameter =>
      let 'Manager_result.MCase res_case := function_parameter in
      let 'existT _ __MCase_'a res_case :=
        existT (A := Set)
          (fun __MCase_'a => Manager_result.case.MCase __MCase_'a) _ res_case in
      fun mselect =>
        Case
          {| case.Case.op_case := Alpha_context.Operation.Encoding.Case op_case;
            case.Case.encoding :=
              Data_encoding.obj3
                (Data_encoding.req None None "balance_updates"
                  Alpha_context.Delegate.balance_updates_encoding)
                (Data_encoding.req None None "operation_result"
                  res_case.(Manager_result.case.MCase.t))
                (Data_encoding.dft None None "internal_operation_results"
                  (Data_encoding.__list_value None
                    internal_operation_result_encoding) nil);
            case.Case.select :=
              fun function_parameter =>
                match function_parameter with
                |
                  Contents_result
                    (Manager_operation_result
                      ({|
                        contents_result.Manager_operation_result.operation_result := Applied res
                          |} as op)) =>
                  match
                    res_case.(Manager_result.case.MCase.select)
                      (Successful_manager_result res) with
                  | Some res =>
                    Some
                      (Manager_operation_result
                        (contents_result.Manager_operation_result.with_operation_result
                          (Applied res) op))
                  | None => None
                  end
                |
                  Contents_result
                    (Manager_operation_result
                      ({|
                        contents_result.Manager_operation_result.operation_result :=
                          Backtracked res errs
                          |} as op)) =>
                  match
                    res_case.(Manager_result.case.MCase.select)
                      (Successful_manager_result res) with
                  | Some res =>
                    Some
                      (Manager_operation_result
                        (contents_result.Manager_operation_result.with_operation_result
                          (Backtracked res errs) op))
                  | None => None
                  end
                |
                  Contents_result
                    (Manager_operation_result
                      ({|
                        contents_result.Manager_operation_result.operation_result := Skipped kind
                          |} as op)) =>
                  match
                    equal_manager_kind kind
                      res_case.(Manager_result.case.MCase.kind) with
                  | None => None
                  | Some Eq =>
                    Some
                      (Manager_operation_result
                        (contents_result.Manager_operation_result.with_operation_result
                          (Skipped kind) op))
                  end
                |
                  Contents_result
                    (Manager_operation_result
                      ({|
                        contents_result.Manager_operation_result.operation_result := Failed kind errs
                          |} as op)) =>
                  match
                    equal_manager_kind kind
                      res_case.(Manager_result.case.MCase.kind) with
                  | None => None
                  | Some Eq =>
                    Some
                      (Manager_operation_result
                        (contents_result.Manager_operation_result.with_operation_result
                          (Failed kind errs) op))
                  end
                | Contents_result Ballot_result => None
                | Contents_result (Endorsement_result _) => None
                | Contents_result (Seed_nonce_revelation_result _) => None
                | Contents_result (Double_endorsement_evidence_result _) => None
                | Contents_result (Double_baking_evidence_result _) => None
                | Contents_result (Activate_account_result _) => None
                | Contents_result Proposals_result => None
                end; case.Case.mselect := mselect;
            case.Case.proj :=
              fun function_parameter =>
                match function_parameter with
                |
                  Manager_operation_result {|
                    contents_result.Manager_operation_result.balance_updates := bus;
                      contents_result.Manager_operation_result.operation_result
                        := __r_value;
                      contents_result.Manager_operation_result.internal_operation_results
                        := rs
                      |} => (bus, __r_value, rs)
                | _ => unreachable_gadt_branch
                end;
            case.Case.inj :=
              fun function_parameter =>
                let '(bus, __r_value, rs) := function_parameter in
                Manager_operation_result
                  {|
                    contents_result.Manager_operation_result.balance_updates :=
                      bus;
                    contents_result.Manager_operation_result.operation_result :=
                      __r_value;
                    contents_result.Manager_operation_result.internal_operation_results :=
                      rs |} |}.
  
  Definition reveal_case : case :=
    make_manager_case Alpha_context.Operation.Encoding.reveal_case
      Manager_result.reveal_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Alpha_context.Manager_operation {|
              Alpha_context.contents.Manager_operation.operation := Alpha_context.Reveal _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
  
  Definition transaction_case : case :=
    make_manager_case Alpha_context.Operation.Encoding.transaction_case
      Manager_result.transaction_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Alpha_context.Manager_operation {|
              Alpha_context.contents.Manager_operation.operation :=
                Alpha_context.Transaction _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
  
  Definition origination_case : case :=
    make_manager_case Alpha_context.Operation.Encoding.origination_case
      Manager_result.origination_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Alpha_context.Manager_operation {|
              Alpha_context.contents.Manager_operation.operation :=
                Alpha_context.Origination _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
  
  Definition delegation_case : case :=
    make_manager_case Alpha_context.Operation.Encoding.delegation_case
      Manager_result.delegation_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Alpha_context.Manager_operation {|
              Alpha_context.contents.Manager_operation.operation :=
                Alpha_context.Delegation _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
End Encoding.

Definition contents_result_encoding
  : Data_encoding.encoding packed_contents_result :=
  let make (function_parameter : Encoding.case)
    : Data_encoding.case packed_contents_result :=
    let
      'Encoding.Case {|
        Encoding.case.Case.op_case :=
          Alpha_context.Operation.Encoding.Case {|
            Alpha_context.Operation.Encoding.case.Case.tag := tag;
              Alpha_context.Operation.Encoding.case.Case.name :=
                name
              |};
          Encoding.case.Case.encoding := encoding;
          Encoding.case.Case.select := select;
          Encoding.case.Case.mselect := _;
          Encoding.case.Case.proj := proj;
          Encoding.case.Case.inj := inj
          |} := function_parameter in
    let 'existT _ __Case_'a [tag, name, encoding, select, proj, inj] :=
      existT (A := Set)
        (fun __Case_'a =>
          [int ** string ** Data_encoding.t __Case_'a **
            packed_contents_result -> option contents_result **
            contents_result -> __Case_'a ** __Case_'a -> contents_result]) _
        [tag, name, encoding, select, proj, inj] in
    let proj (x : packed_contents_result) : option __Case_'a :=
      match select x with
      | None => None
      | Some x => Some (proj x)
      end in
    let inj (x : __Case_'a) : packed_contents_result :=
      Contents_result (inj x) in
    Encoding.tagged_case (Data_encoding.Tag tag) name encoding proj inj in
  (let arg := Data_encoding.def "operation.alpha.contents_result" in
  fun eta => arg None None eta)
    (Data_encoding.union None
      [
        make Encoding.endorsement_case;
        make Encoding.seed_nonce_revelation_case;
        make Encoding.double_endorsement_evidence_case;
        make Encoding.double_baking_evidence_case;
        make Encoding.activate_account_case;
        make Encoding.proposals_case;
        make Encoding.ballot_case;
        make Encoding.reveal_case;
        make Encoding.transaction_case;
        make Encoding.origination_case;
        make Encoding.delegation_case
      ]).

Definition contents_and_result_encoding
  : Data_encoding.encoding packed_contents_and_result :=
  let make (function_parameter : Encoding.case)
    : Data_encoding.case packed_contents_and_result :=
    let
      'Encoding.Case {|
        Encoding.case.Case.op_case :=
          Alpha_context.Operation.Encoding.Case {|
            Alpha_context.Operation.Encoding.case.Case.tag := tag;
              Alpha_context.Operation.Encoding.case.Case.name :=
                name;
              Alpha_context.Operation.Encoding.case.Case.encoding :=
                encoding;
              Alpha_context.Operation.Encoding.case.Case.proj :=
                proj;
              Alpha_context.Operation.Encoding.case.Case.inj := inj
              |};
          Encoding.case.Case.encoding := meta_encoding;
          Encoding.case.Case.mselect := mselect;
          Encoding.case.Case.proj := meta_proj;
          Encoding.case.Case.inj := meta_inj
          |} := function_parameter in
    let 'existT _ [__Case_'a, __Case_'a1]
      [tag, name, encoding, proj, inj, meta_encoding, mselect, meta_proj,
        meta_inj] :=
      existT (A := [Set ** Set])
        (fun '[__Case_'a, __Case_'a1] =>
          [int ** string ** Data_encoding.t __Case_'a1 **
            Alpha_context.Operation.contents -> __Case_'a1 **
            __Case_'a1 -> Alpha_context.Operation.contents **
            Data_encoding.t __Case_'a **
            packed_contents_and_result ->
            option (Alpha_context.contents * contents_result) **
            contents_result -> __Case_'a ** __Case_'a -> contents_result]) [_,
        _]
        [tag, name, encoding, proj, inj, meta_encoding, mselect, meta_proj,
          meta_inj] in
    let proj (c : packed_contents_and_result)
      : option (__Case_'a1 * __Case_'a) :=
      match mselect c with
      | Some (op, res) => Some ((proj op), (meta_proj res))
      | _ => None
      end in
    let inj (function_parameter : __Case_'a1 * __Case_'a)
      : packed_contents_and_result :=
      let '(op, res) := function_parameter in
      Contents_and_result (inj op) (meta_inj res) in
    let encoding :=
      Data_encoding.merge_objs encoding
        (Data_encoding.obj1
          (Data_encoding.req None None "metadata" meta_encoding)) in
    Encoding.tagged_case (Data_encoding.Tag tag) name encoding proj inj in
  (let arg := Data_encoding.def "operation.alpha.operation_contents_and_result"
    in
  fun eta => arg None None eta)
    (Data_encoding.union None
      [
        make Encoding.endorsement_case;
        make Encoding.seed_nonce_revelation_case;
        make Encoding.double_endorsement_evidence_case;
        make Encoding.double_baking_evidence_case;
        make Encoding.activate_account_case;
        make Encoding.proposals_case;
        make Encoding.ballot_case;
        make Encoding.reveal_case;
        make Encoding.transaction_case;
        make Encoding.origination_case;
        make Encoding.delegation_case
      ]).

Inductive contents_result_list : Set :=
| Single_result : contents_result -> contents_result_list
| Cons_result : contents_result -> contents_result_list -> contents_result_list.

Inductive packed_contents_result_list : Set :=
| Contents_result_list : contents_result_list -> packed_contents_result_list.

Definition contents_result_list_encoding
  : Data_encoding.encoding packed_contents_result_list :=
  let fix to_list (function_parameter : packed_contents_result_list)
    {struct function_parameter} : list packed_contents_result :=
    match function_parameter with
    | Contents_result_list (Single_result o) => [ Contents_result o ]
    | Contents_result_list (Cons_result o os) =>
      cons (Contents_result o) (to_list (Contents_result_list os))
    end in
  let fix of_list (function_parameter : list packed_contents_result)
    {struct function_parameter} : packed_contents_result_list :=
    match function_parameter with
    | [] => Pervasives.failwith "cannot decode empty operation result"
    | cons (Contents_result o) [] => Contents_result_list (Single_result o)
    | cons (Contents_result o) os =>
      let 'Contents_result_list os := of_list os in
      match (o, os) with
      | (Manager_operation_result _, Single_result (Manager_operation_result _))
        => Contents_result_list (Cons_result o os)
      | (Manager_operation_result _, Cons_result _ _) =>
        Contents_result_list (Cons_result o os)
      | _ => Pervasives.failwith "cannot decode ill-formed operation result"
      end
    end in
  (let arg := Data_encoding.def "operation.alpha.contents_list_result" in
  fun eta => arg None None eta)
    (Data_encoding.conv to_list of_list None
      (Data_encoding.__list_value None contents_result_encoding)).

Inductive contents_and_result_list : Set :=
| Single_and_result :
  Alpha_context.contents -> contents_result -> contents_and_result_list
| Cons_and_result :
  Alpha_context.contents -> contents_result -> contents_and_result_list ->
  contents_and_result_list.

Inductive packed_contents_and_result_list : Set :=
| Contents_and_result_list :
  contents_and_result_list -> packed_contents_and_result_list.

Definition contents_and_result_list_encoding
  : Data_encoding.encoding packed_contents_and_result_list :=
  let fix to_list (function_parameter : packed_contents_and_result_list)
    {struct function_parameter} : list packed_contents_and_result :=
    match function_parameter with
    | Contents_and_result_list (Single_and_result op res) =>
      [ Contents_and_result op res ]
    | Contents_and_result_list (Cons_and_result op res rest) =>
      cons (Contents_and_result op res)
        (to_list (Contents_and_result_list rest))
    end in
  let fix of_list (function_parameter : list packed_contents_and_result)
    {struct function_parameter} : packed_contents_and_result_list :=
    match function_parameter with
    | [] => Pervasives.failwith "cannot decode empty combined operation result"
    | cons (Contents_and_result op res) [] =>
      Contents_and_result_list (Single_and_result op res)
    | cons (Contents_and_result op res) rest =>
      let 'Contents_and_result_list rest := of_list rest in
      match (op, rest) with
      |
        (Alpha_context.Manager_operation _,
          Single_and_result (Alpha_context.Manager_operation _) _) =>
        Contents_and_result_list (Cons_and_result op res rest)
      | (Alpha_context.Manager_operation _, Cons_and_result _ _ _) =>
        Contents_and_result_list (Cons_and_result op res rest)
      | _ =>
        Pervasives.failwith "cannot decode ill-formed combined operation result"
      end
    end in
  Data_encoding.conv to_list of_list None
    (Data_encoding.__Variable.__list_value None contents_and_result_encoding).

Module operation_metadata.
  Record record : Set := Build {
    contents : contents_result_list }.
  Definition with_contents contents (r : record) :=
    Build contents.
End operation_metadata.
Definition operation_metadata := operation_metadata.record.

Inductive packed_operation_metadata : Set :=
| Operation_metadata : operation_metadata -> packed_operation_metadata
| No_operation_metadata : packed_operation_metadata.

Definition operation_metadata_encoding
  : Data_encoding.encoding packed_operation_metadata :=
  (let arg := Data_encoding.def "operation.alpha.result" in
  fun eta => arg None None eta)
    (Data_encoding.union None
      [
        Data_encoding.__case_value "Operation_metadata" None
          (Data_encoding.Tag 0) contents_result_list_encoding
          (fun function_parameter =>
            match function_parameter with
            |
              Operation_metadata {|
                operation_metadata.contents := contents
                  |} => Some (Contents_result_list contents)
            | _ => None
            end)
          (fun function_parameter =>
            let 'Contents_result_list contents := function_parameter in
            Operation_metadata
              {| operation_metadata.contents := contents |});
        Data_encoding.__case_value "No_operation_metadata" None
          (Data_encoding.Tag 1) Data_encoding.empty
          (fun function_parameter =>
            match function_parameter with
            | No_operation_metadata => Some tt
            | _ => None
            end)
          (fun function_parameter =>
            let '_ := function_parameter in
            No_operation_metadata)
      ]).

Definition kind_equal (op : Alpha_context.contents) (res : contents_result)
  : option eq :=
  match (op, res) with
  | (Alpha_context.Endorsement _, Endorsement_result _) => Some Eq
  | (Alpha_context.Endorsement _, _) => None
  | (Alpha_context.Seed_nonce_revelation _, Seed_nonce_revelation_result _) =>
    Some Eq
  | (Alpha_context.Seed_nonce_revelation _, _) => None
  |
    (Alpha_context.Double_endorsement_evidence _,
      Double_endorsement_evidence_result _) => Some Eq
  | (Alpha_context.Double_endorsement_evidence _, _) => None
  | (Alpha_context.Double_baking_evidence _, Double_baking_evidence_result _) =>
    Some Eq
  | (Alpha_context.Double_baking_evidence _, _) => None
  | (Alpha_context.Activate_account _, Activate_account_result _) => Some Eq
  | (Alpha_context.Activate_account _, _) => None
  | (Alpha_context.Proposals _, Proposals_result) => Some Eq
  | (Alpha_context.Proposals _, _) => None
  | (Alpha_context.Ballot _, Ballot_result) => Some Eq
  | (Alpha_context.Ballot _, _) => None
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation := Alpha_context.Reveal _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Applied (Reveal_result _)
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation := Alpha_context.Reveal _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Backtracked (Reveal_result _) _
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation := Alpha_context.Reveal _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Failed Alpha_context.Kind.Reveal_manager_kind _
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation := Alpha_context.Reveal _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Skipped Alpha_context.Kind.Reveal_manager_kind
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation := Alpha_context.Reveal _
        |}, _) => None
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Transaction _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Applied (Transaction_result _)
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Transaction _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Backtracked (Transaction_result _) _
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Transaction _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Failed Alpha_context.Kind.Transaction_manager_kind _
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Transaction _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Skipped Alpha_context.Kind.Transaction_manager_kind
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Transaction _
        |}, _) => None
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Origination _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Applied (Origination_result _)
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Origination _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Backtracked (Origination_result _) _
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Origination _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Failed Alpha_context.Kind.Origination_manager_kind _
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Origination _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Skipped Alpha_context.Kind.Origination_manager_kind
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Origination _
        |}, _) => None
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Delegation _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Applied (Delegation_result _)
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Delegation _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Backtracked (Delegation_result _) _
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Delegation _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Failed Alpha_context.Kind.Delegation_manager_kind _
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Delegation _
        |},
      Manager_operation_result {|
        contents_result.Manager_operation_result.operation_result :=
          Skipped Alpha_context.Kind.Delegation_manager_kind
          |}) => Some Eq
  |
    (Alpha_context.Manager_operation {|
      Alpha_context.contents.Manager_operation.operation :=
        Alpha_context.Delegation _
        |}, _) => None
  end.

Fixpoint kind_equal_list
  (contents : Alpha_context.contents_list) (res : contents_result_list)
  {struct contents} : option eq :=
  match (contents, res) with
  | (Alpha_context.Single op, Single_result res) =>
    match kind_equal op res with
    | None => None
    | Some Eq => Some Eq
    end
  | (Alpha_context.Cons op ops, Cons_result res ress) =>
    match kind_equal op res with
    | None => None
    | Some Eq =>
      match kind_equal_list ops ress with
      | None => None
      | Some Eq => Some Eq
      end
    end
  | _ => None
  end.

Fixpoint pack_contents_list
  (contents : Alpha_context.contents_list) (res : contents_result_list)
  {struct contents} : contents_and_result_list :=
  match (contents, res) with
  | (Alpha_context.Single op, Single_result res) => Single_and_result op res
  | (Alpha_context.Cons op ops, Cons_result res ress) =>
    Cons_and_result op res (pack_contents_list ops ress)
  |
    (Alpha_context.Single (Alpha_context.Manager_operation _),
      Cons_result (Manager_operation_result _) (Single_result _)) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {|
          contents_result.Manager_operation_result.operation_result := Failed _ _
            |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {|
          contents_result.Manager_operation_result.operation_result := Skipped _
            |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {|
          contents_result.Manager_operation_result.operation_result := Applied _
            |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {|
          contents_result.Manager_operation_result.operation_result := Backtracked _ _
            |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  | (Alpha_context.Single _, Cons_result _ _) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  | _ => unreachable_gadt_branch
  end.

Fixpoint unpack_contents_list (function_parameter : contents_and_result_list)
  {struct function_parameter}
  : Alpha_context.contents_list * contents_result_list :=
  match function_parameter with
  | Single_and_result op res => ((Alpha_context.Single op), (Single_result res))
  | Cons_and_result op res rest =>
    let '(ops, ress) := unpack_contents_list rest in
    ((Alpha_context.Cons op ops), (Cons_result res ress))
  end.

Fixpoint to_list (function_parameter : packed_contents_result_list)
  {struct function_parameter} : list packed_contents_result :=
  match function_parameter with
  | Contents_result_list (Single_result o) => [ Contents_result o ]
  | Contents_result_list (Cons_result o os) =>
    cons (Contents_result o) (to_list (Contents_result_list os))
  end.

Fixpoint of_list (function_parameter : list packed_contents_result)
  {struct function_parameter} : packed_contents_result_list :=
  match function_parameter with
  | [] =>
    (* ❌ Assert instruction is not handled. *)
    assert packed_contents_result_list false
  | cons (Contents_result o) [] => Contents_result_list (Single_result o)
  | cons (Contents_result o) os =>
    let 'Contents_result_list os := of_list os in
    match (o, os) with
    | (Manager_operation_result _, Single_result (Manager_operation_result _))
      => Contents_result_list (Cons_result o os)
    | (Manager_operation_result _, Cons_result _ _) =>
      Contents_result_list (Cons_result o os)
    | _ =>
      Pervasives.failwith
        "Operation result list of length > 1 should only contains manager operations result."
    end
  end.

Definition operation_data_and_metadata_encoding
  : Data_encoding.encoding
    (Alpha_context.packed_protocol_data * packed_operation_metadata) :=
  (let arg := Data_encoding.def "operation.alpha.operation_with_metadata" in
  fun eta => arg None None eta)
    (Data_encoding.union None
      [
        Data_encoding.__case_value "Operation_with_metadata" None
          (Data_encoding.Tag 0)
          (Data_encoding.obj2
            (Data_encoding.req None None "contents"
              (Data_encoding.dynamic_size None
                contents_and_result_list_encoding))
            (Data_encoding.opt None None "signature" Signature.encoding))
          (fun function_parameter =>
            match function_parameter with
            | (Alpha_context.Operation_data _, No_operation_metadata) =>
              None
            | (Alpha_context.Operation_data op, Operation_metadata res)
              =>
              match
                kind_equal_list
                  op.(Alpha_context.protocol_data.contents)
                  res.(operation_metadata.contents) with
              | None =>
                Pervasives.failwith
                  "cannot decode inconsistent combined operation result"
              | Some Eq =>
                Some
                  ((Contents_and_result_list
                    (pack_contents_list
                      op.(Alpha_context.protocol_data.contents)
                      res.(operation_metadata.contents))),
                    op.(Alpha_context.protocol_data.signature))
              end
            end)
          (fun function_parameter =>
            let '(Contents_and_result_list contents, signature) :=
              function_parameter in
            let '(op_contents, res_contents) :=
              unpack_contents_list contents in
            ((Alpha_context.Operation_data
              {|
                Alpha_context.protocol_data.contents :=
                  op_contents;
                Alpha_context.protocol_data.signature :=
                  signature |}),
              (Operation_metadata
                {| operation_metadata.contents := res_contents
                  |})));
        Data_encoding.__case_value "Operation_without_metadata" None
          (Data_encoding.Tag 1)
          (Data_encoding.obj2
            (Data_encoding.req None None "contents"
              (Data_encoding.dynamic_size None
                Alpha_context.Operation.contents_list_encoding))
            (Data_encoding.opt None None "signature" Signature.encoding))
          (fun function_parameter =>
            match function_parameter with
            | (Alpha_context.Operation_data op, No_operation_metadata)
              =>
              Some
                ((Alpha_context.Contents_list
                  op.(Alpha_context.protocol_data.contents)),
                  op.(Alpha_context.protocol_data.signature))
            | (Alpha_context.Operation_data _, Operation_metadata _) =>
              None
            end)
          (fun function_parameter =>
            let '(Alpha_context.Contents_list contents, signature) :=
              function_parameter in
            ((Alpha_context.Operation_data
              {| Alpha_context.protocol_data.contents := contents;
                Alpha_context.protocol_data.signature :=
                  signature |}), No_operation_metadata))
      ]).

Module block_metadata.
  Record record : Set := Build {
    baker : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t);
    level : Alpha_context.Level.t;
    voting_period_kind : Alpha_context.Voting_period.kind;
    nonce_hash : option Nonce_hash.t;
    consumed_gas : Z.t;
    deactivated : list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t);
    balance_updates : Alpha_context.Delegate.balance_updates }.
  Definition with_baker baker (r : record) :=
    Build baker r.(level) r.(voting_period_kind) r.(nonce_hash) r.(consumed_gas)
      r.(deactivated) r.(balance_updates).
  Definition with_level level (r : record) :=
    Build r.(baker) level r.(voting_period_kind) r.(nonce_hash) r.(consumed_gas)
      r.(deactivated) r.(balance_updates).
  Definition with_voting_period_kind voting_period_kind (r : record) :=
    Build r.(baker) r.(level) voting_period_kind r.(nonce_hash) r.(consumed_gas)
      r.(deactivated) r.(balance_updates).
  Definition with_nonce_hash nonce_hash (r : record) :=
    Build r.(baker) r.(level) r.(voting_period_kind) nonce_hash r.(consumed_gas)
      r.(deactivated) r.(balance_updates).
  Definition with_consumed_gas consumed_gas (r : record) :=
    Build r.(baker) r.(level) r.(voting_period_kind) r.(nonce_hash) consumed_gas
      r.(deactivated) r.(balance_updates).
  Definition with_deactivated deactivated (r : record) :=
    Build r.(baker) r.(level) r.(voting_period_kind) r.(nonce_hash)
      r.(consumed_gas) deactivated r.(balance_updates).
  Definition with_balance_updates balance_updates (r : record) :=
    Build r.(baker) r.(level) r.(voting_period_kind) r.(nonce_hash)
      r.(consumed_gas) r.(deactivated) balance_updates.
End block_metadata.
Definition block_metadata := block_metadata.record.

Definition block_metadata_encoding : Data_encoding.encoding block_metadata :=
  (let arg := Data_encoding.def "block_header.alpha.metadata" in
  fun eta => arg None None eta)
    (Data_encoding.conv
      (fun function_parameter =>
        let '{|
          block_metadata.baker := baker;
            block_metadata.level := level;
            block_metadata.voting_period_kind := voting_period_kind;
            block_metadata.nonce_hash := nonce_hash;
            block_metadata.consumed_gas := consumed_gas;
            block_metadata.deactivated := deactivated;
            block_metadata.balance_updates := balance_updates
            |} := function_parameter in
        (baker, level, voting_period_kind, nonce_hash, consumed_gas,
          deactivated, balance_updates))
      (fun function_parameter =>
        let
          '(baker, level, voting_period_kind, nonce_hash, consumed_gas,
            deactivated, balance_updates) := function_parameter in
        {| block_metadata.baker := baker; block_metadata.level := level;
          block_metadata.voting_period_kind := voting_period_kind;
          block_metadata.nonce_hash := nonce_hash;
          block_metadata.consumed_gas := consumed_gas;
          block_metadata.deactivated := deactivated;
          block_metadata.balance_updates := balance_updates |}) None
      (Data_encoding.obj7
        (Data_encoding.req None None "baker"
          (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding))
        (Data_encoding.req None None "level" Alpha_context.Level.encoding)
        (Data_encoding.req None None "voting_period_kind"
          Alpha_context.Voting_period.kind_encoding)
        (Data_encoding.req None None "nonce_hash"
          (Data_encoding.__option_value Nonce_hash.encoding))
        (Data_encoding.req None None "consumed_gas"
          (Data_encoding.check_size 10 Data_encoding.n))
        (Data_encoding.req None None "deactivated"
          (Data_encoding.__list_value None
            (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding)))
        (Data_encoding.req None None "balance_updates"
          Alpha_context.Delegate.balance_updates_encoding))).

Apply_results_mli

  • OCaml size: 191 lines
  • Coq size: 500 lines (+161% compared to OCaml)
apply_results.mli success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Result of applying an operation, can be used for experimenting
    with protocol updates, by clients to print out a summary of the
    operation at pre-injection simulation and at confirmation time,
    and by block explorers. *)

open Alpha_context

type packed_operation_metadata =
  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
  | No_operation_metadata : packed_operation_metadata

(** Result of applying a {!Operation.contents_list}. Follows the same structure. *)
and 'kind contents_result_list =
  | Single_result : 'kind contents_result -> 'kind contents_result_list
  | Cons_result :
      'kind Kind.manager contents_result
      * 'rest Kind.manager contents_result_list
      -> ('kind * 'rest) Kind.manager contents_result_list

(** Result of applying a {!Operation.t}. Follows the same structure. *)
and 'kind operation_metadata = {contents : 'kind contents_result_list}

and packed_contents_result_list =
  | Contents_result_list :
      'kind contents_result_list
      -> packed_contents_result_list

(** Result of applying an {!Operation.contents}. Follows the same structure. *)
and 'kind contents_result =
  | Endorsement_result : {
      balance_updates : Delegate.balance_updates;
      delegate : Signature.Public_key_hash.t;
      slots : int list;
    }
      -> Kind.endorsement contents_result
  | Seed_nonce_revelation_result :
      Delegate.balance_updates
      -> Kind.seed_nonce_revelation contents_result
  | Double_endorsement_evidence_result :
      Delegate.balance_updates
      -> Kind.double_endorsement_evidence contents_result
  | Double_baking_evidence_result :
      Delegate.balance_updates
      -> Kind.double_baking_evidence contents_result
  | Activate_account_result :
      Delegate.balance_updates
      -> Kind.activate_account contents_result
  | Proposals_result : Kind.proposals contents_result
  | Ballot_result : Kind.ballot contents_result
  | Manager_operation_result : {
      balance_updates : Delegate.balance_updates;
      operation_result : 'kind manager_operation_result;
      internal_operation_results : packed_internal_operation_result list;
    }
      -> 'kind Kind.manager contents_result

and packed_contents_result =
  | Contents_result : 'kind contents_result -> packed_contents_result

(** The result of an operation in the queue. [Skipped] ones should
    always be at the tail, and after a single [Failed]. *)
and 'kind manager_operation_result =
  | Applied of 'kind successful_manager_operation_result
  | Backtracked of
      'kind successful_manager_operation_result * error list option
  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result
[@@coq_force_gadt]

(** Result of applying a {!manager_operation_content}, either internal
    or external. *)
and _ successful_manager_operation_result =
  | Reveal_result : {
      consumed_gas : Z.t;
    }
      -> Kind.reveal successful_manager_operation_result
  | Transaction_result : {
      storage : Script.expr option;
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
      allocated_destination_contract : bool;
    }
      -> Kind.transaction successful_manager_operation_result
  | Origination_result : {
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
    }
      -> Kind.origination successful_manager_operation_result
  | Delegation_result : {
      consumed_gas : Z.t;
    }
      -> Kind.delegation successful_manager_operation_result

and packed_successful_manager_operation_result =
  | Successful_manager_result :
      'kind successful_manager_operation_result
      -> packed_successful_manager_operation_result

and packed_internal_operation_result =
  | Internal_operation_result :
      'kind internal_operation * 'kind manager_operation_result
      -> packed_internal_operation_result

(** Serializer for {!packed_operation_result}. *)
val operation_metadata_encoding : packed_operation_metadata Data_encoding.t

val operation_data_and_metadata_encoding :
  (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t

type 'kind contents_and_result_list =
  | Single_and_result :
      'kind Alpha_context.contents * 'kind contents_result
      -> 'kind contents_and_result_list
  | Cons_and_result :
      'kind Kind.manager Alpha_context.contents
      * 'kind Kind.manager contents_result
      * 'rest Kind.manager contents_and_result_list
      -> ('kind * 'rest) Kind.manager contents_and_result_list

type packed_contents_and_result_list =
  | Contents_and_result_list :
      'kind contents_and_result_list
      -> packed_contents_and_result_list

val contents_and_result_list_encoding :
  packed_contents_and_result_list Data_encoding.t

val pack_contents_list :
  'kind contents_list ->
  'kind contents_result_list ->
  'kind contents_and_result_list

val unpack_contents_list :
  'kind contents_and_result_list ->
  'kind contents_list * 'kind contents_result_list

val to_list : packed_contents_result_list -> packed_contents_result list

val of_list : packed_contents_result list -> packed_contents_result_list

type ('a, 'b) eq = Eq : ('a, 'a) eq

val kind_equal_list :
  'kind contents_list ->
  'kind2 contents_result_list ->
  ('kind, 'kind2) eq option

type block_metadata = {
  baker : Signature.Public_key_hash.t;
  level : Level.t;
  voting_period_kind : Voting_period.kind;
  nonce_hash : Nonce_hash.t option;
  consumed_gas : Z.t;
  deactivated : Signature.Public_key_hash.t list;
  balance_updates : Delegate.balance_updates;
}

val block_metadata_encoding : block_metadata Data_encoding.encoding
Apply_results_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Nonce_hash.

Import Alpha_context.

Module
  ConstructorRecords_packed_operation_metadata_contents_result_list_packed_contents_result_list_contents_result_packed_contents_result_manager_operation_result_successful_manager_operation_result_packed_successful_manager_operation_result_packed_internal_operation_result.
  Module contents_result.
    Module Endorsement_result.
      Record record {balance_updates delegate slots : Set} : Set := Build {
        balance_updates : balance_updates;
        delegate : delegate;
        slots : slots }.
      Arguments record : clear implicits.
      Definition with_balance_updates {t_balance_updates t_delegate t_slots}
        balance_updates (r : record t_balance_updates t_delegate t_slots) :=
        Build t_balance_updates t_delegate t_slots balance_updates r.(delegate)
          r.(slots).
      Definition with_delegate {t_balance_updates t_delegate t_slots} delegate
        (r : record t_balance_updates t_delegate t_slots) :=
        Build t_balance_updates t_delegate t_slots r.(balance_updates) delegate
          r.(slots).
      Definition with_slots {t_balance_updates t_delegate t_slots} slots
        (r : record t_balance_updates t_delegate t_slots) :=
        Build t_balance_updates t_delegate t_slots r.(balance_updates)
          r.(delegate) slots.
    End Endorsement_result.
    Definition Endorsement_result_skeleton := Endorsement_result.record.
    
    Module Manager_operation_result.
      Record record {balance_updates operation_result internal_operation_results
        : Set} : Set := Build {
        balance_updates : balance_updates;
        operation_result : operation_result;
        internal_operation_results : internal_operation_results }.
      Arguments record : clear implicits.
      Definition with_balance_updates
        {t_balance_updates t_operation_result t_internal_operation_results}
        balance_updates
        (r :
          record t_balance_updates t_operation_result
            t_internal_operation_results) :=
        Build t_balance_updates t_operation_result t_internal_operation_results
          balance_updates r.(operation_result) r.(internal_operation_results).
      Definition with_operation_result
        {t_balance_updates t_operation_result t_internal_operation_results}
        operation_result
        (r :
          record t_balance_updates t_operation_result
            t_internal_operation_results) :=
        Build t_balance_updates t_operation_result t_internal_operation_results
          r.(balance_updates) operation_result r.(internal_operation_results).
      Definition with_internal_operation_results
        {t_balance_updates t_operation_result t_internal_operation_results}
        internal_operation_results
        (r :
          record t_balance_updates t_operation_result
            t_internal_operation_results) :=
        Build t_balance_updates t_operation_result t_internal_operation_results
          r.(balance_updates) r.(operation_result) internal_operation_results.
    End Manager_operation_result.
    Definition Manager_operation_result_skeleton :=
      Manager_operation_result.record.
  End contents_result.
  Module successful_manager_operation_result.
    Module Reveal_result.
      Record record {consumed_gas : Set} : Set := Build {
        consumed_gas : consumed_gas }.
      Arguments record : clear implicits.
      Definition with_consumed_gas {t_consumed_gas} consumed_gas
        (r : record t_consumed_gas) :=
        Build t_consumed_gas consumed_gas.
    End Reveal_result.
    Definition Reveal_result_skeleton := Reveal_result.record.
    
    Module Transaction_result.
      Record record {storage big_map_diff balance_updates originated_contracts
        consumed_gas storage_size paid_storage_size_diff
        allocated_destination_contract : Set} : Set := Build {
        storage : storage;
        big_map_diff : big_map_diff;
        balance_updates : balance_updates;
        originated_contracts : originated_contracts;
        consumed_gas : consumed_gas;
        storage_size : storage_size;
        paid_storage_size_diff : paid_storage_size_diff;
        allocated_destination_contract : allocated_destination_contract }.
      Arguments record : clear implicits.
      Definition with_storage
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} storage
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract storage r.(big_map_diff)
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_big_map_diff
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} big_map_diff
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) big_map_diff
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_balance_updates
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} balance_updates
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          balance_updates r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_originated_contracts
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} originated_contracts
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          r.(balance_updates) originated_contracts r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_consumed_gas
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} consumed_gas
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          r.(balance_updates) r.(originated_contracts) consumed_gas
          r.(storage_size) r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_storage_size
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} storage_size
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          storage_size r.(paid_storage_size_diff)
          r.(allocated_destination_contract).
      Definition with_paid_storage_size_diff
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} paid_storage_size_diff
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) paid_storage_size_diff
          r.(allocated_destination_contract).
      Definition with_allocated_destination_contract
        {t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract} allocated_destination_contract
        (r :
          record t_storage t_big_map_diff t_balance_updates
            t_originated_contracts t_consumed_gas t_storage_size
            t_paid_storage_size_diff t_allocated_destination_contract) :=
        Build t_storage t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          t_allocated_destination_contract r.(storage) r.(big_map_diff)
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff)
          allocated_destination_contract.
    End Transaction_result.
    Definition Transaction_result_skeleton := Transaction_result.record.
    
    Module Origination_result.
      Record record {big_map_diff balance_updates originated_contracts
        consumed_gas storage_size paid_storage_size_diff : Set} : Set := Build {
        big_map_diff : big_map_diff;
        balance_updates : balance_updates;
        originated_contracts : originated_contracts;
        consumed_gas : consumed_gas;
        storage_size : storage_size;
        paid_storage_size_diff : paid_storage_size_diff }.
      Arguments record : clear implicits.
      Definition with_big_map_diff
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} big_map_diff
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff big_map_diff
          r.(balance_updates) r.(originated_contracts) r.(consumed_gas)
          r.(storage_size) r.(paid_storage_size_diff).
      Definition with_balance_updates
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} balance_updates
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          r.(big_map_diff) balance_updates r.(originated_contracts)
          r.(consumed_gas) r.(storage_size) r.(paid_storage_size_diff).
      Definition with_originated_contracts
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} originated_contracts
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          r.(big_map_diff) r.(balance_updates) originated_contracts
          r.(consumed_gas) r.(storage_size) r.(paid_storage_size_diff).
      Definition with_consumed_gas
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} consumed_gas
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          r.(big_map_diff) r.(balance_updates) r.(originated_contracts)
          consumed_gas r.(storage_size) r.(paid_storage_size_diff).
      Definition with_storage_size
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} storage_size
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          r.(big_map_diff) r.(balance_updates) r.(originated_contracts)
          r.(consumed_gas) storage_size r.(paid_storage_size_diff).
      Definition with_paid_storage_size_diff
        {t_big_map_diff t_balance_updates t_originated_contracts t_consumed_gas
          t_storage_size t_paid_storage_size_diff} paid_storage_size_diff
        (r :
          record t_big_map_diff t_balance_updates t_originated_contracts
            t_consumed_gas t_storage_size t_paid_storage_size_diff) :=
        Build t_big_map_diff t_balance_updates t_originated_contracts
          t_consumed_gas t_storage_size t_paid_storage_size_diff
          r.(big_map_diff) r.(balance_updates) r.(originated_contracts)
          r.(consumed_gas) r.(storage_size) paid_storage_size_diff.
    End Origination_result.
    Definition Origination_result_skeleton := Origination_result.record.
    
    Module Delegation_result.
      Record record {consumed_gas : Set} : Set := Build {
        consumed_gas : consumed_gas }.
      Arguments record : clear implicits.
      Definition with_consumed_gas {t_consumed_gas} consumed_gas
        (r : record t_consumed_gas) :=
        Build t_consumed_gas consumed_gas.
    End Delegation_result.
    Definition Delegation_result_skeleton := Delegation_result.record.
  End successful_manager_operation_result.
End
  ConstructorRecords_packed_operation_metadata_contents_result_list_packed_contents_result_list_contents_result_packed_contents_result_manager_operation_result_successful_manager_operation_result_packed_successful_manager_operation_result_packed_internal_operation_result.
Import
  ConstructorRecords_packed_operation_metadata_contents_result_list_packed_contents_result_list_contents_result_packed_contents_result_manager_operation_result_successful_manager_operation_result_packed_successful_manager_operation_result_packed_internal_operation_result.

Module operation_metadata.
  Record record {contents : Set} : Set := Build {
    contents : contents }.
  Arguments record : clear implicits.
  Definition with_contents {t_contents} contents (r : record t_contents) :=
    Build t_contents contents.
End operation_metadata.
Definition operation_metadata_skeleton := operation_metadata.record.

Reserved Notation "'contents_result.Endorsement_result".
Reserved Notation "'contents_result.Manager_operation_result".
Reserved Notation "'successful_manager_operation_result.Reveal_result".
Reserved Notation "'successful_manager_operation_result.Transaction_result".
Reserved Notation "'successful_manager_operation_result.Origination_result".
Reserved Notation "'successful_manager_operation_result.Delegation_result".
Reserved Notation "'operation_metadata".

Inductive packed_operation_metadata : Set :=
| Operation_metadata : 'operation_metadata -> packed_operation_metadata
| No_operation_metadata : packed_operation_metadata

with contents_result_list : Set :=
| Single_result : contents_result -> contents_result_list
| Cons_result : contents_result -> contents_result_list -> contents_result_list

with packed_contents_result_list : Set :=
| Contents_result_list : contents_result_list -> packed_contents_result_list

with contents_result : Set :=
| Endorsement_result : 'contents_result.Endorsement_result -> contents_result
| Seed_nonce_revelation_result :
  Alpha_context.Delegate.balance_updates -> contents_result
| Double_endorsement_evidence_result :
  Alpha_context.Delegate.balance_updates -> contents_result
| Double_baking_evidence_result :
  Alpha_context.Delegate.balance_updates -> contents_result
| Activate_account_result :
  Alpha_context.Delegate.balance_updates -> contents_result
| Proposals_result : contents_result
| Ballot_result : contents_result
| Manager_operation_result :
  'contents_result.Manager_operation_result -> contents_result

with packed_contents_result : Set :=
| Contents_result : contents_result -> packed_contents_result

with manager_operation_result : Set :=
| Applied : successful_manager_operation_result -> manager_operation_result
| Backtracked :
  successful_manager_operation_result -> option (list Error_monad.__error) ->
  manager_operation_result
| Failed :
  Alpha_context.Kind.manager -> list Error_monad.__error ->
  manager_operation_result
| Skipped : Alpha_context.Kind.manager -> manager_operation_result

with successful_manager_operation_result : Set :=
| Reveal_result :
  'successful_manager_operation_result.Reveal_result ->
  successful_manager_operation_result
| Transaction_result :
  'successful_manager_operation_result.Transaction_result ->
  successful_manager_operation_result
| Origination_result :
  'successful_manager_operation_result.Origination_result ->
  successful_manager_operation_result
| Delegation_result :
  'successful_manager_operation_result.Delegation_result ->
  successful_manager_operation_result

with packed_successful_manager_operation_result : Set :=
| Successful_manager_result :
  successful_manager_operation_result ->
  packed_successful_manager_operation_result

with packed_internal_operation_result : Set :=
| Internal_operation_result :
  Alpha_context.internal_operation -> manager_operation_result ->
  packed_internal_operation_result

where "'operation_metadata" :=
  (operation_metadata_skeleton contents_result_list)
and "'contents_result.Endorsement_result" :=
  (contents_result.Endorsement_result_skeleton
    Alpha_context.Delegate.balance_updates
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) (list int))
and "'contents_result.Manager_operation_result" :=
  (contents_result.Manager_operation_result_skeleton
    Alpha_context.Delegate.balance_updates manager_operation_result
    (list packed_internal_operation_result))
and "'successful_manager_operation_result.Reveal_result" :=
  (successful_manager_operation_result.Reveal_result_skeleton Z.t)
and "'successful_manager_operation_result.Transaction_result" :=
  (successful_manager_operation_result.Transaction_result_skeleton
    (option Alpha_context.Script.expr)
    (option Alpha_context.Contract.big_map_diff)
    Alpha_context.Delegate.balance_updates (list Alpha_context.Contract.t) Z.t
    Z.t Z.t bool)
and "'successful_manager_operation_result.Origination_result" :=
  (successful_manager_operation_result.Origination_result_skeleton
    (option Alpha_context.Contract.big_map_diff)
    Alpha_context.Delegate.balance_updates (list Alpha_context.Contract.t) Z.t
    Z.t Z.t)
and "'successful_manager_operation_result.Delegation_result" :=
  (successful_manager_operation_result.Delegation_result_skeleton Z.t).

Module contents_result.
  Include ConstructorRecords_packed_operation_metadata_contents_result_list_packed_contents_result_list_contents_result_packed_contents_result_manager_operation_result_successful_manager_operation_result_packed_successful_manager_operation_result_packed_internal_operation_result.contents_result.
  Definition Endorsement_result := 'contents_result.Endorsement_result.
  Definition Manager_operation_result :=
    'contents_result.Manager_operation_result.
End contents_result.
Module successful_manager_operation_result.
  Include ConstructorRecords_packed_operation_metadata_contents_result_list_packed_contents_result_list_contents_result_packed_contents_result_manager_operation_result_successful_manager_operation_result_packed_successful_manager_operation_result_packed_internal_operation_result.successful_manager_operation_result.
  Definition Reveal_result :=
    'successful_manager_operation_result.Reveal_result.
  Definition Transaction_result :=
    'successful_manager_operation_result.Transaction_result.
  Definition Origination_result :=
    'successful_manager_operation_result.Origination_result.
  Definition Delegation_result :=
    'successful_manager_operation_result.Delegation_result.
End successful_manager_operation_result.

Definition operation_metadata := 'operation_metadata.

Parameter operation_metadata_encoding :
  Data_encoding.t packed_operation_metadata.

Parameter operation_data_and_metadata_encoding :
  Data_encoding.t
    (Alpha_context.Operation.packed_protocol_data * packed_operation_metadata).

Inductive contents_and_result_list : Set :=
| Single_and_result :
  Alpha_context.contents -> contents_result -> contents_and_result_list
| Cons_and_result :
  Alpha_context.contents -> contents_result -> contents_and_result_list ->
  contents_and_result_list.

Inductive packed_contents_and_result_list : Set :=
| Contents_and_result_list :
  contents_and_result_list -> packed_contents_and_result_list.

Parameter contents_and_result_list_encoding :
  Data_encoding.t packed_contents_and_result_list.

Parameter pack_contents_list :
  Alpha_context.contents_list -> contents_result_list ->
  contents_and_result_list.

Parameter unpack_contents_list :
  contents_and_result_list -> Alpha_context.contents_list * contents_result_list.

Parameter to_list : packed_contents_result_list -> list packed_contents_result.

Parameter of_list : list packed_contents_result -> packed_contents_result_list.

Inductive eq : Set :=
| Eq : eq.

Parameter kind_equal_list :
  Alpha_context.contents_list -> contents_result_list -> option eq.

Module block_metadata.
  Record record : Set := Build {
    baker : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t);
    level : Alpha_context.Level.t;
    voting_period_kind : Alpha_context.Voting_period.kind;
    nonce_hash : option Nonce_hash.t;
    consumed_gas : Z.t;
    deactivated : list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t);
    balance_updates : Alpha_context.Delegate.balance_updates }.
  Definition with_baker baker (r : record) :=
    Build baker r.(level) r.(voting_period_kind) r.(nonce_hash) r.(consumed_gas)
      r.(deactivated) r.(balance_updates).
  Definition with_level level (r : record) :=
    Build r.(baker) level r.(voting_period_kind) r.(nonce_hash) r.(consumed_gas)
      r.(deactivated) r.(balance_updates).
  Definition with_voting_period_kind voting_period_kind (r : record) :=
    Build r.(baker) r.(level) voting_period_kind r.(nonce_hash) r.(consumed_gas)
      r.(deactivated) r.(balance_updates).
  Definition with_nonce_hash nonce_hash (r : record) :=
    Build r.(baker) r.(level) r.(voting_period_kind) nonce_hash r.(consumed_gas)
      r.(deactivated) r.(balance_updates).
  Definition with_consumed_gas consumed_gas (r : record) :=
    Build r.(baker) r.(level) r.(voting_period_kind) r.(nonce_hash) consumed_gas
      r.(deactivated) r.(balance_updates).
  Definition with_deactivated deactivated (r : record) :=
    Build r.(baker) r.(level) r.(voting_period_kind) r.(nonce_hash)
      r.(consumed_gas) deactivated r.(balance_updates).
  Definition with_balance_updates balance_updates (r : record) :=
    Build r.(baker) r.(level) r.(voting_period_kind) r.(nonce_hash)
      r.(consumed_gas) r.(deactivated) balance_updates.
End block_metadata.
Definition block_metadata := block_metadata.record.

Parameter block_metadata_encoding : Data_encoding.encoding block_metadata.

Baking

  • OCaml size: 400 lines
  • Coq size: 423 lines (+5% compared to OCaml)
baking.ml 19 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Misc

type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)

type error += Timestamp_too_early of Timestamp.t * Timestamp.t

(* `Permanent *)

type error += Unexpected_endorsement (* `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 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_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)

let minimal_time c priority pred_timestamp =
  let priority = Int32.of_int priority in
  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
  Lwt.return
    (cumsum_time_between_blocks
       pred_timestamp
       (Constants.time_between_blocks c)
       (Int32.succ priority))

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 = List.hd (Constants.time_between_blocks ctxt) in
  if Compare.Int32.(gap < 1l) then
    failwith "Baking.earlier_block_timestamp: past block."
  else
    Lwt.return (Period.mult (Int32.pred gap) step)
    >>=? fun delay ->
    Lwt.return Timestamp.(current_timestamp +? delay)
    >>=? fun result -> return result

let check_timestamp c priority pred_timestamp =
  minimal_time c priority pred_timestamp
  >>=? fun minimal_time ->
  let timestamp = Alpha_context.Timestamp.current c in
  Lwt.return
    (record_trace
       (Timestamp_too_early (minimal_time, timestamp))
       Timestamp.(timestamp -? minimal_time))

let check_baking_rights c {Block_header_repr.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 block_delay -> return (delegate, block_delay)

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 \
     endosers_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 baking_reward ctxt ~block_priority:prio ~included_endorsements:num_endo =
  fail_unless Compare.Int.(prio >= 0) Incorrect_priority
  >>=? fun () ->
  let max_endorsements = Constants.endorsers_per_block ctxt in
  fail_unless
    Compare.Int.(num_endo >= 0 && num_endo <= max_endorsements)
    Incorrect_number_of_endorsements
  >>=? fun () ->
  let prio_factor_denominator = Int64.(succ (of_int prio)) in
  let endo_factor_numerator =
    Int64.of_int (8 + (2 * num_endo / max_endorsements))
  in
  let endo_factor_denominator = 10L in
  Lwt.return
    Tez.(
      Constants.block_reward ctxt *? endo_factor_numerator
      >>? fun val1 ->
      val1 /? endo_factor_denominator
      >>? fun val2 -> val2 /? prio_factor_denominator)

let endorsing_reward ctxt ~block_priority:prio n =
  if Compare.Int.(prio >= 0) then
    Lwt.return
      Tez.(Constants.endorsement_reward ctxt /? Int64.(succ (of_int prio)))
    >>=? fun tez -> Lwt.return Tez.(tez *? Int64.of_int n)
  else fail Incorrect_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_rights c level =
  fold_left_s
    (fun acc slot ->
      Roll.endorsement_rights_owner c 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
      return (Signature.Public_key_hash.Map.add pkh right acc))
    Signature.Public_key_hash.Map.empty
    (0 --> (Constants.endorsers_per_block c - 1))

let check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t)
    =
  let current_level = Level.current ctxt in
  match[@coq_match_with_default] op.protocol_data.contents with
  | Single (Endorsement {level; _}) -> (
      ( 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.fold (* no find_first *)
          (fun pkh (pk, slots, used) acc ->
            match Operation.check_signature_sync pk chain_id op with
            | Error _ ->
                acc
            | Ok () ->
                Some (pkh, slots, used))
          endorsements
          None
      with
      | None ->
          fail Unexpected_endorsement
      | Some v ->
          return 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 = MBytes.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_repr.shell
      block.protocol_data.contents
      proof_of_work_threshold
  then return_unit
  else fail Invalid_stamp

let check_signature block chain_id key =
  let check_signature key
      {Block_header_repr.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.block_header) =
  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_unit

let last_of_a_cycle ctxt l =
  Compare.Int32.(
    Int32.succ l.Level.cycle_position = Constants.blocks_per_cycle 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

let minimum_allowed_endorsements ctxt ~block_delay =
  let minimum = Constants.initial_endorsers ctxt in
  let delay_per_missing_endorsement =
    Int64.to_int
      (Period.to_seconds (Constants.delay_per_missing_endorsement ctxt))
  in
  let reduced_time_constraint =
    let delay = Int64.to_int (Period.to_seconds block_delay) in
    if Compare.Int.(delay_per_missing_endorsement = 0) then delay
    else delay / delay_per_missing_endorsement
  in
  Compare.Int.max 0 (minimum - reduced_time_constraint)

let minimal_valid_time ctxt ~priority ~endorsing_power =
  let predecessor_timestamp = Timestamp.current ctxt in
  minimal_time ctxt priority predecessor_timestamp
  >>=? fun minimal_time ->
  let minimal_required_endorsements = Constants.initial_endorsers ctxt in
  let delay_per_missing_endorsement =
    Constants.delay_per_missing_endorsement ctxt
  in
  let missing_endorsements =
    Compare.Int.max 0 (minimal_required_endorsements - endorsing_power)
  in
  match
    Period.mult
      (Int32.of_int missing_endorsements)
      delay_per_missing_endorsement
  with
  | Ok delay ->
      return (Time.add minimal_time (Period.to_seconds delay))
  | Error error ->
      Lwt.return (Error error)
Baking.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Unset Guard Checking.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Block_header_repr.
Require Tezos.Misc.

Import Alpha_context.

Import Misc.

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Top-level evaluations are ignored *)
(* top_level_evaluation *)

Definition minimal_time
  (c : Alpha_context.context) (priority : int)
  (pred_timestamp : Alpha_context.Timestamp.time)
  : Lwt.t (Error_monad.tzresult Alpha_context.Timestamp.time) :=
  let priority := Int32.of_int priority in
  let fix cumsum_time_between_blocks
    (acc : Alpha_context.Timestamp.time)
    (durations : list Alpha_context.Period.period)
    (__p_value : (|Compare.Int32|).(Compare.S.t)) {struct acc}
    : Error_monad.tzresult Alpha_context.Timestamp.time :=
    if
      (|Compare.Int32|).(Compare.S.op_lteq) __p_value
        (* ❌ Constant of type int32 is converted to int *)
        0 then
      Error_monad.ok acc
    else
      match durations with
      | [] =>
        cumsum_time_between_blocks acc [ Alpha_context.Period.one_minute ]
          __p_value
      | cons last [] =>
        let? period := Alpha_context.Period.mult __p_value last in
        Alpha_context.Timestamp.op_plusquestion acc period
      | cons first durations =>
        let? acc := Alpha_context.Timestamp.op_plusquestion acc first in
        let __p_value := Int32.pred __p_value in
        cumsum_time_between_blocks acc durations __p_value
      end in
  Lwt.__return
    (cumsum_time_between_blocks pred_timestamp
      (Alpha_context.Constants.time_between_blocks c) (Int32.succ priority)).

Definition earlier_predecessor_timestamp
  (ctxt : Alpha_context.context) (level : Alpha_context.Level.level)
  : Lwt.t (Error_monad.tzresult Alpha_context.Timestamp.time) :=
  let current := Alpha_context.Level.current ctxt in
  let current_timestamp := Alpha_context.Timestamp.current ctxt in
  let gap := Alpha_context.Level.diff level current in
  let step := List.hd (Alpha_context.Constants.time_between_blocks ctxt) in
  if
    (|Compare.Int32|).(Compare.S.op_lt) gap
      (* ❌ Constant of type int32 is converted to int *)
      1 then
    Pervasives.failwith "Baking.earlier_block_timestamp: past block."
  else
    let=? delay :=
      Lwt.__return (Alpha_context.Period.mult (Int32.pred gap) step) in
    let=? __result_value :=
      Lwt.__return
        (Alpha_context.Timestamp.op_plusquestion current_timestamp delay) in
    Error_monad.__return __result_value.

Definition check_timestamp
  (c : Alpha_context.context) (priority : int)
  (pred_timestamp : Alpha_context.Timestamp.time)
  : Lwt.t (Error_monad.tzresult Alpha_context.Period.t) :=
  let=? minimal_time := minimal_time c priority pred_timestamp in
  let timestamp := Alpha_context.Timestamp.current c in
  Lwt.__return
    (Error_monad.record_trace extensible_type_value
      (Alpha_context.Timestamp.op_minusquestion timestamp minimal_time)).

Definition check_baking_rights
  (c : Alpha_context.context) (function_parameter : Block_header_repr.contents)
  : Alpha_context.Timestamp.time ->
  Lwt.t
    (Error_monad.tzresult (Alpha_context.public_key * Alpha_context.Period.t)) :=
  let '{| Block_header_repr.contents.priority := priority |} :=
    function_parameter in
  fun pred_timestamp =>
    let level := Alpha_context.Level.current c in
    let=? delegate := Alpha_context.Roll.baking_rights_owner c level priority in
    let=? block_delay := check_timestamp c priority pred_timestamp in
    Error_monad.__return (delegate, block_delay).

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Top-level evaluations are ignored *)
(* top_level_evaluation *)

(* ❌ Top-level evaluations are ignored *)
(* top_level_evaluation *)

Definition baking_reward
  (ctxt : Alpha_context.context) (prio : (|Compare.Int|).(Compare.S.t))
  (num_endo : (|Compare.Int|).(Compare.S.t))
  : Lwt.t (Error_monad.tzresult Alpha_context.Tez.tez) :=
  let=? '_ :=
    Error_monad.fail_unless ((|Compare.Int|).(Compare.S.op_gteq) prio 0)
      extensible_type_value in
  let max_endorsements := Alpha_context.Constants.endorsers_per_block ctxt in
  let=? '_ :=
    Error_monad.fail_unless
      (Pervasives.op_andand ((|Compare.Int|).(Compare.S.op_gteq) num_endo 0)
        ((|Compare.Int|).(Compare.S.op_lteq) num_endo max_endorsements))
      extensible_type_value in
  let prio_factor_denominator := Int64.succ (Int64.of_int prio) in
  let endo_factor_numerator :=
    Int64.of_int
      (Pervasives.op_plus 8
        (Pervasives.op_div (Pervasives.op_star 2 num_endo) max_endorsements)) in
  let endo_factor_denominator :=
    (* ❌ Constant of type int64 is converted to int *)
    10 in
  Lwt.__return
    (let? val1 :=
      Alpha_context.Tez.op_starquestion
        (Alpha_context.Constants.block_reward ctxt) endo_factor_numerator in
    let? val2 := Alpha_context.Tez.op_divquestion val1 endo_factor_denominator
      in
    Alpha_context.Tez.op_divquestion val2 prio_factor_denominator).

Definition endorsing_reward
  (ctxt : Alpha_context.context) (prio : (|Compare.Int|).(Compare.S.t))
  (n : int) : Lwt.t (Error_monad.tzresult Alpha_context.Tez.tez) :=
  if (|Compare.Int|).(Compare.S.op_gteq) prio 0 then
    let=? tez :=
      Lwt.__return
        (Alpha_context.Tez.op_divquestion
          (Alpha_context.Constants.endorsement_reward ctxt)
          (Int64.succ (Int64.of_int prio))) in
    Lwt.__return (Alpha_context.Tez.op_starquestion tez (Int64.of_int n))
  else
    Error_monad.fail extensible_type_value.

Definition baking_priorities
  (c : Alpha_context.context) (level : Alpha_context.Level.t)
  : Lwt.t (Error_monad.tzresult (Misc.lazy_list_t Alpha_context.public_key)) :=
  let fix f (priority : int) {struct priority}
    : Lwt.t (Error_monad.tzresult (Misc.lazy_list_t Alpha_context.public_key)) :=
    let=? delegate := Alpha_context.Roll.baking_rights_owner c level priority in
    Error_monad.__return
      (Misc.LCons delegate
        (fun function_parameter =>
          let '_ := function_parameter in
          f (Pervasives.succ priority))) in
  f 0.

Definition endorsement_rights
  (c : Alpha_context.context) (level : Alpha_context.Level.t)
  : Lwt.t
    (Error_monad.tzresult
      ((|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.t)
        (Alpha_context.public_key * list int * bool))) :=
  Error_monad.fold_left_s
    (fun acc =>
      fun slot =>
        let=? pk := Alpha_context.Roll.endorsement_rights_owner c level slot in
        let pkh := (|Signature.Public_key|).(S.SPublic_key.__hash_value) pk in
        let __right :=
          match
            (|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.find_opt)
              pkh acc with
          | None => (pk, [ slot ], false)
          | Some (pk, slots, used) => (pk, (cons slot slots), used)
          end in
        Error_monad.__return
          ((|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.add)
            pkh __right acc))
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.empty)
    (Misc.op_minusminusgt 0
      (Pervasives.op_minus (Alpha_context.Constants.endorsers_per_block c) 1)).

Definition check_endorsement_rights
  (ctxt : Alpha_context.context) (chain_id : (|Chain_id|).(S.HASH.t))
  (op : Alpha_context.Operation.t)
  : Lwt.t
    (Error_monad.tzresult
      ((|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.key)
        * list int * bool)) :=
  let current_level := Alpha_context.Level.current ctxt in
  match
    op.(Alpha_context.operation.protocol_data).(Alpha_context.protocol_data.contents)
    with
  |
    Alpha_context.Single
      (Alpha_context.Endorsement {|
        Alpha_context.contents.Endorsement.level := level |}) =>
    let=? endorsements :=
      if
        Alpha_context.Raw_level.op_eq (Alpha_context.Raw_level.succ level)
          current_level.(Alpha_context.Level.t.level) then
        Error_monad.__return (Alpha_context.allowed_endorsements ctxt)
      else
        endorsement_rights ctxt (Alpha_context.Level.from_raw ctxt None level)
      in
    match
      (|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.fold)
        (fun pkh =>
          fun function_parameter =>
            let '(pk, slots, used) := function_parameter in
            fun acc =>
              match Alpha_context.Operation.check_signature_sync pk chain_id op
                with
              | Pervasives.Error _ => acc
              | Pervasives.Ok _ => Some (pkh, slots, used)
              end) endorsements None with
    | None => Error_monad.fail extensible_type_value
    | Some v => Error_monad.__return v
    end
  | _ => unreachable_gadt_branch
  end.

Definition select_delegate
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (delegate_list : Misc.lazy_list_t (|Signature.Public_key|).(S.SPublic_key.t))
  (max_priority : (|Compare.Int|).(Compare.S.t))
  : Lwt.t (Error_monad.tzresult (list (|Compare.Int|).(Compare.S.t))) :=
  let fix loop
    (acc : list (|Compare.Int|).(Compare.S.t))
    (l : Misc.lazy_list_t (|Signature.Public_key|).(S.SPublic_key.t))
    (n : (|Compare.Int|).(Compare.S.t)) {struct acc}
    : Lwt.t (Error_monad.tzresult (list (|Compare.Int|).(Compare.S.t))) :=
    if (|Compare.Int|).(Compare.S.op_gteq) n max_priority then
      Error_monad.__return (List.rev acc)
    else
      let 'Misc.LCons pk __t_value := l in
      let acc :=
        if
          (|Signature.Public_key_hash|).(S.SPublic_key_hash.equal) delegate
            ((|Signature.Public_key|).(S.SPublic_key.__hash_value) pk) then
          cons n acc
        else
          acc in
      let=? __t_value := __t_value tt in
      loop acc __t_value (Pervasives.succ n) in
  loop nil delegate_list 0.

Definition first_baking_priorities
  (ctxt : Alpha_context.context)
  (op_staroptstar : option (|Compare.Int|).(Compare.S.t))
  : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Alpha_context.Level.t ->
  Lwt.t (Error_monad.tzresult (list (|Compare.Int|).(Compare.S.t))) :=
  let max_priority :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => 32
    end in
  fun delegate =>
    fun level =>
      let=? delegate_list := baking_priorities ctxt level in
      select_delegate delegate delegate_list max_priority.

Definition check_hash
  (__hash_value : (|Block_hash|).(S.HASH.t))
  (stamp_threshold : (|Compare.Uint64|).(Compare.S.t)) : bool :=
  let __bytes_value := (|Block_hash|).(S.HASH.to_bytes) __hash_value in
  let word := MBytes.get_int64 __bytes_value 0 in
  (|Compare.Uint64|).(Compare.S.op_lteq) word stamp_threshold.

Definition check_header_proof_of_work_stamp
  (shell : Block_header.shell_header)
  (contents : Alpha_context.Block_header.contents)
  (stamp_threshold : (|Compare.Uint64|).(Compare.S.t)) : bool :=
  let __hash_value :=
    Alpha_context.Block_header.__hash_value
      {| Alpha_context.Block_header.block_header.shell := shell;
        Alpha_context.Block_header.block_header.protocol_data :=
          {| Alpha_context.Block_header.protocol_data.contents := contents;
            Alpha_context.Block_header.protocol_data.signature := Signature.zero
            |} |} in
  check_hash __hash_value stamp_threshold.

Definition check_proof_of_work_stamp
  (ctxt : Alpha_context.context) (block : Block_header_repr.block_header)
  : Lwt.t (Error_monad.tzresult unit) :=
  let proof_of_work_threshold :=
    Alpha_context.Constants.proof_of_work_threshold ctxt in
  if
    check_header_proof_of_work_stamp
      block.(Block_header_repr.block_header.shell)
      block.(Block_header_repr.block_header.protocol_data).(Block_header_repr.protocol_data.contents)
      proof_of_work_threshold then
    Error_monad.return_unit
  else
    Error_monad.fail extensible_type_value.

Definition check_signature
  (block : Block_header_repr.block_header) (chain_id : (|Chain_id|).(S.HASH.t))
  (__key_value : (|Signature.Public_key|).(S.SPublic_key.t))
  : Lwt.t (Error_monad.tzresult unit) :=
  let check_signature
    (__key_value : (|Signature.Public_key|).(S.SPublic_key.t))
    (function_parameter : Block_header_repr.block_header) : bool :=
    let '{|
      Block_header_repr.block_header.shell := shell;
        Block_header_repr.block_header.protocol_data := {|
          Block_header_repr.protocol_data.contents := contents;
            Block_header_repr.protocol_data.signature := signature
            |}
        |} := function_parameter in
    let unsigned_header :=
      Data_encoding.Binary.to_bytes_exn
        Alpha_context.Block_header.unsigned_encoding (shell, contents) in
    Signature.check (Some (Signature.Block_header chain_id)) __key_value
      signature unsigned_header in
  if check_signature __key_value block then
    Error_monad.return_unit
  else
    Error_monad.fail extensible_type_value.

Definition max_fitness_gap {A : Set} (_ctxt : A) : int64 :=
  (* ❌ Constant of type int64 is converted to int *)
  1.

Definition check_fitness_gap
  (ctxt : Alpha_context.context)
  (block : Alpha_context.Block_header.block_header)
  : Lwt.t (Error_monad.tzresult unit) :=
  let current_fitness := Alpha_context.Fitness.current ctxt in
  let=? announced_fitness :=
    Lwt.__return
      (Alpha_context.Fitness.to_int64
        block.(Alpha_context.Block_header.block_header.shell).(Block_header.shell_header.fitness))
    in
  let gap := Int64.sub announced_fitness current_fitness in
  if
    Pervasives.op_pipepipe
      ((|Compare.Int64|).(Compare.S.op_lteq) gap
        (* ❌ Constant of type int64 is converted to int *)
        0) ((|Compare.Int64|).(Compare.S.op_lt) (max_fitness_gap ctxt) gap) then
    Error_monad.fail extensible_type_value
  else
    Error_monad.return_unit.

Definition last_of_a_cycle
  (ctxt : Alpha_context.context) (l : Alpha_context.Level.t) : bool :=
  (|Compare.Int32|).(Compare.S.op_eq)
    (Int32.succ l.(Alpha_context.Level.t.cycle_position))
    (Alpha_context.Constants.blocks_per_cycle ctxt).

Definition dawn_of_a_new_cycle (ctxt : Alpha_context.context)
  : Lwt.t (Error_monad.tzresult (option Alpha_context.Cycle.t)) :=
  let level := Alpha_context.Level.current ctxt in
  if last_of_a_cycle ctxt level then
    Error_monad.return_some level.(Alpha_context.Level.t.cycle)
  else
    Error_monad.return_none.

Definition minimum_allowed_endorsements
  (ctxt : Alpha_context.context) (block_delay : Alpha_context.Period.period)
  : (|Compare.Int|).(Compare.S.t) :=
  let minimum := Alpha_context.Constants.initial_endorsers ctxt in
  let delay_per_missing_endorsement :=
    Int64.to_int
      (Alpha_context.Period.to_seconds
        (Alpha_context.Constants.delay_per_missing_endorsement ctxt)) in
  let reduced_time_constraint :=
    let delay := Int64.to_int (Alpha_context.Period.to_seconds block_delay) in
    if (|Compare.Int|).(Compare.S.op_eq) delay_per_missing_endorsement 0 then
      delay
    else
      Pervasives.op_div delay delay_per_missing_endorsement in
  (|Compare.Int|).(Compare.S.max) 0
    (Pervasives.op_minus minimum reduced_time_constraint).

Definition minimal_valid_time
  (ctxt : Alpha_context.context) (priority : int) (endorsing_power : int)
  : Lwt.t (Error_monad.tzresult Time.t) :=
  let predecessor_timestamp := Alpha_context.Timestamp.current ctxt in
  let=? minimal_time := minimal_time ctxt priority predecessor_timestamp in
  let minimal_required_endorsements :=
    Alpha_context.Constants.initial_endorsers ctxt in
  let delay_per_missing_endorsement :=
    Alpha_context.Constants.delay_per_missing_endorsement ctxt in
  let missing_endorsements :=
    (|Compare.Int|).(Compare.S.max) 0
      (Pervasives.op_minus minimal_required_endorsements endorsing_power) in
  match
    Alpha_context.Period.mult (Int32.of_int missing_endorsements)
      delay_per_missing_endorsement with
  | Pervasives.Ok delay =>
    Error_monad.__return
      (Time.add minimal_time (Alpha_context.Period.to_seconds delay))
  | Pervasives.Error __error_value =>
    Lwt.__return (Pervasives.Error __error_value)
  end.

Baking_mli

  • OCaml size: 166 lines
  • Coq size: 95 lines (-43% compared to OCaml)
baking.mli 6 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Misc

type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)

type error += Timestamp_too_early of Timestamp.t * Timestamp.t

(* `Permanent *)

type error +=
  | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t

(* `Permanent *)

type error += Unexpected_endorsement

type error += Invalid_signature (* `Permanent *)

type error += Invalid_stamp (* `Permanent *)

(** [minimal_time ctxt priority pred_block_time] returns the minimal
    time, given the predecessor block timestamp [pred_block_time],
    after which a baker with priority [priority] is allowed to
    bake. Fail with [Invalid_time_between_blocks_constant] if the minimal
    time cannot be computed. *)
val minimal_time : context -> int -> Time.t -> Time.t tzresult Lwt.t

(** [check_baking_rights ctxt block pred_timestamp] verifies that:
    * the contract that owned the roll at cycle start has the block signer as delegate.
    * the timestamp is coherent with the announced slot.
*)
val check_baking_rights :
  context ->
  Block_header.contents ->
  Time.t ->
  (public_key * Period.t) tzresult Lwt.t

(** For a given level computes who has the right to
    include an endorsement in the next block.
    The result can be stored in Alpha_context.allowed_endorsements *)
val endorsement_rights :
  context ->
  Level.t ->
  (public_key * int list * bool) Signature.Public_key_hash.Map.t tzresult Lwt.t

(** Check that the operation was signed by a delegate allowed
    to endorse at the level specified by the endorsement. *)
val check_endorsement_rights :
  context ->
  Chain_id.t ->
  Kind.endorsement Operation.t ->
  (public_key_hash * int list * bool) tzresult Lwt.t

(** Returns the baking reward calculated w.r.t a given priority [p] and a
    number [e] of included endorsements as follows:
      (block_reward / (p+1)) * (0.8 + 0.2 * e / endorsers_per_block)
*)
val baking_reward :
  context ->
  block_priority:int ->
  included_endorsements:int ->
  Tez.t tzresult Lwt.t

(** Returns the endorsing reward calculated w.r.t a given priority.  *)
val endorsing_reward :
  context -> block_priority:int -> int -> Tez.t tzresult Lwt.t

(** [baking_priorities ctxt level] is the lazy list of contract's
    public key hashes that are allowed to bake for [level]. *)
val baking_priorities : context -> Level.t -> public_key lazy_list

(** [first_baking_priorities ctxt ?max_priority contract_hash level]
    is a list of priorities of max [?max_priority] elements, where the
    delegate of [contract_hash] is allowed to bake for [level]. If
    [?max_priority] is [None], a sensible number of priorities is
    returned. *)
val first_baking_priorities :
  context ->
  ?max_priority:int ->
  public_key_hash ->
  Level.t ->
  int list tzresult Lwt.t

(** [check_signature ctxt chain_id block id] check if the block is
    signed with the given key, and belongs to the given [chain_id] *)
val check_signature :
  Block_header.block_header -> Chain_id.t -> public_key -> unit tzresult Lwt.t

(** Checks if the header that would be built from the given components
    is valid for the given diffculty. The signature is not passed as it
    is does not impact the proof-of-work stamp. The stamp is checked on
    the hash of a block header whose signature has been zeroed-out. *)
val check_header_proof_of_work_stamp :
  Block_header.shell_header -> Block_header.contents -> int64 -> bool

(** verify if the proof of work stamp is valid *)
val check_proof_of_work_stamp :
  context -> Block_header.block_header -> unit tzresult Lwt.t

(** check if the gap between the fitness of the current context
    and the given block is within the protocol parameters *)
val check_fitness_gap :
  context -> Block_header.block_header -> unit tzresult Lwt.t

val dawn_of_a_new_cycle : context -> Cycle.t option tzresult Lwt.t

val earlier_predecessor_timestamp :
  context -> Level.t -> Timestamp.t tzresult Lwt.t

(** Since Emmy+

    A block is valid only if its timestamp has a minimal delay with
    respect to the previous block's timestamp, and this minimal delay
    depends not only on the block's priority but also on the number of
    endorsement operations included in the block.

    In Emmy+, blocks' fitness increases by one unit with each level.

    In this way, Emmy+ simplifies the optimal baking strategy: The
    bakers used to have to choose whether to wait for more endorsements
    to include in their block, or to publish the block immediately,
    without waiting. The incentive for including more endorsements was
    to increase the fitness and win against unknown blocks. However,
    when a block was produced too late in the priority period, there
    was the risk that the block did not reach endorsers before the
    block of next priority. In Emmy+, the baker does not need to take
    such a decision, because the baker cannot publish a block too
    early. *)

(** Given a delay of a block's timestamp with respect to the minimum
    time to bake at the block's priority (as returned by
    `minimum_time`), it returns the minimum number of endorsements that
    the block has to contain *)
val minimum_allowed_endorsements : context -> block_delay:Period.t -> int

(** This is the somehow the dual of the previous function. Given a
    block priority and a number of endorsement slots (given by the
    `endorsing_power` argument), it returns the minimum time at which
    the next block can be baked. *)
val minimal_valid_time :
  context -> priority:int -> endorsing_power:int -> Time.t tzresult Lwt.t
Baking_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Misc.

Import Alpha_context.

Import Misc.

(* extensible_type_definition `error` *)

(* extensible_type_definition `error` *)

(* extensible_type_definition `error` *)

(* extensible_type_definition `error` *)

(* extensible_type_definition `error` *)

(* extensible_type_definition `error` *)

Parameter minimal_time :
  Alpha_context.context -> int -> Time.t -> Lwt.t (Error_monad.tzresult Time.t).

Parameter check_baking_rights :
  Alpha_context.context -> Alpha_context.Block_header.contents -> Time.t ->
  Lwt.t
    (Error_monad.tzresult (Alpha_context.public_key * Alpha_context.Period.t)).

Parameter endorsement_rights :
  Alpha_context.context -> Alpha_context.Level.t ->
  Lwt.t
    (Error_monad.tzresult
      ((|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.t)
        (Alpha_context.public_key * list int * bool))).

Parameter check_endorsement_rights :
  Alpha_context.context -> (|Chain_id|).(S.HASH.t) ->
  Alpha_context.Operation.t ->
  Lwt.t (Error_monad.tzresult (Alpha_context.public_key_hash * list int * bool)).

Parameter baking_reward :
  Alpha_context.context -> int -> int ->
  Lwt.t (Error_monad.tzresult Alpha_context.Tez.t).

Parameter endorsing_reward :
  Alpha_context.context -> int -> int ->
  Lwt.t (Error_monad.tzresult Alpha_context.Tez.t).

Parameter baking_priorities :
  Alpha_context.context -> Alpha_context.Level.t ->
  Misc.lazy_list Alpha_context.public_key.

Parameter first_baking_priorities :
  Alpha_context.context -> option int -> Alpha_context.public_key_hash ->
  Alpha_context.Level.t -> Lwt.t (Error_monad.tzresult (list int)).

Parameter check_signature :
  Alpha_context.Block_header.block_header -> (|Chain_id|).(S.HASH.t) ->
  Alpha_context.public_key -> Lwt.t (Error_monad.tzresult unit).

Parameter check_header_proof_of_work_stamp :
  Alpha_context.Block_header.shell_header ->
  Alpha_context.Block_header.contents -> int64 -> bool.

Parameter check_proof_of_work_stamp :
  Alpha_context.context -> Alpha_context.Block_header.block_header ->
  Lwt.t (Error_monad.tzresult unit).

Parameter check_fitness_gap :
  Alpha_context.context -> Alpha_context.Block_header.block_header ->
  Lwt.t (Error_monad.tzresult unit).

Parameter dawn_of_a_new_cycle :
  Alpha_context.context ->
  Lwt.t (Error_monad.tzresult (option Alpha_context.Cycle.t)).

Parameter earlier_predecessor_timestamp :
  Alpha_context.context -> Alpha_context.Level.t ->
  Lwt.t (Error_monad.tzresult Alpha_context.Timestamp.t).

Parameter minimum_allowed_endorsements :
  Alpha_context.context -> Alpha_context.Period.t -> int.

Parameter minimal_valid_time :
  Alpha_context.context -> int -> int -> Lwt.t (Error_monad.tzresult Time.t).

Blinded_public_key_hash

  • OCaml size: 57 lines
  • Coq size: 137 lines (+140% compared to OCaml)
blinded_public_key_hash.ml 2 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module H =
  Blake2B.Make
    (Base58)
    (struct
      let name = "Blinded public key hash"

      let title = "A blinded public key hash"

      let b58check_prefix = "\001\002\049\223"

      let size = Some Ed25519.Public_key_hash.size
    end)

include H

let () = Base58.check_encoded_prefix b58check_encoding "btz1" 37

let of_ed25519_pkh activation_code pkh =
  hash_bytes ~key:activation_code [Ed25519.Public_key_hash.to_bytes pkh]

type activation_code = MBytes.t

let activation_code_size = Ed25519.Public_key_hash.size

let activation_code_encoding = Data_encoding.Fixed.bytes activation_code_size

let activation_code_of_hex h =
  if Compare.Int.(String.length h <> activation_code_size * 2) then
    invalid_arg "Blinded_public_key_hash.activation_code_of_hex" ;
  MBytes.of_hex (`Hex h)

module Index : Storage_description.INDEX with type t = t = H
Blinded_public_key_hash.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Storage_description.

Definition H :=
  (Blake2B.Make
    (existT (A := unit) (fun _ => _) tt
      {|
        Blake2B.SRegister.register_encoding {_} := Base58.register_encoding
      |}))
    (let name := "Blinded public key hash" in
    let title := "A blinded public key hash" in
    let b58check_prefix := "\001\0021\223" in
    let size :=
      Some (|Ed25519|).(S.SIGNATURE.Public_key_hash).(S.SPublic_key_hash.size)
      in
    existT (A := unit) (fun _ => _) tt
      {|
        Blake2B.PrefixedName.name := name;
        Blake2B.PrefixedName.title := title;
        Blake2B.PrefixedName.size := size;
        Blake2B.PrefixedName.b58check_prefix := b58check_prefix
      |}).

Definition t := (|H|).(S.HASH.t).

Definition name := (|H|).(S.HASH.name).

Definition title := (|H|).(S.HASH.title).

Definition pp := (|H|).(S.HASH.pp).

Definition pp_short := (|H|).(S.HASH.pp_short).

Definition op_eq := (|H|).(S.HASH.op_eq).

Definition op_ltgt := (|H|).(S.HASH.op_ltgt).

Definition op_lt := (|H|).(S.HASH.op_lt).

Definition op_lteq := (|H|).(S.HASH.op_lteq).

Definition op_gteq := (|H|).(S.HASH.op_gteq).

Definition op_gt := (|H|).(S.HASH.op_gt).

Definition compare := (|H|).(S.HASH.compare).

Definition equal := (|H|).(S.HASH.equal).

Definition max := (|H|).(S.HASH.max).

Definition min := (|H|).(S.HASH.min).

Definition hash_bytes := (|H|).(S.HASH.hash_bytes).

Definition hash_string := (|H|).(S.HASH.hash_string).

Definition zero := (|H|).(S.HASH.zero).

Definition size := (|H|).(S.HASH.size).

Definition to_bytes := (|H|).(S.HASH.to_bytes).

Definition of_bytes_opt := (|H|).(S.HASH.of_bytes_opt).

Definition of_bytes_exn := (|H|).(S.HASH.of_bytes_exn).

Definition to_b58check := (|H|).(S.HASH.to_b58check).

Definition to_short_b58check := (|H|).(S.HASH.to_short_b58check).

Definition of_b58check_exn := (|H|).(S.HASH.of_b58check_exn).

Definition of_b58check_opt := (|H|).(S.HASH.of_b58check_opt).

Definition b58check_encoding := (|H|).(S.HASH.b58check_encoding).

Definition encoding := (|H|).(S.HASH.encoding).

Definition rpc_arg := (|H|).(S.HASH.rpc_arg).

Definition to_path := (|H|).(S.HASH.to_path).

Definition of_path := (|H|).(S.HASH.of_path).

Definition of_path_exn := (|H|).(S.HASH.of_path_exn).

Definition prefix_path := (|H|).(S.HASH.prefix_path).

Definition path_length := (|H|).(S.HASH.path_length).

(* ❌ Top-level evaluations are ignored *)
(* top_level_evaluation *)

Definition of_ed25519_pkh
  (activation_code : MBytes.t)
  (pkh : (|Ed25519|).(S.SIGNATURE.Public_key_hash).(S.SPublic_key_hash.t))
  : t :=
  hash_bytes (Some activation_code)
    [
      (|Ed25519|).(S.SIGNATURE.Public_key_hash).(S.SPublic_key_hash.to_bytes)
        pkh
    ].

Definition activation_code : Set := MBytes.t.

Definition activation_code_size : int :=
  (|Ed25519|).(S.SIGNATURE.Public_key_hash).(S.SPublic_key_hash.size).

Definition activation_code_encoding : Data_encoding.encoding MBytes.t :=
  Data_encoding.Fixed.__bytes_value activation_code_size.

Definition activation_code_of_hex (h : string) : MBytes.t :=
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  MBytes.of_hex (MBytes.Hex h).

Definition Index : {_ : unit & Storage_description.INDEX.signature (t := t)} :=
  existT (A := unit) (fun _ => _) tt
    {|
      Storage_description.INDEX.path_length := (|H|).(S.HASH.path_length);
      Storage_description.INDEX.to_path := (|H|).(S.HASH.to_path);
      Storage_description.INDEX.of_path := (|H|).(S.HASH.of_path);
      Storage_description.INDEX.rpc_arg := (|H|).(S.HASH.rpc_arg);
      Storage_description.INDEX.encoding := (|H|).(S.HASH.encoding);
      Storage_description.INDEX.compare := (|H|).(S.HASH.compare)
    |}.

Blinded_public_key_hash_mli

  • OCaml size: 36 lines
  • Coq size: 113 lines (+213% compared to OCaml)
blinded_public_key_hash.mli 1 warning
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include S.HASH

type activation_code

val activation_code_encoding : activation_code Data_encoding.t

val of_ed25519_pkh : activation_code -> Ed25519.Public_key_hash.t -> t

val activation_code_of_hex : string -> activation_code

module Index : Storage_description.INDEX with type t = t
Blinded_public_key_hash_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Storage_description.

Parameter Included_HASH :
  {'[t, __Set_t, Map_t] : [Set ** Set ** Set -> Set] &
    S.HASH.signature (t := t) (__Set_t := __Set_t) (Map_t := Map_t)}.

Definition t := (|Included_HASH|).(S.HASH.t).

Definition name : string := (|Included_HASH|).(S.HASH.name).

Definition title : string := (|Included_HASH|).(S.HASH.title).

Definition pp : Format.formatter -> t -> unit := (|Included_HASH|).(S.HASH.pp).

Definition pp_short : Format.formatter -> t -> unit :=
  (|Included_HASH|).(S.HASH.pp_short).

Definition op_eq : t -> t -> bool := (|Included_HASH|).(S.HASH.op_eq).

Definition op_ltgt : t -> t -> bool := (|Included_HASH|).(S.HASH.op_ltgt).

Definition op_lt : t -> t -> bool := (|Included_HASH|).(S.HASH.op_lt).

Definition op_lteq : t -> t -> bool := (|Included_HASH|).(S.HASH.op_lteq).

Definition op_gteq : t -> t -> bool := (|Included_HASH|).(S.HASH.op_gteq).

Definition op_gt : t -> t -> bool := (|Included_HASH|).(S.HASH.op_gt).

Definition compare : t -> t -> int := (|Included_HASH|).(S.HASH.compare).

Definition equal : t -> t -> bool := (|Included_HASH|).(S.HASH.equal).

Definition max : t -> t -> t := (|Included_HASH|).(S.HASH.max).

Definition min : t -> t -> t := (|Included_HASH|).(S.HASH.min).

Definition hash_bytes : option MBytes.t -> list MBytes.t -> t :=
  (|Included_HASH|).(S.HASH.hash_bytes).

Definition hash_string : option string -> list string -> t :=
  (|Included_HASH|).(S.HASH.hash_string).

Definition zero : t := (|Included_HASH|).(S.HASH.zero).

Definition size : int := (|Included_HASH|).(S.HASH.size).

Definition to_bytes : t -> MBytes.t := (|Included_HASH|).(S.HASH.to_bytes).

Definition of_bytes_opt : MBytes.t -> option t :=
  (|Included_HASH|).(S.HASH.of_bytes_opt).

Definition of_bytes_exn : MBytes.t -> t :=
  (|Included_HASH|).(S.HASH.of_bytes_exn).

Definition to_b58check : t -> string := (|Included_HASH|).(S.HASH.to_b58check).

Definition to_short_b58check : t -> string :=
  (|Included_HASH|).(S.HASH.to_short_b58check).

Definition of_b58check_exn : string -> t :=
  (|Included_HASH|).(S.HASH.of_b58check_exn).

Definition of_b58check_opt : string -> option t :=
  (|Included_HASH|).(S.HASH.of_b58check_opt).

Definition b58check_encoding : Base58.encoding t :=
  (|Included_HASH|).(S.HASH.b58check_encoding).

Definition encoding : Data_encoding.t t := (|Included_HASH|).(S.HASH.encoding).

Definition rpc_arg : RPC_arg.t t := (|Included_HASH|).(S.HASH.rpc_arg).

Definition to_path : t -> list string -> list string :=
  (|Included_HASH|).(S.HASH.to_path).

Definition of_path : list string -> option t :=
  (|Included_HASH|).(S.HASH.of_path).

Definition of_path_exn : list string -> t :=
  (|Included_HASH|).(S.HASH.of_path_exn).

Definition prefix_path : string -> list string :=
  (|Included_HASH|).(S.HASH.prefix_path).

Definition path_length : int := (|Included_HASH|).(S.HASH.path_length).

Definition __Set := existT (fun _ => _) tt (|Included_HASH|).(S.HASH.__Set).

Definition Map := existT (fun _ => _) tt (|Included_HASH|).(S.HASH.Map).

Parameter activation_code : Set.

Parameter activation_code_encoding : Data_encoding.t activation_code.

Parameter of_ed25519_pkh :
  activation_code ->
  (|Ed25519|).(S.SIGNATURE.Public_key_hash).(S.SPublic_key_hash.t) -> t.

Parameter activation_code_of_hex : string -> activation_code.

Parameter Index : {_ : unit & Storage_description.INDEX.signature (t := t)}.

Block_header_repr

  • OCaml size: 132 lines
  • Coq size: 176 lines (+33% compared to OCaml)
block_header_repr.ml success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Block header *)

type contents = {
  priority : int;
  seed_nonce_hash : Nonce_hash.t option;
  proof_of_work_nonce : MBytes.t;
}

type protocol_data = {contents : contents; signature : Signature.t}

type block_header = {
  shell : Block_header.shell_header;
  protocol_data : protocol_data;
}

type raw = Block_header.t

type shell_header = Block_header.shell_header

let raw_encoding = Block_header.encoding

let shell_header_encoding = Block_header.shell_header_encoding

let contents_encoding =
  let open Data_encoding in
  def "block_header.alpha.unsigned_contents"
  @@ conv
       (fun {priority; seed_nonce_hash; proof_of_work_nonce} ->
         (priority, proof_of_work_nonce, seed_nonce_hash))
       (fun (priority, proof_of_work_nonce, seed_nonce_hash) ->
         {priority; seed_nonce_hash; proof_of_work_nonce})
       (obj3
          (req "priority" uint16)
          (req
             "proof_of_work_nonce"
             (Fixed.bytes Constants_repr.proof_of_work_nonce_size))
          (opt "seed_nonce_hash" Nonce_hash.encoding))

let protocol_data_encoding =
  let open Data_encoding in
  def "block_header.alpha.signed_contents"
  @@ conv
       (fun {contents; signature} -> (contents, signature))
       (fun (contents, signature) -> {contents; signature})
       (merge_objs
          contents_encoding
          (obj1 (req "signature" Signature.encoding)))

let raw {shell; protocol_data} =
  let protocol_data =
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data
  in
  {Block_header.shell; protocol_data}

let unsigned_encoding =
  let open Data_encoding in
  merge_objs Block_header.shell_header_encoding contents_encoding

let encoding =
  let open Data_encoding in
  def "block_header.alpha.full_header"
  @@ conv
       (fun {shell; protocol_data} -> (shell, protocol_data))
       (fun (shell, protocol_data) -> {shell; protocol_data})
       (merge_objs Block_header.shell_header_encoding protocol_data_encoding)

(** Constants *)

let max_header_length =
  let fake_shell =
    {
      Block_header.level = 0l;
      proto_level = 0;
      predecessor = Block_hash.zero;
      timestamp = Time.of_seconds 0L;
      validation_passes = 0;
      operations_hash = Operation_list_list_hash.zero;
      fitness = Fitness_repr.from_int64 0L;
      context = Context_hash.zero;
    }
  in
  let fake_contents =
    {
      priority = 0;
      proof_of_work_nonce =
        MBytes.create Constants_repr.proof_of_work_nonce_size;
      seed_nonce_hash = Some Nonce_hash.zero;
    }
  in
  Data_encoding.Binary.length
    encoding
    {
      shell = fake_shell;
      protocol_data = {contents = fake_contents; signature = Signature.zero};
    }

(** Header parsing entry point  *)

let hash_raw = Block_header.hash

let hash {shell; protocol_data} =
  Block_header.hash
    {
      shell;
      protocol_data =
        Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data;
    }
Block_header_repr.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Constants_repr.
Require Tezos.Fitness_repr.
Require Tezos.Nonce_hash.

Module contents.
  Record record : Set := Build {
    priority : int;
    seed_nonce_hash : option Nonce_hash.t;
    proof_of_work_nonce : MBytes.t }.
  Definition with_priority priority (r : record) :=
    Build priority r.(seed_nonce_hash) r.(proof_of_work_nonce).
  Definition with_seed_nonce_hash seed_nonce_hash (r : record) :=
    Build r.(priority) seed_nonce_hash r.(proof_of_work_nonce).
  Definition with_proof_of_work_nonce proof_of_work_nonce (r : record) :=
    Build r.(priority) r.(seed_nonce_hash) proof_of_work_nonce.
End contents.
Definition contents := contents.record.

Module protocol_data.
  Record record : Set := Build {
    contents : contents;
    signature : Signature.t }.
  Definition with_contents contents (r : record) :=
    Build contents r.(signature).
  Definition with_signature signature (r : record) :=
    Build r.(contents) signature.
End protocol_data.
Definition protocol_data := protocol_data.record.

Module block_header.
  Record record : Set := Build {
    shell : Block_header.shell_header;
    protocol_data : protocol_data }.
  Definition with_shell shell (r : record) :=
    Build shell r.(protocol_data).
  Definition with_protocol_data protocol_data (r : record) :=
    Build r.(shell) protocol_data.
End block_header.
Definition block_header := block_header.record.

Definition raw : Set := Block_header.t.

Definition shell_header : Set := Block_header.shell_header.

Definition raw_encoding : Data_encoding.t Block_header.t :=
  Block_header.encoding.

Definition shell_header_encoding : Data_encoding.t Block_header.shell_header :=
  Block_header.shell_header_encoding.

Definition contents_encoding : Data_encoding.encoding contents :=
  (let arg := Data_encoding.def "block_header.alpha.unsigned_contents" in
  fun eta => arg None None eta)
    (Data_encoding.conv
      (fun function_parameter =>
        let '{|
          contents.priority := priority;
            contents.seed_nonce_hash := seed_nonce_hash;
            contents.proof_of_work_nonce := proof_of_work_nonce
            |} := function_parameter in
        (priority, proof_of_work_nonce, seed_nonce_hash))
      (fun function_parameter =>
        let '(priority, proof_of_work_nonce, seed_nonce_hash) :=
          function_parameter in
        {| contents.priority := priority;
          contents.seed_nonce_hash := seed_nonce_hash;
          contents.proof_of_work_nonce := proof_of_work_nonce |}) None
      (Data_encoding.obj3
        (Data_encoding.req None None "priority" Data_encoding.uint16)
        (Data_encoding.req None None "proof_of_work_nonce"
          (Data_encoding.Fixed.__bytes_value
            Constants_repr.proof_of_work_nonce_size))
        (Data_encoding.opt None None "seed_nonce_hash" Nonce_hash.encoding))).

Definition protocol_data_encoding : Data_encoding.encoding protocol_data :=
  (let arg := Data_encoding.def "block_header.alpha.signed_contents" in
  fun eta => arg None None eta)
    (Data_encoding.conv
      (fun function_parameter =>
        let '{|
          protocol_data.contents := contents;
            protocol_data.signature := signature
            |} := function_parameter in
        (contents, signature))
      (fun function_parameter =>
        let '(contents, signature) := function_parameter in
        {| protocol_data.contents := contents;
          protocol_data.signature := signature |}) None
      (Data_encoding.merge_objs contents_encoding
        (Data_encoding.obj1
          (Data_encoding.req None None "signature" Signature.encoding)))).

Definition __raw_value (function_parameter : block_header) : Block_header.t :=
  let '{|
    block_header.shell := shell;
      block_header.protocol_data := protocol_data
      |} := function_parameter in
  let protocol_data :=
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data in
  {| Block_header.t.shell := shell;
    Block_header.t.protocol_data := protocol_data |}.

Definition unsigned_encoding
  : Data_encoding.encoding (Block_header.shell_header * contents) :=
  Data_encoding.merge_objs Block_header.shell_header_encoding contents_encoding.

Definition encoding : Data_encoding.encoding block_header :=
  (let arg := Data_encoding.def "block_header.alpha.full_header" in
  fun eta => arg None None eta)
    (Data_encoding.conv
      (fun function_parameter =>
        let '{|
          block_header.shell := shell;
            block_header.protocol_data := protocol_data
            |} := function_parameter in
        (shell, protocol_data))
      (fun function_parameter =>
        let '(shell, protocol_data) := function_parameter in
        {| block_header.shell := shell;
          block_header.protocol_data := protocol_data |}) None
      (Data_encoding.merge_objs Block_header.shell_header_encoding
        protocol_data_encoding)).

Definition max_header_length : int :=
  let fake_shell :=
    {|
      Block_header.shell_header.level :=
        (* ❌ Constant of type int32 is converted to int *)
        0; Block_header.shell_header.proto_level := 0;
      Block_header.shell_header.predecessor := (|Block_hash|).(S.HASH.zero);
      Block_header.shell_header.timestamp :=
        Time.of_seconds
          (* ❌ Constant of type int64 is converted to int *)
          0; Block_header.shell_header.validation_passes := 0;
      Block_header.shell_header.operations_hash :=
        (|Operation_list_list_hash|).(S.MERKLE_TREE.zero);
      Block_header.shell_header.fitness :=
        Fitness_repr.from_int64
          (* ❌ Constant of type int64 is converted to int *)
          0; Block_header.shell_header.context := (|Context_hash|).(S.HASH.zero)
      |} in
  let fake_contents :=
    {| contents.priority := 0; contents.seed_nonce_hash := Some Nonce_hash.zero;
      contents.proof_of_work_nonce :=
        MBytes.create Constants_repr.proof_of_work_nonce_size |} in
  Data_encoding.Binary.length encoding
    {| block_header.shell := fake_shell;
      block_header.protocol_data :=
        {| protocol_data.contents := fake_contents;
          protocol_data.signature := Signature.zero |} |}.

Definition hash_raw : Block_header.t -> (|Block_hash|).(S.HASH.t) :=
  Block_header.__hash_value.

Definition __hash_value (function_parameter : block_header)
  : (|Block_hash|).(S.HASH.t) :=
  let '{|
    block_header.shell := shell;
      block_header.protocol_data := protocol_data
      |} := function_parameter in
  Block_header.__hash_value
    {| Block_header.t.shell := shell;
      Block_header.t.protocol_data :=
        Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data
      |}.

Block_header_repr_mli

  • OCaml size: 62 lines
  • Coq size: 73 lines (+17% compared to OCaml)
block_header_repr.mli success
(*****************************************************************************)
(*                                                                           *)
(* 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 contents = {
  priority : int;
  seed_nonce_hash : Nonce_hash.t option;
  proof_of_work_nonce : MBytes.t;
}

type protocol_data = {contents : contents; signature : Signature.t}

type block_header = {
  shell : Block_header.shell_header;
  protocol_data : protocol_data;
}

type raw = Block_header.t

type shell_header = Block_header.shell_header

val raw : block_header -> raw

val encoding : block_header Data_encoding.encoding

val raw_encoding : raw Data_encoding.t

val contents_encoding : contents Data_encoding.t

val unsigned_encoding : (Block_header.shell_header * contents) Data_encoding.t

val protocol_data_encoding : protocol_data Data_encoding.encoding

val shell_header_encoding : shell_header Data_encoding.encoding

(** The maximum size of block headers in bytes *)
val max_header_length : int

val hash : block_header -> Block_hash.t

val hash_raw : raw -> Block_hash.t
Block_header_repr_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Nonce_hash.

Module contents.
  Record record : Set := Build {
    priority : int;
    seed_nonce_hash : option Nonce_hash.t;
    proof_of_work_nonce : MBytes.t }.
  Definition with_priority priority (r : record) :=
    Build priority r.(seed_nonce_hash) r.(proof_of_work_nonce).
  Definition with_seed_nonce_hash seed_nonce_hash (r : record) :=
    Build r.(priority) seed_nonce_hash r.(proof_of_work_nonce).
  Definition with_proof_of_work_nonce proof_of_work_nonce (r : record) :=
    Build r.(priority) r.(seed_nonce_hash) proof_of_work_nonce.
End contents.
Definition contents := contents.record.

Module protocol_data.
  Record record : Set := Build {
    contents : contents;
    signature : Signature.t }.
  Definition with_contents contents (r : record) :=
    Build contents r.(signature).
  Definition with_signature signature (r : record) :=
    Build r.(contents) signature.
End protocol_data.
Definition protocol_data := protocol_data.record.

Module block_header.
  Record record : Set := Build {
    shell : Block_header.shell_header;
    protocol_data : protocol_data }.
  Definition with_shell shell (r : record) :=
    Build shell r.(protocol_data).
  Definition with_protocol_data protocol_data (r : record) :=
    Build r.(shell) protocol_data.
End block_header.
Definition block_header := block_header.record.

Definition raw : Set := Block_header.t.

Definition shell_header : Set := Block_header.shell_header.

Parameter __raw_value : block_header -> raw.

Parameter encoding : Data_encoding.encoding block_header.

Parameter raw_encoding : Data_encoding.t raw.

Parameter contents_encoding : Data_encoding.t contents.

Parameter unsigned_encoding :
  Data_encoding.t (Block_header.shell_header * contents).

Parameter protocol_data_encoding : Data_encoding.encoding protocol_data.

Parameter shell_header_encoding : Data_encoding.encoding shell_header.

Parameter max_header_length : int.

Parameter __hash_value : block_header -> (|Block_hash|).(S.HASH.t).

Parameter hash_raw : raw -> (|Block_hash|).(S.HASH.t).

Bootstrap_storage

  • OCaml size: 152 lines
  • Coq size: 188 lines (+23% compared to OCaml)
bootstrap_storage.ml success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Misc

let init_account ctxt
    ({public_key_hash; public_key; amount} : Parameters_repr.bootstrap_account)
    =
  let contract = Contract_repr.implicit_contract public_key_hash in
  Contract_storage.credit ctxt contract amount
  >>=? fun ctxt ->
  match public_key with
  | Some public_key ->
      Contract_storage.reveal_manager_key ctxt public_key_hash public_key
      >>=? fun ctxt ->
      Delegate_storage.set ctxt contract (Some public_key_hash)
      >>=? fun ctxt -> return ctxt
  | None ->
      return ctxt

let init_contract ~typecheck ctxt
    ({delegate; amount; script} : Parameters_repr.bootstrap_contract) =
  Contract_storage.fresh_contract_from_current_nonce ctxt
  >>=? fun (ctxt, contract) ->
  typecheck ctxt script
  >>=? fun (script, ctxt) ->
  Contract_storage.originate_raw
    ctxt
    contract
    ~balance:amount
    ~prepaid_bootstrap_storage:true
    ~script
    ~delegate:(Some delegate)
  >>=? fun ctxt -> return ctxt

let init ctxt ~typecheck ?ramp_up_cycles ?no_reward_cycles accounts contracts =
  let nonce =
    Operation_hash.hash_bytes [MBytes.of_string "Un festival de GADT."]
  in
  let ctxt = Raw_context.init_origination_nonce ctxt nonce in
  fold_left_s init_account ctxt accounts
  >>=? fun ctxt ->
  fold_left_s (init_contract ~typecheck) ctxt contracts
  >>=? fun ctxt ->
  ( match no_reward_cycles with
  | None ->
      return ctxt
  | Some cycles ->
      (* Store pending ramp ups. *)
      let constants = Raw_context.constants ctxt in
      (* Start without reward *)
      Raw_context.patch_constants ctxt (fun c ->
          {
            c with
            block_reward = Tez_repr.zero;
            endorsement_reward = Tez_repr.zero;
          })
      >>= fun ctxt ->
      (* Store the final reward. *)
      Storage.Ramp_up.Rewards.init
        ctxt
        (Cycle_repr.of_int32_exn (Int32.of_int cycles))
        (constants.block_reward, constants.endorsement_reward) )
  >>=? fun ctxt ->
  match ramp_up_cycles with
  | None ->
      return ctxt
  | Some cycles ->
      (* Store pending ramp ups. *)
      let constants = Raw_context.constants ctxt in
      Lwt.return
        Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles)
      >>=? fun block_step ->
      Lwt.return
        Tez_repr.(
          constants.endorsement_security_deposit /? Int64.of_int cycles)
      >>=? fun endorsement_step ->
      (* Start without security_deposit *)
      Raw_context.patch_constants ctxt (fun c ->
          {
            c with
            block_security_deposit = Tez_repr.zero;
            endorsement_security_deposit = Tez_repr.zero;
          })
      >>= fun ctxt ->
      fold_left_s
        (fun ctxt cycle ->
          Lwt.return Tez_repr.(block_step *? Int64.of_int cycle)
          >>=? fun block_security_deposit ->
          Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle)
          >>=? fun endorsement_security_deposit ->
          let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in
          Storage.Ramp_up.Security_deposits.init
            ctxt
            cycle
            (block_security_deposit, endorsement_security_deposit))
        ctxt
        (1 --> (cycles - 1))
      >>=? fun ctxt ->
      (* Store the final security deposits. *)
      Storage.Ramp_up.Security_deposits.init
        ctxt
        (Cycle_repr.of_int32_exn (Int32.of_int cycles))
        ( constants.block_security_deposit,
          constants.endorsement_security_deposit )
      >>=? fun ctxt -> return ctxt

let cycle_end ctxt last_cycle =
  let next_cycle = Cycle_repr.succ last_cycle in
  Storage.Ramp_up.Rewards.get_option ctxt next_cycle
  >>=? (function
         | None ->
             return ctxt
         | Some (block_reward, endorsement_reward) ->
             Storage.Ramp_up.Rewards.delete ctxt next_cycle
             >>=? fun ctxt ->
             Raw_context.patch_constants ctxt (fun c ->
                 {c with block_reward; endorsement_reward})
             >>= fun ctxt -> return ctxt)
  >>=? fun ctxt ->
  Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle
  >>=? function
  | None ->
      return ctxt
  | Some (block_security_deposit, endorsement_security_deposit) ->
      Storage.Ramp_up.Security_deposits.delete ctxt next_cycle
      >>=? fun ctxt ->
      Raw_context.patch_constants ctxt (fun c ->
          {c with block_security_deposit; endorsement_security_deposit})
      >>= fun ctxt -> return ctxt
Bootstrap_storage.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Constants_repr.
Require Tezos.Contract_repr.
Require Tezos.Contract_storage.
Require Tezos.Cycle_repr.
Require Tezos.Delegate_storage.
Require Tezos.Misc.
Require Tezos.Parameters_repr.
Require Tezos.Raw_context.
Require Tezos.Script_repr.
Require Tezos.Storage_mli. Module Storage := Storage_mli.
Require Tezos.Storage_sigs.
Require Tezos.Tez_repr.

Import Misc.

Definition init_account
  (ctxt : Raw_context.t)
  (function_parameter : Parameters_repr.bootstrap_account)
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let '{|
    Parameters_repr.bootstrap_account.public_key_hash := public_key_hash;
      Parameters_repr.bootstrap_account.public_key := public_key;
      Parameters_repr.bootstrap_account.amount := amount
      |} := function_parameter in
  let contract := Contract_repr.implicit_contract public_key_hash in
  let=? ctxt := Contract_storage.credit ctxt contract amount in
  match public_key with
  | Some public_key =>
    let=? ctxt :=
      Contract_storage.reveal_manager_key ctxt public_key_hash public_key in
    let=? ctxt := Delegate_storage.set ctxt contract (Some public_key_hash) in
    Error_monad.__return ctxt
  | None => Error_monad.__return ctxt
  end.

Definition init_contract
  (typecheck :
    Raw_context.t -> Script_repr.t ->
    Lwt.t
      (Error_monad.tzresult
        ((Script_repr.t * option Contract_storage.big_map_diff) * Raw_context.t)))
  (ctxt : Raw_context.t)
  (function_parameter : Parameters_repr.bootstrap_contract)
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let '{|
    Parameters_repr.bootstrap_contract.delegate := delegate;
      Parameters_repr.bootstrap_contract.amount := amount;
      Parameters_repr.bootstrap_contract.script := script
      |} := function_parameter in
  let=? '(ctxt, contract) :=
    Contract_storage.fresh_contract_from_current_nonce ctxt in
  let=? '(script, ctxt) := typecheck ctxt script in
  let=? ctxt :=
    Contract_storage.originate_raw ctxt (Some true) contract amount script
      (Some delegate) in
  Error_monad.__return ctxt.

Definition init
  (ctxt : Raw_context.t)
  (typecheck :
    Raw_context.t -> Script_repr.t ->
    Lwt.t
      (Error_monad.tzresult
        ((Script_repr.t * option Contract_storage.big_map_diff) * Raw_context.t)))
  (ramp_up_cycles : option int) (no_reward_cycles : option int)
  (accounts : list Parameters_repr.bootstrap_account)
  (contracts : list Parameters_repr.bootstrap_contract)
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let __nonce_value :=
    (|Operation_hash|).(S.HASH.hash_bytes) None
      [ MBytes.of_string "Un festival de GADT." ] in
  let ctxt := Raw_context.init_origination_nonce ctxt __nonce_value in
  let=? ctxt := Error_monad.fold_left_s init_account ctxt accounts in
  let=? ctxt := Error_monad.fold_left_s (init_contract typecheck) ctxt contracts
    in
  let=? ctxt :=
    match no_reward_cycles with
    | None => Error_monad.__return ctxt
    | Some cycles =>
      let constants := Raw_context.constants ctxt in
      let= ctxt :=
        Raw_context.patch_constants ctxt
          (fun c =>
            Constants_repr.parametric.with_endorsement_reward Tez_repr.zero
              (Constants_repr.parametric.with_block_reward Tez_repr.zero c)) in
      (|Storage.Ramp_up.Rewards|).(Storage_sigs.Indexed_data_storage.init) ctxt
        (Cycle_repr.of_int32_exn (Int32.of_int cycles))
        (constants.(Constants_repr.parametric.block_reward),
          constants.(Constants_repr.parametric.endorsement_reward))
    end in
  match ramp_up_cycles with
  | None => Error_monad.__return ctxt
  | Some cycles =>
    let constants := Raw_context.constants ctxt in
    let=? block_step :=
      Lwt.__return
        (Tez_repr.op_divquestion
          constants.(Constants_repr.parametric.block_security_deposit)
          (Int64.of_int cycles)) in
    let=? endorsement_step :=
      Lwt.__return
        (Tez_repr.op_divquestion
          constants.(Constants_repr.parametric.endorsement_security_deposit)
          (Int64.of_int cycles)) in
    let= ctxt :=
      Raw_context.patch_constants ctxt
        (fun c =>
          Constants_repr.parametric.with_endorsement_security_deposit
            Tez_repr.zero
            (Constants_repr.parametric.with_block_security_deposit Tez_repr.zero
              c)) in
    let=? ctxt :=
      Error_monad.fold_left_s
        (fun ctxt =>
          fun cycle =>
            let=? block_security_deposit :=
              Lwt.__return
                (Tez_repr.op_starquestion block_step (Int64.of_int cycle)) in
            let=? endorsement_security_deposit :=
              Lwt.__return
                (Tez_repr.op_starquestion endorsement_step (Int64.of_int cycle))
              in
            let cycle := Cycle_repr.of_int32_exn (Int32.of_int cycle) in
            (|Storage.Ramp_up.Security_deposits|).(Storage_sigs.Indexed_data_storage.init)
              ctxt cycle (block_security_deposit, endorsement_security_deposit))
        ctxt (Misc.op_minusminusgt 1 (Pervasives.op_minus cycles 1)) in
    let=? ctxt :=
      (|Storage.Ramp_up.Security_deposits|).(Storage_sigs.Indexed_data_storage.init)
        ctxt (Cycle_repr.of_int32_exn (Int32.of_int cycles))
        (constants.(Constants_repr.parametric.block_security_deposit),
          constants.(Constants_repr.parametric.endorsement_security_deposit)) in
    Error_monad.__return ctxt
  end.

Definition cycle_end
  (ctxt :
    (|Storage.Ramp_up.Rewards|).(Storage_sigs.Indexed_data_storage.context))
  (last_cycle : Cycle_repr.cycle)
  : Lwt.t
    (Error_monad.tzresult
      (|Storage.Ramp_up.Rewards|).(Storage_sigs.Indexed_data_storage.context)) :=
  let next_cycle := Cycle_repr.succ last_cycle in
  let=? ctxt :=
    let=? function_parameter :=
      (|Storage.Ramp_up.Rewards|).(Storage_sigs.Indexed_data_storage.get_option)
        ctxt next_cycle in
    match function_parameter with
    | None => Error_monad.__return ctxt
    | Some (block_reward, endorsement_reward) =>
      let=? ctxt :=
        (|Storage.Ramp_up.Rewards|).(Storage_sigs.Indexed_data_storage.delete)
          ctxt next_cycle in
      let= ctxt :=
        Raw_context.patch_constants ctxt
          (fun c =>
            Constants_repr.parametric.with_endorsement_reward endorsement_reward
              (Constants_repr.parametric.with_block_reward block_reward c)) in
      Error_monad.__return ctxt
    end in
  let=? function_parameter :=
    (|Storage.Ramp_up.Security_deposits|).(Storage_sigs.Indexed_data_storage.get_option)
      ctxt next_cycle in
  match function_parameter with
  | None => Error_monad.__return ctxt
  | Some (block_security_deposit, endorsement_security_deposit) =>
    let=? ctxt :=
      (|Storage.Ramp_up.Security_deposits|).(Storage_sigs.Indexed_data_storage.delete)
        ctxt next_cycle in
    let= ctxt :=
      Raw_context.patch_constants ctxt
        (fun c =>
          Constants_repr.parametric.with_endorsement_security_deposit
            endorsement_security_deposit
            (Constants_repr.parametric.with_block_security_deposit
              block_security_deposit c)) in
    Error_monad.__return ctxt
  end.

Bootstrap_storage_mli

  • OCaml size: 40 lines
  • Coq size: 29 lines (-28% compared to OCaml)
bootstrap_storage.mli success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

val init :
  Raw_context.t ->
  typecheck:(Raw_context.t ->
            Script_repr.t ->
            ( (Script_repr.t * Contract_storage.big_map_diff option)
            * Raw_context.t )
            tzresult
            Lwt.t) ->
  ?ramp_up_cycles:int ->
  ?no_reward_cycles:int ->
  Parameters_repr.bootstrap_account list ->
  Parameters_repr.bootstrap_contract list ->
  Raw_context.t tzresult Lwt.t

val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
Bootstrap_storage_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Contract_storage.
Require Tezos.Cycle_repr.
Require Tezos.Parameters_repr.
Require Tezos.Raw_context.
Require Tezos.Script_repr.

Parameter init :
  Raw_context.t ->
  (Raw_context.t -> Script_repr.t ->
  Lwt.t
    (Error_monad.tzresult
      ((Script_repr.t * option Contract_storage.big_map_diff) * Raw_context.t)))
  -> option int -> option int -> list Parameters_repr.bootstrap_account ->
  list Parameters_repr.bootstrap_contract ->
  Lwt.t (Error_monad.tzresult Raw_context.t).

Parameter cycle_end :
  Raw_context.t -> Cycle_repr.t -> Lwt.t (Error_monad.tzresult Raw_context.t).

Commitment_repr

  • OCaml size: 40 lines
  • Coq size: 41 lines (+2% compared to OCaml)
commitment_repr.ml success
(*****************************************************************************)
(*                                                                           *)
(* 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 t = {
  blinded_public_key_hash : Blinded_public_key_hash.t;
  amount : Tez_repr.t;
}

let encoding =
  let open Data_encoding in
  conv
    (fun {blinded_public_key_hash; amount} ->
      (blinded_public_key_hash, amount))
    (fun (blinded_public_key_hash, amount) ->
      {blinded_public_key_hash; amount})
    (tup2 Blinded_public_key_hash.encoding Tez_repr.encoding)

let not_first_class_module = ()
Commitment_repr.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Blinded_public_key_hash.
Require Tezos.Tez_repr.

Module t.
  Record record : Set := Build {
    blinded_public_key_hash : Blinded_public_key_hash.t;
    amount : Tez_repr.t }.
  Definition with_blinded_public_key_hash blinded_public_key_hash
    (r : record) :=
    Build blinded_public_key_hash r.(amount).
  Definition with_amount amount (r : record) :=
    Build r.(blinded_public_key_hash) amount.
End t.
Definition t := t.record.

Definition encoding : Data_encoding.encoding t :=
  Data_encoding.conv
    (fun function_parameter =>
      let '{|
        t.blinded_public_key_hash := blinded_public_key_hash;
          t.amount := amount
          |} := function_parameter in
      (blinded_public_key_hash, amount))
    (fun function_parameter =>
      let '(blinded_public_key_hash, amount) := function_parameter in
      {| t.blinded_public_key_hash := blinded_public_key_hash;
        t.amount := amount |}) None
    (Data_encoding.tup2 Blinded_public_key_hash.encoding Tez_repr.encoding).

Definition not_first_class_module : unit := tt.

Commitment_repr_mli

  • OCaml size: 33 lines
  • Coq size: 29 lines (-13% compared to OCaml)
commitment_repr.mli success
(*****************************************************************************)
(*                                                                           *)
(* 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 t = {
  blinded_public_key_hash : Blinded_public_key_hash.t;
  amount : Tez_repr.t;
}

val encoding : t Data_encoding.t

val not_first_class_module : unit
Commitment_repr_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Blinded_public_key_hash.
Require Tezos.Tez_repr.

Module t.
  Record record : Set := Build {
    blinded_public_key_hash : Blinded_public_key_hash.t;
    amount : Tez_repr.t }.
  Definition with_blinded_public_key_hash blinded_public_key_hash
    (r : record) :=
    Build blinded_public_key_hash r.(amount).
  Definition with_amount amount (r : record) :=
    Build r.(blinded_public_key_hash) amount.
End t.
Definition t := t.record.

Parameter encoding : Data_encoding.t t.

Parameter not_first_class_module : unit.

Commitment_storage

  • OCaml size: 34 lines
  • Coq size: 50 lines (+47% compared to OCaml)
commitment_storage.ml success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let get_opt = Storage.Commitments.get_option

let delete = Storage.Commitments.delete

let init ctxt commitments =
  let init_commitment ctxt Commitment_repr.{blinded_public_key_hash; amount} =
    Storage.Commitments.init ctxt blinded_public_key_hash amount
  in
  fold_left_s init_commitment ctxt commitments >>=? fun ctxt -> return ctxt
Commitment_storage.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Blinded_public_key_hash.
Require Tezos.Commitment_repr.
Require Tezos.Raw_context.
Require Tezos.Storage_mli. Module Storage := Storage_mli.
Require Tezos.Storage_sigs.
Require Tezos.Tez_repr.

Definition get_opt
  : (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.context) ->
  (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.key) ->
  Lwt.t
    (Error_monad.tzresult
      (option (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.value))) :=
  (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.get_option).

Definition delete
  : (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.context) ->
  (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.key) ->
  Lwt.t (Error_monad.tzresult Raw_context.t) :=
  (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.delete).

Definition init
  (ctxt : (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.context))
  (commitments : list Commitment_repr.t)
  : Lwt.t
    (Error_monad.tzresult
      (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.context)) :=
  let init_commitment
    (ctxt : (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.context))
    (function_parameter : Commitment_repr.t)
    : Lwt.t (Error_monad.tzresult Raw_context.t) :=
    let '{|
      Commitment_repr.t.blinded_public_key_hash := blinded_public_key_hash;
        Commitment_repr.t.amount := amount
        |} := function_parameter in
    (|Storage.Commitments|).(Storage_sigs.Indexed_data_storage.init) ctxt
      blinded_public_key_hash amount in
  let=? ctxt := Error_monad.fold_left_s init_commitment ctxt commitments in
  Error_monad.__return ctxt.

Commitment_storage_mli

  • OCaml size: 35 lines
  • Coq size: 27 lines (-23% compared to OCaml)
commitment_storage.mli success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

val init :
  Raw_context.t -> Commitment_repr.t list -> Raw_context.t tzresult Lwt.t

val get_opt :
  Raw_context.t ->
  Blinded_public_key_hash.t ->
  Tez_repr.t option tzresult Lwt.t

val delete :
  Raw_context.t -> Blinded_public_key_hash.t -> Raw_context.t tzresult Lwt.t
Commitment_storage_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Blinded_public_key_hash.
Require Tezos.Commitment_repr.
Require Tezos.Raw_context.
Require Tezos.Tez_repr.

Parameter init :
  Raw_context.t -> list Commitment_repr.t ->
  Lwt.t (Error_monad.tzresult Raw_context.t).

Parameter get_opt :
  Raw_context.t -> Blinded_public_key_hash.t ->
  Lwt.t (Error_monad.tzresult (option Tez_repr.t)).

Parameter delete :
  Raw_context.t -> Blinded_public_key_hash.t ->
  Lwt.t (Error_monad.tzresult Raw_context.t).

Constants_repr

  • OCaml size: 238 lines
  • Coq size: 604 lines (+153% compared to OCaml)
constants_repr.ml success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let version_number_004 = "\000"

let version_number = "\001"

let proof_of_work_nonce_size = 8

let nonce_length = 32

let max_revelations_per_block = 32

let max_proposals_per_delegate = 20

let max_operation_data_length = 16 * 1024 (* 16kB *)

type fixed = {
  proof_of_work_nonce_size : int;
  nonce_length : int;
  max_revelations_per_block : int;
  max_operation_data_length : int;
  max_proposals_per_delegate : int;
}

let fixed_encoding =
  let open Data_encoding in
  conv
    (fun c ->
      ( c.proof_of_work_nonce_size,
        c.nonce_length,
        c.max_revelations_per_block,
        c.max_operation_data_length,
        c.max_proposals_per_delegate ))
    (fun ( proof_of_work_nonce_size,
           nonce_length,
           max_revelations_per_block,
           max_operation_data_length,
           max_proposals_per_delegate ) ->
      {
        proof_of_work_nonce_size;
        nonce_length;
        max_revelations_per_block;
        max_operation_data_length;
        max_proposals_per_delegate;
      })
    (obj5
       (req "proof_of_work_nonce_size" uint8)
       (req "nonce_length" uint8)
       (req "max_revelations_per_block" uint8)
       (req "max_operation_data_length" int31)
       (req "max_proposals_per_delegate" uint8))

let fixed =
  {
    proof_of_work_nonce_size;
    nonce_length;
    max_revelations_per_block;
    max_operation_data_length;
    max_proposals_per_delegate;
  }

type parametric = {
  preserved_cycles : int;
  blocks_per_cycle : int32;
  blocks_per_commitment : int32;
  blocks_per_roll_snapshot : int32;
  blocks_per_voting_period : int32;
  time_between_blocks : Period_repr.t list;
  endorsers_per_block : int;
  hard_gas_limit_per_operation : Z.t;
  hard_gas_limit_per_block : Z.t;
  proof_of_work_threshold : int64;
  tokens_per_roll : Tez_repr.t;
  michelson_maximum_type_size : int;
  seed_nonce_revelation_tip : Tez_repr.t;
  origination_size : int;
  block_security_deposit : Tez_repr.t;
  endorsement_security_deposit : Tez_repr.t;
  block_reward : Tez_repr.t;
  endorsement_reward : Tez_repr.t;
  cost_per_byte : Tez_repr.t;
  hard_storage_limit_per_operation : Z.t;
  test_chain_duration : int64;
  (* in seconds *)
  quorum_min : int32;
  quorum_max : int32;
  min_proposal_quorum : int32;
  initial_endorsers : int;
  delay_per_missing_endorsement : Period_repr.t;
}

let parametric_encoding =
  let open Data_encoding in
  conv
    (fun c ->
      ( ( c.preserved_cycles,
          c.blocks_per_cycle,
          c.blocks_per_commitment,
          c.blocks_per_roll_snapshot,
          c.blocks_per_voting_period,
          c.time_between_blocks,
          c.endorsers_per_block,
          c.hard_gas_limit_per_operation,
          c.hard_gas_limit_per_block ),
        ( ( c.proof_of_work_threshold,
            c.tokens_per_roll,
            c.michelson_maximum_type_size,
            c.seed_nonce_revelation_tip,
            c.origination_size,
            c.block_security_deposit,
            c.endorsement_security_deposit,
            c.block_reward ),
          ( c.endorsement_reward,
            c.cost_per_byte,
            c.hard_storage_limit_per_operation,
            c.test_chain_duration,
            c.quorum_min,
            c.quorum_max,
            c.min_proposal_quorum,
            c.initial_endorsers,
            c.delay_per_missing_endorsement ) ) ))
    (fun ( ( preserved_cycles,
             blocks_per_cycle,
             blocks_per_commitment,
             blocks_per_roll_snapshot,
             blocks_per_voting_period,
             time_between_blocks,
             endorsers_per_block,
             hard_gas_limit_per_operation,
             hard_gas_limit_per_block ),
           ( ( proof_of_work_threshold,
               tokens_per_roll,
               michelson_maximum_type_size,
               seed_nonce_revelation_tip,
               origination_size,
               block_security_deposit,
               endorsement_security_deposit,
               block_reward ),
             ( endorsement_reward,
               cost_per_byte,
               hard_storage_limit_per_operation,
               test_chain_duration,
               quorum_min,
               quorum_max,
               min_proposal_quorum,
               initial_endorsers,
               delay_per_missing_endorsement ) ) ) ->
      {
        preserved_cycles;
        blocks_per_cycle;
        blocks_per_commitment;
        blocks_per_roll_snapshot;
        blocks_per_voting_period;
        time_between_blocks;
        endorsers_per_block;
        hard_gas_limit_per_operation;
        hard_gas_limit_per_block;
        proof_of_work_threshold;
        tokens_per_roll;
        michelson_maximum_type_size;
        seed_nonce_revelation_tip;
        origination_size;
        block_security_deposit;
        endorsement_security_deposit;
        block_reward;
        endorsement_reward;
        cost_per_byte;
        hard_storage_limit_per_operation;
        test_chain_duration;
        quorum_min;
        quorum_max;
        min_proposal_quorum;
        initial_endorsers;
        delay_per_missing_endorsement;
      })
    (merge_objs
       (obj9
          (req "preserved_cycles" uint8)
          (req "blocks_per_cycle" int32)
          (req "blocks_per_commitment" int32)
          (req "blocks_per_roll_snapshot" int32)
          (req "blocks_per_voting_period" int32)
          (req "time_between_blocks" (list Period_repr.encoding))
          (req "endorsers_per_block" uint16)
          (req "hard_gas_limit_per_operation" z)
          (req "hard_gas_limit_per_block" z))
       (merge_objs
          (obj8
             (req "proof_of_work_threshold" int64)
             (req "tokens_per_roll" Tez_repr.encoding)
             (req "michelson_maximum_type_size" uint16)
             (req "seed_nonce_revelation_tip" Tez_repr.encoding)
             (req "origination_size" int31)
             (req "block_security_deposit" Tez_repr.encoding)
             (req "endorsement_security_deposit" Tez_repr.encoding)
             (req "block_reward" Tez_repr.encoding))
          (obj9
             (req "endorsement_reward" Tez_repr.encoding)
             (req "cost_per_byte" Tez_repr.encoding)
             (req "hard_storage_limit_per_operation" z)
             (req "test_chain_duration" int64)
             (req "quorum_min" int32)
             (req "quorum_max" int32)
             (req "min_proposal_quorum" int32)
             (req "initial_endorsers" uint16)
             (req "delay_per_missing_endorsement" Period_repr.encoding))))

type t = {fixed : fixed; parametric : parametric}

let encoding =
  let open Data_encoding in
  conv
    (fun {fixed; parametric} -> (fixed, parametric))
    (fun (fixed, parametric) -> {fixed; parametric})
    (merge_objs fixed_encoding parametric_encoding)
Constants_repr.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Period_repr.
Require Tezos.Tez_repr.

Definition version_number_004 : string := "\000".

Definition version_number : string := "\001".

Definition proof_of_work_nonce_size : int := 8.

Definition nonce_length : int := 32.

Definition max_revelations_per_block : int := 32.

Definition max_proposals_per_delegate : int := 20.

Definition max_operation_data_length : int := Pervasives.op_star 16 1024.

Module fixed.
  Record record : Set := Build {
    proof_of_work_nonce_size : int;
    nonce_length : int;
    max_revelations_per_block : int;
    max_operation_data_length : int;
    max_proposals_per_delegate : int }.
  Definition with_proof_of_work_nonce_size proof_of_work_nonce_size
    (r : record) :=
    Build proof_of_work_nonce_size r.(nonce_length)
      r.(max_revelations_per_block) r.(max_operation_data_length)
      r.(max_proposals_per_delegate).
  Definition with_nonce_length nonce_length (r : record) :=
    Build r.(proof_of_work_nonce_size) nonce_length
      r.(max_revelations_per_block) r.(max_operation_data_length)
      r.(max_proposals_per_delegate).
  Definition with_max_revelations_per_block max_revelations_per_block
    (r : record) :=
    Build r.(proof_of_work_nonce_size) r.(nonce_length)
      max_revelations_per_block r.(max_operation_data_length)
      r.(max_proposals_per_delegate).
  Definition with_max_operation_data_length max_operation_data_length
    (r : record) :=
    Build r.(proof_of_work_nonce_size) r.(nonce_length)
      r.(max_revelations_per_block) max_operation_data_length
      r.(max_proposals_per_delegate).
  Definition with_max_proposals_per_delegate max_proposals_per_delegate
    (r : record) :=
    Build r.(proof_of_work_nonce_size) r.(nonce_length)
      r.(max_revelations_per_block) r.(max_operation_data_length)
      max_proposals_per_delegate.
End fixed.
Definition fixed := fixed.record.

Definition fixed_encoding : Data_encoding.encoding fixed :=
  Data_encoding.conv
    (fun c =>
      (c.(fixed.proof_of_work_nonce_size), c.(fixed.nonce_length),
        c.(fixed.max_revelations_per_block),
        c.(fixed.max_operation_data_length),
        c.(fixed.max_proposals_per_delegate)))
    (fun function_parameter =>
      let
        '(proof_of_work_nonce_size, nonce_length, max_revelations_per_block,
          max_operation_data_length, max_proposals_per_delegate) :=
        function_parameter in
      {| fixed.proof_of_work_nonce_size := proof_of_work_nonce_size;
        fixed.nonce_length := nonce_length;
        fixed.max_revelations_per_block := max_revelations_per_block;
        fixed.max_operation_data_length := max_operation_data_length;
        fixed.max_proposals_per_delegate := max_proposals_per_delegate |}) None
    (Data_encoding.obj5
      (Data_encoding.req None None "proof_of_work_nonce_size"
        Data_encoding.uint8)
      (Data_encoding.req None None "nonce_length" Data_encoding.uint8)
      (Data_encoding.req None None "max_revelations_per_block"
        Data_encoding.uint8)
      (Data_encoding.req None None "max_operation_data_length"
        Data_encoding.int31)
      (Data_encoding.req None None "max_proposals_per_delegate"
        Data_encoding.uint8)).

Definition __fixed_value : fixed :=
  {| fixed.proof_of_work_nonce_size := proof_of_work_nonce_size;
    fixed.nonce_length := nonce_length;
    fixed.max_revelations_per_block := max_revelations_per_block;
    fixed.max_operation_data_length := max_operation_data_length;
    fixed.max_proposals_per_delegate := max_proposals_per_delegate |}.

Module parametric.
  Record record : Set := Build {
    preserved_cycles : int;
    blocks_per_cycle : int32;
    blocks_per_commitment : int32;
    blocks_per_roll_snapshot : int32;
    blocks_per_voting_period : int32;
    time_between_blocks : list Period_repr.t;
    endorsers_per_block : int;
    hard_gas_limit_per_operation : Z.t;
    hard_gas_limit_per_block : Z.t;
    proof_of_work_threshold : int64;
    tokens_per_roll : Tez_repr.t;
    michelson_maximum_type_size : int;
    seed_nonce_revelation_tip : Tez_repr.t;
    origination_size : int;
    block_security_deposit : Tez_repr.t;
    endorsement_security_deposit : Tez_repr.t;
    block_reward : Tez_repr.t;
    endorsement_reward : Tez_repr.t;
    cost_per_byte : Tez_repr.t;
    hard_storage_limit_per_operation : Z.t;
    test_chain_duration : int64;
    quorum_min : int32;
    quorum_max : int32;
    min_proposal_quorum : int32;
    initial_endorsers : int;
    delay_per_missing_endorsement : Period_repr.t }.
  Definition with_preserved_cycles preserved_cycles (r : record) :=
    Build preserved_cycles r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_blocks_per_cycle blocks_per_cycle (r : record) :=
    Build r.(preserved_cycles) blocks_per_cycle r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_blocks_per_commitment blocks_per_commitment (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) blocks_per_commitment
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_blocks_per_roll_snapshot blocks_per_roll_snapshot
    (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      blocks_per_roll_snapshot r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_blocks_per_voting_period blocks_per_voting_period
    (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) blocks_per_voting_period
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_time_between_blocks time_between_blocks (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      time_between_blocks r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_endorsers_per_block endorsers_per_block (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) endorsers_per_block
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_hard_gas_limit_per_operation hard_gas_limit_per_operation
    (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      hard_gas_limit_per_operation r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_hard_gas_limit_per_block hard_gas_limit_per_block
    (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) hard_gas_limit_per_block
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_proof_of_work_threshold proof_of_work_threshold
    (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      proof_of_work_threshold r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_tokens_per_roll tokens_per_roll (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) tokens_per_roll
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_michelson_maximum_type_size michelson_maximum_type_size
    (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      michelson_maximum_type_size r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_seed_nonce_revelation_tip seed_nonce_revelation_tip
    (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) seed_nonce_revelation_tip
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_origination_size origination_size (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      origination_size r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_block_security_deposit block_security_deposit (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) block_security_deposit
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_endorsement_security_deposit endorsement_security_deposit
    (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      endorsement_security_deposit r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_block_reward block_reward (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) block_reward r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_endorsement_reward endorsement_reward (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) endorsement_reward
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      r.(delay_per_missing_endorsement).
  Definition with_cost_per_byte cost_per_byte (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      cost_per_byte r.(hard_storage_limit_per_operation) r.(test_chain_duration)
      r.(quorum_min) r.(quorum_max) r.(min_proposal_quorum)
      r.(initial_endorsers) r.(delay_per_missing_endorsement).
  Definition with_hard_storage_limit_per_operation
    hard_storage_limit_per_operation (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) hard_storage_limit_per_operation r.(test_chain_duration)
      r.(quorum_min) r.(quorum_max) r.(min_proposal_quorum)
      r.(initial_endorsers) r.(delay_per_missing_endorsement).
  Definition with_test_chain_duration test_chain_duration (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation) test_chain_duration
      r.(quorum_min) r.(quorum_max) r.(min_proposal_quorum)
      r.(initial_endorsers) r.(delay_per_missing_endorsement).
  Definition with_quorum_min quorum_min (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) quorum_min r.(quorum_max) r.(min_proposal_quorum)
      r.(initial_endorsers) r.(delay_per_missing_endorsement).
  Definition with_quorum_max quorum_max (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) quorum_max r.(min_proposal_quorum)
      r.(initial_endorsers) r.(delay_per_missing_endorsement).
  Definition with_min_proposal_quorum min_proposal_quorum (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max) min_proposal_quorum
      r.(initial_endorsers) r.(delay_per_missing_endorsement).
  Definition with_initial_endorsers initial_endorsers (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) initial_endorsers
      r.(delay_per_missing_endorsement).
  Definition with_delay_per_missing_endorsement delay_per_missing_endorsement
    (r : record) :=
    Build r.(preserved_cycles) r.(blocks_per_cycle) r.(blocks_per_commitment)
      r.(blocks_per_roll_snapshot) r.(blocks_per_voting_period)
      r.(time_between_blocks) r.(endorsers_per_block)
      r.(hard_gas_limit_per_operation) r.(hard_gas_limit_per_block)
      r.(proof_of_work_threshold) r.(tokens_per_roll)
      r.(michelson_maximum_type_size) r.(seed_nonce_revelation_tip)
      r.(origination_size) r.(block_security_deposit)
      r.(endorsement_security_deposit) r.(block_reward) r.(endorsement_reward)
      r.(cost_per_byte) r.(hard_storage_limit_per_operation)
      r.(test_chain_duration) r.(quorum_min) r.(quorum_max)
      r.(min_proposal_quorum) r.(initial_endorsers)
      delay_per_missing_endorsement.
End parametric.
Definition parametric := parametric.record.

Definition parametric_encoding : Data_encoding.encoding parametric :=
  Data_encoding.conv
    (fun c =>
      ((c.(parametric.preserved_cycles), c.(parametric.blocks_per_cycle),
        c.(parametric.blocks_per_commitment),
        c.(parametric.blocks_per_roll_snapshot),
        c.(parametric.blocks_per_voting_period),
        c.(parametric.time_between_blocks), c.(parametric.endorsers_per_block),
        c.(parametric.hard_gas_limit_per_operation),
        c.(parametric.hard_gas_limit_per_block)),
        ((c.(parametric.proof_of_work_threshold),
          c.(parametric.tokens_per_roll),
          c.(parametric.michelson_maximum_type_size),
          c.(parametric.seed_nonce_revelation_tip),
          c.(parametric.origination_size),
          c.(parametric.block_security_deposit),
          c.(parametric.endorsement_security_deposit),
          c.(parametric.block_reward)),
          (c.(parametric.endorsement_reward), c.(parametric.cost_per_byte),
            c.(parametric.hard_storage_limit_per_operation),
            c.(parametric.test_chain_duration), c.(parametric.quorum_min),
            c.(parametric.quorum_max), c.(parametric.min_proposal_quorum),
            c.(parametric.initial_endorsers),
            c.(parametric.delay_per_missing_endorsement)))))
    (fun function_parameter =>
      let
        '((preserved_cycles, blocks_per_cycle, blocks_per_commitment,
          blocks_per_roll_snapshot, blocks_per_voting_period,
          time_between_blocks, endorsers_per_block,
          hard_gas_limit_per_operation, hard_gas_limit_per_block),
          ((proof_of_work_threshold, tokens_per_roll,
            michelson_maximum_type_size, seed_nonce_revelation_tip,
            origination_size, block_security_deposit,
            endorsement_security_deposit, block_reward),
            (endorsement_reward, cost_per_byte,
              hard_storage_limit_per_operation, test_chain_duration, quorum_min,
              quorum_max, min_proposal_quorum, initial_endorsers,
              delay_per_missing_endorsement))) := function_parameter in
      {| parametric.preserved_cycles := preserved_cycles;
        parametric.blocks_per_cycle := blocks_per_cycle;
        parametric.blocks_per_commitment := blocks_per_commitment;
        parametric.blocks_per_roll_snapshot := blocks_per_roll_snapshot;
        parametric.blocks_per_voting_period := blocks_per_voting_period;
        parametric.time_between_blocks := time_between_blocks;
        parametric.endorsers_per_block := endorsers_per_block;
        parametric.hard_gas_limit_per_operation := hard_gas_limit_per_operation;
        parametric.hard_gas_limit_per_block := hard_gas_limit_per_block;
        parametric.proof_of_work_threshold := proof_of_work_threshold;
        parametric.tokens_per_roll := tokens_per_roll;
        parametric.michelson_maximum_type_size := michelson_maximum_type_size;
        parametric.seed_nonce_revelation_tip := seed_nonce_revelation_tip;
        parametric.origination_size := origination_size;
        parametric.block_security_deposit := block_security_deposit;
        parametric.endorsement_security_deposit := endorsement_security_deposit;
        parametric.block_reward := block_reward;
        parametric.endorsement_reward := endorsement_reward;
        parametric.cost_per_byte := cost_per_byte;
        parametric.hard_storage_limit_per_operation :=
          hard_storage_limit_per_operation;
        parametric.test_chain_duration := test_chain_duration;
        parametric.quorum_min := quorum_min;
        parametric.quorum_max := quorum_max;
        parametric.min_proposal_quorum := min_proposal_quorum;
        parametric.initial_endorsers := initial_endorsers;
        parametric.delay_per_missing_endorsement :=
          delay_per_missing_endorsement |}) None
    (Data_encoding.merge_objs
      (Data_encoding.obj9
        (Data_encoding.req None None "preserved_cycles" Data_encoding.uint8)
        (Data_encoding.req None None "blocks_per_cycle"
          Data_encoding.__int32_value)
        (Data_encoding.req None None "blocks_per_commitment"
          Data_encoding.__int32_value)
        (Data_encoding.req None None "blocks_per_roll_snapshot"
          Data_encoding.__int32_value)
        (Data_encoding.req None None "blocks_per_voting_period"
          Data_encoding.__int32_value)
        (Data_encoding.req None None "time_between_blocks"
          (Data_encoding.__list_value None Period_repr.encoding))
        (Data_encoding.req None None "endorsers_per_block" Data_encoding.uint16)
        (Data_encoding.req None None "hard_gas_limit_per_operation"
          Data_encoding.z)
        (Data_encoding.req None None "hard_gas_limit_per_block" Data_encoding.z))
      (Data_encoding.merge_objs
        (Data_encoding.obj8
          (Data_encoding.req None None "proof_of_work_threshold"
            Data_encoding.__int64_value)
          (Data_encoding.req None None "tokens_per_roll" Tez_repr.encoding)
          (Data_encoding.req None None "michelson_maximum_type_size"
            Data_encoding.uint16)
          (Data_encoding.req None None "seed_nonce_revelation_tip"
            Tez_repr.encoding)
          (Data_encoding.req None None "origination_size" Data_encoding.int31)
          (Data_encoding.req None None "block_security_deposit"
            Tez_repr.encoding)
          (Data_encoding.req None None "endorsement_security_deposit"
            Tez_repr.encoding)
          (Data_encoding.req None None "block_reward" Tez_repr.encoding))
        (Data_encoding.obj9
          (Data_encoding.req None None "endorsement_reward" Tez_repr.encoding)
          (Data_encoding.req None None "cost_per_byte" Tez_repr.encoding)
          (Data_encoding.req None None "hard_storage_limit_per_operation"
            Data_encoding.z)
          (Data_encoding.req None None "test_chain_duration"
            Data_encoding.__int64_value)
          (Data_encoding.req None None "quorum_min" Data_encoding.__int32_value)
          (Data_encoding.req None None "quorum_max" Data_encoding.__int32_value)
          (Data_encoding.req None None "min_proposal_quorum"
            Data_encoding.__int32_value)
          (Data_encoding.req None None "initial_endorsers" Data_encoding.uint16)
          (Data_encoding.req None None "delay_per_missing_endorsement"
            Period_repr.encoding)))).

Module t.
  Record record : Set := Build {
    fixed : fixed;
    parametric : parametric }.
  Definition with_fixed fixed (r : record) :=
    Build fixed r.(parametric).
  Definition with_parametric parametric (r : record) :=
    Build r.(fixed) parametric.
End t.
Definition t := t.record.

Definition encoding : Data_encoding.encoding t :=
  Data_encoding.conv
    (fun function_parameter =>
      let '{| t.fixed := __fixed_value; t.parametric := __parametric_value |} :=
        function_parameter in
      (__fixed_value, __parametric_value))
    (fun function_parameter =>
      let '(__fixed_value, __parametric_value) := function_parameter in
      {| t.fixed := __fixed_value; t.parametric := __parametric_value |}) None
    (Data_encoding.merge_objs fixed_encoding parametric_encoding).

Constants_services

  • OCaml size: 60 lines
  • Coq size: 61 lines (+1% compared to OCaml)
constants_services.ml 1 warning
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

let custom_root =
  ( RPC_path.(open_root / "context" / "constants")
    : RPC_context.t RPC_path.context )

module S = struct
  open Data_encoding

  let errors =
    RPC_service.get_service
      ~description:"Schema for all the RPC errors from this protocol version"
      ~query:RPC_query.empty
      ~output:json_schema
      RPC_path.(custom_root / "errors")

  let all =
    RPC_service.get_service
      ~description:"All constants"
      ~query:RPC_query.empty
      ~output:Alpha_context.Constants.encoding
      custom_root
end

let register () =
  let open Services_registration in
  register0_noctxt S.errors (fun () () ->
      return Data_encoding.Json.(schema error_encoding)) ;
  register0 S.all (fun ctxt () () ->
      let open Constants in
      return {fixed; parametric = parametric ctxt})

let errors ctxt block = RPC_context.make_call0 S.errors ctxt block () ()

let all ctxt block = RPC_context.make_call0 S.all ctxt block () ()
Constants_services.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Services_registration.

Import Alpha_context.

Definition custom_root : RPC_path.context RPC_context.t :=
  RPC_path.op_div (RPC_path.op_div RPC_path.open_root "context") "constants".

Module S.
  Import Data_encoding.
  
  Definition errors
    : RPC_service.service RPC_context.t RPC_context.t unit unit
      Data_encoding.json_schema :=
    RPC_service.get_service
      (Some "Schema for all the RPC errors from this protocol version")
      RPC_query.empty Data_encoding.__json_schema_value
      (RPC_path.op_div custom_root "errors").
  
  Definition all
    : RPC_service.service RPC_context.t RPC_context.t unit unit
      Alpha_context.Constants.t :=
    RPC_service.get_service (Some "All constants") RPC_query.empty
      Alpha_context.Constants.encoding custom_root.
End S.

Definition register (function_parameter : unit) : unit :=
  let '_ := function_parameter in
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  Services_registration.register0 S.all
    (fun ctxt =>
      fun function_parameter =>
        let '_ := function_parameter in
        fun function_parameter =>
          let '_ := function_parameter in
          Error_monad.__return
            {|
              Alpha_context.Constants.t.fixed :=
                Alpha_context.Constants.__fixed_value;
              Alpha_context.Constants.t.parametric :=
                Alpha_context.Constants.__parametric_value ctxt |}).

Definition errors {A : Set} (ctxt : RPC_context.simple A) (block : A)
  : Lwt.t (Error_monad.shell_tzresult Data_encoding.json_schema) :=
  RPC_context.make_call0 S.errors ctxt block tt tt.

Definition all {A : Set} (ctxt : RPC_context.simple A) (block : A)
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Constants.t) :=
  RPC_context.make_call0 S.all ctxt block tt tt.

Constants_services_mli

  • OCaml size: 36 lines
  • Coq size: 24 lines (-34% compared to OCaml)
constants_services.mli success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val errors :
  'a #RPC_context.simple ->
  'a ->
  Data_encoding.json_schema shell_tzresult Lwt.t

(** Returns all the constants of the protocol *)
val all : 'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t

val register : unit -> unit
Constants_services_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.

Import Alpha_context.

Parameter errors : forall {a : Set},
  RPC_context.simple a -> a ->
  Lwt.t (Error_monad.shell_tzresult Data_encoding.json_schema).

Parameter all : forall {a : Set},
  RPC_context.simple a -> a ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Constants.t).

Parameter register : unit -> unit.

Constants_storage

  • OCaml size: 130 lines
  • Coq size: 124 lines (-5% compared to OCaml)
constants_storage.ml success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let preserved_cycles c =
  let constants = Raw_context.constants c in
  constants.preserved_cycles

let blocks_per_cycle c =
  let constants = Raw_context.constants c in
  constants.blocks_per_cycle

let blocks_per_commitment c =
  let constants = Raw_context.constants c in
  constants.blocks_per_commitment

let blocks_per_roll_snapshot c =
  let constants = Raw_context.constants c in
  constants.blocks_per_roll_snapshot

let blocks_per_voting_period c =
  let constants = Raw_context.constants c in
  constants.blocks_per_voting_period

let time_between_blocks c =
  let constants = Raw_context.constants c in
  constants.time_between_blocks

let endorsers_per_block c =
  let constants = Raw_context.constants c in
  constants.endorsers_per_block

let initial_endorsers c =
  let constants = Raw_context.constants c in
  constants.initial_endorsers

let delay_per_missing_endorsement c =
  let constants = Raw_context.constants c in
  constants.delay_per_missing_endorsement

let hard_gas_limit_per_operation c =
  let constants = Raw_context.constants c in
  constants.hard_gas_limit_per_operation

let hard_gas_limit_per_block c =
  let constants = Raw_context.constants c in
  constants.hard_gas_limit_per_block

let cost_per_byte c =
  let constants = Raw_context.constants c in
  constants.cost_per_byte

let hard_storage_limit_per_operation c =
  let constants = Raw_context.constants c in
  constants.hard_storage_limit_per_operation

let proof_of_work_threshold c =
  let constants = Raw_context.constants c in
  constants.proof_of_work_threshold

let tokens_per_roll c =
  let constants = Raw_context.constants c in
  constants.tokens_per_roll

let michelson_maximum_type_size c =
  let constants = Raw_context.constants c in
  constants.michelson_maximum_type_size

let seed_nonce_revelation_tip c =
  let constants = Raw_context.constants c in
  constants.seed_nonce_revelation_tip

let origination_size c =
  let constants = Raw_context.constants c in
  constants.origination_size

let block_security_deposit c =
  let constants = Raw_context.constants c in
  constants.block_security_deposit

let endorsement_security_deposit c =
  let constants = Raw_context.constants c in
  constants.endorsement_security_deposit

let block_reward c =
  let constants = Raw_context.constants c in
  constants.block_reward

let endorsement_reward c =
  let constants = Raw_context.constants c in
  constants.endorsement_reward

let test_chain_duration c =
  let constants = Raw_context.constants c in
  constants.test_chain_duration

let quorum_min c =
  let constants = Raw_context.constants c in
  constants.quorum_min

let quorum_max c =
  let constants = Raw_context.constants c in
  constants.quorum_max

let min_proposal_quorum c =
  let constants = Raw_context.constants c in
  constants.min_proposal_quorum

let parametric c = Raw_context.constants c
Constants_storage.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Constants_repr.
Require Tezos.Period_repr.
Require Tezos.Raw_context.
Require Tezos.Tez_repr.

Definition preserved_cycles (c : Raw_context.context) : int :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.preserved_cycles).

Definition blocks_per_cycle (c : Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.blocks_per_cycle).

Definition blocks_per_commitment (c : Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.blocks_per_commitment).

Definition blocks_per_roll_snapshot (c : Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.blocks_per_roll_snapshot).

Definition blocks_per_voting_period (c : Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.blocks_per_voting_period).

Definition time_between_blocks (c : Raw_context.context) : list Period_repr.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.time_between_blocks).

Definition endorsers_per_block (c : Raw_context.context) : int :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.endorsers_per_block).

Definition initial_endorsers (c : Raw_context.context) : int :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.initial_endorsers).

Definition delay_per_missing_endorsement (c : Raw_context.context)
  : Period_repr.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.delay_per_missing_endorsement).

Definition hard_gas_limit_per_operation (c : Raw_context.context) : Z.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.hard_gas_limit_per_operation).

Definition hard_gas_limit_per_block (c : Raw_context.context) : Z.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.hard_gas_limit_per_block).

Definition cost_per_byte (c : Raw_context.context) : Tez_repr.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.cost_per_byte).

Definition hard_storage_limit_per_operation (c : Raw_context.context) : Z.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.hard_storage_limit_per_operation).

Definition proof_of_work_threshold (c : Raw_context.context) : int64 :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.proof_of_work_threshold).

Definition tokens_per_roll (c : Raw_context.context) : Tez_repr.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.tokens_per_roll).

Definition michelson_maximum_type_size (c : Raw_context.context) : int :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.michelson_maximum_type_size).

Definition seed_nonce_revelation_tip (c : Raw_context.context) : Tez_repr.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.seed_nonce_revelation_tip).

Definition origination_size (c : Raw_context.context) : int :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.origination_size).

Definition block_security_deposit (c : Raw_context.context) : Tez_repr.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.block_security_deposit).

Definition endorsement_security_deposit (c : Raw_context.context)
  : Tez_repr.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.endorsement_security_deposit).

Definition block_reward (c : Raw_context.context) : Tez_repr.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.block_reward).

Definition endorsement_reward (c : Raw_context.context) : Tez_repr.t :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.endorsement_reward).

Definition test_chain_duration (c : Raw_context.context) : int64 :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.test_chain_duration).

Definition quorum_min (c : Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.quorum_min).

Definition quorum_max (c : Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.quorum_max).

Definition min_proposal_quorum (c : Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  constants.(Constants_repr.parametric.min_proposal_quorum).

Definition __parametric_value (c : Raw_context.context)
  : Constants_repr.parametric := Raw_context.constants c.

Contract_hash

  • OCaml size: 44 lines
  • Coq size: 102 lines (+131% compared to OCaml)
contract_hash.ml 1 warning
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* 20 *)
let contract_hash = "\002\090\121" (* KT1(36) *)

module Blake2BModule =
  Blake2B.Make
    (Base58)
    (struct
      let name = "Contract_hash"

      let title = "A contract ID"

      let b58check_prefix = contract_hash

      let size = Some 20
    end)

include Blake2BModule

let () = Base58.check_encoded_prefix b58check_encoding "KT1" 36
Contract_hash.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.

Definition contract_hash : string := "\002Zy".

Definition Blake2BModule :=
  (Blake2B.Make
    (existT (A := unit) (fun _ => _) tt
      {|
        Blake2B.SRegister.register_encoding {_} := Base58.register_encoding
      |}))
    (let name := "Contract_hash" in
    let title := "A contract ID" in
    let b58check_prefix := contract_hash in
    let size := Some 20 in
    existT (A := unit) (fun _ => _) tt
      {|
        Blake2B.PrefixedName.name := name;
        Blake2B.PrefixedName.title := title;
        Blake2B.PrefixedName.size := size;
        Blake2B.PrefixedName.b58check_prefix := b58check_prefix
      |}).

Definition t := (|Blake2BModule|).(S.HASH.t).

Definition name := (|Blake2BModule|).(S.HASH.name).

Definition title := (|Blake2BModule|).(S.HASH.title).

Definition pp := (|Blake2BModule|).(S.HASH.pp).

Definition pp_short := (|Blake2BModule|).(S.HASH.pp_short).

Definition op_eq := (|Blake2BModule|).(S.HASH.op_eq).

Definition op_ltgt := (|Blake2BModule|).(S.HASH.op_ltgt).

Definition op_lt := (|Blake2BModule|).(S.HASH.op_lt).

Definition op_lteq := (|Blake2BModule|).(S.HASH.op_lteq).

Definition op_gteq := (|Blake2BModule|).(S.HASH.op_gteq).

Definition op_gt := (|Blake2BModule|).(S.HASH.op_gt).

Definition compare := (|Blake2BModule|).(S.HASH.compare).

Definition equal := (|Blake2BModule|).(S.HASH.equal).

Definition max := (|Blake2BModule|).(S.HASH.max).

Definition min := (|Blake2BModule|).(S.HASH.min).

Definition hash_bytes := (|Blake2BModule|).(S.HASH.hash_bytes).

Definition hash_string := (|Blake2BModule|).(S.HASH.hash_string).

Definition zero := (|Blake2BModule|).(S.HASH.zero).

Definition size := (|Blake2BModule|).(S.HASH.size).

Definition to_bytes := (|Blake2BModule|).(S.HASH.to_bytes).

Definition of_bytes_opt := (|Blake2BModule|).(S.HASH.of_bytes_opt).

Definition of_bytes_exn := (|Blake2BModule|).(S.HASH.of_bytes_exn).

Definition to_b58check := (|Blake2BModule|).(S.HASH.to_b58check).

Definition to_short_b58check := (|Blake2BModule|).(S.HASH.to_short_b58check).

Definition of_b58check_exn := (|Blake2BModule|).(S.HASH.of_b58check_exn).

Definition of_b58check_opt := (|Blake2BModule|).(S.HASH.of_b58check_opt).

Definition b58check_encoding := (|Blake2BModule|).(S.HASH.b58check_encoding).

Definition encoding := (|Blake2BModule|).(S.HASH.encoding).

Definition rpc_arg := (|Blake2BModule|).(S.HASH.rpc_arg).

Definition to_path := (|Blake2BModule|).(S.HASH.to_path).

Definition of_path := (|Blake2BModule|).(S.HASH.of_path).

Definition of_path_exn := (|Blake2BModule|).(S.HASH.of_path_exn).

Definition prefix_path := (|Blake2BModule|).(S.HASH.prefix_path).

Definition path_length := (|Blake2BModule|).(S.HASH.path_length).

(* ❌ Top-level evaluations are ignored *)
(* top_level_evaluation *)

Contract_repr

  • OCaml size: 232 lines
  • Coq size: 282 lines (+21% compared to OCaml)
contract_repr.ml 14 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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 t =
  | Implicit of Signature.Public_key_hash.t
  | Originated of Contract_hash.t

module CompareModule = Compare.Make (struct
  type nonrec t = t

  let compare l1 l2 =
    match (l1, l2) with
    | (Implicit pkh1, Implicit pkh2) ->
        Signature.Public_key_hash.compare pkh1 pkh2
    | (Originated h1, Originated h2) ->
        Contract_hash.compare h1 h2
    | (Implicit _, Originated _) ->
        -1
    | (Originated _, Implicit _) ->
        1
end)

include CompareModule

type contract = t

type error += Invalid_contract_notation of string (* `Permanent *)

let to_b58check = function
  | Implicit pbk ->
      Signature.Public_key_hash.to_b58check pbk
  | Originated h ->
      Contract_hash.to_b58check h

let of_b58check s =
  match Base58.decode s with
  | Some (Ed25519.Public_key_hash.Data h) ->
      ok (Implicit (Signature.Ed25519Hash h))
  | Some (Secp256k1.Public_key_hash.Data h) ->
      ok (Implicit (Signature.Secp256k1Hash h))
  | Some (P256.Public_key_hash.Data h) ->
      ok (Implicit (Signature.P256Hash h))
  | Some (Contract_hash.Data h) ->
      ok (Originated h)
  | _ ->
      error (Invalid_contract_notation s)

let pp ppf = function
  | Implicit pbk ->
      Signature.Public_key_hash.pp ppf pbk
  | Originated h ->
      Contract_hash.pp ppf h

let pp_short ppf = function
  | Implicit pbk ->
      Signature.Public_key_hash.pp_short ppf pbk
  | Originated h ->
      Contract_hash.pp_short ppf h

let encoding =
  let open Data_encoding in
  def
    "contract_id"
    ~title:"A contract handle"
    ~description:
      "A contract notation as given to an RPC or inside scripts. Can be a \
       base58 implicit contract hash or a base58 originated contract hash."
  @@ splitted
       ~binary:
         (union
            ~tag_size:`Uint8
            [ case
                (Tag 0)
                ~title:"Implicit"
                Signature.Public_key_hash.encoding
                (function Implicit k -> Some k | _ -> None)
                (fun k -> Implicit k);
              case
                (Tag 1)
                (Fixed.add_padding Contract_hash.encoding 1)
                ~title:"Originated"
                (function Originated k -> Some k | _ -> None)
                (fun k -> Originated k) ])
       ~json:
         (conv
            to_b58check
            (fun s ->
              match of_b58check s with
              | Ok s ->
                  s
              | Error _ ->
                  Json.cannot_destruct "Invalid contract notation.")
            string)

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"contract.invalid_contract_notation"
    ~title:"Invalid contract notation"
    ~pp:(fun ppf x -> Format.fprintf ppf "Invalid contract notation %S" x)
    ~description:
      "A malformed contract notation was given to an RPC or in a script."
    (obj1 (req "notation" string))
    (function Invalid_contract_notation loc -> Some loc | _ -> None)
    (fun loc -> Invalid_contract_notation loc)

let implicit_contract id = Implicit id

let is_implicit = function Implicit m -> Some m | Originated _ -> None

let is_originated = function Implicit _ -> None | Originated h -> Some h

type origination_nonce = {
  operation_hash : Operation_hash.t;
  origination_index : int32;
}

let origination_nonce_encoding =
  let open Data_encoding in
  conv
    (fun {operation_hash; origination_index} ->
      (operation_hash, origination_index))
    (fun (operation_hash, origination_index) ->
      {operation_hash; origination_index})
  @@ obj2 (req "operation" Operation_hash.encoding) (dft "index" int32 0l)

let originated_contract nonce =
  let data =
    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce
  in
  Originated (Contract_hash.hash_bytes [data])

let originated_contracts
    ~since:{origination_index = first; operation_hash = first_hash}
    ~until:( {origination_index = last; operation_hash = last_hash} as
           origination_nonce ) =
  assert (Operation_hash.equal first_hash last_hash) ;
  let rec contracts acc origination_index =
    if Compare.Int32.(origination_index < first) then acc
    else
      let origination_nonce = {origination_nonce with origination_index} in
      let acc = originated_contract origination_nonce :: acc in
      contracts acc (Int32.pred origination_index)
  in
  contracts [] (Int32.pred last)

let initial_origination_nonce operation_hash =
  {operation_hash; origination_index = 0l}

let incr_origination_nonce nonce =
  let origination_index = Int32.succ nonce.origination_index in
  {nonce with origination_index}

let rpc_arg =
  let construct = to_b58check in
  let destruct hash =
    match of_b58check hash with
    | Error _ ->
        Error "Cannot parse contract id"
    | Ok contract ->
        Ok contract
  in
  RPC_arg.make
    ~descr:"A contract identifier encoded in b58check."
    ~name:"contract_id"
    ~construct
    ~destruct
    ()

module Index : Storage_description.INDEX with type t = contract = struct
  type t = contract

  let path_length = 7

  let to_path c l =
    let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
    let (`Hex key) = MBytes.to_hex raw_key in
    let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
    String.sub index_key 0 2 :: String.sub index_key 2 2
    :: String.sub index_key 4 2 :: String.sub index_key 6 2
    :: String.sub index_key 8 2 :: String.sub index_key 10 2 :: key :: l

  let of_path = function
    | []
    | [_]
    | [_; _]
    | [_; _; _]
    | [_; _; _; _]
    | [_; _; _; _; _]
    | [_; _; _; _; _; _]
    | _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ ->
        None
    | [index1; index2; index3; index4; index5; index6; key] ->
        let raw_key = MBytes.of_hex (`Hex key) in
        let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
        assert (Compare.String.(String.sub index_key 0 2 = index1)) ;
        assert (Compare.String.(String.sub index_key 2 2 = index2)) ;
        assert (Compare.String.(String.sub index_key 4 2 = index3)) ;
        assert (Compare.String.(String.sub index_key 6 2 = index4)) ;
        assert (Compare.String.(String.sub index_key 8 2 = index5)) ;
        assert (Compare.String.(String.sub index_key 10 2 = index6)) ;
        Data_encoding.Binary.of_bytes encoding raw_key

  let rpc_arg = rpc_arg

  let encoding = encoding

  let compare = compare
end
Contract_repr.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Unset Guard Checking.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Contract_hash.
Require Tezos.Storage_description.

Inductive t : Set :=
| Implicit : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> t
| Originated : Contract_hash.t -> t.

Definition CompareModule :=
  Compare.Make
    (let t : Set := t in
    let compare (l1 : t) (l2 : t) : int :=
      match (l1, l2) with
      | (Implicit pkh1, Implicit pkh2) =>
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.compare) pkh1 pkh2
      | (Originated h1, Originated h2) => Contract_hash.compare h1 h2
      | (Implicit _, Originated _) => (-1)
      | (Originated _, Implicit _) => 1
      end in
    existT (A := Set) _ _
      {|
        Compare.COMPARABLE.compare := compare
      |}).

Definition op_eq := (|CompareModule|).(Compare.S.op_eq).

Definition op_ltgt := (|CompareModule|).(Compare.S.op_ltgt).

Definition op_lt := (|CompareModule|).(Compare.S.op_lt).

Definition op_lteq := (|CompareModule|).(Compare.S.op_lteq).

Definition op_gteq := (|CompareModule|).(Compare.S.op_gteq).

Definition op_gt := (|CompareModule|).(Compare.S.op_gt).

Definition compare := (|CompareModule|).(Compare.S.compare).

Definition equal := (|CompareModule|).(Compare.S.equal).

Definition max := (|CompareModule|).(Compare.S.max).

Definition min := (|CompareModule|).(Compare.S.min).

Definition contract : Set := t.

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

Definition to_b58check (function_parameter : t) : string :=
  match function_parameter with
  | Implicit pbk =>
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.to_b58check) pbk
  | Originated h => Contract_hash.to_b58check h
  end.

Definition of_b58check (s : string) : Error_monad.tzresult t :=
  let '_ := Base58.decode s in
  Error_monad.__error_value extensible_type_value.

Definition pp (ppf : Format.formatter) (function_parameter : t) : unit :=
  match function_parameter with
  | Implicit pbk =>
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.pp) ppf pbk
  | Originated h => Contract_hash.pp ppf h
  end.

Definition pp_short (ppf : Format.formatter) (function_parameter : t) : unit :=
  match function_parameter with
  | Implicit pbk =>
    (|Signature.Public_key_hash|).(S.SPublic_key_hash.pp_short) ppf pbk
  | Originated h => Contract_hash.pp_short ppf h
  end.

Definition encoding : Data_encoding.encoding t :=
  (Data_encoding.def "contract_id" (Some "A contract handle")
    (Some
      "A contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash."))
    (Data_encoding.splitted
      (Data_encoding.conv to_b58check
        (fun s =>
          match of_b58check s with
          | Pervasives.Ok s => s
          | Pervasives.Error _ =>
            Data_encoding.Json.cannot_destruct
              (CamlinternalFormatBasics.Format
                (CamlinternalFormatBasics.String_literal
                  "Invalid contract notation."
                  CamlinternalFormatBasics.End_of_format)
                "Invalid contract notation.")
          end) None Data_encoding.__string_value)
      (Data_encoding.union (Some Data_encoding.Uint8)
        [
          Data_encoding.__case_value "Implicit" None (Data_encoding.Tag 0)
            (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding)
            (fun function_parameter =>
              match function_parameter with
              | Implicit k => Some k
              | _ => None
              end) (fun k => Implicit k);
          Data_encoding.__case_value "Originated" None (Data_encoding.Tag 1)
            (Data_encoding.Fixed.add_padding Contract_hash.encoding 1)
            (fun function_parameter =>
              match function_parameter with
              | Originated k => Some k
              | _ => None
              end) (fun k => Originated k)
        ])).

(* ❌ Top-level evaluations are ignored *)
(* top_level_evaluation *)

Definition implicit_contract
  (id : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) : t := Implicit id.

Definition is_implicit (function_parameter : t)
  : option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) :=
  match function_parameter with
  | Implicit m => Some m
  | Originated _ => None
  end.

Definition is_originated (function_parameter : t) : option Contract_hash.t :=
  match function_parameter with
  | Implicit _ => None
  | Originated h => Some h
  end.

Module origination_nonce.
  Record record : Set := Build {
    operation_hash : (|Operation_hash|).(S.HASH.t);
    origination_index : int32 }.
  Definition with_operation_hash operation_hash (r : record) :=
    Build operation_hash r.(origination_index).
  Definition with_origination_index origination_index (r : record) :=
    Build r.(operation_hash) origination_index.
End origination_nonce.
Definition origination_nonce := origination_nonce.record.

Definition origination_nonce_encoding
  : Data_encoding.encoding origination_nonce :=
  (let arg :=
    Data_encoding.conv
      (fun function_parameter =>
        let '{|
          origination_nonce.operation_hash := operation_hash;
            origination_nonce.origination_index := origination_index
            |} := function_parameter in
        (operation_hash, origination_index))
      (fun function_parameter =>
        let '(operation_hash, origination_index) := function_parameter in
        {| origination_nonce.operation_hash := operation_hash;
          origination_nonce.origination_index := origination_index |}) in
  fun eta => arg None eta)
    (Data_encoding.obj2
      (Data_encoding.req None None "operation"
        (|Operation_hash|).(S.HASH.encoding))
      (Data_encoding.dft None None "index" Data_encoding.__int32_value
        (* ❌ Constant of type int32 is converted to int *)
        0)).

Definition originated_contract (__nonce_value : origination_nonce) : t :=
  let data :=
    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding __nonce_value
    in
  Originated (Contract_hash.hash_bytes None [ data ]).

Definition originated_contracts (function_parameter : origination_nonce)
  : origination_nonce -> list t :=
  let '{|
    origination_nonce.operation_hash := first_hash;
      origination_nonce.origination_index := first
      |} := function_parameter in
  fun function_parameter =>
    let
      '{|
        origination_nonce.operation_hash := last_hash;
          origination_nonce.origination_index := last
          |} as origination_nonce := function_parameter in
    (* ❌ Sequences of instructions are ignored (operator ";") *)
    (* ❌ instruction_sequence ";" *)
    let fix contracts
      (acc : list t) (origination_index : (|Compare.Int32|).(Compare.S.t))
      {struct acc} : list t :=
      if (|Compare.Int32|).(Compare.S.op_lt) origination_index first then
        acc
      else
        let origination_nonce :=
          origination_nonce.with_origination_index origination_index
            origination_nonce in
        let acc := cons (originated_contract origination_nonce) acc in
        contracts acc (Int32.pred origination_index) in
    contracts nil (Int32.pred last).

Definition initial_origination_nonce
  (operation_hash : (|Operation_hash|).(S.HASH.t)) : origination_nonce :=
  {| origination_nonce.operation_hash := operation_hash;
    origination_nonce.origination_index :=
      (* ❌ Constant of type int32 is converted to int *)
      0 |}.

Definition incr_origination_nonce (__nonce_value : origination_nonce)
  : origination_nonce :=
  let origination_index :=
    Int32.succ __nonce_value.(origination_nonce.origination_index) in
  origination_nonce.with_origination_index origination_index __nonce_value.

Definition rpc_arg : RPC_arg.arg t :=
  let construct := to_b58check in
  let destruct (__hash_value : string) : Pervasives.result t string :=
    match of_b58check __hash_value with
    | Pervasives.Error _ => Pervasives.Error "Cannot parse contract id"
    | Pervasives.Ok contract => Pervasives.Ok contract
    end in
  RPC_arg.make (Some "A contract identifier encoded in b58check.") "contract_id"
    destruct construct tt.

Definition Index :
  {_ : unit & Storage_description.INDEX.signature (t := contract)} :=
  let t : Set := contract in
  let path_length := 7 in
  let to_path (c : t) (l : list string) : list string :=
    let raw_key := Data_encoding.Binary.to_bytes_exn encoding c in
    let 'MBytes.Hex __key_value := MBytes.to_hex raw_key in
    let 'MBytes.Hex index_key := MBytes.to_hex (Raw_hashes.blake2b raw_key) in
    cons (String.sub index_key 0 2)
      (cons (String.sub index_key 2 2)
        (cons (String.sub index_key 4 2)
          (cons (String.sub index_key 6 2)
            (cons (String.sub index_key 8 2)
              (cons (String.sub index_key 10 2) (cons __key_value l)))))) in
  let of_path (function_parameter : list (|Compare.String|).(Compare.S.t))
    : option t :=
    match function_parameter with
    |
      ([] | cons _ [] | cons _ (cons _ []) | cons _ (cons _ (cons _ [])) |
      cons _ (cons _ (cons _ (cons _ []))) |
      cons _ (cons _ (cons _ (cons _ (cons _ [])))) |
      cons _ (cons _ (cons _ (cons _ (cons _ (cons _ []))))) |
      cons _ (cons _ (cons _ (cons _ (cons _ (cons _ (cons _ (cons _ _))))))))
      => None
    |
      cons index1
        (cons index2
          (cons index3
            (cons index4 (cons index5 (cons index6 (cons __key_value [])))))) =>
      let raw_key := MBytes.of_hex (MBytes.Hex __key_value) in
      let 'MBytes.Hex index_key := MBytes.to_hex (Raw_hashes.blake2b raw_key) in
      (* ❌ Sequences of instructions are ignored (operator ";") *)
      (* ❌ instruction_sequence ";" *)
      (* ❌ Sequences of instructions are ignored (operator ";") *)
      (* ❌ instruction_sequence ";" *)
      (* ❌ Sequences of instructions are ignored (operator ";") *)
      (* ❌ instruction_sequence ";" *)
      (* ❌ Sequences of instructions are ignored (operator ";") *)
      (* ❌ instruction_sequence ";" *)
      (* ❌ Sequences of instructions are ignored (operator ";") *)
      (* ❌ instruction_sequence ";" *)
      (* ❌ Sequences of instructions are ignored (operator ";") *)
      (* ❌ instruction_sequence ";" *)
      Data_encoding.Binary.of_bytes encoding raw_key
    end in
  existT (A := unit) (fun _ => _) tt
    {|
      Storage_description.INDEX.path_length := path_length;
      Storage_description.INDEX.to_path := to_path;
      Storage_description.INDEX.of_path := of_path;
      Storage_description.INDEX.rpc_arg := rpc_arg;
      Storage_description.INDEX.encoding := encoding;
      Storage_description.INDEX.compare := compare
    |}.

Contract_repr_mli

  • OCaml size: 80 lines
  • Coq size: 89 lines (+11% compared to OCaml)
contract_repr.mli 1 warning
(*****************************************************************************)
(*                                                                           *)
(* 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 t = private
  | Implicit of Signature.Public_key_hash.t
  | Originated of Contract_hash.t

type contract = t

include Compare.S with type t := contract

(** {2 Implicit contracts} *)

val implicit_contract : Signature.Public_key_hash.t -> contract

val is_implicit : contract -> Signature.Public_key_hash.t option

(** {2 Originated contracts} *)

(** Originated contracts handles are crafted from the hash of the
    operation that triggered their origination (and nothing else).
    As a single operation can trigger several originations, the
    corresponding handles are forged from a deterministic sequence of
    nonces, initialized with the hash of the operation. *)
type origination_nonce

val originated_contract : origination_nonce -> contract

val originated_contracts :
  since:origination_nonce -> until:origination_nonce -> contract list

val initial_origination_nonce : Operation_hash.t -> origination_nonce

val incr_origination_nonce : origination_nonce -> origination_nonce

val is_originated : contract -> Contract_hash.t option

(** {2 Human readable notation} *)

type error += Invalid_contract_notation of string (* `Permanent *)

val to_b58check : contract -> string

val of_b58check : string -> contract tzresult

val pp : Format.formatter -> contract -> unit

val pp_short : Format.formatter -> contract -> unit

(** {2 Serializers} *)

val encoding : contract Data_encoding.t

val origination_nonce_encoding : origination_nonce Data_encoding.t

val rpc_arg : contract RPC_arg.arg

module Index : Storage_description.INDEX with type t = t
Contract_repr_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Contract_hash.
Require Tezos.Storage_description.

Inductive t : Set :=
| Implicit : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> t
| Originated : Contract_hash.t -> t.

Definition contract : Set := t.

Parameter Included_S : {_ : unit & Compare.S.signature (t := contract)}.

Definition op_eq : contract -> contract -> bool :=
  (|Included_S|).(Compare.S.op_eq).

Definition op_ltgt : contract -> contract -> bool :=
  (|Included_S|).(Compare.S.op_ltgt).

Definition op_lt : contract -> contract -> bool :=
  (|Included_S|).(Compare.S.op_lt).

Definition op_lteq : contract -> contract -> bool :=
  (|Included_S|).(Compare.S.op_lteq).

Definition op_gteq : contract -> contract -> bool :=
  (|Included_S|).(Compare.S.op_gteq).

Definition op_gt : contract -> contract -> bool :=
  (|Included_S|).(Compare.S.op_gt).

Definition compare : contract -> contract -> int :=
  (|Included_S|).(Compare.S.compare).

Definition equal : contract -> contract -> bool :=
  (|Included_S|).(Compare.S.equal).

Definition max : contract -> contract -> contract :=
  (|Included_S|).(Compare.S.max).

Definition min : contract -> contract -> contract :=
  (|Included_S|).(Compare.S.min).

Parameter implicit_contract :
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> contract.

Parameter is_implicit :
  contract -> option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t).

Parameter origination_nonce : Set.

Parameter originated_contract : origination_nonce -> contract.

Parameter originated_contracts :
  origination_nonce -> origination_nonce -> list contract.

Parameter initial_origination_nonce :
  (|Operation_hash|).(S.HASH.t) -> origination_nonce.

Parameter incr_origination_nonce : origination_nonce -> origination_nonce.

Parameter is_originated : contract -> option Contract_hash.t.

(* extensible_type_definition `error` *)

Parameter to_b58check : contract -> string.

Parameter of_b58check : string -> Error_monad.tzresult contract.

Parameter pp : Format.formatter -> contract -> unit.

Parameter pp_short : Format.formatter -> contract -> unit.

Parameter encoding : Data_encoding.t contract.

Parameter origination_nonce_encoding : Data_encoding.t origination_nonce.

Parameter rpc_arg : RPC_arg.arg contract.

Parameter Index : {_ : unit & Storage_description.INDEX.signature (t := t)}.

Contract_services

  • OCaml size: 429 lines
  • Coq size: 430 lines (+0% compared to OCaml)
contract_services.ml 15 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

let custom_root =
  ( RPC_path.(open_root / "context" / "contracts")
    : RPC_context.t RPC_path.context )

let big_map_root =
  ( RPC_path.(open_root / "context" / "big_maps")
    : RPC_context.t RPC_path.context )

type info = {
  balance : Tez.t;
  delegate : public_key_hash option;
  counter : counter option;
  script : Script.t option;
}

let info_encoding =
  let open Data_encoding in
  conv
    (fun {balance; delegate; script; counter} ->
      (balance, delegate, script, counter))
    (fun (balance, delegate, script, counter) ->
      {balance; delegate; script; counter})
  @@ obj4
       (req "balance" Tez.encoding)
       (opt "delegate" Signature.Public_key_hash.encoding)
       (opt "script" Script.encoding)
       (opt "counter" n)

module S = struct
  open Data_encoding

  let balance =
    RPC_service.get_service
      ~description:"Access the balance of a contract."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "balance")

  let manager_key =
    RPC_service.get_service
      ~description:"Access the manager of a contract."
      ~query:RPC_query.empty
      ~output:(option Signature.Public_key.encoding)
      RPC_path.(custom_root /: Contract.rpc_arg / "manager_key")

  let delegate =
    RPC_service.get_service
      ~description:"Access the delegate of a contract, if any."
      ~query:RPC_query.empty
      ~output:Signature.Public_key_hash.encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "delegate")

  let counter =
    RPC_service.get_service
      ~description:"Access the counter of a contract, if any."
      ~query:RPC_query.empty
      ~output:z
      RPC_path.(custom_root /: Contract.rpc_arg / "counter")

  let script =
    RPC_service.get_service
      ~description:"Access the code and data of the contract."
      ~query:RPC_query.empty
      ~output:Script.encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "script")

  let storage =
    RPC_service.get_service
      ~description:"Access the data of the contract."
      ~query:RPC_query.empty
      ~output:Script.expr_encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "storage")

  let entrypoint_type =
    RPC_service.get_service
      ~description:"Return the type of the given entrypoint of the contract"
      ~query:RPC_query.empty
      ~output:Script.expr_encoding
      RPC_path.(
        custom_root /: Contract.rpc_arg / "entrypoints" /: RPC_arg.string)

  let list_entrypoints =
    RPC_service.get_service
      ~description:"Return the list of entrypoints of the contract"
      ~query:RPC_query.empty
      ~output:
        (obj2
           (dft
              "unreachable"
              (Data_encoding.list
                 (obj1
                    (req
                       "path"
                       (Data_encoding.list
                          Michelson_v1_primitives.prim_encoding))))
              [])
           (req "entrypoints" (assoc Script.expr_encoding)))
      RPC_path.(custom_root /: Contract.rpc_arg / "entrypoints")

  let contract_big_map_get_opt =
    RPC_service.post_service
      ~description:
        "Access the value associated with a key in a big map of the contract \
         (deprecated)."
      ~query:RPC_query.empty
      ~input:
        (obj2
           (req "key" Script.expr_encoding)
           (req "type" Script.expr_encoding))
      ~output:(option Script.expr_encoding)
      RPC_path.(custom_root /: Contract.rpc_arg / "big_map_get")

  let big_map_get =
    RPC_service.get_service
      ~description:"Access the value associated with a key in a big map."
      ~query:RPC_query.empty
      ~output:Script.expr_encoding
      RPC_path.(big_map_root /: Big_map.rpc_arg /: Script_expr_hash.rpc_arg)

  let info =
    RPC_service.get_service
      ~description:"Access the complete status of a contract."
      ~query:RPC_query.empty
      ~output:info_encoding
      RPC_path.(custom_root /: Contract.rpc_arg)

  let list =
    RPC_service.get_service
      ~description:
        "All existing contracts (including non-empty default contracts)."
      ~query:RPC_query.empty
      ~output:(list Contract.encoding)
      custom_root
end

let register () =
  let open Services_registration in
  register0 S.list (fun ctxt () () -> Contract.list ctxt >>= return) ;
  let register_field s f =
    register1 s (fun ctxt contract () () ->
        Contract.exists ctxt contract
        >>=? function true -> f ctxt contract | false -> raise Not_found)
  in
  let register_opt_field s f =
    register_field s (fun ctxt a1 ->
        f ctxt a1 >>=? function None -> raise Not_found | Some v -> return v)
  in
  let do_big_map_get ctxt id key =
    let open Script_ir_translator in
    let ctxt = Gas.set_unlimited ctxt in
    Big_map.exists ctxt id
    >>=? fun (ctxt, types) ->
    match types with
    | None ->
        raise Not_found
    | Some (_, value_type) -> (
        Lwt.return
          (parse_ty
             ctxt
             ~legacy:true
             ~allow_big_map:false
             ~allow_operation:false
             ~allow_contract:true
             (Micheline.root value_type))
        >>=? fun (Ex_ty value_type, ctxt) ->
        Big_map.get_opt ctxt id key
        >>=? fun (_ctxt, value) ->
        match value with
        | None ->
            raise Not_found
        | Some value ->
            (parse_data [@coq_implicit "(a := unit)"])
              ctxt
              ~legacy:true
              value_type
              (Micheline.root value)
            >>=? fun (value, ctxt) ->
            unparse_data ctxt Readable value_type value
            >>=? fun (value, _ctxt) -> return (Micheline.strip_locations value)
        )
  in
  register_field S.balance Contract.get_balance ;
  register1 S.manager_key (fun ctxt contract () () ->
      match Contract.is_implicit contract with
      | None ->
          raise Not_found
      | Some mgr -> (
          Contract.is_manager_key_revealed ctxt mgr
          >>=? function
          | false ->
              return_none
          | true ->
              Contract.get_manager_key ctxt mgr >>=? return_some )) ;
  register_opt_field S.delegate Delegate.get ;
  register1 S.counter (fun ctxt contract () () ->
      match Contract.is_implicit contract with
      | None ->
          raise Not_found
      | Some mgr ->
          Contract.get_counter ctxt mgr) ;
  register_opt_field S.script (fun c v ->
      Contract.get_script c v >>=? fun (_, v) -> return v) ;
  register_opt_field S.storage (fun ctxt contract ->
      Contract.get_script ctxt contract
      >>=? fun (ctxt, script) ->
      match script with
      | None ->
          return_none
      | Some script ->
          let ctxt = Gas.set_unlimited ctxt in
          let open Script_ir_translator in
          parse_script ctxt ~legacy:true script
          >>=? fun (Ex_script script, ctxt) ->
          unparse_script ctxt Readable script
          >>=? fun (script, ctxt) ->
          Script.force_decode_in_context ctxt script.storage
          >>=? fun (storage, _ctxt) -> return_some storage) ;
  register2 S.entrypoint_type (fun ctxt v entrypoint () () ->
      Contract.get_script_code ctxt v
      >>=? fun (_, expr) ->
      match expr with
      | None ->
          raise Not_found
      | Some expr -> (
          let ctxt = Gas.set_unlimited ctxt in
          let legacy = true in
          let open Script_ir_translator in
          Script.force_decode_in_context ctxt expr
          >>=? fun (expr, _) ->
          Lwt.return
            ( parse_toplevel ~legacy expr
            >>? fun (arg_type, _, _, root_name) ->
            parse_ty
              ctxt
              ~legacy
              ~allow_big_map:true
              ~allow_operation:false
              ~allow_contract:true
              arg_type
            >>? fun (Ex_ty arg_type, _) ->
            Script_ir_translator.find_entrypoint ~root_name arg_type entrypoint
            )
          >>= function
          | Ok (_f, Ex_ty ty) ->
              unparse_ty ctxt ty
              >>=? fun (ty_node, _) ->
              return (Micheline.strip_locations ty_node)
          | Error _ ->
              raise Not_found )) ;
  register1 S.list_entrypoints (fun ctxt v () () ->
      Contract.get_script_code ctxt v
      >>=? fun (_, expr) ->
      match expr with
      | None ->
          raise Not_found
      | Some expr ->
          let ctxt = Gas.set_unlimited ctxt in
          let legacy = true in
          let open Script_ir_translator in
          Script.force_decode_in_context ctxt expr
          >>=? fun (expr, _) ->
          Lwt.return
            ( parse_toplevel ~legacy expr
            >>? fun (arg_type, _, _, root_name) ->
            parse_ty
              ctxt
              ~legacy
              ~allow_big_map:true
              ~allow_operation:false
              ~allow_contract:true
              arg_type
            >>? fun (Ex_ty arg_type, _) ->
            Script_ir_translator.list_entrypoints ~root_name arg_type ctxt )
          >>=? fun (unreachable_entrypoint, map) ->
          return
            ( unreachable_entrypoint,
              Entrypoints_map.fold
                (fun entry (_, ty) acc ->
                  (entry, Micheline.strip_locations ty) :: acc)
                map
                [] )) ;
  register1 S.contract_big_map_get_opt (fun ctxt contract () (key, key_type) ->
      Contract.get_script ctxt contract
      >>=? fun (ctxt, script) ->
      Lwt.return
        (Script_ir_translator.parse_packable_ty
           ctxt
           ~legacy:true
           (Micheline.root key_type))
      >>=? fun (Ex_ty key_type, ctxt) ->
      Script_ir_translator.parse_data
        ctxt
        ~legacy:true
        key_type
        (Micheline.root key)
      >>=? fun (key, ctxt) ->
      Script_ir_translator.hash_data ctxt key_type key
      >>=? fun (key, ctxt) ->
      match script with
      | None ->
          raise Not_found
      | Some script ->
          let ctxt = Gas.set_unlimited ctxt in
          let open Script_ir_translator in
          parse_script ctxt ~legacy:true script
          >>=? fun (Ex_script script, ctxt) ->
          Script_ir_translator.collect_big_maps
            ctxt
            script.storage_type
            script.storage
          >>=? fun (ids, _ctxt) ->
          let ids = Script_ir_translator.list_of_big_map_ids ids in
          let rec find = function
            | [] ->
                return_none
            | (id : Z.t) :: ids -> (
              try do_big_map_get ctxt id key >>=? return_some
              with Not_found -> find ids )
          in
          find ids) ;
  register2 S.big_map_get (fun ctxt id key () () -> do_big_map_get ctxt id key) ;
  register_field S.info (fun ctxt contract ->
      Contract.get_balance ctxt contract
      >>=? fun balance ->
      Delegate.get ctxt contract
      >>=? fun delegate ->
      ( match Contract.is_implicit contract with
      | Some manager ->
          Contract.get_counter ctxt manager
          >>=? fun counter -> return_some counter
      | None ->
          return None )
      >>=? fun counter ->
      Contract.get_script ctxt contract
      >>=? fun (ctxt, script) ->
      ( match script with
      | None ->
          return (None, ctxt)
      | Some script ->
          let ctxt = Gas.set_unlimited ctxt in
          let open Script_ir_translator in
          parse_script ctxt ~legacy:true script
          >>=? fun (Ex_script script, ctxt) ->
          unparse_script ctxt Readable script
          >>=? fun (script, ctxt) -> return (Some script, ctxt) )
      >>=? fun (script, _ctxt) -> return {balance; delegate; script; counter})

let list ctxt block = RPC_context.make_call0 S.list ctxt block () ()

let info ctxt block contract =
  RPC_context.make_call1 S.info ctxt block contract () ()

let balance ctxt block contract =
  RPC_context.make_call1 S.balance ctxt block contract () ()

let manager_key ctxt block mgr =
  RPC_context.make_call1
    S.manager_key
    ctxt
    block
    (Contract.implicit_contract mgr)
    ()
    ()

let delegate ctxt block contract =
  RPC_context.make_call1 S.delegate ctxt block contract () ()

let delegate_opt ctxt block contract =
  RPC_context.make_opt_call1 S.delegate ctxt block contract () ()

let counter ctxt block mgr =
  RPC_context.make_call1
    S.counter
    ctxt
    block
    (Contract.implicit_contract mgr)
    ()
    ()

let script ctxt block contract =
  RPC_context.make_call1 S.script ctxt block contract () ()

let script_opt ctxt block contract =
  RPC_context.make_opt_call1 S.script ctxt block contract () ()

let storage ctxt block contract =
  RPC_context.make_call1 S.storage ctxt block contract () ()

let entrypoint_type ctxt block contract entrypoint =
  RPC_context.make_call2 S.entrypoint_type ctxt block contract entrypoint () ()

let list_entrypoints ctxt block contract =
  RPC_context.make_call1 S.list_entrypoints ctxt block contract () ()

let storage_opt ctxt block contract =
  RPC_context.make_opt_call1 S.storage ctxt block contract () ()

let big_map_get ctxt block id key =
  RPC_context.make_call2 S.big_map_get ctxt block id key () ()

let contract_big_map_get_opt ctxt block contract key =
  RPC_context.make_call1 S.contract_big_map_get_opt ctxt block contract () key
Contract_services.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Michelson_v1_primitives.
Require Tezos.Script_expr_hash.
Require Tezos.Script_ir_translator.
Require Tezos.Script_typed_ir.
Require Tezos.Services_registration.

Import Alpha_context.

Definition custom_root : RPC_path.context RPC_context.t :=
  RPC_path.op_div (RPC_path.op_div RPC_path.open_root "context") "contracts".

Definition big_map_root : RPC_path.context RPC_context.t :=
  RPC_path.op_div (RPC_path.op_div RPC_path.open_root "context") "big_maps".

Module info.
  Record record : Set := Build {
    balance : Alpha_context.Tez.t;
    delegate : option Alpha_context.public_key_hash;
    counter : option Alpha_context.counter;
    script : option Alpha_context.Script.t }.
  Definition with_balance balance (r : record) :=
    Build balance r.(delegate) r.(counter) r.(script).
  Definition with_delegate delegate (r : record) :=
    Build r.(balance) delegate r.(counter) r.(script).
  Definition with_counter counter (r : record) :=
    Build r.(balance) r.(delegate) counter r.(script).
  Definition with_script script (r : record) :=
    Build r.(balance) r.(delegate) r.(counter) script.
End info.
Definition info := info.record.

Definition info_encoding : Data_encoding.encoding info :=
  (let arg :=
    Data_encoding.conv
      (fun function_parameter =>
        let '{|
          info.balance := balance;
            info.delegate := delegate;
            info.counter := counter;
            info.script := script
            |} := function_parameter in
        (balance, delegate, script, counter))
      (fun function_parameter =>
        let '(balance, delegate, script, counter) := function_parameter in
        {| info.balance := balance; info.delegate := delegate;
          info.counter := counter; info.script := script |}) in
  fun eta => arg None eta)
    (Data_encoding.obj4
      (Data_encoding.req None None "balance" Alpha_context.Tez.encoding)
      (Data_encoding.opt None None "delegate"
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding))
      (Data_encoding.opt None None "script" Alpha_context.Script.encoding)
      (Data_encoding.opt None None "counter" Data_encoding.n)).

Module S.
  Import Data_encoding.
  
  Definition balance
    : RPC_service.service RPC_context.t
      (RPC_context.t * Alpha_context.Contract.contract) unit unit
      Alpha_context.Tez.t :=
    RPC_service.get_service (Some "Access the balance of a contract.")
      RPC_query.empty Alpha_context.Tez.encoding
      (RPC_path.op_div
        (RPC_path.op_divcolon custom_root Alpha_context.Contract.rpc_arg)
        "balance").
  
  Definition manager_key
    : RPC_service.service RPC_context.t
      (RPC_context.t * Alpha_context.Contract.contract) unit unit
      (option (|Signature.Public_key|).(S.SPublic_key.t)) :=
    RPC_service.get_service (Some "Access the manager of a contract.")
      RPC_query.empty
      (Data_encoding.__option_value
        (|Signature.Public_key|).(S.SPublic_key.encoding))
      (RPC_path.op_div
        (RPC_path.op_divcolon custom_root Alpha_context.Contract.rpc_arg)
        "manager_key").
  
  Definition delegate
    : RPC_service.service RPC_context.t
      (RPC_context.t * Alpha_context.Contract.contract) unit unit
      (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) :=
    RPC_service.get_service (Some "Access the delegate of a contract, if any.")
      RPC_query.empty
      (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding)
      (RPC_path.op_div
        (RPC_path.op_divcolon custom_root Alpha_context.Contract.rpc_arg)
        "delegate").
  
  Definition counter
    : RPC_service.service RPC_context.t
      (RPC_context.t * Alpha_context.Contract.contract) unit unit Z.t :=
    RPC_service.get_service (Some "Access the counter of a contract, if any.")
      RPC_query.empty Data_encoding.z
      (RPC_path.op_div
        (RPC_path.op_divcolon custom_root Alpha_context.Contract.rpc_arg)
        "counter").
  
  Definition script
    : RPC_service.service RPC_context.t
      (RPC_context.t * Alpha_context.Contract.contract) unit unit
      Alpha_context.Script.t :=
    RPC_service.get_service (Some "Access the code and data of the contract.")
      RPC_query.empty Alpha_context.Script.encoding
      (RPC_path.op_div
        (RPC_path.op_divcolon custom_root Alpha_context.Contract.rpc_arg)
        "script").
  
  Definition storage
    : RPC_service.service RPC_context.t
      (RPC_context.t * Alpha_context.Contract.contract) unit unit
      Alpha_context.Script.expr :=
    RPC_service.get_service (Some "Access the data of the contract.")
      RPC_query.empty Alpha_context.Script.expr_encoding
      (RPC_path.op_div
        (RPC_path.op_divcolon custom_root Alpha_context.Contract.rpc_arg)
        "storage").
  
  Definition entrypoint_type
    : RPC_service.service RPC_context.t
      ((RPC_context.t * Alpha_context.Contract.contract) * string) unit unit
      Alpha_context.Script.expr :=
    RPC_service.get_service
      (Some "Return the type of the given entrypoint of the contract")
      RPC_query.empty Alpha_context.Script.expr_encoding
      (RPC_path.op_divcolon
        (RPC_path.op_div
          (RPC_path.op_divcolon custom_root Alpha_context.Contract.rpc_arg)
          "entrypoints") RPC_arg.__string_value).
  
  Definition list_entrypoints
    : RPC_service.service RPC_context.t
      (RPC_context.t * Alpha_context.Contract.contract) unit unit
      (list (list Michelson_v1_primitives.prim) *
        list (string * Alpha_context.Script.expr)) :=
    RPC_service.get_service
      (Some "Return the list of entrypoints of the contract") RPC_query.empty
      (Data_encoding.obj2
        (Data_encoding.dft None None "unreachable"
          (Data_encoding.__list_value None
            (Data_encoding.obj1
              (Data_encoding.req None None "path"
                (Data_encoding.__list_value None
                  Michelson_v1_primitives.prim_encoding)))) nil)
        (Data_encoding.req None None "entrypoints"
          (Data_encoding.assoc Alpha_context.Script.expr_encoding)))
      (RPC_path.op_div
        (RPC_path.op_divcolon custom_root Alpha_context.Contract.rpc_arg)
        "entrypoints").
  
  Definition contract_big_map_get_opt
    : RPC_service.service RPC_context.t
      (RPC_context.t * Alpha_context.Contract.contract) unit
      (Alpha_context.Script.expr * Alpha_context.Script.expr)
      (option Alpha_context.Script.expr) :=
    RPC_service.post_service
      (Some
        "Access the value associated with a key in a big map of the contract (deprecated).")
      RPC_query.empty
      (Data_encoding.obj2
        (Data_encoding.req None None "key" Alpha_context.Script.expr_encoding)
        (Data_encoding.req None None "type" Alpha_context.Script.expr_encoding))
      (Data_encoding.__option_value Alpha_context.Script.expr_encoding)
      (RPC_path.op_div
        (RPC_path.op_divcolon custom_root Alpha_context.Contract.rpc_arg)
        "big_map_get").
  
  Definition big_map_get
    : RPC_service.service RPC_context.t
      ((RPC_context.t * Alpha_context.Big_map.id) * Script_expr_hash.t) unit
      unit Alpha_context.Script.expr :=
    RPC_service.get_service
      (Some "Access the value associated with a key in a big map.")
      RPC_query.empty Alpha_context.Script.expr_encoding
      (RPC_path.op_divcolon
        (RPC_path.op_divcolon big_map_root Alpha_context.Big_map.rpc_arg)
        Script_expr_hash.rpc_arg).
  
  Definition __info_value
    : RPC_service.service RPC_context.t
      (RPC_context.t * Alpha_context.Contract.contract) unit unit info :=
    RPC_service.get_service (Some "Access the complete status of a contract.")
      RPC_query.empty info_encoding
      (RPC_path.op_divcolon custom_root Alpha_context.Contract.rpc_arg).
  
  Definition __list_value
    : RPC_service.service RPC_context.t RPC_context.t unit unit
      (list Alpha_context.Contract.t) :=
    RPC_service.get_service
      (Some "All existing contracts (including non-empty default contracts).")
      RPC_query.empty
      (Data_encoding.__list_value None Alpha_context.Contract.encoding)
      custom_root.
End S.

Definition register (function_parameter : unit) : unit :=
  let '_ := function_parameter in
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  let register_field {A : Set}
    (s :
      RPC_service.t Updater.rpc_context
        (Updater.rpc_context * Alpha_context.Contract.contract) unit unit A)
    (f :
      Alpha_context.t -> Alpha_context.Contract.contract ->
      Lwt.t (Error_monad.tzresult A)) : unit :=
    Services_registration.register1 s
      (fun ctxt =>
        fun contract =>
          fun function_parameter =>
            let '_ := function_parameter in
            fun function_parameter =>
              let '_ := function_parameter in
              let=? function_parameter :=
                Alpha_context.Contract.__exists ctxt contract in
              match function_parameter with
              | true => f ctxt contract
              | false => Pervasives.raise extensible_type_value
              end) in
  let register_opt_field {A : Set}
    (s :
      RPC_service.t Updater.rpc_context
        (Updater.rpc_context * Alpha_context.Contract.contract) unit unit A)
    (f :
      Alpha_context.t -> Alpha_context.Contract.contract ->
      Lwt.t (Error_monad.tzresult (option A))) : unit :=
    register_field s
      (fun ctxt =>
        fun a1 =>
          let=? function_parameter := f ctxt a1 in
          match function_parameter with
          | None => Pervasives.raise extensible_type_value
          | Some v => Error_monad.__return v
          end) in
  let do_big_map_get
    (ctxt : Alpha_context.context) (id : Alpha_context.Big_map.id)
    (__key_value : Script_expr_hash.t)
    : Lwt.t
      (Error_monad.tzresult (Micheline.canonical Alpha_context.Script.prim)) :=
    let ctxt := Alpha_context.Gas.set_unlimited ctxt in
    let=? '(ctxt, types) := Alpha_context.Big_map.__exists ctxt id in
    match types with
    | None => Pervasives.raise extensible_type_value
    | Some (_, value_type) =>
      let=? '(Script_ir_translator.Ex_ty value_type, ctxt) :=
        Lwt.__return
          (Script_ir_translator.parse_ty ctxt true false false true
            (Micheline.root value_type)) in
      let=? '(_ctxt, value) := Alpha_context.Big_map.get_opt ctxt id __key_value
        in
      match value with
      | None => Pervasives.raise extensible_type_value
      | Some value =>
        let=? '(value, ctxt) :=
          (Script_ir_translator.parse_data (a := unit)) None ctxt true
            value_type (Micheline.root value) in
        let=? '(value, _ctxt) :=
          Script_ir_translator.unparse_data ctxt Script_ir_translator.Readable
            value_type value in
        Error_monad.__return (Micheline.strip_locations value)
      end
    end in
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  register_field S.__info_value
    (fun ctxt =>
      fun contract =>
        let=? balance := Alpha_context.Contract.get_balance ctxt contract in
        let=? delegate := Alpha_context.Delegate.get ctxt contract in
        let=? counter :=
          match Alpha_context.Contract.is_implicit contract with
          | Some manager =>
            let=? counter := Alpha_context.Contract.get_counter ctxt manager in
            Error_monad.return_some counter
          | None => Error_monad.__return None
          end in
        let=? '(ctxt, script) := Alpha_context.Contract.get_script ctxt contract
          in
        let=? '(script, _ctxt) :=
          match script with
          | None => Error_monad.__return (None, ctxt)
          | Some script =>
            let ctxt := Alpha_context.Gas.set_unlimited ctxt in
            let=? '(Script_ir_translator.Ex_script script, ctxt) :=
              Script_ir_translator.parse_script None ctxt true script in
            let 'existT _ __Ex_script_'b2 [script, ctxt] :=
              existT (A := Set)
                (fun __Ex_script_'b2 =>
                  [Script_typed_ir.script __Ex_script_'b2 **
                    Alpha_context.context]) _ [script, ctxt] in
            let=? '(script, ctxt) :=
              Script_ir_translator.unparse_script ctxt
                Script_ir_translator.Readable script in
            Error_monad.__return ((Some script), ctxt)
          end in
        Error_monad.__return
          {| info.balance := balance; info.delegate := delegate;
            info.counter := counter; info.script := script |}).

Definition __list_value {A : Set} (ctxt : RPC_context.simple A) (block : A)
  : Lwt.t (Error_monad.shell_tzresult (list Alpha_context.Contract.t)) :=
  RPC_context.make_call0 S.__list_value ctxt block tt tt.

Definition __info_value {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract)
  : Lwt.t (Error_monad.shell_tzresult info) :=
  RPC_context.make_call1 S.__info_value ctxt block contract tt tt.

Definition balance {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract)
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.balance ctxt block contract tt tt.

Definition manager_key {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (mgr : Alpha_context.public_key_hash)
  : Lwt.t
    (Error_monad.shell_tzresult
      (option (|Signature.Public_key|).(S.SPublic_key.t))) :=
  RPC_context.make_call1 S.manager_key ctxt block
    (Alpha_context.Contract.implicit_contract mgr) tt tt.

Definition delegate {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract)
  : Lwt.t
    (Error_monad.shell_tzresult
      (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) :=
  RPC_context.make_call1 S.delegate ctxt block contract tt tt.

Definition delegate_opt {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract)
  : Lwt.t
    (Error_monad.shell_tzresult
      (option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))) :=
  RPC_context.make_opt_call1 S.delegate ctxt block contract tt tt.

Definition counter {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (mgr : Alpha_context.public_key_hash)
  : Lwt.t (Error_monad.shell_tzresult Z.t) :=
  RPC_context.make_call1 S.counter ctxt block
    (Alpha_context.Contract.implicit_contract mgr) tt tt.

Definition script {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract)
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Script.t) :=
  RPC_context.make_call1 S.script ctxt block contract tt tt.

Definition script_opt {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract)
  : Lwt.t (Error_monad.shell_tzresult (option Alpha_context.Script.t)) :=
  RPC_context.make_opt_call1 S.script ctxt block contract tt tt.

Definition storage {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract)
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Script.expr) :=
  RPC_context.make_call1 S.storage ctxt block contract tt tt.

Definition entrypoint_type {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract) (entrypoint : string)
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Script.expr) :=
  RPC_context.make_call2 S.entrypoint_type ctxt block contract entrypoint tt tt.

Definition list_entrypoints {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract)
  : Lwt.t
    (Error_monad.shell_tzresult
      (list (list Michelson_v1_primitives.prim) *
        list (string * Alpha_context.Script.expr))) :=
  RPC_context.make_call1 S.list_entrypoints ctxt block contract tt tt.

Definition storage_opt {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract)
  : Lwt.t (Error_monad.shell_tzresult (option Alpha_context.Script.expr)) :=
  RPC_context.make_opt_call1 S.storage ctxt block contract tt tt.

Definition big_map_get {A : Set}
  (ctxt : RPC_context.simple A) (block : A) (id : Alpha_context.Big_map.id)
  (__key_value : Script_expr_hash.t)
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Script.expr) :=
  RPC_context.make_call2 S.big_map_get ctxt block id __key_value tt tt.

Definition contract_big_map_get_opt {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (contract : Alpha_context.Contract.contract)
  (__key_value : Alpha_context.Script.expr * Alpha_context.Script.expr)
  : Lwt.t (Error_monad.shell_tzresult (option Alpha_context.Script.expr)) :=
  RPC_context.make_call1 S.contract_big_map_get_opt ctxt block contract tt
    __key_value.

Contract_services_mli

  • OCaml size: 119 lines
  • Coq size: 101 lines (-16% compared to OCaml)
contract_services.mli success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val list : 'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t

type info = {
  balance : Tez.t;
  delegate : public_key_hash option;
  counter : counter option;
  script : Script.t option;
}

val info_encoding : info Data_encoding.t

val info :
  'a #RPC_context.simple -> 'a -> Contract.t -> info shell_tzresult Lwt.t

val balance :
  'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t

val manager_key :
  'a #RPC_context.simple ->
  'a ->
  public_key_hash ->
  public_key option shell_tzresult Lwt.t

val delegate :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  public_key_hash shell_tzresult Lwt.t

val delegate_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  public_key_hash option shell_tzresult Lwt.t

val counter :
  'a #RPC_context.simple ->
  'a ->
  public_key_hash ->
  counter shell_tzresult Lwt.t

val script :
  'a #RPC_context.simple -> 'a -> Contract.t -> Script.t shell_tzresult Lwt.t

val script_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.t option shell_tzresult Lwt.t

val storage :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.expr shell_tzresult Lwt.t

val entrypoint_type :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  string ->
  Script.expr shell_tzresult Lwt.t

val list_entrypoints :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  (Michelson_v1_primitives.prim list list * (string * Script.expr) list)
  shell_tzresult
  Lwt.t

val storage_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.expr option shell_tzresult Lwt.t

val big_map_get :
  'a #RPC_context.simple ->
  'a ->
  Z.t ->
  Script_expr_hash.t ->
  Script.expr shell_tzresult Lwt.t

val contract_big_map_get_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.expr * Script.expr ->
  Script.expr option shell_tzresult Lwt.t

val register : unit -> unit
Contract_services_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Michelson_v1_primitives.
Require Tezos.Script_expr_hash.

Import Alpha_context.

Parameter __list_value : forall {a : Set},
  RPC_context.simple a -> a ->
  Lwt.t (Error_monad.shell_tzresult (list Alpha_context.Contract.t)).

Module info.
  Record record : Set := Build {
    balance : Alpha_context.Tez.t;
    delegate : option Alpha_context.public_key_hash;
    counter : option Alpha_context.counter;
    script : option Alpha_context.Script.t }.
  Definition with_balance balance (r : record) :=
    Build balance r.(delegate) r.(counter) r.(script).
  Definition with_delegate delegate (r : record) :=
    Build r.(balance) delegate r.(counter) r.(script).
  Definition with_counter counter (r : record) :=
    Build r.(balance) r.(delegate) counter r.(script).
  Definition with_script script (r : record) :=
    Build r.(balance) r.(delegate) r.(counter) script.
End info.
Definition info := info.record.

Parameter info_encoding : Data_encoding.t info.

Parameter __info_value : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t ->
  Lwt.t (Error_monad.shell_tzresult info).

Parameter balance : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Tez.t).

Parameter manager_key : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.public_key_hash ->
  Lwt.t (Error_monad.shell_tzresult (option Alpha_context.public_key)).

Parameter delegate : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.public_key_hash).

Parameter delegate_opt : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t ->
  Lwt.t (Error_monad.shell_tzresult (option Alpha_context.public_key_hash)).

Parameter counter : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.public_key_hash ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.counter).

Parameter script : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Script.t).

Parameter script_opt : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t ->
  Lwt.t (Error_monad.shell_tzresult (option Alpha_context.Script.t)).

Parameter storage : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Script.expr).

Parameter entrypoint_type : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t -> string ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Script.expr).

Parameter list_entrypoints : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t ->
  Lwt.t
    (Error_monad.shell_tzresult
      (list (list Michelson_v1_primitives.prim) *
        list (string * Alpha_context.Script.expr))).

Parameter storage_opt : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t ->
  Lwt.t (Error_monad.shell_tzresult (option Alpha_context.Script.expr)).

Parameter big_map_get : forall {a : Set},
  RPC_context.simple a -> a -> Z.t -> Script_expr_hash.t ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Script.expr).

Parameter contract_big_map_get_opt : forall {a : Set},
  RPC_context.simple a -> a -> Alpha_context.Contract.t ->
  Alpha_context.Script.expr * Alpha_context.Script.expr ->
  Lwt.t (Error_monad.shell_tzresult (option Alpha_context.Script.expr)).

Parameter register : unit -> unit.

Contract_storage

  • OCaml size: 733 lines
  • Coq size: 818 lines (+11% compared to OCaml)
contract_storage.ml 16 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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 error +=
  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
  | (* `Temporary *)
      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t
  | (* `Branch *)
      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t
  | (* `Temporary *)
      Unspendable_contract of Contract_repr.contract
  | (* `Permanent *)
      Non_existing_contract of Contract_repr.contract
  | (* `Temporary *)
      Empty_implicit_contract of Signature.Public_key_hash.t
  | (* `Temporary *)
      Empty_transaction of Contract_repr.t (* `Temporary *)
  | Inconsistent_hash of
      Signature.Public_key.t
      * Signature.Public_key_hash.t
      * Signature.Public_key_hash.t
  | (* `Permanent *)
      Inconsistent_public_key of
      Signature.Public_key.t * Signature.Public_key.t
  | (* `Permanent *)
      Failure of string (* `Permanent *)
  | Previously_revealed_key of Contract_repr.t (* `Permanent *)
  | Unrevealed_manager_key of Contract_repr.t

(* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"contract.unspendable_contract"
    ~title:"Unspendable contract"
    ~description:
      "An operation tried to spend tokens from an unspendable contract"
    ~pp:(fun ppf c ->
      Format.fprintf
        ppf
        "The tokens of contract %a can only be spent by its script"
        Contract_repr.pp
        c)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Unspendable_contract c -> Some c | _ -> None)
    (fun c -> Unspendable_contract c) ;
  register_error_kind
    `Temporary
    ~id:"contract.balance_too_low"
    ~title:"Balance too low"
    ~description:
      "An operation tried to spend more tokens than the contract has"
    ~pp:(fun ppf (c, b, a) ->
      Format.fprintf
        ppf
        "Balance of contract %a too low (%a) to spend %a"
        Contract_repr.pp
        c
        Tez_repr.pp
        b
        Tez_repr.pp
        a)
    Data_encoding.(
      obj3
        (req "contract" Contract_repr.encoding)
        (req "balance" Tez_repr.encoding)
        (req "amount" Tez_repr.encoding))
    (function Balance_too_low (c, b, a) -> Some (c, b, a) | _ -> None)
    (fun (c, b, a) -> Balance_too_low (c, b, a)) ;
  register_error_kind
    `Temporary
    ~id:"contract.counter_in_the_future"
    ~title:"Invalid counter (not yet reached) in a manager operation"
    ~description:"An operation assumed a contract counter in the future"
    ~pp:(fun ppf (contract, exp, found) ->
      Format.fprintf
        ppf
        "Counter %s not yet reached for contract %a (expected %s)"
        (Z.to_string found)
        Contract_repr.pp
        contract
        (Z.to_string exp))
    Data_encoding.(
      obj3
        (req "contract" Contract_repr.encoding)
        (req "expected" z)
        (req "found" z))
    (function Counter_in_the_future (c, x, y) -> Some (c, x, y) | _ -> None)
    (fun (c, x, y) -> Counter_in_the_future (c, x, y)) ;
  register_error_kind
    `Branch
    ~id:"contract.counter_in_the_past"
    ~title:"Invalid counter (already used) in a manager operation"
    ~description:"An operation assumed a contract counter in the past"
    ~pp:(fun ppf (contract, exp, found) ->
      Format.fprintf
        ppf
        "Counter %s already used for contract %a (expected %s)"
        (Z.to_string found)
        Contract_repr.pp
        contract
        (Z.to_string exp))
    Data_encoding.(
      obj3
        (req "contract" Contract_repr.encoding)
        (req "expected" z)
        (req "found" z))
    (function Counter_in_the_past (c, x, y) -> Some (c, x, y) | _ -> None)
    (fun (c, x, y) -> Counter_in_the_past (c, x, y)) ;
  register_error_kind
    `Temporary
    ~id:"contract.non_existing_contract"
    ~title:"Non existing contract"
    ~description:
      "A contract handle is not present in the context (either it never was \
       or it has been destroyed)"
    ~pp:(fun ppf contract ->
      Format.fprintf ppf "Contract %a does not exist" Contract_repr.pp contract)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Non_existing_contract c -> Some c | _ -> None)
    (fun c -> Non_existing_contract c) ;
  register_error_kind
    `Permanent
    ~id:"contract.manager.inconsistent_hash"
    ~title:"Inconsistent public key hash"
    ~description:
      "A revealed manager public key is inconsistent with the announced hash"
    ~pp:(fun ppf (k, eh, ph) ->
      Format.fprintf
        ppf
        "The hash of the manager public key %s is not %a as announced but %a"
        (Signature.Public_key.to_b58check k)
        Signature.Public_key_hash.pp
        ph
        Signature.Public_key_hash.pp
        eh)
    Data_encoding.(
      obj3
        (req "public_key" Signature.Public_key.encoding)
        (req "expected_hash" Signature.Public_key_hash.encoding)
        (req "provided_hash" Signature.Public_key_hash.encoding))
    (function Inconsistent_hash (k, eh, ph) -> Some (k, eh, ph) | _ -> None)
    (fun (k, eh, ph) -> Inconsistent_hash (k, eh, ph)) ;
  register_error_kind
    `Permanent
    ~id:"contract.manager.inconsistent_public_key"
    ~title:"Inconsistent public key"
    ~description:
      "A provided manager public key is different with the public key stored \
       in the contract"
    ~pp:(fun ppf (eh, ph) ->
      Format.fprintf
        ppf
        "Expected manager public key %s but %s was provided"
        (Signature.Public_key.to_b58check ph)
        (Signature.Public_key.to_b58check eh))
    Data_encoding.(
      obj2
        (req "public_key" Signature.Public_key.encoding)
        (req "expected_public_key" Signature.Public_key.encoding))
    (function Inconsistent_public_key (eh, ph) -> Some (eh, ph) | _ -> None)
    (fun (eh, ph) -> Inconsistent_public_key (eh, ph)) ;
  register_error_kind
    `Permanent
    ~id:"contract.failure"
    ~title:"Contract storage failure"
    ~description:"Unexpected contract storage error"
    ~pp:(fun ppf s -> Format.fprintf ppf "Contract_storage.Failure %S" s)
    Data_encoding.(obj1 (req "message" string))
    (function Failure s -> Some s | _ -> None)
    (fun s -> Failure s) ;
  register_error_kind
    `Branch
    ~id:"contract.unrevealed_key"
    ~title:"Manager operation precedes key revelation"
    ~description:
      "One tried to apply a manager operation without revealing the manager \
       public key"
    ~pp:(fun ppf s ->
      Format.fprintf
        ppf
        "Unrevealed manager key for contract %a."
        Contract_repr.pp
        s)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Unrevealed_manager_key s -> Some s | _ -> None)
    (fun s -> Unrevealed_manager_key s) ;
  register_error_kind
    `Branch
    ~id:"contract.previously_revealed_key"
    ~title:"Manager operation already revealed"
    ~description:"One tried to revealed twice a manager public key"
    ~pp:(fun ppf s ->
      Format.fprintf
        ppf
        "Previously revealed manager key for contract %a."
        Contract_repr.pp
        s)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Previously_revealed_key s -> Some s | _ -> None)
    (fun s -> Previously_revealed_key s) ;
  register_error_kind
    `Branch
    ~id:"implicit.empty_implicit_contract"
    ~title:"Empty implicit contract"
    ~description:
      "No manager operations are allowed on an empty implicit contract."
    ~pp:(fun ppf implicit ->
      Format.fprintf
        ppf
        "Empty implicit contract (%a)"
        Signature.Public_key_hash.pp
        implicit)
    Data_encoding.(obj1 (req "implicit" Signature.Public_key_hash.encoding))
    (function Empty_implicit_contract c -> Some c | _ -> None)
    (fun c -> Empty_implicit_contract c) ;
  register_error_kind
    `Branch
    ~id:"contract.empty_transaction"
    ~title:"Empty transaction"
    ~description:"Forbidden to credit 0ĂȘϩ to a contract without code."
    ~pp:(fun ppf contract ->
      Format.fprintf
        ppf
        "Transaction of 0ĂȘϩ towards a contract without code are forbidden \
         (%a)."
        Contract_repr.pp
        contract)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Empty_transaction c -> Some c | _ -> None)
    (fun c -> Empty_transaction c)

let failwith msg = fail (Failure msg)

type big_map_diff_item =
  | Update of {
      big_map : Z.t;
      diff_key : Script_repr.expr;
      diff_key_hash : Script_expr_hash.t;
      diff_value : Script_repr.expr option;
    }
  | Clear of Z.t
  | Copy of Z.t * Z.t
  | Alloc of {
      big_map : Z.t;
      key_type : Script_repr.expr;
      value_type : Script_repr.expr;
    }

type big_map_diff = big_map_diff_item list

let big_map_diff_item_encoding =
  let open Data_encoding in
  union
    [ case
        (Tag 0)
        ~title:"update"
        (obj5
           (req "action" (constant "update"))
           (req "big_map" z)
           (req "key_hash" Script_expr_hash.encoding)
           (req "key" Script_repr.expr_encoding)
           (opt "value" Script_repr.expr_encoding))
        (function
          | Update {big_map; diff_key_hash; diff_key; diff_value} ->
              Some ((), big_map, diff_key_hash, diff_key, diff_value)
          | _ ->
              None)
        (fun ((), big_map, diff_key_hash, diff_key, diff_value) ->
          Update {big_map; diff_key_hash; diff_key; diff_value});
      case
        (Tag 1)
        ~title:"remove"
        (obj2 (req "action" (constant "remove")) (req "big_map" z))
        (function Clear big_map -> Some ((), big_map) | _ -> None)
        (fun ((), big_map) -> Clear big_map);
      case
        (Tag 2)
        ~title:"copy"
        (obj3
           (req "action" (constant "copy"))
           (req "source_big_map" z)
           (req "destination_big_map" z))
        (function Copy (src, dst) -> Some ((), src, dst) | _ -> None)
        (fun ((), src, dst) -> Copy (src, dst));
      case
        (Tag 3)
        ~title:"alloc"
        (obj4
           (req "action" (constant "alloc"))
           (req "big_map" z)
           (req "key_type" Script_repr.expr_encoding)
           (req "value_type" Script_repr.expr_encoding))
        (function
          | Alloc {big_map; key_type; value_type} ->
              Some ((), big_map, key_type, value_type)
          | _ ->
              None)
        (fun ((), big_map, key_type, value_type) ->
          Alloc {big_map; key_type; value_type}) ]

let big_map_diff_encoding =
  let open Data_encoding in
  def "contract.big_map_diff" @@ list big_map_diff_item_encoding

let big_map_key_cost = 65

let big_map_cost = 33

let update_script_big_map c = function
  | None ->
      return (c, Z.zero)
  | Some diff ->
      fold_left_s
        (fun (c, total) -> function Clear id ->
              Storage.Big_map.Total_bytes.get c id
              >>=? fun size ->
              Storage.Big_map.remove_rec c id
              >>= fun c ->
              if Compare.Z.(id < Z.zero) then return (c, total)
              else return (c, Z.sub (Z.sub total size) (Z.of_int big_map_cost))
          | Copy (from, to_) ->
              Storage.Big_map.copy c ~from ~to_
              >>=? fun c ->
              if Compare.Z.(to_ < Z.zero) then return (c, total)
              else
                Storage.Big_map.Total_bytes.get c from
                >>=? fun size ->
                return (c, Z.add (Z.add total size) (Z.of_int big_map_cost))
          | Alloc {big_map; key_type; value_type} ->
              Storage.Big_map.Total_bytes.init c big_map Z.zero
              >>=? fun c ->
              (* Annotations are erased to allow sharing on
                 [Copy]. The types from the contract code are used,
                 these ones are only used to make sure they are
                 compatible during transmissions between contracts,
                 and only need to be compatible, annotations
                 nonwhistanding. *)
              let key_type =
                Micheline.strip_locations
                  (Script_repr.strip_annotations (Micheline.root key_type))
              in
              let value_type =
                Micheline.strip_locations
                  (Script_repr.strip_annotations (Micheline.root value_type))
              in
              Storage.Big_map.Key_type.init c big_map key_type
              >>=? fun c ->
              Storage.Big_map.Value_type.init c big_map value_type
              >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then return (c, total)
              else return (c, Z.add total (Z.of_int big_map_cost))
          | Update {big_map; diff_key_hash; diff_value = None} ->
              Storage.Big_map.Contents.remove (c, big_map) diff_key_hash
              >>=? fun (c, freed, existed) ->
              let freed =
                if existed then freed + big_map_key_cost else freed
              in
              Storage.Big_map.Total_bytes.get c big_map
              >>=? fun size ->
              Storage.Big_map.Total_bytes.set
                c
                big_map
                (Z.sub size (Z.of_int freed))
              >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then return (c, total)
              else return (c, Z.sub total (Z.of_int freed))
          | Update {big_map; diff_key_hash; diff_value = Some v} ->
              Storage.Big_map.Contents.init_set (c, big_map) diff_key_hash v
              >>=? fun (c, size_diff, existed) ->
              let size_diff =
                if existed then size_diff else size_diff + big_map_key_cost
              in
              Storage.Big_map.Total_bytes.get c big_map
              >>=? fun size ->
              Storage.Big_map.Total_bytes.set
                c
                big_map
                (Z.add size (Z.of_int size_diff))
              >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then return (c, total)
              else return (c, Z.add total (Z.of_int size_diff)))
        (c, Z.zero)
        diff

let create_base c ?(prepaid_bootstrap_storage = false)
    (* Free space for bootstrap contracts *)
    contract ~balance ~manager ~delegate ?script () =
  ( match Contract_repr.is_implicit contract with
  | None ->
      return c
  | Some _ ->
      Storage.Contract.Global_counter.get c
      >>=? fun counter -> Storage.Contract.Counter.init c contract counter )
  >>=? fun c ->
  Storage.Contract.Balance.init c contract balance
  >>=? fun c ->
  ( match manager with
  | Some manager ->
      Storage.Contract.Manager.init c contract (Manager_repr.Hash manager)
  | None ->
      return c )
  >>=? fun c ->
  ( match delegate with
  | None ->
      return c
  | Some delegate ->
      Delegate_storage.init c contract delegate )
  >>=? fun c ->
  match script with
  | Some ({Script_repr.code; storage}, big_map_diff) ->
      Storage.Contract.Code.init c contract code
      >>=? fun (c, code_size) ->
      Storage.Contract.Storage.init c contract storage
      >>=? fun (c, storage_size) ->
      update_script_big_map c big_map_diff
      >>=? fun (c, big_map_size) ->
      let total_size =
        Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size
      in
      assert (Compare.Z.(total_size >= Z.zero)) ;
      let prepaid_bootstrap_storage =
        if prepaid_bootstrap_storage then total_size else Z.zero
      in
      Storage.Contract.Paid_storage_space.init
        c
        contract
        prepaid_bootstrap_storage
      >>=? fun c ->
      Storage.Contract.Used_storage_space.init c contract total_size
  | None ->
      return c

let originate_raw c ?prepaid_bootstrap_storage contract ~balance ~script
    ~delegate =
  create_base
    c
    ?prepaid_bootstrap_storage
    contract
    ~balance
    ~manager:None
    ~delegate
    ~script
    ()

let create_implicit c manager ~balance =
  create_base
    c
    (Contract_repr.implicit_contract manager)
    ~balance
    ~manager:(Some manager)
    ?script:None
    ~delegate:None
    ()

let delete c contract =
  match Contract_repr.is_implicit contract with
  | None ->
      (* For non implicit contract Big_map should be cleared *)
      failwith "Non implicit contracts cannot be removed"
  | Some _ ->
      Delegate_storage.remove c contract
      >>=? fun c ->
      Storage.Contract.Balance.delete c contract
      >>=? fun c ->
      Storage.Contract.Manager.delete c contract
      >>=? fun c ->
      Storage.Contract.Counter.delete c contract
      >>=? fun c ->
      Storage.Contract.Code.remove c contract
      >>=? fun (c, _, _) ->
      Storage.Contract.Storage.remove c contract
      >>=? fun (c, _, _) ->
      Storage.Contract.Paid_storage_space.remove c contract
      >>= fun c ->
      Storage.Contract.Used_storage_space.remove c contract
      >>= fun c -> return c

let allocated c contract =
  Storage.Contract.Balance.get_option c contract
  >>=? function None -> return_false | Some _ -> return_true

let exists c contract =
  match Contract_repr.is_implicit contract with
  | Some _ ->
      return_true
  | None ->
      allocated c contract

let must_exist c contract =
  exists c contract
  >>=? function
  | true -> return_unit | false -> fail (Non_existing_contract contract)

let must_be_allocated c contract =
  allocated c contract
  >>=? function
  | true ->
      return_unit
  | false -> (
    match Contract_repr.is_implicit contract with
    | Some pkh ->
        fail (Empty_implicit_contract pkh)
    | None ->
        fail (Non_existing_contract contract) )

let list c = Storage.Contract.list c

let fresh_contract_from_current_nonce c =
  Lwt.return (Raw_context.increment_origination_nonce c)
  >>=? fun (c, nonce) -> return (c, Contract_repr.originated_contract nonce)

let originated_from_current_nonce ~since:ctxt_since ~until:ctxt_until =
  Lwt.return (Raw_context.origination_nonce ctxt_since)
  >>=? fun since ->
  Lwt.return (Raw_context.origination_nonce ctxt_until)
  >>=? fun until ->
  filter_map_s
    (fun contract ->
      exists ctxt_until contract
      >>=? function true -> return_some contract | false -> return_none)
    (Contract_repr.originated_contracts ~since ~until)

let check_counter_increment c manager counter =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Counter.get c contract
  >>=? fun contract_counter ->
  let expected = Z.succ contract_counter in
  if Compare.Z.(expected = counter) then return_unit
  else if Compare.Z.(expected > counter) then
    fail (Counter_in_the_past (contract, expected, counter))
  else fail (Counter_in_the_future (contract, expected, counter))

let increment_counter c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Global_counter.get c
  >>=? fun global_counter ->
  Storage.Contract.Global_counter.set c (Z.succ global_counter)
  >>=? fun c ->
  Storage.Contract.Counter.get c contract
  >>=? fun contract_counter ->
  Storage.Contract.Counter.set c contract (Z.succ contract_counter)

let get_script_code c contract = Storage.Contract.Code.get_option c contract

let get_script c contract =
  Storage.Contract.Code.get_option c contract
  >>=? fun (c, code) ->
  Storage.Contract.Storage.get_option c contract
  >>=? fun (c, storage) ->
  match (code, storage) with
  | (None, None) ->
      return (c, None)
  | (Some code, Some storage) ->
      return (c, Some {Script_repr.code; storage})
  | (None, Some _) | (Some _, None) ->
      failwith "get_script"

let get_storage ctxt contract =
  Storage.Contract.Storage.get_option ctxt contract
  >>=? function
  | (ctxt, None) ->
      return (ctxt, None)
  | (ctxt, Some storage) ->
      Lwt.return (Script_repr.force_decode storage)
      >>=? fun (storage, cost) ->
      Lwt.return (Raw_context.consume_gas ctxt cost)
      >>=? fun ctxt -> return (ctxt, Some storage)

let get_counter c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Counter.get_option c contract
  >>=? function
  | None -> (
    match Contract_repr.is_implicit contract with
    | Some _ ->
        Storage.Contract.Global_counter.get c
    | None ->
        failwith "get_counter" )
  | Some v ->
      return v

let get_manager_key c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Manager.get_option c contract
  >>=? function
  | None ->
      failwith "get_manager_key"
  | Some (Manager_repr.Hash _) ->
      fail (Unrevealed_manager_key contract)
  | Some (Manager_repr.Public_key v) ->
      return v

let is_manager_key_revealed c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Manager.get_option c contract
  >>=? function
  | None ->
      return_false
  | Some (Manager_repr.Hash _) ->
      return_false
  | Some (Manager_repr.Public_key _) ->
      return_true

let reveal_manager_key c manager public_key =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Manager.get c contract
  >>=? function
  | Public_key _ ->
      fail (Previously_revealed_key contract)
  | Hash v ->
      let actual_hash = Signature.Public_key.hash public_key in
      if Signature.Public_key_hash.equal actual_hash v then
        let v = Manager_repr.Public_key public_key in
        Storage.Contract.Manager.set c contract v >>=? fun c -> return c
      else fail (Inconsistent_hash (public_key, v, actual_hash))

let get_balance c contract =
  Storage.Contract.Balance.get_option c contract
  >>=? function
  | None -> (
    match Contract_repr.is_implicit contract with
    | Some _ ->
        return Tez_repr.zero
    | None ->
        failwith "get_balance" )
  | Some v ->
      return v

let update_script_storage c contract storage big_map_diff =
  let storage = Script_repr.lazy_expr storage in
  update_script_big_map c big_map_diff
  >>=? fun (c, big_map_size_diff) ->
  Storage.Contract.Storage.set c contract storage
  >>=? fun (c, size_diff) ->
  Storage.Contract.Used_storage_space.get c contract
  >>=? fun previous_size ->
  let new_size =
    Z.add previous_size (Z.add big_map_size_diff (Z.of_int size_diff))
  in
  Storage.Contract.Used_storage_space.set c contract new_size

let spend c contract amount =
  Storage.Contract.Balance.get c contract
  >>=? fun balance ->
  match Tez_repr.(balance -? amount) with
  | Error _ ->
      fail (Balance_too_low (contract, balance, amount))
  | Ok new_balance -> (
      Storage.Contract.Balance.set c contract new_balance
      >>=? fun c ->
      Roll_storage.Contract.remove_amount c contract amount
      >>=? fun c ->
      if Tez_repr.(new_balance > Tez_repr.zero) then return c
      else
        match Contract_repr.is_implicit contract with
        | None ->
            return c (* Never delete originated contracts *)
        | Some pkh -> (
            Delegate_storage.get c contract
            >>=? function
            | Some pkh' ->
                (* Don't delete "delegate" contract *)
                assert (Signature.Public_key_hash.equal pkh pkh') ;
                return c
            | None ->
                (* Delete empty implicit contract *)
                delete c contract ) )

let credit c contract amount =
  ( if Tez_repr.(amount <> Tez_repr.zero) then return c
  else
    Storage.Contract.Code.mem c contract
    >>=? fun (c, target_has_code) ->
    fail_unless target_has_code (Empty_transaction contract)
    >>=? fun () -> return c )
  >>=? fun c ->
  Storage.Contract.Balance.get_option c contract
  >>=? function
  | None -> (
    match Contract_repr.is_implicit contract with
    | None ->
        fail (Non_existing_contract contract)
    | Some manager ->
        create_implicit c manager ~balance:amount )
  | Some balance ->
      Lwt.return Tez_repr.(amount +? balance)
      >>=? fun balance ->
      Storage.Contract.Balance.set c contract balance
      >>=? fun c -> Roll_storage.Contract.add_amount c contract amount

let init c = Storage.Contract.Global_counter.init c Z.zero

let used_storage_space c contract =
  Storage.Contract.Used_storage_space.get_option c contract
  >>=? function None -> return Z.zero | Some fees -> return fees

let paid_storage_space c contract =
  Storage.Contract.Paid_storage_space.get_option c contract
  >>=? function None -> return Z.zero | Some paid_space -> return paid_space

let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space
    =
  Storage.Contract.Paid_storage_space.get c contract
  >>=? fun already_paid_space ->
  if Compare.Z.(already_paid_space >= new_storage_space) then return (Z.zero, c)
  else
    let to_pay = Z.sub new_storage_space already_paid_space in
    Storage.Contract.Paid_storage_space.set c contract new_storage_space
    >>=? fun c -> return (to_pay, c)
Contract_storage.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Contract_repr.
Require Tezos.Delegate_storage.
Require Tezos.Gas_limit_repr.
Require Tezos.Manager_repr.
Require Tezos.Michelson_v1_primitives.
Require Tezos.Raw_context.
Require Tezos.Roll_storage.
Require Tezos.Script_expr_hash.
Require Tezos.Script_repr.
Require Tezos.Storage_mli. Module Storage := Storage_mli.
Require Tezos.Storage_sigs.
Require Tezos.Tez_repr.

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Top-level evaluations are ignored *)
(* top_level_evaluation *)

Definition failwith {A : Set} (msg : string) : Lwt.t (Error_monad.tzresult A) :=
  Error_monad.fail extensible_type_value.

Module ConstructorRecords_big_map_diff_item.
  Module big_map_diff_item.
    Module Update.
      Record record {big_map diff_key diff_key_hash diff_value : Set} : Set := Build {
        big_map : big_map;
        diff_key : diff_key;
        diff_key_hash : diff_key_hash;
        diff_value : diff_value }.
      Arguments record : clear implicits.
      Definition with_big_map
        {t_big_map t_diff_key t_diff_key_hash t_diff_value} big_map
        (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
        Build t_big_map t_diff_key t_diff_key_hash t_diff_value big_map
          r.(diff_key) r.(diff_key_hash) r.(diff_value).
      Definition with_diff_key
        {t_big_map t_diff_key t_diff_key_hash t_diff_value} diff_key
        (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
        Build t_big_map t_diff_key t_diff_key_hash t_diff_value r.(big_map)
          diff_key r.(diff_key_hash) r.(diff_value).
      Definition with_diff_key_hash
        {t_big_map t_diff_key t_diff_key_hash t_diff_value} diff_key_hash
        (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
        Build t_big_map t_diff_key t_diff_key_hash t_diff_value r.(big_map)
          r.(diff_key) diff_key_hash r.(diff_value).
      Definition with_diff_value
        {t_big_map t_diff_key t_diff_key_hash t_diff_value} diff_value
        (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
        Build t_big_map t_diff_key t_diff_key_hash t_diff_value r.(big_map)
          r.(diff_key) r.(diff_key_hash) diff_value.
    End Update.
    Definition Update_skeleton := Update.record.
    
    Module Alloc.
      Record record {big_map key_type value_type : Set} : Set := Build {
        big_map : big_map;
        key_type : key_type;
        value_type : value_type }.
      Arguments record : clear implicits.
      Definition with_big_map {t_big_map t_key_type t_value_type} big_map
        (r : record t_big_map t_key_type t_value_type) :=
        Build t_big_map t_key_type t_value_type big_map r.(key_type)
          r.(value_type).
      Definition with_key_type {t_big_map t_key_type t_value_type} key_type
        (r : record t_big_map t_key_type t_value_type) :=
        Build t_big_map t_key_type t_value_type r.(big_map) key_type
          r.(value_type).
      Definition with_value_type {t_big_map t_key_type t_value_type} value_type
        (r : record t_big_map t_key_type t_value_type) :=
        Build t_big_map t_key_type t_value_type r.(big_map) r.(key_type)
          value_type.
    End Alloc.
    Definition Alloc_skeleton := Alloc.record.
  End big_map_diff_item.
End ConstructorRecords_big_map_diff_item.
Import ConstructorRecords_big_map_diff_item.

Reserved Notation "'big_map_diff_item.Update".
Reserved Notation "'big_map_diff_item.Alloc".

Inductive big_map_diff_item : Set :=
| Update : 'big_map_diff_item.Update -> big_map_diff_item
| Clear : Z.t -> big_map_diff_item
| Copy : Z.t -> Z.t -> big_map_diff_item
| Alloc : 'big_map_diff_item.Alloc -> big_map_diff_item

where "'big_map_diff_item.Update" :=
  (big_map_diff_item.Update_skeleton Z.t Script_repr.expr Script_expr_hash.t
    (option Script_repr.expr))
and "'big_map_diff_item.Alloc" :=
  (big_map_diff_item.Alloc_skeleton Z.t Script_repr.expr Script_repr.expr).

Module big_map_diff_item.
  Include ConstructorRecords_big_map_diff_item.big_map_diff_item.
  Definition Update := 'big_map_diff_item.Update.
  Definition Alloc := 'big_map_diff_item.Alloc.
End big_map_diff_item.

Definition big_map_diff : Set := list big_map_diff_item.

Definition big_map_diff_item_encoding
  : Data_encoding.encoding big_map_diff_item :=
  Data_encoding.union None
    [
      Data_encoding.__case_value "update" None (Data_encoding.Tag 0)
        (Data_encoding.obj5
          (Data_encoding.req None None "action"
            (Data_encoding.constant "update"))
          (Data_encoding.req None None "big_map" Data_encoding.z)
          (Data_encoding.req None None "key_hash" Script_expr_hash.encoding)
          (Data_encoding.req None None "key" Script_repr.expr_encoding)
          (Data_encoding.opt None None "value" Script_repr.expr_encoding))
        (fun function_parameter =>
          match function_parameter with
          |
            Update {|
              big_map_diff_item.Update.big_map := big_map;
                big_map_diff_item.Update.diff_key := diff_key;
                big_map_diff_item.Update.diff_key_hash :=
                  diff_key_hash;
                big_map_diff_item.Update.diff_value := diff_value
                |} =>
            Some (tt, big_map, diff_key_hash, diff_key, diff_value)
          | _ => None
          end)
        (fun function_parameter =>
          let '(_, big_map, diff_key_hash, diff_key, diff_value) :=
            function_parameter in
          Update
            {| big_map_diff_item.Update.big_map := big_map;
              big_map_diff_item.Update.diff_key := diff_key;
              big_map_diff_item.Update.diff_key_hash := diff_key_hash;
              big_map_diff_item.Update.diff_value := diff_value |});
      Data_encoding.__case_value "remove" None (Data_encoding.Tag 1)
        (Data_encoding.obj2
          (Data_encoding.req None None "action"
            (Data_encoding.constant "remove"))
          (Data_encoding.req None None "big_map" Data_encoding.z))
        (fun function_parameter =>
          match function_parameter with
          | Clear big_map => Some (tt, big_map)
          | _ => None
          end)
        (fun function_parameter =>
          let '(_, big_map) := function_parameter in
          Clear big_map);
      Data_encoding.__case_value "copy" None (Data_encoding.Tag 2)
        (Data_encoding.obj3
          (Data_encoding.req None None "action"
            (Data_encoding.constant "copy"))
          (Data_encoding.req None None "source_big_map" Data_encoding.z)
          (Data_encoding.req None None "destination_big_map" Data_encoding.z))
        (fun function_parameter =>
          match function_parameter with
          | Copy src dst => Some (tt, src, dst)
          | _ => None
          end)
        (fun function_parameter =>
          let '(_, src, dst) := function_parameter in
          Copy src dst);
      Data_encoding.__case_value "alloc" None (Data_encoding.Tag 3)
        (Data_encoding.obj4
          (Data_encoding.req None None "action"
            (Data_encoding.constant "alloc"))
          (Data_encoding.req None None "big_map" Data_encoding.z)
          (Data_encoding.req None None "key_type" Script_repr.expr_encoding)
          (Data_encoding.req None None "value_type"
            Script_repr.expr_encoding))
        (fun function_parameter =>
          match function_parameter with
          |
            Alloc {|
              big_map_diff_item.Alloc.big_map := big_map;
                big_map_diff_item.Alloc.key_type := key_type;
                big_map_diff_item.Alloc.value_type := value_type
                |} => Some (tt, big_map, key_type, value_type)
          | _ => None
          end)
        (fun function_parameter =>
          let '(_, big_map, key_type, value_type) := function_parameter in
          Alloc
            {| big_map_diff_item.Alloc.big_map := big_map;
              big_map_diff_item.Alloc.key_type := key_type;
              big_map_diff_item.Alloc.value_type := value_type |})
    ].

Definition big_map_diff_encoding
  : Data_encoding.encoding (list big_map_diff_item) :=
  (let arg := Data_encoding.def "contract.big_map_diff" in
  fun eta => arg None None eta)
    (Data_encoding.__list_value None big_map_diff_item_encoding).

Definition big_map_key_cost : int := 65.

Definition big_map_cost : int := 33.

Definition update_script_big_map
  (c :
    (|Storage.Big_map.Total_bytes|).(Storage_sigs.Indexed_data_storage.context))
  (function_parameter : option (list big_map_diff_item))
  : Lwt.t
    (Error_monad.tzresult
      ((|Storage.Big_map.Total_bytes|).(Storage_sigs.Indexed_data_storage.context)
        * Z.t)) :=
  match function_parameter with
  | None => Error_monad.__return (c, Z.zero)
  | Some diff =>
    Error_monad.fold_left_s
      (fun function_parameter =>
        let '(c, total) := function_parameter in
        fun function_parameter =>
          match function_parameter with
          | Clear id =>
            let=? size :=
              (|Storage.Big_map.Total_bytes|).(Storage_sigs.Indexed_data_storage.get)
                c id in
            let= c := Storage.Big_map.remove_rec c id in
            if (|Compare.Z|).(Compare.S.op_lt) id Z.zero then
              Error_monad.__return (c, total)
            else
              Error_monad.__return
                (c, (Z.sub (Z.sub total size) (Z.of_int big_map_cost)))
          | Copy from to_ =>
            let=? c := Storage.Big_map.copy c from to_ in
            if (|Compare.Z|).(Compare.S.op_lt) to_ Z.zero then
              Error_monad.__return (c, total)
            else
              let=? size :=
                (|Storage.Big_map.Total_bytes|).(Storage_sigs.Indexed_data_storage.get)
                  c from in
              Error_monad.__return
                (c, (Z.add (Z.add total size) (Z.of_int big_map_cost)))
          |
            Alloc {|
              big_map_diff_item.Alloc.big_map := big_map;
                big_map_diff_item.Alloc.key_type := key_type;
                big_map_diff_item.Alloc.value_type := value_type
                |} =>
            let=? c :=
              (|Storage.Big_map.Total_bytes|).(Storage_sigs.Indexed_data_storage.init)
                c big_map Z.zero in
            let key_type :=
              Micheline.strip_locations
                (Script_repr.strip_annotations (Micheline.root key_type)) in
            let value_type :=
              Micheline.strip_locations
                (Script_repr.strip_annotations (Micheline.root value_type)) in
            let=? c :=
              (|Storage.Big_map.Key_type|).(Storage_sigs.Indexed_data_storage.init)
                c big_map key_type in
            let=? c :=
              (|Storage.Big_map.Value_type|).(Storage_sigs.Indexed_data_storage.init)
                c big_map value_type in
            if (|Compare.Z|).(Compare.S.op_lt) big_map Z.zero then
              Error_monad.__return (c, total)
            else
              Error_monad.__return (c, (Z.add total (Z.of_int big_map_cost)))
          |
            Update {|
              big_map_diff_item.Update.big_map := big_map;
                big_map_diff_item.Update.diff_key_hash := diff_key_hash;
                big_map_diff_item.Update.diff_value := None
                |} =>
            let=? '(c, freed, existed) :=
              (|Storage.Big_map.Contents|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.remove)
                (c, big_map) diff_key_hash in
            let freed :=
              if existed then
                Pervasives.op_plus freed big_map_key_cost
              else
                freed in
            let=? size :=
              (|Storage.Big_map.Total_bytes|).(Storage_sigs.Indexed_data_storage.get)
                c big_map in
            let=? c :=
              (|Storage.Big_map.Total_bytes|).(Storage_sigs.Indexed_data_storage.set)
                c big_map (Z.sub size (Z.of_int freed)) in
            if (|Compare.Z|).(Compare.S.op_lt) big_map Z.zero then
              Error_monad.__return (c, total)
            else
              Error_monad.__return (c, (Z.sub total (Z.of_int freed)))
          |
            Update {|
              big_map_diff_item.Update.big_map := big_map;
                big_map_diff_item.Update.diff_key_hash := diff_key_hash;
                big_map_diff_item.Update.diff_value := Some v
                |} =>
            let=? '(c, size_diff, existed) :=
              (|Storage.Big_map.Contents|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.init_set)
                (c, big_map) diff_key_hash v in
            let size_diff :=
              if existed then
                size_diff
              else
                Pervasives.op_plus size_diff big_map_key_cost in
            let=? size :=
              (|Storage.Big_map.Total_bytes|).(Storage_sigs.Indexed_data_storage.get)
                c big_map in
            let=? c :=
              (|Storage.Big_map.Total_bytes|).(Storage_sigs.Indexed_data_storage.set)
                c big_map (Z.add size (Z.of_int size_diff)) in
            if (|Compare.Z|).(Compare.S.op_lt) big_map Z.zero then
              Error_monad.__return (c, total)
            else
              Error_monad.__return (c, (Z.add total (Z.of_int size_diff)))
          end) (c, Z.zero) diff
  end.

Definition create_base (c : Raw_context.t) (op_staroptstar : option bool)
  : Contract_repr.contract ->
  (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.value) ->
  option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  option (Script_repr.t * option (list big_map_diff_item)) -> unit ->
  Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let prepaid_bootstrap_storage :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => false
    end in
  fun contract =>
    fun balance =>
      fun manager =>
        fun delegate =>
          fun script =>
            fun function_parameter =>
              let '_ := function_parameter in
              let=? c :=
                match Contract_repr.is_implicit contract with
                | None => Error_monad.__return c
                | Some _ =>
                  let=? counter := Storage.Contract.Global_counter.get c in
                  (|Storage.Contract.Counter|).(Storage_sigs.Indexed_data_storage.init)
                    c contract counter
                end in
              let=? c :=
                (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.init)
                  c contract balance in
              let=? c :=
                match manager with
                | Some manager =>
                  (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.init)
                    c contract (Manager_repr.Hash manager)
                | None => Error_monad.__return c
                end in
              let=? c :=
                match delegate with
                | None => Error_monad.__return c
                | Some delegate => Delegate_storage.init c contract delegate
                end in
              match script with
              |
                Some
                  ({|
                    Script_repr.t.code := code;
                      Script_repr.t.storage := storage
                      |}, big_map_diff) =>
                let=? '(c, code_size) :=
                  (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.init)
                    c contract code in
                let=? '(c, storage_size) :=
                  (|Storage.Contract.Storage|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.init)
                    c contract storage in
                let=? '(c, big_map_size) := update_script_big_map c big_map_diff
                  in
                let total_size :=
                  Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size))
                    big_map_size in
                (* ❌ Sequences of instructions are ignored (operator ";") *)
                (* ❌ instruction_sequence ";" *)
                let prepaid_bootstrap_storage :=
                  if prepaid_bootstrap_storage then
                    total_size
                  else
                    Z.zero in
                let=? c :=
                  (|Storage.Contract.Paid_storage_space|).(Storage_sigs.Indexed_data_storage.init)
                    c contract prepaid_bootstrap_storage in
                (|Storage.Contract.Used_storage_space|).(Storage_sigs.Indexed_data_storage.init)
                  c contract total_size
              | None => Error_monad.__return c
              end.

Definition originate_raw
  (c : Raw_context.t) (prepaid_bootstrap_storage : option bool)
  (contract : Contract_repr.contract)
  (balance :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.value))
  (script : Script_repr.t * option (list big_map_diff_item))
  (delegate : option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  create_base c prepaid_bootstrap_storage contract balance None delegate
    (Some script) tt.

Definition create_implicit
  (c : Raw_context.t)
  (manager : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (balance :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.value))
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  create_base c None (Contract_repr.implicit_contract manager) balance
    (Some manager) None None tt.

Definition delete (c : Raw_context.t) (contract : Contract_repr.contract)
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  match Contract_repr.is_implicit contract with
  | None => failwith "Non implicit contracts cannot be removed"
  | Some _ =>
    let=? c := Delegate_storage.remove c contract in
    let=? c :=
      (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.delete) c
        contract in
    let=? c :=
      (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.delete) c
        contract in
    let=? c :=
      (|Storage.Contract.Counter|).(Storage_sigs.Indexed_data_storage.delete) c
        contract in
    let=? '(c, _, _) :=
      (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.remove)
        c contract in
    let=? '(c, _, _) :=
      (|Storage.Contract.Storage|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.remove)
        c contract in
    let= c :=
      (|Storage.Contract.Paid_storage_space|).(Storage_sigs.Indexed_data_storage.remove)
        c contract in
    let= c :=
      (|Storage.Contract.Used_storage_space|).(Storage_sigs.Indexed_data_storage.remove)
        c contract in
    Error_monad.__return c
  end.

Definition allocated
  (c : (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t (Error_monad.tzresult bool) :=
  let=? function_parameter :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.get_option)
      c contract in
  match function_parameter with
  | None => Error_monad.return_false
  | Some _ => Error_monad.return_true
  end.

Definition __exists
  (c : (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context))
  (contract : Contract_repr.contract) : Lwt.t (Error_monad.tzresult bool) :=
  match Contract_repr.is_implicit contract with
  | Some _ => Error_monad.return_true
  | None => allocated c contract
  end.

Definition must_exist
  (c : (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context))
  (contract : Contract_repr.contract) : Lwt.t (Error_monad.tzresult unit) :=
  let=? function_parameter := __exists c contract in
  match function_parameter with
  | true => Error_monad.return_unit
  | false => Error_monad.fail extensible_type_value
  end.

Definition must_be_allocated
  (c : (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t (Error_monad.tzresult unit) :=
  let=? function_parameter := allocated c contract in
  match function_parameter with
  | true => Error_monad.return_unit
  | false =>
    match Contract_repr.is_implicit contract with
    | Some pkh => Error_monad.fail extensible_type_value
    | None => Error_monad.fail extensible_type_value
    end
  end.

Definition __list_value (c : Raw_context.t) : Lwt.t (list Contract_repr.t) :=
  Storage.Contract.__list_value c.

Definition fresh_contract_from_current_nonce (c : Raw_context.t)
  : Lwt.t (Error_monad.tzresult (Raw_context.t * Contract_repr.contract)) :=
  let=? '(c, __nonce_value) :=
    Lwt.__return (Raw_context.increment_origination_nonce c) in
  Error_monad.__return (c, (Contract_repr.originated_contract __nonce_value)).

Definition originated_from_current_nonce
  (ctxt_since : Raw_context.t) (ctxt_until : Raw_context.t)
  : Lwt.t (Error_monad.tzresult (list Contract_repr.contract)) :=
  let=? since := Lwt.__return (Raw_context.origination_nonce ctxt_since) in
  let=? until := Lwt.__return (Raw_context.origination_nonce ctxt_until) in
  Error_monad.filter_map_s
    (fun contract =>
      let=? function_parameter := __exists ctxt_until contract in
      match function_parameter with
      | true => Error_monad.return_some contract
      | false => Error_monad.return_none
      end) (Contract_repr.originated_contracts since until).

Definition check_counter_increment
  (c : (|Storage.Contract.Counter|).(Storage_sigs.Indexed_data_storage.context))
  (manager : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (counter : (|Compare.Z|).(Compare.S.t)) : Lwt.t (Error_monad.tzresult unit) :=
  let contract := Contract_repr.implicit_contract manager in
  let=? contract_counter :=
    (|Storage.Contract.Counter|).(Storage_sigs.Indexed_data_storage.get) c
      contract in
  let expected := Z.succ contract_counter in
  if (|Compare.Z|).(Compare.S.op_eq) expected counter then
    Error_monad.return_unit
  else
    if (|Compare.Z|).(Compare.S.op_gt) expected counter then
      Error_monad.fail extensible_type_value
    else
      Error_monad.fail extensible_type_value.

Definition increment_counter
  (c : Raw_context.t)
  (manager : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let contract := Contract_repr.implicit_contract manager in
  let=? global_counter := Storage.Contract.Global_counter.get c in
  let=? c := Storage.Contract.Global_counter.set c (Z.succ global_counter) in
  let=? contract_counter :=
    (|Storage.Contract.Counter|).(Storage_sigs.Indexed_data_storage.get) c
      contract in
  (|Storage.Contract.Counter|).(Storage_sigs.Indexed_data_storage.set) c
    contract (Z.succ contract_counter).

Definition get_script_code
  (c :
    (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.context))
  (contract :
    (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.key))
  : Lwt.t
    (Error_monad.tzresult
      (Raw_context.t *
        option
          (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.value))) :=
  (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.get_option)
    c contract.

Definition get_script
  (c :
    (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.context))
  (contract :
    (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.key))
  : Lwt.t (Error_monad.tzresult (Raw_context.t * option Script_repr.t)) :=
  let=? '(c, code) :=
    (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.get_option)
      c contract in
  let=? '(c, storage) :=
    (|Storage.Contract.Storage|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.get_option)
      c contract in
  match (code, storage) with
  | (None, None) => Error_monad.__return (c, None)
  | (Some code, Some storage) =>
    Error_monad.__return
      (c,
        (Some {| Script_repr.t.code := code; Script_repr.t.storage := storage |}))
  | ((None, Some _) | (Some _, None)) => failwith "get_script"
  end.

Definition get_storage
  (ctxt :
    (|Storage.Contract.Storage|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.context))
  (contract :
    (|Storage.Contract.Storage|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.key))
  : Lwt.t (Error_monad.tzresult (Raw_context.t * option Script_repr.expr)) :=
  let=? function_parameter :=
    (|Storage.Contract.Storage|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.get_option)
      ctxt contract in
  match function_parameter with
  | (ctxt, None) => Error_monad.__return (ctxt, None)
  | (ctxt, Some storage) =>
    let=? '(storage, cost) := Lwt.__return (Script_repr.force_decode storage) in
    let=? ctxt := Lwt.__return (Raw_context.consume_gas ctxt cost) in
    Error_monad.__return (ctxt, (Some storage))
  end.

Definition get_counter
  (c : (|Storage.Contract.Counter|).(Storage_sigs.Indexed_data_storage.context))
  (manager : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult Z.t) :=
  let contract := Contract_repr.implicit_contract manager in
  let=? function_parameter :=
    (|Storage.Contract.Counter|).(Storage_sigs.Indexed_data_storage.get_option)
      c contract in
  match function_parameter with
  | None =>
    match Contract_repr.is_implicit contract with
    | Some _ => Storage.Contract.Global_counter.get c
    | None => failwith "get_counter"
    end
  | Some v => Error_monad.__return v
  end.

Definition get_manager_key
  (c : (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.context))
  (manager : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult (|Signature.Public_key|).(S.SPublic_key.t)) :=
  let contract := Contract_repr.implicit_contract manager in
  let=? function_parameter :=
    (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.get_option)
      c contract in
  match function_parameter with
  | None => failwith "get_manager_key"
  | Some (Manager_repr.Hash _) => Error_monad.fail extensible_type_value
  | Some (Manager_repr.Public_key v) => Error_monad.__return v
  end.

Definition is_manager_key_revealed
  (c : (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.context))
  (manager : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult bool) :=
  let contract := Contract_repr.implicit_contract manager in
  let=? function_parameter :=
    (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.get_option)
      c contract in
  match function_parameter with
  | None => Error_monad.return_false
  | Some (Manager_repr.Hash _) => Error_monad.return_false
  | Some (Manager_repr.Public_key _) => Error_monad.return_true
  end.

Definition reveal_manager_key
  (c : (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.context))
  (manager : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (public_key : (|Signature.Public_key|).(S.SPublic_key.t))
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let contract := Contract_repr.implicit_contract manager in
  let=? function_parameter :=
    (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.get) c
      contract in
  match function_parameter with
  | Manager_repr.Public_key _ => Error_monad.fail extensible_type_value
  | Manager_repr.Hash v =>
    let actual_hash :=
      (|Signature.Public_key|).(S.SPublic_key.__hash_value) public_key in
    if (|Signature.Public_key_hash|).(S.SPublic_key_hash.equal) actual_hash v
      then
      let v := Manager_repr.Public_key public_key in
      let=? c :=
        (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.set) c
          contract v in
      Error_monad.__return c
    else
      Error_monad.fail extensible_type_value
  end.

Definition get_balance
  (c : (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t (Error_monad.tzresult Tez_repr.t) :=
  let=? function_parameter :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.get_option)
      c contract in
  match function_parameter with
  | None =>
    match Contract_repr.is_implicit contract with
    | Some _ => Error_monad.__return Tez_repr.zero
    | None => failwith "get_balance"
    end
  | Some v => Error_monad.__return v
  end.

Definition update_script_storage
  (c :
    (|Storage.Big_map.Total_bytes|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Storage|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.key))
  (storage : Script_repr.expr) (big_map_diff : option (list big_map_diff_item))
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let storage := Script_repr.__lazy_expr_value storage in
  let=? '(c, big_map_size_diff) := update_script_big_map c big_map_diff in
  let=? '(c, size_diff) :=
    (|Storage.Contract.Storage|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.set)
      c contract storage in
  let=? previous_size :=
    (|Storage.Contract.Used_storage_space|).(Storage_sigs.Indexed_data_storage.get)
      c contract in
  let new_size :=
    Z.add previous_size (Z.add big_map_size_diff (Z.of_int size_diff)) in
  (|Storage.Contract.Used_storage_space|).(Storage_sigs.Indexed_data_storage.set)
    c contract new_size.

Definition spend
  (c : (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.key))
  (amount : Tez_repr.t) : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let=? balance :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.get) c
      contract in
  match Tez_repr.op_minusquestion balance amount with
  | Pervasives.Error _ => Error_monad.fail extensible_type_value
  | Pervasives.Ok new_balance =>
    let=? c :=
      (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.set) c
        contract new_balance in
    let=? c := Roll_storage.Contract.remove_amount c contract amount in
    if Tez_repr.op_gt new_balance Tez_repr.zero then
      Error_monad.__return c
    else
      match Contract_repr.is_implicit contract with
      | None => Error_monad.__return c
      | Some pkh =>
        let=? function_parameter := Delegate_storage.get c contract in
        match function_parameter with
        | Some pkh' =>
          (* ❌ Sequences of instructions are ignored (operator ";") *)
          (* ❌ instruction_sequence ";" *)
          Error_monad.__return c
        | None => delete c contract
        end
      end
  end.

Definition credit
  (c :
    (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.context))
  (contract :
    (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.key))
  (amount : Tez_repr.t) : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let=? c :=
    if Tez_repr.op_ltgt amount Tez_repr.zero then
      Error_monad.__return c
    else
      let=? '(c, target_has_code) :=
        (|Storage.Contract.Code|).(Storage_sigs.Non_iterable_indexed_carbonated_data_storage.mem)
          c contract in
      let=? '_ := Error_monad.fail_unless target_has_code extensible_type_value
        in
      Error_monad.__return c in
  let=? function_parameter :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.get_option)
      c contract in
  match function_parameter with
  | None =>
    match Contract_repr.is_implicit contract with
    | None => Error_monad.fail extensible_type_value
    | Some manager => create_implicit c manager amount
    end
  | Some balance =>
    let=? balance := Lwt.__return (Tez_repr.op_plusquestion amount balance) in
    let=? c :=
      (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.set) c
        contract balance in
    Roll_storage.Contract.add_amount c contract amount
  end.

Definition init (c : Raw_context.t)
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  Storage.Contract.Global_counter.init c Z.zero.

Definition used_storage_space
  (c :
    (|Storage.Contract.Used_storage_space|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Used_storage_space|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t (Error_monad.tzresult Z.t) :=
  let=? function_parameter :=
    (|Storage.Contract.Used_storage_space|).(Storage_sigs.Indexed_data_storage.get_option)
      c contract in
  match function_parameter with
  | None => Error_monad.__return Z.zero
  | Some fees => Error_monad.__return fees
  end.

Definition paid_storage_space
  (c :
    (|Storage.Contract.Paid_storage_space|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Paid_storage_space|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t (Error_monad.tzresult Z.t) :=
  let=? function_parameter :=
    (|Storage.Contract.Paid_storage_space|).(Storage_sigs.Indexed_data_storage.get_option)
      c contract in
  match function_parameter with
  | None => Error_monad.__return Z.zero
  | Some paid_space => Error_monad.__return paid_space
  end.

Definition set_paid_storage_space_and_return_fees_to_pay
  (c :
    (|Storage.Contract.Paid_storage_space|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Paid_storage_space|).(Storage_sigs.Indexed_data_storage.key))
  (new_storage_space : (|Compare.Z|).(Compare.S.t))
  : Lwt.t
    (Error_monad.tzresult
      (Z.t *
        (|Storage.Contract.Paid_storage_space|).(Storage_sigs.Indexed_data_storage.context))) :=
  let=? already_paid_space :=
    (|Storage.Contract.Paid_storage_space|).(Storage_sigs.Indexed_data_storage.get)
      c contract in
  if (|Compare.Z|).(Compare.S.op_gteq) already_paid_space new_storage_space then
    Error_monad.__return (Z.zero, c)
  else
    let to_pay := Z.sub new_storage_space already_paid_space in
    let=? c :=
      (|Storage.Contract.Paid_storage_space|).(Storage_sigs.Indexed_data_storage.set)
        c contract new_storage_space in
    Error_monad.__return (to_pay, c).

Contract_storage_mli

  • OCaml size: 169 lines
  • Coq size: 191 lines (+13% compared to OCaml)
contract_storage.mli 1 warning
(*****************************************************************************)
(*                                                                           *)
(* 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 error +=
  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
  | (* `Temporary *)
      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t
  | (* `Branch *)
      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t
  | (* `Temporary *)
      Unspendable_contract of Contract_repr.contract
  | (* `Permanent *)
      Non_existing_contract of Contract_repr.contract
  | (* `Temporary *)
      Empty_implicit_contract of Signature.Public_key_hash.t
  | (* `Temporary *)
      Empty_transaction of Contract_repr.t (* `Temporary *)
  | Inconsistent_hash of
      Signature.Public_key.t
      * Signature.Public_key_hash.t
      * Signature.Public_key_hash.t
  | (* `Permanent *)
      Inconsistent_public_key of
      Signature.Public_key.t * Signature.Public_key.t
  | (* `Permanent *)
      Failure of string (* `Permanent *)
  | Previously_revealed_key of Contract_repr.t (* `Permanent *)
  | Unrevealed_manager_key of Contract_repr.t

(* `Permanent *)

val exists : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t

val must_exist : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t

val allocated : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t

val must_be_allocated : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t

val list : Raw_context.t -> Contract_repr.t list Lwt.t

val check_counter_increment :
  Raw_context.t -> Signature.Public_key_hash.t -> Z.t -> unit tzresult Lwt.t

val increment_counter :
  Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t

val get_manager_key :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Signature.Public_key.t tzresult Lwt.t

val is_manager_key_revealed :
  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

val reveal_manager_key :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Signature.Public_key.t ->
  Raw_context.t tzresult Lwt.t

val get_balance : Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t

val get_counter :
  Raw_context.t -> Signature.Public_key_hash.t -> Z.t tzresult Lwt.t

val get_script_code :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Script_repr.lazy_expr option) tzresult Lwt.t

val get_script :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Script_repr.t option) tzresult Lwt.t

val get_storage :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Script_repr.expr option) tzresult Lwt.t

type big_map_diff_item =
  | Update of {
      big_map : Z.t;
      diff_key : Script_repr.expr;
      diff_key_hash : Script_expr_hash.t;
      diff_value : Script_repr.expr option;
    }
  | Clear of Z.t
  | Copy of Z.t * Z.t
  | Alloc of {
      big_map : Z.t;
      key_type : Script_repr.expr;
      value_type : Script_repr.expr;
    }

type big_map_diff = big_map_diff_item list

val big_map_diff_encoding : big_map_diff Data_encoding.t

val update_script_storage :
  Raw_context.t ->
  Contract_repr.t ->
  Script_repr.expr ->
  big_map_diff option ->
  Raw_context.t tzresult Lwt.t

val credit :
  Raw_context.t ->
  Contract_repr.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

val spend :
  Raw_context.t ->
  Contract_repr.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

val originate_raw :
  Raw_context.t ->
  ?prepaid_bootstrap_storage:bool ->
  Contract_repr.t ->
  balance:Tez_repr.t ->
  script:Script_repr.t * big_map_diff option ->
  delegate:Signature.Public_key_hash.t option ->
  Raw_context.t tzresult Lwt.t

val fresh_contract_from_current_nonce :
  Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult Lwt.t

val originated_from_current_nonce :
  since:Raw_context.t ->
  until:Raw_context.t ->
  Contract_repr.t list tzresult Lwt.t

val init : Raw_context.t -> Raw_context.t tzresult Lwt.t

val used_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t

val paid_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t

val set_paid_storage_space_and_return_fees_to_pay :
  Raw_context.t ->
  Contract_repr.t ->
  Z.t ->
  (Z.t * Raw_context.t) tzresult Lwt.t
Contract_storage_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Contract_repr.
Require Tezos.Raw_context.
Require Tezos.Script_expr_hash.
Require Tezos.Script_repr.
Require Tezos.Tez_repr.

(* extensible_type_definition `error` *)

Parameter __exists :
  Raw_context.t -> Contract_repr.t -> Lwt.t (Error_monad.tzresult bool).

Parameter must_exist :
  Raw_context.t -> Contract_repr.t -> Lwt.t (Error_monad.tzresult unit).

Parameter allocated :
  Raw_context.t -> Contract_repr.t -> Lwt.t (Error_monad.tzresult bool).

Parameter must_be_allocated :
  Raw_context.t -> Contract_repr.t -> Lwt.t (Error_monad.tzresult unit).

Parameter __list_value : Raw_context.t -> Lwt.t (list Contract_repr.t).

Parameter check_counter_increment :
  Raw_context.t -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Z.t -> Lwt.t (Error_monad.tzresult unit).

Parameter increment_counter :
  Raw_context.t -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.tzresult Raw_context.t).

Parameter get_manager_key :
  Raw_context.t -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.tzresult (|Signature.Public_key|).(S.SPublic_key.t)).

Parameter is_manager_key_revealed :
  Raw_context.t -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.tzresult bool).

Parameter reveal_manager_key :
  Raw_context.t -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  (|Signature.Public_key|).(S.SPublic_key.t) ->
  Lwt.t (Error_monad.tzresult Raw_context.t).

Parameter get_balance :
  Raw_context.t -> Contract_repr.t -> Lwt.t (Error_monad.tzresult Tez_repr.t).

Parameter get_counter :
  Raw_context.t -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.tzresult Z.t).

Parameter get_script_code :
  Raw_context.t -> Contract_repr.t ->
  Lwt.t (Error_monad.tzresult (Raw_context.t * option Script_repr.lazy_expr)).

Parameter get_script :
  Raw_context.t -> Contract_repr.t ->
  Lwt.t (Error_monad.tzresult (Raw_context.t * option Script_repr.t)).

Parameter get_storage :
  Raw_context.t -> Contract_repr.t ->
  Lwt.t (Error_monad.tzresult (Raw_context.t * option Script_repr.expr)).

Module ConstructorRecords_big_map_diff_item.
  Module big_map_diff_item.
    Module Update.
      Record record {big_map diff_key diff_key_hash diff_value : Set} : Set := Build {
        big_map : big_map;
        diff_key : diff_key;
        diff_key_hash : diff_key_hash;
        diff_value : diff_value }.
      Arguments record : clear implicits.
      Definition with_big_map
        {t_big_map t_diff_key t_diff_key_hash t_diff_value} big_map
        (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
        Build t_big_map t_diff_key t_diff_key_hash t_diff_value big_map
          r.(diff_key) r.(diff_key_hash) r.(diff_value).
      Definition with_diff_key
        {t_big_map t_diff_key t_diff_key_hash t_diff_value} diff_key
        (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
        Build t_big_map t_diff_key t_diff_key_hash t_diff_value r.(big_map)
          diff_key r.(diff_key_hash) r.(diff_value).
      Definition with_diff_key_hash
        {t_big_map t_diff_key t_diff_key_hash t_diff_value} diff_key_hash
        (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
        Build t_big_map t_diff_key t_diff_key_hash t_diff_value r.(big_map)
          r.(diff_key) diff_key_hash r.(diff_value).
      Definition with_diff_value
        {t_big_map t_diff_key t_diff_key_hash t_diff_value} diff_value
        (r : record t_big_map t_diff_key t_diff_key_hash t_diff_value) :=
        Build t_big_map t_diff_key t_diff_key_hash t_diff_value r.(big_map)
          r.(diff_key) r.(diff_key_hash) diff_value.
    End Update.
    Definition Update_skeleton := Update.record.
    
    Module Alloc.
      Record record {big_map key_type value_type : Set} : Set := Build {
        big_map : big_map;
        key_type : key_type;
        value_type : value_type }.
      Arguments record : clear implicits.
      Definition with_big_map {t_big_map t_key_type t_value_type} big_map
        (r : record t_big_map t_key_type t_value_type) :=
        Build t_big_map t_key_type t_value_type big_map r.(key_type)
          r.(value_type).
      Definition with_key_type {t_big_map t_key_type t_value_type} key_type
        (r : record t_big_map t_key_type t_value_type) :=
        Build t_big_map t_key_type t_value_type r.(big_map) key_type
          r.(value_type).
      Definition with_value_type {t_big_map t_key_type t_value_type} value_type
        (r : record t_big_map t_key_type t_value_type) :=
        Build t_big_map t_key_type t_value_type r.(big_map) r.(key_type)
          value_type.
    End Alloc.
    Definition Alloc_skeleton := Alloc.record.
  End big_map_diff_item.
End ConstructorRecords_big_map_diff_item.
Import ConstructorRecords_big_map_diff_item.

Reserved Notation "'big_map_diff_item.Update".
Reserved Notation "'big_map_diff_item.Alloc".

Inductive big_map_diff_item : Set :=
| Update : 'big_map_diff_item.Update -> big_map_diff_item
| Clear : Z.t -> big_map_diff_item
| Copy : Z.t -> Z.t -> big_map_diff_item
| Alloc : 'big_map_diff_item.Alloc -> big_map_diff_item

where "'big_map_diff_item.Update" :=
  (big_map_diff_item.Update_skeleton Z.t Script_repr.expr Script_expr_hash.t
    (option Script_repr.expr))
and "'big_map_diff_item.Alloc" :=
  (big_map_diff_item.Alloc_skeleton Z.t Script_repr.expr Script_repr.expr).

Module big_map_diff_item.
  Include ConstructorRecords_big_map_diff_item.big_map_diff_item.
  Definition Update := 'big_map_diff_item.Update.
  Definition Alloc := 'big_map_diff_item.Alloc.
End big_map_diff_item.

Definition big_map_diff : Set := list big_map_diff_item.

Parameter big_map_diff_encoding : Data_encoding.t big_map_diff.

Parameter update_script_storage :
  Raw_context.t -> Contract_repr.t -> Script_repr.expr -> option big_map_diff ->
  Lwt.t (Error_monad.tzresult Raw_context.t).

Parameter credit :
  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
  Lwt.t (Error_monad.tzresult Raw_context.t).

Parameter spend :
  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
  Lwt.t (Error_monad.tzresult Raw_context.t).

Parameter originate_raw :
  Raw_context.t -> option bool -> Contract_repr.t -> Tez_repr.t ->
  Script_repr.t * option big_map_diff ->
  option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.tzresult Raw_context.t).

Parameter fresh_contract_from_current_nonce :
  Raw_context.t ->
  Lwt.t (Error_monad.tzresult (Raw_context.t * Contract_repr.t)).

Parameter originated_from_current_nonce :
  Raw_context.t -> Raw_context.t ->
  Lwt.t (Error_monad.tzresult (list Contract_repr.t)).

Parameter init : Raw_context.t -> Lwt.t (Error_monad.tzresult Raw_context.t).

Parameter used_storage_space :
  Raw_context.t -> Contract_repr.t -> Lwt.t (Error_monad.tzresult Z.t).

Parameter paid_storage_space :
  Raw_context.t -> Contract_repr.t -> Lwt.t (Error_monad.tzresult Z.t).

Parameter set_paid_storage_space_and_return_fees_to_pay :
  Raw_context.t -> Contract_repr.t -> Z.t ->
  Lwt.t (Error_monad.tzresult (Z.t * Raw_context.t)).

Cycle_repr

  • OCaml size: 93 lines
  • Coq size: 127 lines (+36% compared to OCaml)
cycle_repr.ml 4 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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 t = int32

type cycle = t

let encoding = Data_encoding.int32

let rpc_arg =
  let construct = Int32.to_string in
  let destruct str =
    match Int32.of_string str with
    | exception _ ->
        Error "Cannot parse cycle"
    | cycle ->
        Ok cycle
  in
  RPC_arg.make
    ~descr:"A cycle integer"
    ~name:"block_cycle"
    ~construct
    ~destruct
    ()

let pp ppf cycle = Format.fprintf ppf "%ld" cycle

include (Compare.Int32 : Compare.S with type t := t)

module Map = Map.Make (Compare.Int32)

let root = 0l

let succ = Int32.succ

let pred = function 0l -> None | i -> Some (Int32.pred i)

let add c i =
  assert (Compare.Int.(i > 0)) ;
  Int32.add c (Int32.of_int i)

let sub c i =
  assert (Compare.Int.(i > 0)) ;
  let r = Int32.sub c (Int32.of_int i) in
  if Compare.Int32.(r < 0l) then None else Some r

let to_int32 i = i

let of_int32_exn l =
  if Compare.Int32.(l >= 0l) then l
  else invalid_arg "Level_repr.Cycle.of_int32"

module Index : Storage_description.INDEX with type t = cycle = struct
  type t = cycle

  let path_length = 1

  let to_path c l = Int32.to_string (to_int32 c) :: l

  let of_path = function
    | [s] -> (
      try Some (Int32.of_string s) with _ -> None )
    | _ ->
        None

  let rpc_arg = rpc_arg

  let encoding = encoding

  let compare = compare
end
Cycle_repr.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Storage_description.

Definition t : Set := int32.

Definition cycle : Set := t.

Definition encoding : Data_encoding.encoding int32 :=
  Data_encoding.__int32_value.

Definition rpc_arg : RPC_arg.arg int32 :=
  let construct := Int32.to_string in
  let destruct (str : string) : Pervasives.result int32 string :=
    let 'cycle := Int32.of_string str in
    Pervasives.Ok cycle in
  RPC_arg.make (Some "A cycle integer") "block_cycle" destruct construct tt.

Definition pp (ppf : Format.formatter) (cycle : int32) : unit :=
  Format.fprintf ppf
    (CamlinternalFormatBasics.Format
      (CamlinternalFormatBasics.Int32 CamlinternalFormatBasics.Int_d
        CamlinternalFormatBasics.No_padding
        CamlinternalFormatBasics.No_precision
        CamlinternalFormatBasics.End_of_format) "%ld") cycle.

Definition op_eq := (|Compare.Int32|).(Compare.S.op_eq).

Definition op_ltgt := (|Compare.Int32|).(Compare.S.op_ltgt).

Definition op_lt := (|Compare.Int32|).(Compare.S.op_lt).

Definition op_lteq := (|Compare.Int32|).(Compare.S.op_lteq).

Definition op_gteq := (|Compare.Int32|).(Compare.S.op_gteq).

Definition op_gt := (|Compare.Int32|).(Compare.S.op_gt).

Definition compare := (|Compare.Int32|).(Compare.S.compare).

Definition equal := (|Compare.Int32|).(Compare.S.equal).

Definition max := (|Compare.Int32|).(Compare.S.max).

Definition min := (|Compare.Int32|).(Compare.S.min).

Definition Map :=
  Map.Make
    (existT (A := Set) _ _
      {|
        Compare.COMPARABLE.compare := (|Compare.Int32|).(Compare.S.compare)
      |}).

Definition root : int32 :=
  (* ❌ Constant of type int32 is converted to int *)
  0.

Definition succ : int32 -> int32 := Int32.succ.

Definition pred (function_parameter : int32) : option int32 :=
  match function_parameter with
  |
    (* ❌ Constant of type int32 is converted to int *)
    0 => None
  | i => Some (Int32.pred i)
  end.

Definition add (c : int32) (i : (|Compare.Int|).(Compare.S.t)) : int32 :=
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  Int32.add c (Int32.of_int i).

Definition sub (c : int32) (i : (|Compare.Int|).(Compare.S.t)) : option int32 :=
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  let __r_value := Int32.sub c (Int32.of_int i) in
  if
    (|Compare.Int32|).(Compare.S.op_lt) __r_value
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    None
  else
    Some __r_value.

Definition to_int32 {A : Set} (i : A) : A := i.

Definition of_int32_exn (l : (|Compare.Int32|).(Compare.S.t))
  : (|Compare.Int32|).(Compare.S.t) :=
  if
    (|Compare.Int32|).(Compare.S.op_gteq) l
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    l
  else
    Pervasives.invalid_arg "Level_repr.Cycle.of_int32".

Definition Index : {_ : unit & Storage_description.INDEX.signature (t := cycle)}
  :=
  let t : Set := cycle in
  let path_length := 1 in
  let to_path (c : int32) (l : list string) : list string :=
    cons (Int32.to_string (to_int32 c)) l in
  let of_path (function_parameter : list string) : option int32 :=
    match function_parameter with
    | cons s [] =>
      (* ❌ Try-with are not handled *)
      try (Some (Int32.of_string s))
    | _ => None
    end in
  existT (A := unit) (fun _ => _) tt
    {|
      Storage_description.INDEX.path_length := path_length;
      Storage_description.INDEX.to_path := to_path;
      Storage_description.INDEX.of_path := of_path;
      Storage_description.INDEX.rpc_arg := rpc_arg;
      Storage_description.INDEX.encoding := encoding;
      Storage_description.INDEX.compare := compare
    |}.

Cycle_repr_mli

  • OCaml size: 54 lines
  • Coq size: 62 lines (+14% compared to OCaml)
cycle_repr.mli success
(*****************************************************************************)
(*                                                                           *)
(* 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 t

type cycle = t

include Compare.S with type t := t

val encoding : cycle Data_encoding.t

val rpc_arg : cycle RPC_arg.arg

val pp : Format.formatter -> cycle -> unit

val root : cycle

val pred : cycle -> cycle option

val add : cycle -> int -> cycle

val sub : cycle -> int -> cycle option

val succ : cycle -> cycle

val to_int32 : cycle -> int32

val of_int32_exn : int32 -> cycle

module Map : S.MAP with type key = cycle

module Index : Storage_description.INDEX with type t = cycle
Cycle_repr_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Storage_description.

Parameter t : Set.

Definition cycle : Set := t.

Parameter Included_S : {_ : unit & Compare.S.signature (t := t)}.

Definition op_eq : t -> t -> bool := (|Included_S|).(Compare.S.op_eq).

Definition op_ltgt : t -> t -> bool := (|Included_S|).(Compare.S.op_ltgt).

Definition op_lt : t -> t -> bool := (|Included_S|).(Compare.S.op_lt).

Definition op_lteq : t -> t -> bool := (|Included_S|).(Compare.S.op_lteq).

Definition op_gteq : t -> t -> bool := (|Included_S|).(Compare.S.op_gteq).

Definition op_gt : t -> t -> bool := (|Included_S|).(Compare.S.op_gt).

Definition compare : t -> t -> int := (|Included_S|).(Compare.S.compare).

Definition equal : t -> t -> bool := (|Included_S|).(Compare.S.equal).

Definition max : t -> t -> t := (|Included_S|).(Compare.S.max).

Definition min : t -> t -> t := (|Included_S|).(Compare.S.min).

Parameter encoding : Data_encoding.t cycle.

Parameter rpc_arg : RPC_arg.arg cycle.

Parameter pp : Format.formatter -> cycle -> unit.

Parameter root : cycle.

Parameter pred : cycle -> option cycle.

Parameter add : cycle -> int -> cycle.

Parameter sub : cycle -> int -> option cycle.

Parameter succ : cycle -> cycle.

Parameter to_int32 : cycle -> int32.

Parameter of_int32_exn : int32 -> cycle.

Parameter Map : {t : Set -> Set & S.MAP.signature (key := cycle) (t := t)}.

Parameter Index : {_ : unit & Storage_description.INDEX.signature (t := cycle)}.

Delegate_services

  • OCaml size: 693 lines
  • Coq size: 1022 lines (+47% compared to OCaml)
delegate_services.ml 14 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type info = {
  balance : Tez.t;
  frozen_balance : Tez.t;
  frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t;
  staking_balance : Tez.t;
  delegated_contracts : Contract_repr.t list;
  delegated_balance : Tez.t;
  deactivated : bool;
  grace_period : Cycle.t;
}

let info_encoding =
  let open Data_encoding in
  conv
    (fun { balance;
           frozen_balance;
           frozen_balance_by_cycle;
           staking_balance;
           delegated_contracts;
           delegated_balance;
           deactivated;
           grace_period } ->
      ( balance,
        frozen_balance,
        frozen_balance_by_cycle,
        staking_balance,
        delegated_contracts,
        delegated_balance,
        deactivated,
        grace_period ))
    (fun ( balance,
           frozen_balance,
           frozen_balance_by_cycle,
           staking_balance,
           delegated_contracts,
           delegated_balance,
           deactivated,
           grace_period ) ->
      {
        balance;
        frozen_balance;
        frozen_balance_by_cycle;
        staking_balance;
        delegated_contracts;
        delegated_balance;
        deactivated;
        grace_period;
      })
    (obj8
       (req "balance" Tez.encoding)
       (req "frozen_balance" Tez.encoding)
       (req "frozen_balance_by_cycle" Delegate.frozen_balance_by_cycle_encoding)
       (req "staking_balance" Tez.encoding)
       (req "delegated_contracts" (list Contract_repr.encoding))
       (req "delegated_balance" Tez.encoding)
       (req "deactivated" bool)
       (req "grace_period" Cycle.encoding))

module S = struct
  let raw_path = RPC_path.(open_root / "context" / "delegates")

  open Data_encoding

  type list_query = {active : bool; inactive : bool}

  let list_query : list_query RPC_query.t =
    let open RPC_query in
    query (fun active inactive -> {active; inactive})
    |+ flag "active" (fun t -> t.active)
    |+ flag "inactive" (fun t -> t.inactive)
    |> seal

  let list_delegate =
    RPC_service.get_service
      ~description:"Lists all registered delegates."
      ~query:list_query
      ~output:(list Signature.Public_key_hash.encoding)
      raw_path

  let path = RPC_path.(raw_path /: Signature.Public_key_hash.rpc_arg)

  let info =
    RPC_service.get_service
      ~description:"Everything about a delegate."
      ~query:RPC_query.empty
      ~output:info_encoding
      path

  let balance =
    RPC_service.get_service
      ~description:
        "Returns the full balance of a given delegate, including the frozen \
         balances."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "balance")

  let frozen_balance =
    RPC_service.get_service
      ~description:
        "Returns the total frozen balances of a given delegate, this includes \
         the frozen deposits, rewards and fees."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "frozen_balance")

  let frozen_balance_by_cycle =
    RPC_service.get_service
      ~description:
        "Returns the frozen balances of a given delegate, indexed by the \
         cycle by which it will be unfrozen"
      ~query:RPC_query.empty
      ~output:Delegate.frozen_balance_by_cycle_encoding
      RPC_path.(path / "frozen_balance_by_cycle")

  let staking_balance =
    RPC_service.get_service
      ~description:
        "Returns the total amount of tokens delegated to a given delegate. \
         This includes the balances of all the contracts that delegate to it, \
         but also the balance of the delegate itself and its frozen fees and \
         deposits. The rewards do not count in the delegated balance until \
         they are unfrozen."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "staking_balance")

  let delegated_contracts =
    RPC_service.get_service
      ~description:
        "Returns the list of contracts that delegate to a given delegate."
      ~query:RPC_query.empty
      ~output:(list Contract_repr.encoding)
      RPC_path.(path / "delegated_contracts")

  let delegated_balance =
    RPC_service.get_service
      ~description:
        "Returns the balances of all the contracts that delegate to a given \
         delegate. This excludes the delegate's own balance and its frozen \
         balances."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "delegated_balance")

  let deactivated =
    RPC_service.get_service
      ~description:
        "Tells whether the delegate is currently tagged as deactivated or not."
      ~query:RPC_query.empty
      ~output:bool
      RPC_path.(path / "deactivated")

  let grace_period =
    RPC_service.get_service
      ~description:
        "Returns the cycle by the end of which the delegate might be \
         deactivated if she fails to execute any delegate action. A \
         deactivated delegate might be reactivated (without loosing any \
         rolls) by simply re-registering as a delegate. For deactivated \
         delegates, this value contains the cycle by which they were \
         deactivated."
      ~query:RPC_query.empty
      ~output:Cycle.encoding
      RPC_path.(path / "grace_period")
end

let begin_register () =
  let open Services_registration in
  register0 S.list_delegate (fun ctxt q () ->
      Delegate.list ctxt
      >>= fun delegates ->
      if q.active && q.inactive then return delegates
      else if q.active then
        filter_map_s
          (fun pkh ->
            Delegate.deactivated ctxt pkh
            >>=? function true -> return_none | false -> return_some pkh)
          delegates
      else if q.inactive then
        filter_map_s
          (fun pkh ->
            Delegate.deactivated ctxt pkh
            >>=? function false -> return_none | true -> return_some pkh)
          delegates
      else return_nil) ;
  register1 S.info (fun ctxt pkh () () ->
      Delegate.full_balance ctxt pkh
      >>=? fun balance ->
      Delegate.frozen_balance ctxt pkh
      >>=? fun frozen_balance ->
      Delegate.frozen_balance_by_cycle ctxt pkh
      >>= fun frozen_balance_by_cycle ->
      Delegate.staking_balance ctxt pkh
      >>=? fun staking_balance ->
      Delegate.delegated_contracts ctxt pkh
      >>= fun delegated_contracts ->
      Delegate.delegated_balance ctxt pkh
      >>=? fun delegated_balance ->
      Delegate.deactivated ctxt pkh
      >>=? fun deactivated ->
      Delegate.grace_period ctxt pkh
      >>=? fun grace_period ->
      return
        {
          balance;
          frozen_balance;
          frozen_balance_by_cycle;
          staking_balance;
          delegated_contracts;
          delegated_balance;
          deactivated;
          grace_period;
        }) ;
  register1 S.balance (fun ctxt pkh () () -> Delegate.full_balance ctxt pkh) ;
  register1 S.frozen_balance (fun ctxt pkh () () ->
      Delegate.frozen_balance ctxt pkh) ;
  register1 S.frozen_balance_by_cycle (fun ctxt pkh () () ->
      Delegate.frozen_balance_by_cycle ctxt pkh >>= return) ;
  register1 S.staking_balance (fun ctxt pkh () () ->
      Delegate.staking_balance ctxt pkh) ;
  register1 S.delegated_contracts (fun ctxt pkh () () ->
      Delegate.delegated_contracts ctxt pkh >>= return) ;
  register1 S.delegated_balance (fun ctxt pkh () () ->
      Delegate.delegated_balance ctxt pkh) ;
  register1 S.deactivated (fun ctxt pkh () () -> Delegate.deactivated ctxt pkh) ;
  register1 S.grace_period (fun ctxt pkh () () ->
      Delegate.grace_period ctxt pkh)

let list ctxt block ?(active = true) ?(inactive = false) () =
  RPC_context.make_call0 S.list_delegate ctxt block {active; inactive} ()

let info ctxt block pkh = RPC_context.make_call1 S.info ctxt block pkh () ()

let balance ctxt block pkh =
  RPC_context.make_call1 S.balance ctxt block pkh () ()

let frozen_balance ctxt block pkh =
  RPC_context.make_call1 S.frozen_balance ctxt block pkh () ()

let frozen_balance_by_cycle ctxt block pkh =
  RPC_context.make_call1 S.frozen_balance_by_cycle ctxt block pkh () ()

let staking_balance ctxt block pkh =
  RPC_context.make_call1 S.staking_balance ctxt block pkh () ()

let delegated_contracts ctxt block pkh =
  RPC_context.make_call1 S.delegated_contracts ctxt block pkh () ()

let delegated_balance ctxt block pkh =
  RPC_context.make_call1 S.delegated_balance ctxt block pkh () ()

let deactivated ctxt block pkh =
  RPC_context.make_call1 S.deactivated ctxt block pkh () ()

let grace_period ctxt block pkh =
  RPC_context.make_call1 S.grace_period ctxt block pkh () ()

let requested_levels ~default ctxt cycles levels =
  match (levels, cycles) with
  | ([], []) ->
      return [default]
  | (levels, cycles) ->
      (* explicitly fail when requested levels or cycle are in the past...
         or too far in the future... *)
      let levels =
        List.sort_uniq
          Level.compare
          (List.concat
             ( List.map (Level.from_raw ctxt) levels
             :: List.map (Level.levels_in_cycle ctxt) cycles ))
      in
      map_s
        (fun level ->
          let current_level = Level.current ctxt in
          if Level.(level <= current_level) then return (level, None)
          else
            Baking.earlier_predecessor_timestamp ctxt level
            >>=? fun timestamp -> return (level, Some timestamp))
        levels

module Baking_rights = struct
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    priority : int;
    timestamp : Timestamp.t option;
  }

  let encoding =
    let open Data_encoding in
    conv
      (fun {level; delegate; priority; timestamp} ->
        (level, delegate, priority, timestamp))
      (fun (level, delegate, priority, timestamp) ->
        {level; delegate; priority; timestamp})
      (obj4
         (req "level" Raw_level.encoding)
         (req "delegate" Signature.Public_key_hash.encoding)
         (req "priority" uint16)
         (opt "estimated_time" Timestamp.encoding))

  module S = struct
    let custom_root = RPC_path.(open_root / "helpers" / "baking_rights")

    type baking_rights_query = {
      levels : Raw_level.t list;
      cycles : Cycle.t list;
      delegates : Signature.Public_key_hash.t list;
      max_priority : int option;
      all : bool;
    }

    let baking_rights_query =
      let open RPC_query in
      query (fun levels cycles delegates max_priority all ->
          {levels; cycles; delegates; max_priority; all})
      |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
      |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t ->
             t.delegates)
      |+ opt_field "max_priority" RPC_arg.int (fun t -> t.max_priority)
      |+ flag "all" (fun t -> t.all)
      |> seal

    let baking_rights =
      RPC_service.get_service
        ~description:
          "Retrieves the list of delegates allowed to bake a block.\n\
           By default, it gives the best baking priorities for bakers that \
           have at least one opportunity below the 64th priority for the next \
           block.\n\
           Parameters `level` and `cycle` can be used to specify the (valid) \
           level(s) in the past or future at which the baking rights have to \
           be returned. Parameter `delegate` can be used to restrict the \
           results to the given delegates. If parameter `all` is set, all the \
           baking opportunities for each baker at each level are returned, \
           instead of just the first one.\n\
           Returns the list of baking slots. Also returns the minimal \
           timestamps that correspond to these slots. The timestamps are \
           omitted for levels in the past, and are only estimates for levels \
           later that the next block, based on the hypothesis that all \
           predecessor blocks were baked at the first priority."
        ~query:baking_rights_query
        ~output:(Data_encoding.list encoding)
        custom_root
  end

  let baking_priorities ctxt max_prio (level, pred_timestamp) =
    Baking.baking_priorities ctxt level
    >>=? fun contract_list ->
    let rec loop l acc priority =
      if Compare.Int.(priority >= max_prio) then return (List.rev acc)
      else
        let (Misc.LCons (pk, next)) = l in
        let delegate = Signature.Public_key.hash pk in
        ( match pred_timestamp with
        | None ->
            return_none
        | Some pred_timestamp ->
            Baking.minimal_time ctxt priority pred_timestamp
            >>=? fun t -> return_some t )
        >>=? fun timestamp ->
        let acc =
          {level = level.level; delegate; priority; timestamp} :: acc
        in
        next () >>=? fun l -> loop l acc (priority + 1)
    in
    loop contract_list [] 0

  let remove_duplicated_delegates rights =
    List.rev @@ fst
    @@ List.fold_left
         (fun (acc, previous) r ->
           if Signature.Public_key_hash.Set.mem r.delegate previous then
             (acc, previous)
           else
             (r :: acc, Signature.Public_key_hash.Set.add r.delegate previous))
         ([], Signature.Public_key_hash.Set.empty)
         rights

  let register () =
    let open Services_registration in
    register0 S.baking_rights (fun ctxt q () ->
        requested_levels
          ~default:
            ( Level.succ ctxt (Level.current ctxt),
              Some (Timestamp.current ctxt) )
          ctxt
          q.cycles
          q.levels
        >>=? fun levels ->
        let max_priority =
          match q.max_priority with None -> 64 | Some max -> max
        in
        map_s (baking_priorities ctxt max_priority) levels
        >>=? fun rights ->
        let rights =
          if q.all then rights else List.map remove_duplicated_delegates rights
        in
        let rights = List.concat rights in
        match q.delegates with
        | [] ->
            return rights
        | _ :: _ as delegates ->
            let is_requested p =
              List.exists
                (Signature.Public_key_hash.equal p.delegate)
                delegates
            in
            return (List.filter is_requested rights))

  let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false)
      ?max_priority block =
    RPC_context.make_call0
      S.baking_rights
      ctxt
      block
      {levels; cycles; delegates; max_priority; all}
      ()
end

module Endorsing_rights = struct
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    slots : int list;
    estimated_time : Time.t option;
  }

  let encoding =
    let open Data_encoding in
    conv
      (fun {level; delegate; slots; estimated_time} ->
        (level, delegate, slots, estimated_time))
      (fun (level, delegate, slots, estimated_time) ->
        {level; delegate; slots; estimated_time})
      (obj4
         (req "level" Raw_level.encoding)
         (req "delegate" Signature.Public_key_hash.encoding)
         (req "slots" (list uint16))
         (opt "estimated_time" Timestamp.encoding))

  module S = struct
    let custom_root = RPC_path.(open_root / "helpers" / "endorsing_rights")

    type endorsing_rights_query = {
      levels : Raw_level.t list;
      cycles : Cycle.t list;
      delegates : Signature.Public_key_hash.t list;
    }

    let endorsing_rights_query =
      let open RPC_query in
      query (fun levels cycles delegates -> {levels; cycles; delegates})
      |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
      |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t ->
             t.delegates)
      |> seal

    let endorsing_rights =
      RPC_service.get_service
        ~description:
          "Retrieves the delegates allowed to endorse a block.\n\
           By default, it gives the endorsement slots for delegates that have \
           at least one in the next block.\n\
           Parameters `level` and `cycle` can be used to specify the (valid) \
           level(s) in the past or future at which the endorsement rights \
           have to be returned. Parameter `delegate` can be used to restrict \
           the results to the given delegates.\n\
           Returns the list of endorsement slots. Also returns the minimal \
           timestamps that correspond to these slots. The timestamps are \
           omitted for levels in the past, and are only estimates for levels \
           later that the next block, based on the hypothesis that all \
           predecessor blocks were baked at the first priority."
        ~query:endorsing_rights_query
        ~output:(Data_encoding.list encoding)
        custom_root
  end

  let endorsement_slots ctxt (level, estimated_time) =
    Baking.endorsement_rights ctxt level
    >>=? fun rights ->
    return
      (Signature.Public_key_hash.Map.fold
         (fun delegate (_, slots, _) acc ->
           {level = level.level; delegate; slots; estimated_time} :: acc)
         rights
         [])

  let register () =
    let open Services_registration in
    register0 S.endorsing_rights (fun ctxt q () ->
        requested_levels
          ~default:(Level.current ctxt, Some (Timestamp.current ctxt))
          ctxt
          q.cycles
          q.levels
        >>=? fun levels ->
        map_s (endorsement_slots ctxt) levels
        >>=? fun rights ->
        let rights = List.concat rights in
        match q.delegates with
        | [] ->
            return rights
        | _ :: _ as delegates ->
            let is_requested p =
              List.exists
                (Signature.Public_key_hash.equal p.delegate)
                delegates
            in
            return (List.filter is_requested rights))

  let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) block =
    RPC_context.make_call0
      S.endorsing_rights
      ctxt
      block
      {levels; cycles; delegates}
      ()
end

module Endorsing_power = struct
  let endorsing_power ctxt (operation, chain_id) =
    let (Operation_data data) = operation.protocol_data in
    match data.contents with
    | Single (Endorsement _) ->
        Baking.check_endorsement_rights
          ctxt
          chain_id
          {shell = operation.shell; protocol_data = data}
        >>=? fun (_, slots, _) -> return (List.length slots)
    | _ ->
        failwith "Operation is not an endorsement"

  module S = struct
    let endorsing_power =
      let open Data_encoding in
      RPC_service.post_service
        ~description:
          "Get the endorsing power of an endorsement, that is, the number of \
           slots that the endorser has"
        ~query:RPC_query.empty
        ~input:
          (obj2
             (req "endorsement_operation" Operation.encoding)
             (req "chain_id" Chain_id.encoding))
        ~output:int31
        RPC_path.(open_root / "endorsing_power")
  end

  let register () =
    let open Services_registration in
    register0 S.endorsing_power (fun ctxt () (op, chain_id) ->
        endorsing_power ctxt (op, chain_id))

  let get ctxt block op chain_id =
    RPC_context.make_call0 S.endorsing_power ctxt block () (op, chain_id)
end

module Required_endorsements = struct
  let required_endorsements ctxt block_delay =
    return (Baking.minimum_allowed_endorsements ctxt ~block_delay)

  module S = struct
    type t = {block_delay : Period.t}

    let required_endorsements_query =
      let open RPC_query in
      query (fun block_delay -> {block_delay})
      |+ field "block_delay" Period.rpc_arg Period.zero (fun t ->
             t.block_delay)
      |> seal

    let required_endorsements =
      let open Data_encoding in
      RPC_service.get_service
        ~description:
          "Minimum number of endorsements for a block to be valid, given a \
           delay of the block's timestamp with respect to the minimum time to \
           bake at the block's priority"
        ~query:required_endorsements_query
        ~output:int31
        RPC_path.(open_root / "required_endorsements")
  end

  let register () =
    let open Services_registration in
    register0 S.required_endorsements (fun ctxt {block_delay} () ->
        required_endorsements ctxt block_delay)

  let get ctxt block block_delay =
    RPC_context.make_call0 S.required_endorsements ctxt block {block_delay} ()
end

module Minimal_valid_time = struct
  let minimal_valid_time ctxt ~priority ~endorsing_power =
    Baking.minimal_valid_time ctxt ~priority ~endorsing_power

  module S = struct
    type t = {priority : int; endorsing_power : int}

    let minimal_valid_time_query =
      let open RPC_query in
      query (fun priority endorsing_power -> {priority; endorsing_power})
      |+ field "priority" RPC_arg.int 0 (fun t -> t.priority)
      |+ field "endorsing_power" RPC_arg.int 0 (fun t -> t.endorsing_power)
      |> seal

    let minimal_valid_time =
      RPC_service.get_service
        ~description:
          "Minimal valid time for a block given a priority and an endorsing \
           power."
        ~query:minimal_valid_time_query
        ~output:Time.encoding
        RPC_path.(open_root / "minimal_valid_time")
  end

  let register () =
    let open Services_registration in
    register0 S.minimal_valid_time (fun ctxt {priority; endorsing_power} () ->
        minimal_valid_time ctxt ~priority ~endorsing_power)

  let get ctxt block priority endorsing_power =
    RPC_context.make_call0
      S.minimal_valid_time
      ctxt
      block
      {priority; endorsing_power}
      ()
end

let register () =
  begin_register () ;
  Baking_rights.register () ;
  Endorsing_rights.register () ;
  Endorsing_power.register () ;
  Required_endorsements.register () ;
  Minimal_valid_time.register ()

let endorsement_rights ctxt level =
  Endorsing_rights.endorsement_slots ctxt (level, None)
  >>=? fun l ->
  return (List.map (fun {Endorsing_rights.delegate; _} -> delegate) l)

let baking_rights ctxt max_priority =
  let max = match max_priority with None -> 64 | Some m -> m in
  let level = Level.current ctxt in
  Baking_rights.baking_priorities ctxt max (level, None)
  >>=? fun l ->
  return
    ( level.level,
      List.map
        (fun {Baking_rights.delegate; timestamp; _} -> (delegate, timestamp))
        l )

let endorsing_power ctxt operation =
  Endorsing_power.endorsing_power ctxt operation

let required_endorsements ctxt delay =
  Required_endorsements.required_endorsements ctxt delay

let minimal_valid_time ctxt priority endorsing_power =
  Minimal_valid_time.minimal_valid_time ctxt priority endorsing_power
Delegate_services.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Baking.
Require Tezos.Contract_repr.
Require Tezos.Misc.
Require Tezos.Services_registration.

Import Alpha_context.

Module info.
  Record record : Set := Build {
    balance : Alpha_context.Tez.t;
    frozen_balance : Alpha_context.Tez.t;
    frozen_balance_by_cycle :
      (|Alpha_context.Cycle.Map|).(S.MAP.t)
        Alpha_context.Delegate.frozen_balance;
    staking_balance : Alpha_context.Tez.t;
    delegated_contracts : list Contract_repr.t;
    delegated_balance : Alpha_context.Tez.t;
    deactivated : bool;
    grace_period : Alpha_context.Cycle.t }.
  Definition with_balance balance (r : record) :=
    Build balance r.(frozen_balance) r.(frozen_balance_by_cycle)
      r.(staking_balance) r.(delegated_contracts) r.(delegated_balance)
      r.(deactivated) r.(grace_period).
  Definition with_frozen_balance frozen_balance (r : record) :=
    Build r.(balance) frozen_balance r.(frozen_balance_by_cycle)
      r.(staking_balance) r.(delegated_contracts) r.(delegated_balance)
      r.(deactivated) r.(grace_period).
  Definition with_frozen_balance_by_cycle frozen_balance_by_cycle
    (r : record) :=
    Build r.(balance) r.(frozen_balance) frozen_balance_by_cycle
      r.(staking_balance) r.(delegated_contracts) r.(delegated_balance)
      r.(deactivated) r.(grace_period).
  Definition with_staking_balance staking_balance (r : record) :=
    Build r.(balance) r.(frozen_balance) r.(frozen_balance_by_cycle)
      staking_balance r.(delegated_contracts) r.(delegated_balance)
      r.(deactivated) r.(grace_period).
  Definition with_delegated_contracts delegated_contracts (r : record) :=
    Build r.(balance) r.(frozen_balance) r.(frozen_balance_by_cycle)
      r.(staking_balance) delegated_contracts r.(delegated_balance)
      r.(deactivated) r.(grace_period).
  Definition with_delegated_balance delegated_balance (r : record) :=
    Build r.(balance) r.(frozen_balance) r.(frozen_balance_by_cycle)
      r.(staking_balance) r.(delegated_contracts) delegated_balance
      r.(deactivated) r.(grace_period).
  Definition with_deactivated deactivated (r : record) :=
    Build r.(balance) r.(frozen_balance) r.(frozen_balance_by_cycle)
      r.(staking_balance) r.(delegated_contracts) r.(delegated_balance)
      deactivated r.(grace_period).
  Definition with_grace_period grace_period (r : record) :=
    Build r.(balance) r.(frozen_balance) r.(frozen_balance_by_cycle)
      r.(staking_balance) r.(delegated_contracts) r.(delegated_balance)
      r.(deactivated) grace_period.
End info.
Definition info := info.record.

Definition info_encoding : Data_encoding.encoding info :=
  Data_encoding.conv
    (fun function_parameter =>
      let '{|
        info.balance := balance;
          info.frozen_balance := __frozen_balance_value;
          info.frozen_balance_by_cycle := frozen_balance_by_cycle;
          info.staking_balance := staking_balance;
          info.delegated_contracts := delegated_contracts;
          info.delegated_balance := delegated_balance;
          info.deactivated := deactivated;
          info.grace_period := grace_period
          |} := function_parameter in
      (balance, __frozen_balance_value, frozen_balance_by_cycle,
        staking_balance, delegated_contracts, delegated_balance, deactivated,
        grace_period))
    (fun function_parameter =>
      let
        '(balance, __frozen_balance_value, frozen_balance_by_cycle,
          staking_balance, delegated_contracts, delegated_balance, deactivated,
          grace_period) := function_parameter in
      {| info.balance := balance; info.frozen_balance := __frozen_balance_value;
        info.frozen_balance_by_cycle := frozen_balance_by_cycle;
        info.staking_balance := staking_balance;
        info.delegated_contracts := delegated_contracts;
        info.delegated_balance := delegated_balance;
        info.deactivated := deactivated; info.grace_period := grace_period |})
    None
    (Data_encoding.obj8
      (Data_encoding.req None None "balance" Alpha_context.Tez.encoding)
      (Data_encoding.req None None "frozen_balance" Alpha_context.Tez.encoding)
      (Data_encoding.req None None "frozen_balance_by_cycle"
        Alpha_context.Delegate.frozen_balance_by_cycle_encoding)
      (Data_encoding.req None None "staking_balance" Alpha_context.Tez.encoding)
      (Data_encoding.req None None "delegated_contracts"
        (Data_encoding.__list_value None Contract_repr.encoding))
      (Data_encoding.req None None "delegated_balance"
        Alpha_context.Tez.encoding)
      (Data_encoding.req None None "deactivated" Data_encoding.__bool_value)
      (Data_encoding.req None None "grace_period" Alpha_context.Cycle.encoding)).

Module S.
  Definition raw_path : RPC_path.path Updater.rpc_context Updater.rpc_context :=
    RPC_path.op_div (RPC_path.op_div RPC_path.open_root "context") "delegates".
  
  Import Data_encoding.
  
  Module list_query.
    Record record : Set := Build {
      active : bool;
      inactive : bool }.
    Definition with_active active (r : record) :=
      Build active r.(inactive).
    Definition with_inactive inactive (r : record) :=
      Build r.(active) inactive.
  End list_query.
  Definition list_query := list_query.record.
  
  Definition __list_query_value : RPC_query.t list_query :=
    RPC_query.seal
      (RPC_query.op_pipeplus
        (RPC_query.op_pipeplus
          (RPC_query.__query_value
            (fun active =>
              fun inactive =>
                {| list_query.active := active; list_query.inactive := inactive
                  |}))
          (RPC_query.flag None "active"
            (fun __t_value => __t_value.(list_query.active))))
        (RPC_query.flag None "inactive"
          (fun __t_value => __t_value.(list_query.inactive)))).
  
  Definition list_delegate
    : RPC_service.service Updater.rpc_context Updater.rpc_context list_query
      unit (list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) :=
    RPC_service.get_service (Some "Lists all registered delegates.")
      __list_query_value
      (Data_encoding.__list_value None
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding)) raw_path.
  
  Definition path
    : RPC_path.path Updater.rpc_context
      (Updater.rpc_context *
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) :=
    RPC_path.op_divcolon raw_path
      (|Signature.Public_key_hash|).(S.SPublic_key_hash.rpc_arg).
  
  Definition __info_value
    : RPC_service.service Updater.rpc_context
      (Updater.rpc_context *
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) unit unit info :=
    RPC_service.get_service (Some "Everything about a delegate.")
      RPC_query.empty info_encoding path.
  
  Definition balance
    : RPC_service.service Updater.rpc_context
      (Updater.rpc_context *
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) unit unit
      Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the full balance of a given delegate, including the frozen balances.")
      RPC_query.empty Alpha_context.Tez.encoding
      (RPC_path.op_div path "balance").
  
  Definition __frozen_balance_value
    : RPC_service.service Updater.rpc_context
      (Updater.rpc_context *
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) unit unit
      Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the total frozen balances of a given delegate, this includes the frozen deposits, rewards and fees.")
      RPC_query.empty Alpha_context.Tez.encoding
      (RPC_path.op_div path "frozen_balance").
  
  Definition frozen_balance_by_cycle
    : RPC_service.service Updater.rpc_context
      (Updater.rpc_context *
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) unit unit
      ((|Alpha_context.Cycle.Map|).(S.MAP.t)
        Alpha_context.Delegate.frozen_balance) :=
    RPC_service.get_service
      (Some
        "Returns the frozen balances of a given delegate, indexed by the cycle by which it will be unfrozen")
      RPC_query.empty Alpha_context.Delegate.frozen_balance_by_cycle_encoding
      (RPC_path.op_div path "frozen_balance_by_cycle").
  
  Definition staking_balance
    : RPC_service.service Updater.rpc_context
      (Updater.rpc_context *
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) unit unit
      Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the total amount of tokens delegated to a given delegate. This includes the balances of all the contracts that delegate to it, but also the balance of the delegate itself and its frozen fees and deposits. The rewards do not count in the delegated balance until they are unfrozen.")
      RPC_query.empty Alpha_context.Tez.encoding
      (RPC_path.op_div path "staking_balance").
  
  Definition delegated_contracts
    : RPC_service.service Updater.rpc_context
      (Updater.rpc_context *
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) unit unit
      (list Contract_repr.contract) :=
    RPC_service.get_service
      (Some "Returns the list of contracts that delegate to a given delegate.")
      RPC_query.empty (Data_encoding.__list_value None Contract_repr.encoding)
      (RPC_path.op_div path "delegated_contracts").
  
  Definition delegated_balance
    : RPC_service.service Updater.rpc_context
      (Updater.rpc_context *
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) unit unit
      Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the balances of all the contracts that delegate to a given delegate. This excludes the delegate's own balance and its frozen balances.")
      RPC_query.empty Alpha_context.Tez.encoding
      (RPC_path.op_div path "delegated_balance").
  
  Definition deactivated
    : RPC_service.service Updater.rpc_context
      (Updater.rpc_context *
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) unit unit bool :=
    RPC_service.get_service
      (Some
        "Tells whether the delegate is currently tagged as deactivated or not.")
      RPC_query.empty Data_encoding.__bool_value
      (RPC_path.op_div path "deactivated").
  
  Definition grace_period
    : RPC_service.service Updater.rpc_context
      (Updater.rpc_context *
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) unit unit
      Alpha_context.Cycle.t :=
    RPC_service.get_service
      (Some
        "Returns the cycle by the end of which the delegate might be deactivated if she fails to execute any delegate action. A deactivated delegate might be reactivated (without loosing any rolls) by simply re-registering as a delegate. For deactivated delegates, this value contains the cycle by which they were deactivated.")
      RPC_query.empty Alpha_context.Cycle.encoding
      (RPC_path.op_div path "grace_period").
End S.

Definition begin_register (function_parameter : unit) : unit :=
  let '_ := function_parameter in
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  Services_registration.register1 S.grace_period
    (fun ctxt =>
      fun pkh =>
        fun function_parameter =>
          let '_ := function_parameter in
          fun function_parameter =>
            let '_ := function_parameter in
            Alpha_context.Delegate.grace_period ctxt pkh).

Definition __list_value {A : Set}
  (ctxt : RPC_context.simple A) (block : A) (op_staroptstar : option bool)
  : option bool -> unit ->
  Lwt.t
    (Error_monad.shell_tzresult
      (list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))) :=
  let active :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => true
    end in
  fun op_staroptstar =>
    let inactive :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => false
      end in
    fun function_parameter =>
      let '_ := function_parameter in
      RPC_context.make_call0 S.list_delegate ctxt block
        {| S.list_query.active := active; S.list_query.inactive := inactive |}
        tt.

Definition __info_value {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (pkh : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.shell_tzresult info) :=
  RPC_context.make_call1 S.__info_value ctxt block pkh tt tt.

Definition balance {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (pkh : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.balance ctxt block pkh tt tt.

Definition __frozen_balance_value {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (pkh : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.__frozen_balance_value ctxt block pkh tt tt.

Definition frozen_balance_by_cycle {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (pkh : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t
    (Error_monad.shell_tzresult
      ((|Alpha_context.Cycle.Map|).(S.MAP.t)
        Alpha_context.Delegate.frozen_balance)) :=
  RPC_context.make_call1 S.frozen_balance_by_cycle ctxt block pkh tt tt.

Definition staking_balance {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (pkh : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.staking_balance ctxt block pkh tt tt.

Definition delegated_contracts {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (pkh : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.shell_tzresult (list Contract_repr.contract)) :=
  RPC_context.make_call1 S.delegated_contracts ctxt block pkh tt tt.

Definition delegated_balance {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (pkh : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.delegated_balance ctxt block pkh tt tt.

Definition deactivated {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (pkh : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.shell_tzresult bool) :=
  RPC_context.make_call1 S.deactivated ctxt block pkh tt tt.

Definition grace_period {A : Set}
  (ctxt : RPC_context.simple A) (block : A)
  (pkh : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.shell_tzresult Alpha_context.Cycle.t) :=
  RPC_context.make_call1 S.grace_period ctxt block pkh tt tt.

Definition requested_levels
  (default : Alpha_context.Level.t * option Alpha_context.Timestamp.t)
  (ctxt : Alpha_context.context) (cycles : list Alpha_context.Cycle.t)
  (levels : list Alpha_context.Raw_level.t)
  : Lwt.t
    (Error_monad.tzresult
      (list (Alpha_context.Level.t * option Alpha_context.Timestamp.t))) :=
  match (levels, cycles) with
  | ([], []) => Error_monad.__return [ default ]
  | (levels, cycles) =>
    let levels :=
      List.sort_uniq Alpha_context.Level.compare
        (List.concat
          (cons
            (List.map
              (let arg := Alpha_context.Level.from_raw ctxt in
              fun eta => arg None eta) levels)
            (List.map (Alpha_context.Level.levels_in_cycle ctxt) cycles))) in
    Error_monad.map_s
      (fun level =>
        let current_level := Alpha_context.Level.current ctxt in
        if Alpha_context.Level.op_lteq level current_level then
          Error_monad.__return (level, None)
        else
          let=? timestamp := Baking.earlier_predecessor_timestamp ctxt level in
          Error_monad.__return (level, (Some timestamp))) levels
  end.

Module Baking_rights.
  Module t.
    Record record : Set := Build {
      level : Alpha_context.Raw_level.t;
      delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t);
      priority : int;
      timestamp : option Alpha_context.Timestamp.t }.
    Definition with_level level (r : record) :=
      Build level r.(delegate) r.(priority) r.(timestamp).
    Definition with_delegate delegate (r : record) :=
      Build r.(level) delegate r.(priority) r.(timestamp).
    Definition with_priority priority (r : record) :=
      Build r.(level) r.(delegate) priority r.(timestamp).
    Definition with_timestamp timestamp (r : record) :=
      Build r.(level) r.(delegate) r.(priority) timestamp.
  End t.
  Definition t := t.record.
  
  Definition encoding : Data_encoding.encoding t :=
    Data_encoding.conv
      (fun function_parameter =>
        let '{|
          t.level := level;
            t.delegate := delegate;
            t.priority := priority;
            t.timestamp := timestamp
            |} := function_parameter in
        (level, delegate, priority, timestamp))
      (fun function_parameter =>
        let '(level, delegate, priority, timestamp) := function_parameter in
        {| t.level := level; t.delegate := delegate; t.priority := priority;
          t.timestamp := timestamp |}) None
      (Data_encoding.obj4
        (Data_encoding.req None None "level" Alpha_context.Raw_level.encoding)
        (Data_encoding.req None None "delegate"
          (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding))
        (Data_encoding.req None None "priority" Data_encoding.uint16)
        (Data_encoding.opt None None "estimated_time"
          Alpha_context.Timestamp.encoding)).
  
  Module S.
    Definition custom_root
      : RPC_path.path Updater.rpc_context Updater.rpc_context :=
      RPC_path.op_div (RPC_path.op_div RPC_path.open_root "helpers")
        "baking_rights".
    
    Module baking_rights_query.
      Record record : Set := Build {
        levels : list Alpha_context.Raw_level.t;
        cycles : list Alpha_context.Cycle.t;
        delegates : list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t);
        max_priority : option int;
        all : bool }.
      Definition with_levels levels (r : record) :=
        Build levels r.(cycles) r.(delegates) r.(max_priority) r.(all).
      Definition with_cycles cycles (r : record) :=
        Build r.(levels) cycles r.(delegates) r.(max_priority) r.(all).
      Definition with_delegates delegates (r : record) :=
        Build r.(levels) r.(cycles) delegates r.(max_priority) r.(all).
      Definition with_max_priority max_priority (r : record) :=
        Build r.(levels) r.(cycles) r.(delegates) max_priority r.(all).
      Definition with_all all (r : record) :=
        Build r.(levels) r.(cycles) r.(delegates) r.(max_priority) all.
    End baking_rights_query.
    Definition baking_rights_query := baking_rights_query.record.
    
    Definition __baking_rights_query_value : RPC_query.t baking_rights_query :=
      RPC_query.seal
        (RPC_query.op_pipeplus
          (RPC_query.op_pipeplus
            (RPC_query.op_pipeplus
              (RPC_query.op_pipeplus
                (RPC_query.op_pipeplus
                  (RPC_query.__query_value
                    (fun levels =>
                      fun cycles =>
                        fun delegates =>
                          fun max_priority =>
                            fun all =>
                              {| baking_rights_query.levels := levels;
                                baking_rights_query.cycles := cycles;
                                baking_rights_query.delegates := delegates;
                                baking_rights_query.max_priority := max_priority;
                                baking_rights_query.all := all |}))
                  (RPC_query.multi_field None "level"
                    Alpha_context.Raw_level.rpc_arg
                    (fun __t_value => __t_value.(baking_rights_query.levels))))
                (RPC_query.multi_field None "cycle" Alpha_context.Cycle.rpc_arg
                  (fun __t_value => __t_value.(baking_rights_query.cycles))))
              (RPC_query.multi_field None "delegate"
                (|Signature.Public_key_hash|).(S.SPublic_key_hash.rpc_arg)
                (fun __t_value => __t_value.(baking_rights_query.delegates))))
            (RPC_query.opt_field None "max_priority" RPC_arg.__int_value
              (fun __t_value => __t_value.(baking_rights_query.max_priority))))
          (RPC_query.flag None "all"
            (fun __t_value => __t_value.(baking_rights_query.all)))).
    
    Definition baking_rights
      : RPC_service.service Updater.rpc_context Updater.rpc_context
        baking_rights_query unit (list t) :=
      RPC_service.get_service
        (Some
          "Retrieves the list of delegates allowed to bake a block.\nBy default, it gives the best baking priorities for bakers that have at least one opportunity below the 64th priority for the next block.\nParameters `level` and `cycle` can be used to specify the (valid) level(s) in the past or future at which the baking rights have to be returned. Parameter `delegate` can be used to restrict the results to the given delegates. If parameter `all` is set, all the baking opportunities for each baker at each level are returned, instead of just the first one.\nReturns the list of baking slots. Also returns the minimal timestamps that correspond to these slots. The timestamps are omitted for levels in the past, and are only estimates for levels later that the next block, based on the hypothesis that all predecessor blocks were baked at the first priority.")
        __baking_rights_query_value (Data_encoding.__list_value None encoding)
        custom_root.
  End S.
  
  Definition baking_priorities
    (ctxt : Alpha_context.context) (max_prio : (|Compare.Int|).(Compare.S.t))
    (function_parameter : Alpha_context.Level.t * option Time.t)
    : Lwt.t (Error_monad.tzresult (list t)) :=
    let '(level, pred_timestamp) := function_parameter in
    let=? contract_list := Baking.baking_priorities ctxt level in
    let fix loop
      (l : Misc.lazy_list_t (|Signature.Public_key|).(S.SPublic_key.t))
      (acc : list t) (priority : (|Compare.Int|).(Compare.S.t))
      : Lwt.t (Error_monad.tzresult (list t)) :=
      if (|Compare.Int|).(Compare.S.op_gteq) priority max_prio then
        Error_monad.__return (List.rev acc)
      else
        let 'Misc.LCons pk next := l in
        let delegate := (|Signature.Public_key|).(S.SPublic_key.__hash_value) pk
          in
        let=? timestamp :=
          match pred_timestamp with
          | None => Error_monad.return_none
          | Some pred_timestamp =>
            let=? __t_value := Baking.minimal_time ctxt priority pred_timestamp
              in
            Error_monad.return_some __t_value
          end in
        let acc :=
          cons
            {| t.level := level.(Alpha_context.Level.t.level);
              t.delegate := delegate; t.priority := priority;
              t.timestamp := timestamp |} acc in
        let=? l := next tt in
        loop l acc (Pervasives.op_plus priority 1) in
    loop contract_list nil 0.
  
  Definition remove_duplicated_delegates (rights : list t) : list t :=
    List.rev
      (Pervasives.fst
        (List.fold_left
          (fun function_parameter =>
            let '(acc, previous) := function_parameter in
            fun __r_value =>
              if
                (|Signature.Public_key_hash|).(S.SPublic_key_hash.__Set).(S.INDEXES_Set.mem)
                  __r_value.(t.delegate) previous then
                (acc, previous)
              else
                ((cons __r_value acc),
                  ((|Signature.Public_key_hash|).(S.SPublic_key_hash.__Set).(S.INDEXES_Set.add)
                    __r_value.(t.delegate) previous)))
          (nil,
            (|Signature.Public_key_hash|).(S.SPublic_key_hash.__Set).(S.INDEXES_Set.empty))
          rights)).
  
  Definition register (function_parameter : unit) : unit :=
    let '_ := function_parameter in
    Services_registration.register0 S.baking_rights
      (fun ctxt =>
        fun q =>
          fun function_parameter =>
            let '_ := function_parameter in
            let=? levels :=
              requested_levels
                ((Alpha_context.Level.succ ctxt
                  (Alpha_context.Level.current ctxt)),
                  (Some (Alpha_context.Timestamp.current ctxt))) ctxt
                q.(S.baking_rights_query.cycles)
                q.(S.baking_rights_query.levels) in
            let max_priority :=
              match q.(S.baking_rights_query.max_priority) with
              | None => 64
              | Some max => max
              end in
            let=? rights :=
              Error_monad.map_s (baking_priorities ctxt max_priority) levels in
            let rights :=
              if q.(S.baking_rights_query.all) then
                rights
              else
                List.map remove_duplicated_delegates rights in
            let rights := List.concat rights in
            match q.(S.baking_rights_query.delegates) with
            | [] => Error_monad.__return rights
            | (cons _ _) as delegates =>
              let is_requested (__p_value : t) : bool :=
                List.__exists
                  ((|Signature.Public_key_hash|).(S.SPublic_key_hash.equal)
                    __p_value.(t.delegate)) delegates in
              Error_monad.__return (List.filter is_requested rights)
            end).
  
  Definition get {A : Set}
    (ctxt : RPC_context.simple A)
    (op_staroptstar : option (list Alpha_context.Raw_level.t))
    : option (list Alpha_context.Cycle.t) ->
    option (list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) ->
    option bool -> option int -> A ->
    Lwt.t (Error_monad.shell_tzresult (list t)) :=
    let levels :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => nil
      end in
    fun op_staroptstar =>
      let cycles :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => nil
        end in
      fun op_staroptstar =>
        let delegates :=
          match op_staroptstar with
          | Some op_starsthstar => op_starsthstar
          | None => nil
          end in
        fun op_staroptstar =>
          let all :=
            match op_staroptstar with
            | Some op_starsthstar => op_starsthstar
            | None => false
            end in
          fun max_priority =>
            fun block =>
              RPC_context.make_call0 S.baking_rights ctxt block
                {| S.baking_rights_query.levels := levels;
                  S.baking_rights_query.cycles := cycles;
                  S.baking_rights_query.delegates := delegates;
                  S.baking_rights_query.max_priority := max_priority;
                  S.baking_rights_query.all := all |} tt.
End Baking_rights.

Module Endorsing_rights.
  Module t.
    Record record : Set := Build {
      level : Alpha_context.Raw_level.t;
      delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t);
      slots : list int;
      estimated_time : option Time.t }.
    Definition with_level level (r : record) :=
      Build level r.(delegate) r.(slots) r.(estimated_time).
    Definition with_delegate delegate (r : record) :=
      Build r.(level) delegate r.(slots) r.(estimated_time).
    Definition with_slots slots (r : record) :=
      Build r.(level) r.(delegate) slots r.(estimated_time).
    Definition with_estimated_time estimated_time (r : record) :=
      Build r.(level) r.(delegate) r.(slots) estimated_time.
  End t.
  Definition t := t.record.
  
  Definition encoding : Data_encoding.encoding t :=
    Data_encoding.conv
      (fun function_parameter =>
        let '{|
          t.level := level;
            t.delegate := delegate;
            t.slots := slots;
            t.estimated_time := estimated_time
            |} := function_parameter in
        (level, delegate, slots, estimated_time))
      (fun function_parameter =>
        let '(level, delegate, slots, estimated_time) := function_parameter in
        {| t.level := level; t.delegate := delegate; t.slots := slots;
          t.estimated_time := estimated_time |}) None
      (Data_encoding.obj4
        (Data_encoding.req None None "level" Alpha_context.Raw_level.encoding)
        (Data_encoding.req None None "delegate"
          (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding))
        (Data_encoding.req None None "slots"
          (Data_encoding.__list_value None Data_encoding.uint16))
        (Data_encoding.opt None None "estimated_time"
          Alpha_context.Timestamp.encoding)).
  
  Module S.
    Definition custom_root
      : RPC_path.path Updater.rpc_context Updater.rpc_context :=
      RPC_path.op_div (RPC_path.op_div RPC_path.open_root "helpers")
        "endorsing_rights".
    
    Module endorsing_rights_query.
      Record record : Set := Build {
        levels : list Alpha_context.Raw_level.t;
        cycles : list Alpha_context.Cycle.t;
        delegates : list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) }.
      Definition with_levels levels (r : record) :=
        Build levels r.(cycles) r.(delegates).
      Definition with_cycles cycles (r : record) :=
        Build r.(levels) cycles r.(delegates).
      Definition with_delegates delegates (r : record) :=
        Build r.(levels) r.(cycles) delegates.
    End endorsing_rights_query.
    Definition endorsing_rights_query := endorsing_rights_query.record.
    
    Definition __endorsing_rights_query_value
      : RPC_query.t endorsing_rights_query :=
      RPC_query.seal
        (RPC_query.op_pipeplus
          (RPC_query.op_pipeplus
            (RPC_query.op_pipeplus
              (RPC_query.__query_value
                (fun levels =>
                  fun cycles =>
                    fun delegates =>
                      {| endorsing_rights_query.levels := levels;
                        endorsing_rights_query.cycles := cycles;
                        endorsing_rights_query.delegates := delegates |}))
              (RPC_query.multi_field None "level"
                Alpha_context.Raw_level.rpc_arg
                (fun __t_value => __t_value.(endorsing_rights_query.levels))))
            (RPC_query.multi_field None "cycle" Alpha_context.Cycle.rpc_arg
              (fun __t_value => __t_value.(endorsing_rights_query.cycles))))
          (RPC_query.multi_field None "delegate"
            (|Signature.Public_key_hash|).(S.SPublic_key_hash.rpc_arg)
            (fun __t_value => __t_value.(endorsing_rights_query.delegates)))).
    
    Definition endorsing_rights
      : RPC_service.service Updater.rpc_context Updater.rpc_context
        endorsing_rights_query unit (list t) :=
      RPC_service.get_service
        (Some
          "Retrieves the delegates allowed to endorse a block.\nBy default, it gives the endorsement slots for delegates that have at least one in the next block.\nParameters `level` and `cycle` can be used to specify the (valid) level(s) in the past or future at which the endorsement rights have to be returned. Parameter `delegate` can be used to restrict the results to the given delegates.\nReturns the list of endorsement slots. Also returns the minimal timestamps that correspond to these slots. The timestamps are omitted for levels in the past, and are only estimates for levels later that the next block, based on the hypothesis that all predecessor blocks were baked at the first priority.")
        __endorsing_rights_query_value
        (Data_encoding.__list_value None encoding) custom_root.
  End S.
  
  Definition endorsement_slots
    (ctxt : Alpha_context.context)
    (function_parameter : Alpha_context.Level.t * option Time.t)
    : Lwt.t (Error_monad.tzresult (list t)) :=
    let '(level, estimated_time) := function_parameter in
    let=? rights := Baking.endorsement_rights ctxt level in
    Error_monad.__return
      ((|Signature.Public_key_hash|).(S.SPublic_key_hash.Map).(S.INDEXES_Map.fold)
        (fun delegate =>
          fun function_parameter =>
            let '(_, slots, _) := function_parameter in
            fun acc =>
              cons
                {| t.level := level.(Alpha_context.Level.t.level);
                  t.delegate := delegate; t.slots := slots;
                  t.estimated_time := estimated_time |} acc) rights nil).
  
  Definition register (function_parameter : unit) : unit :=
    let '_ := function_parameter in
    Services_registration.register0 S.endorsing_rights
      (fun ctxt =>
        fun q =>
          fun function_parameter =>
            let '_ := function_parameter in
            let=? levels :=
              requested_levels
                ((Alpha_context.Level.current ctxt),
                  (Some (Alpha_context.Timestamp.current ctxt))) ctxt
                q.(S.endorsing_rights_query.cycles)
                q.(S.endorsing_rights_query.levels) in
            let=? rights := Error_monad.map_s (endorsement_slots ctxt) levels in
            let rights := List.concat rights in
            match q.(S.endorsing_rights_query.delegates) with
            | [] => Error_monad.__return rights
            | (cons _ _) as delegates =>
              let is_requested (__p_value : t) : bool :=
                List.__exists
                  ((|Signature.Public_key_hash|).(S.SPublic_key_hash.equal)
                    __p_value.(t.delegate)) delegates in
              Error_monad.__return (List.filter is_requested rights)
            end).
  
  Definition get {A : Set}
    (ctxt : RPC_context.simple A)
    (op_staroptstar : option (list Alpha_context.Raw_level.t))
    : option (list Alpha_context.Cycle.t) ->
    option (list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t)) -> A ->
    Lwt.t (Error_monad.shell_tzresult (list t)) :=
    let levels :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => nil
      end in
    fun op_staroptstar =>
      let cycles :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => nil
        end in
      fun op_staroptstar =>
        let delegates :=
          match op_staroptstar with
          | Some op_starsthstar => op_starsthstar
          | None => nil
          end in
        fun block =>
          RPC_context.make_call0 S.endorsing_rights ctxt block
            {| S.endorsing_rights_query.levels := levels;
              S.endorsing_rights_query.cycles := cycles;
              S.endorsing_rights_query.delegates := delegates |} tt.
End Endorsing_rights.

Module Endorsing_power.
  Definition endorsing_power
    (ctxt : Alpha_context.context)
    (function_parameter :
      Alpha_context.packed_operation * (|Chain_id|).(S.HASH.t))
    : Lwt.t (Error_monad.tzresult int) :=
    let '(operation, chain_id) := function_parameter in
    let 'Alpha_context.Operation_data data :=
      operation.(Alpha_context.packed_operation.protocol_data) in
    match data.(Alpha_context.protocol_data.contents) with
    | Alpha_context.Single (Alpha_context.Endorsement _) =>
      let=? '(_, slots, _) :=
        Baking.check_endorsement_rights ctxt chain_id
          {|
            Alpha_context.operation.shell :=
              operation.(Alpha_context.packed_operation.shell);
            Alpha_context.operation.protocol_data := data |} in
      Error_monad.__return (List.length slots)
    | _ => Pervasives.failwith "Operation is not an endorsement"
    end.
  
  Module S.
    Definition endorsing_power
      : RPC_service.service Updater.rpc_context Updater.rpc_context unit
        (Alpha_context.Operation.packed * (|Chain_id|).(S.HASH.t)) int :=
      RPC_service.post_service
        (Some
          "Get the endorsing power of an endorsement, that is, the number of slots that the endorser has")
        RPC_query.empty
        (Data_encoding.obj2
          (Data_encoding.req None None "endorsement_operation"
            Alpha_context.Operation.encoding)
          (Data_encoding.req None None "chain_id" (|Chain_id|).(S.HASH.encoding)))
        Data_encoding.int31
        (RPC_path.op_div RPC_path.open_root "endorsing_power").
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let '_ := function_parameter in
    Services_registration.register0 S.endorsing_power
      (fun ctxt =>
        fun function_parameter =>
          let '_ := function_parameter in
          fun function_parameter =>
            let '(op, chain_id) := function_parameter in
            endorsing_power ctxt (op, chain_id)).
  
  Definition get {A : Set}
    (ctxt : RPC_context.simple A) (block : A)
    (op : Alpha_context.Operation.packed) (chain_id : (|Chain_id|).(S.HASH.t))
    : Lwt.t (Error_monad.shell_tzresult int) :=
    RPC_context.make_call0 S.endorsing_power ctxt block tt (op, chain_id).
End Endorsing_power.

Module Required_endorsements.
  Definition required_endorsements
    (ctxt : Alpha_context.context) (block_delay : Alpha_context.Period.t)
    : Lwt.t (Error_monad.tzresult int) :=
    Error_monad.__return (Baking.minimum_allowed_endorsements ctxt block_delay).
  
  Module S.
    Module t.
      Record record : Set := Build {
        block_delay : Alpha_context.Period.t }.
      Definition with_block_delay block_delay (r : record) :=
        Build block_delay.
    End t.
    Definition t := t.record.
    
    Definition required_endorsements_query : RPC_query.t t :=
      RPC_query.seal
        (RPC_query.op_pipeplus
          (RPC_query.__query_value
            (fun block_delay => {| t.block_delay := block_delay |}))
          (RPC_query.__field_value None "block_delay"
            Alpha_context.Period.rpc_arg Alpha_context.Period.zero
            (fun __t_value => __t_value.(t.block_delay)))).
    
    Definition required_endorsements
      : RPC_service.service Updater.rpc_context Updater.rpc_context t unit int :=
      RPC_service.get_service
        (Some
          "Minimum number of endorsements for a block to be valid, given a delay of the block's timestamp with respect to the minimum time to bake at the block's priority")
        required_endorsements_query Data_encoding.int31
        (RPC_path.op_div RPC_path.open_root "required_endorsements").
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let '_ := function_parameter in
    Services_registration.register0 S.required_endorsements
      (fun ctxt =>
        fun function_parameter =>
          let '{| S.t.block_delay := block_delay |} := function_parameter in
          fun function_parameter =>
            let '_ := function_parameter in
            required_endorsements ctxt block_delay).
  
  Definition get {A : Set}
    (ctxt : RPC_context.simple A) (block : A)
    (block_delay : Alpha_context.Period.t)
    : Lwt.t (Error_monad.shell_tzresult int) :=
    RPC_context.make_call0 S.required_endorsements ctxt block
      {| S.t.block_delay := block_delay |} tt.
End Required_endorsements.

Module Minimal_valid_time.
  Definition minimal_valid_time
    (ctxt : Alpha_context.context) (priority : int) (endorsing_power : int)
    : Lwt.t (Error_monad.tzresult Time.t) :=
    Baking.minimal_valid_time ctxt priority endorsing_power.
  
  Module S.
    Module t.
      Record record : Set := Build {
        priority : int;
        endorsing_power : int }.
      Definition with_priority priority (r : record) :=
        Build priority r.(endorsing_power).
      Definition with_endorsing_power endorsing_power (r : record) :=
        Build r.(priority) endorsing_power.
    End t.
    Definition t := t.record.
    
    Definition minimal_valid_time_query : RPC_query.t t :=
      RPC_query.seal
        (RPC_query.op_pipeplus
          (RPC_query.op_pipeplus
            (RPC_query.__query_value
              (fun priority =>
                fun endorsing_power =>
                  {| t.priority := priority;
                    t.endorsing_power := endorsing_power |}))
            (RPC_query.__field_value None "priority" RPC_arg.__int_value 0
              (fun __t_value => __t_value.(t.priority))))
          (RPC_query.__field_value None "endorsing_power" RPC_arg.__int_value 0
            (fun __t_value => __t_value.(t.endorsing_power)))).
    
    Definition minimal_valid_time
      : RPC_service.service Updater.rpc_context Updater.rpc_context t unit
        Time.t :=
      RPC_service.get_service
        (Some
          "Minimal valid time for a block given a priority and an endorsing power.")
        minimal_valid_time_query Time.encoding
        (RPC_path.op_div RPC_path.open_root "minimal_valid_time").
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let '_ := function_parameter in
    Services_registration.register0 S.minimal_valid_time
      (fun ctxt =>
        fun function_parameter =>
          let '{|
            S.t.priority := priority;
              S.t.endorsing_power := endorsing_power
              |} := function_parameter in
          fun function_parameter =>
            let '_ := function_parameter in
            minimal_valid_time ctxt priority endorsing_power).
  
  Definition get {A : Set}
    (ctxt : RPC_context.simple A) (block : A) (priority : int)
    (endorsing_power : int) : Lwt.t (Error_monad.shell_tzresult Time.t) :=
    RPC_context.make_call0 S.minimal_valid_time ctxt block
      {| S.t.priority := priority; S.t.endorsing_power := endorsing_power |} tt.
End Minimal_valid_time.

Definition register (function_parameter : unit) : unit :=
  let '_ := function_parameter in
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  (* ❌ Sequences of instructions are ignored (operator ";") *)
  (* ❌ instruction_sequence ";" *)
  Minimal_valid_time.register tt.

Definition endorsement_rights
  (ctxt : Alpha_context.context) (level : Alpha_context.Level.t)
  : Lwt.t
    (Error_monad.tzresult
      (list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))) :=
  let=? l := Endorsing_rights.endorsement_slots ctxt (level, None) in
  Error_monad.__return
    (List.map
      (fun function_parameter =>
        let '{| Endorsing_rights.t.delegate := delegate |} := function_parameter
          in
        delegate) l).

Definition baking_rights
  (ctxt : Alpha_context.context)
  (max_priority : option (|Compare.Int|).(Compare.S.t))
  : Lwt.t
    (Error_monad.tzresult
      (Alpha_context.Raw_level.t *
        list
          ((|Signature.Public_key_hash|).(S.SPublic_key_hash.t) *
            option Alpha_context.Timestamp.t))) :=
  let max :=
    match max_priority with
    | None => 64
    | Some m => m
    end in
  let level := Alpha_context.Level.current ctxt in
  let=? l := Baking_rights.baking_priorities ctxt max (level, None) in
  Error_monad.__return
    (level.(Alpha_context.Level.t.level),
      (List.map
        (fun function_parameter =>
          let '{|
            Baking_rights.t.delegate := delegate;
              Baking_rights.t.timestamp := timestamp
              |} := function_parameter in
          (delegate, timestamp)) l)).

Definition endorsing_power
  (ctxt : Alpha_context.context)
  (operation : Alpha_context.packed_operation * (|Chain_id|).(S.HASH.t))
  : Lwt.t (Error_monad.tzresult int) :=
  Endorsing_power.endorsing_power ctxt operation.

Definition required_endorsements
  (ctxt : Alpha_context.context) (delay : Alpha_context.Period.t)
  : Lwt.t (Error_monad.tzresult int) :=
  Required_endorsements.required_endorsements ctxt delay.

Definition minimal_valid_time
  (ctxt : Alpha_context.context) (priority : int) (endorsing_power : int)
  : Lwt.t (Error_monad.tzresult Time.t) :=
  Minimal_valid_time.minimal_valid_time ctxt priority endorsing_power.

Delegate_services_mli

  • OCaml size: 211 lines
  • Coq size: 210 lines (-1% compared to OCaml)
delegate_services.mli success
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val list :
  'a #RPC_context.simple ->
  'a ->
  ?active:bool ->
  ?inactive:bool ->
  unit ->
  Signature.Public_key_hash.t list shell_tzresult Lwt.t

type info = {
  balance : Tez.t;
  frozen_balance : Tez.t;
  frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t;
  staking_balance : Tez.t;
  delegated_contracts : Contract_repr.t list;
  delegated_balance : Tez.t;
  deactivated : bool;
  grace_period : Cycle.t;
}

val info_encoding : info Data_encoding.t

val info :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  info shell_tzresult Lwt.t

val balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val frozen_balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val frozen_balance_by_cycle :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Delegate.frozen_balance Cycle.Map.t shell_tzresult Lwt.t

val staking_balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val delegated_contracts :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Contract_repr.t list shell_tzresult Lwt.t

val delegated_balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val deactivated :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  bool shell_tzresult Lwt.t

val grace_period :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Cycle.t shell_tzresult Lwt.t

module Baking_rights : sig
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    priority : int;
    timestamp : Timestamp.t option;
  }

  (** Retrieves the list of delegates allowed to bake a block.

      By default, it gives the best baking priorities for bakers
      that have at least one opportunity below the 64th priority for
      the next block.

      Parameters [levels] and [cycles] can be used to specify the
      (valid) level(s) in the past or future at which the baking rights
      have to be returned. Parameter [delegates] can be used to
      restrict the results to the given delegates. If parameter [all]
      is [true], all the baking opportunities for each baker at each level
      are returned, instead of just the first one.

      Returns the list of baking slots. Also returns the minimal
      timestamps that correspond to these slots. The timestamps are
      omitted for levels in the past, and are only estimates for levels
      later that the next block, based on the hypothesis that all
      predecessor blocks were baked at the first priority. *)
  val get :
    'a #RPC_context.simple ->
    ?levels:Raw_level.t list ->
    ?cycles:Cycle.t list ->
    ?delegates:Signature.public_key_hash list ->
    ?all:bool ->
    ?max_priority:int ->
    'a ->
    t list shell_tzresult Lwt.t
end

module Endorsing_rights : sig
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    slots : int list;
    estimated_time : Timestamp.t option;
  }

  (** Retrieves the delegates allowed to endorse a block.

      By default, it gives the endorsement slots for bakers that have
      at least one in the next block.

      Parameters [levels] and [cycles] can be used to specify the
      (valid) level(s) in the past or future at which the endorsement
      rights have to be returned. Parameter [delegates] can be used to
      restrict the results to the given delegates.  Returns the list of
      endorsement slots. Also returns the minimal timestamps that
      correspond to these slots.

      Timestamps are omitted for levels in the past, and are only
      estimates for levels later that the next block, based on the
      hypothesis that all predecessor blocks were baked at the first
      priority. *)
  val get :
    'a #RPC_context.simple ->
    ?levels:Raw_level.t list ->
    ?cycles:Cycle.t list ->
    ?delegates:Signature.public_key_hash list ->
    'a ->
    t list shell_tzresult Lwt.t
end

module Endorsing_power : sig
  val get :
    'a #RPC_context.simple ->
    'a ->
    Alpha_context.packed_operation ->
    Chain_id.t ->
    int shell_tzresult Lwt.t
end

module Required_endorsements : sig
  val get :
    'a #RPC_context.simple -> 'a -> Period.t -> int shell_tzresult Lwt.t
end

module Minimal_valid_time : sig
  val get :
    'a #RPC_context.simple -> 'a -> int -> int -> Time.t shell_tzresult Lwt.t
end

(* temporary export for deprecated unit test *)
val endorsement_rights :
  Alpha_context.t -> Level.t -> public_key_hash list tzresult Lwt.t

val baking_rights :
  Alpha_context.t ->
  int option ->
  (Raw_level.t * (public_key_hash * Time.t option) list) tzresult Lwt.t

val endorsing_power :
  Alpha_context.t ->
  Alpha_context.packed_operation * Chain_id.t ->
  int tzresult Lwt.t

val required_endorsements :
  Alpha_context.t -> Alpha_context.Period.t -> int tzresult Lwt.t

val minimal_valid_time : Alpha_context.t -> int -> int -> Time.t tzresult Lwt.t

val register : unit -> unit
Delegate_services_mli.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Alpha_context.
Require Tezos.Contract_repr.

Import Alpha_context.

Parameter __list_value : forall {a : Set},
  RPC_context.simple a -> a -> option bool -> option bool -> unit ->
  Lwt.t
    (Error_monad.shell_tzresult
      (list (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))).

Module info.
  Record record : Set := Build {
    balance : Alpha_context.Tez.t;
    frozen_balance : Alpha_context.Tez.t;
    frozen_balance_by_cycle :
      (|Alpha_context.Cycle.Map|).(S.MAP.t)
        Alpha_context.Delegate.frozen_balance;
    staking_balance : Alpha_context.Tez.t;
    delegated_contracts : list Contract_repr.t;
    delegated_balance : Alpha_context.Tez.t;
    deactivated : bool;
    grace_period : Alpha_context.Cycle.t }.
  Definition with_balance balance (r : record) :=
    Build balance r.(frozen_balance) r.(frozen_balance_by_cycle)
      r.(staking_balance) r.(delegated_contracts) r.(delegated_balance)
      r.(deactivated) r.(grace_period).
  Definition with_frozen_balance frozen_balance (r : record) :=
    Build r.(balance) frozen_balance r.(frozen_balance_by_cycle)
      r.(staking_balance) r.(delegated_contracts) r.(delegated_balance)
      r.(deactivated) r.(grace_period).
  Definition with_frozen_balance_by_cycle frozen_balance_by_cycle
    (r : record) :=
    Build r.(balance) r.(frozen_balance) frozen_balance_by_cycle
      r.(staking_balance) r.(delegated_contracts) r.(delegated_balance)
      r.(deactivated) r.(grace_period).
  Definition with_staking_balance staking_balance (r : record) :=
    Build r.(balance) r.(frozen_balance) r.(frozen_balance_by_cycle)
      staking_balance r.(delegated_contracts) r.(delegated_balance)
      r.(deactivated) r.(grace_period).
  Definition with_delegated_contracts delegated_contracts (r : record) :=
    Build r.(balance) r.(frozen_balance) r.(frozen_balance_by_cycle)
      r.(staking_balance) delegated_contracts r.(delegated_balance)
      r.(deactivated) r.(grace_period).
  Definition with_delegated_balance delegated_balance (r : record) :=
    Build r.(balance) r.(frozen_balance) r.(frozen_balance_by_cycle)
      r.(staking_balance) r.(delegated_contracts) delegated_balance
      r.(deactivated) r.(grace_period).
  Definition with_deactivated deactivated (r : record) :=
    Build r.(balance) r.(frozen_balance) r.(frozen_balance_by_cycle)
      r.(staking_balance) r.(delegated_contracts) r.(delegated_balance)
      deactivated r.(grace_period).
  Definition with_grace_period grace_period (r : record) :=
    Build r.(balance) r.(frozen_balance) r.(frozen_balance_by_cycle)
      r.(staking_balance) r.(delegated_contracts) r.(delegated_balance)
      r.(deactivated) grace_period.
End info.
Definition info := info.record.

Parameter info_encoding : Data_encoding.t info.

Parameter __info_value : forall {a : Set},
  RPC_context.simple a -> a ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.shell_tzresult info).

Parameter balance : forall {a : Set},
  RPC_context.simple a -> a ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Tez.t).

Parameter __frozen_balance_value : forall {a : Set},
  RPC_context.simple a -> a ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Tez.t).

Parameter frozen_balance_by_cycle : forall {a : Set},
  RPC_context.simple a -> a ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t
    (Error_monad.shell_tzresult
      ((|Alpha_context.Cycle.Map|).(S.MAP.t)
        Alpha_context.Delegate.frozen_balance)).

Parameter staking_balance : forall {a : Set},
  RPC_context.simple a -> a ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Tez.t).

Parameter delegated_contracts : forall {a : Set},
  RPC_context.simple a -> a ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.shell_tzresult (list Contract_repr.t)).

Parameter delegated_balance : forall {a : Set},
  RPC_context.simple a -> a ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Tez.t).

Parameter deactivated : forall {a : Set},
  RPC_context.simple a -> a ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.shell_tzresult bool).

Parameter grace_period : forall {a : Set},
  RPC_context.simple a -> a ->
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.shell_tzresult Alpha_context.Cycle.t).

Module Baking_rights.
  Module t.
    Record record : Set := Build {
      level : Alpha_context.Raw_level.t;
      delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t);
      priority : int;
      timestamp : option Alpha_context.Timestamp.t }.
    Definition with_level level (r : record) :=
      Build level r.(delegate) r.(priority) r.(timestamp).
    Definition with_delegate delegate (r : record) :=
      Build r.(level) delegate r.(priority) r.(timestamp).
    Definition with_priority priority (r : record) :=
      Build r.(level) r.(delegate) priority r.(timestamp).
    Definition with_timestamp timestamp (r : record) :=
      Build r.(level) r.(delegate) r.(priority) timestamp.
  End t.
  Definition t := t.record.
  
  Parameter get : forall {a : Set},
    RPC_context.simple a -> option (list Alpha_context.Raw_level.t) ->
    option (list Alpha_context.Cycle.t) ->
    option (list Signature.public_key_hash) -> option bool -> option int -> a ->
    Lwt.t (Error_monad.shell_tzresult (list t)).
End Baking_rights.

Module Endorsing_rights.
  Module t.
    Record record : Set := Build {
      level : Alpha_context.Raw_level.t;
      delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t);
      slots : list int;
      estimated_time : option Alpha_context.Timestamp.t }.
    Definition with_level level (r : record) :=
      Build level r.(delegate) r.(slots) r.(estimated_time).
    Definition with_delegate delegate (r : record) :=
      Build r.(level) delegate r.(slots) r.(estimated_time).
    Definition with_slots slots (r : record) :=
      Build r.(level) r.(delegate) slots r.(estimated_time).
    Definition with_estimated_time estimated_time (r : record) :=
      Build r.(level) r.(delegate) r.(slots) estimated_time.
  End t.
  Definition t := t.record.
  
  Parameter get : forall {a : Set},
    RPC_context.simple a -> option (list Alpha_context.Raw_level.t) ->
    option (list Alpha_context.Cycle.t) ->
    option (list Signature.public_key_hash) -> a ->
    Lwt.t (Error_monad.shell_tzresult (list t)).
End Endorsing_rights.

Module Endorsing_power.
  Parameter get : forall {a : Set},
    RPC_context.simple a -> a -> Alpha_context.packed_operation ->
    (|Chain_id|).(S.HASH.t) -> Lwt.t (Error_monad.shell_tzresult int).
End Endorsing_power.

Module Required_endorsements.
  Parameter get : forall {a : Set},
    RPC_context.simple a -> a -> Alpha_context.Period.t ->
    Lwt.t (Error_monad.shell_tzresult int).
End Required_endorsements.

Module Minimal_valid_time.
  Parameter get : forall {a : Set},
    RPC_context.simple a -> a -> int -> int ->
    Lwt.t (Error_monad.shell_tzresult Time.t).
End Minimal_valid_time.

Parameter endorsement_rights :
  Alpha_context.t -> Alpha_context.Level.t ->
  Lwt.t (Error_monad.tzresult (list Alpha_context.public_key_hash)).

Parameter baking_rights :
  Alpha_context.t -> option int ->
  Lwt.t
    (Error_monad.tzresult
      (Alpha_context.Raw_level.t *
        list (Alpha_context.public_key_hash * option Time.t))).

Parameter endorsing_power :
  Alpha_context.t -> Alpha_context.packed_operation * (|Chain_id|).(S.HASH.t) ->
  Lwt.t (Error_monad.tzresult int).

Parameter required_endorsements :
  Alpha_context.t -> Alpha_context.Period.t -> Lwt.t (Error_monad.tzresult int).

Parameter minimal_valid_time :
  Alpha_context.t -> int -> int -> Lwt.t (Error_monad.tzresult Time.t).

Parameter register : unit -> unit.

Delegate_storage

  • OCaml size: 713 lines
  • Coq size: 897 lines (+25% compared to OCaml)
delegate_storage.ml 11 warnings
(*****************************************************************************)
(*                                                                           *)
(* 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 balance =
  | Contract of Contract_repr.t
  | Rewards of Signature.Public_key_hash.t * Cycle_repr.t
  | Fees of Signature.Public_key_hash.t * Cycle_repr.t
  | Deposits of Signature.Public_key_hash.t * Cycle_repr.t

let balance_encoding =
  let open Data_encoding in
  def "operation_metadata.alpha.balance"
  @@ union
       [ case
           (Tag 0)
           ~title:"Contract"
           (obj2
              (req "kind" (constant "contract"))
              (req "contract" Contract_repr.encoding))
           (function Contract c -> Some ((), c) | _ -> None)
           (fun ((), c) -> Contract c);
         case
           (Tag 1)
           ~title:"Rewards"
           (obj4
              (req "kind" (constant "freezer"))
              (req "category" (constant "rewards"))
              (req "delegate" Signature.Public_key_hash.encoding)
              (req "cycle" Cycle_repr.encoding))
           (function Rewards (d, l) -> Some ((), (), d, l) | _ -> None)
           (fun ((), (), d, l) -> Rewards (d, l));
         case
           (Tag 2)
           ~title:"Fees"
           (obj4
              (req "kind" (constant "freezer"))
              (req "category" (constant "fees"))
              (req "delegate" Signature.Public_key_hash.encoding)
              (req "cycle" Cycle_repr.encoding))
           (function Fees (d, l) -> Some ((), (), d, l) | _ -> None)
           (fun ((), (), d, l) -> Fees (d, l));
         case
           (Tag 3)
           ~title:"Deposits"
           (obj4
              (req "kind" (constant "freezer"))
              (req "category" (constant "deposits"))
              (req "delegate" Signature.Public_key_hash.encoding)
              (req "cycle" Cycle_repr.encoding))
           (function Deposits (d, l) -> Some ((), (), d, l) | _ -> None)
           (fun ((), (), d, l) -> Deposits (d, l)) ]

type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t

let balance_update_encoding =
  let open Data_encoding in
  def "operation_metadata.alpha.balance_update"
  @@ obj1
       (req
          "change"
          (conv
             (function
               | Credited v ->
                   Tez_repr.to_mutez v
               | Debited v ->
                   Int64.neg (Tez_repr.to_mutez v))
             ( Json.wrap_error
             @@ fun v ->
             if Compare.Int64.(v < 0L) then
               match Tez_repr.of_mutez (Int64.neg v) with
               | Some v ->
                   Debited v
               | None ->
                   failwith "Qty.of_mutez"
             else
               match Tez_repr.of_mutez v with
               | Some v ->
                   Credited v
               | None ->
                   failwith "Qty.of_mutez" )
             int64))

type balance_updates = (balance * balance_update) list

let balance_updates_encoding =
  let open Data_encoding in
  def "operation_metadata.alpha.balance_updates"
  @@ list (merge_objs balance_encoding balance_update_encoding)

let cleanup_balance_updates balance_updates =
  List.filter
    (fun (_, (Credited update | Debited update)) ->
      not (Tez_repr.equal update Tez_repr.zero))
    balance_updates

type frozen_balance = {
  deposit : Tez_repr.t;
  fees : Tez_repr.t;
  rewards : Tez_repr.t;
}

let frozen_balance_encoding =
  let open Data_encoding in
  conv
    (fun {deposit; fees; rewards} -> (deposit, fees, rewards))
    (fun (deposit, fees, rewards) -> {deposit; fees; rewards})
    (obj3
       (req "deposit" Tez_repr.encoding)
       (req "fees" Tez_repr.encoding)
       (req "rewards" Tez_repr.encoding))

type error +=
  | No_deletion of Signature.Public_key_hash.t (* `Permanent *)
  | Active_delegate (* `Temporary *)
  | Current_delegate (* `Temporary *)
  | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)
  | Balance_too_low_for_deposit of {
      delegate : Signature.Public_key_hash.t;
      deposit : Tez_repr.t;
      balance : Tez_repr.t;
    }

(* `Temporary *)

let () =
  register_error_kind
    `Permanent
    ~id:"delegate.no_deletion"
    ~title:"Forbidden delegate deletion"
    ~description:"Tried to unregister a delegate"
    ~pp:(fun ppf delegate ->
      Format.fprintf
        ppf
        "Delegate deletion is forbidden (%a)"
        Signature.Public_key_hash.pp
        delegate)
    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
    (function No_deletion c -> Some c | _ -> None)
    (fun c -> No_deletion c) ;
  register_error_kind
    `Temporary
    ~id:"delegate.already_active"
    ~title:"Delegate already active"
    ~description:"Useless delegate reactivation"
    ~pp:(fun ppf () ->
      Format.fprintf ppf "The delegate is still active, no need to refresh it")
    Data_encoding.empty
    (function Active_delegate -> Some () | _ -> None)
    (fun () -> Active_delegate) ;
  register_error_kind
    `Temporary
    ~id:"delegate.unchanged"
    ~title:"Unchanged delegated"
    ~description:"Contract already delegated to the given delegate"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "The contract is already delegated to the same delegate")
    Data_encoding.empty
    (function Current_delegate -> Some () | _ -> None)
    (fun () -> Current_delegate) ;
  register_error_kind
    `Permanent
    ~id:"delegate.empty_delegate_account"
    ~title:"Empty delegate account"
    ~description:
      "Cannot register a delegate when its implicit account is empty"
    ~pp:(fun ppf delegate ->
      Format.fprintf
        ppf
        "Delegate registration is forbidden when the delegate\n\
        \           implicit account is empty (%a)"
        Signature.Public_key_hash.pp
        delegate)
    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
    (function Empty_delegate_account c -> Some c | _ -> None)
    (fun c -> Empty_delegate_account c) ;
  register_error_kind
    `Temporary
    ~id:"delegate.balance_too_low_for_deposit"
    ~title:"Balance too low for deposit"
    ~description:"Cannot freeze deposit when the balance is too low"
    ~pp:(fun ppf (delegate, balance, deposit) ->
      Format.fprintf
        ppf
        "Delegate %a has a too low balance (%a) to deposit %a"
        Signature.Public_key_hash.pp
        delegate
        Tez_repr.pp
        balance
        Tez_repr.pp
        deposit)
    Data_encoding.(
      obj3
        (req "delegate" Signature.Public_key_hash.encoding)
        (req "balance" Tez_repr.encoding)
        (req "deposit" Tez_repr.encoding))
    (function
      | Balance_too_low_for_deposit {delegate; balance; deposit} ->
          Some (delegate, balance, deposit)
      | _ ->
          None)
    (fun (delegate, balance, deposit) ->
      Balance_too_low_for_deposit {delegate; balance; deposit})

let link c contract delegate =
  Storage.Contract.Balance.get c contract
  >>=? fun balance ->
  Roll_storage.Delegate.add_amount c delegate balance
  >>=? fun c ->
  Storage.Contract.Delegated.add
    (c, Contract_repr.implicit_contract delegate)
    contract
  >>= fun c -> return c

let unlink c contract =
  Storage.Contract.Balance.get c contract
  >>=? fun balance ->
  Storage.Contract.Delegate.get_option c contract
  >>=? function
  | None ->
      return c
  | Some delegate ->
      (* Removes the balance of the contract from the delegate *)
      Roll_storage.Delegate.remove_amount c delegate balance
      >>=? fun c ->
      Storage.Contract.Delegated.del
        (c, Contract_repr.implicit_contract delegate)
        contract
      >>= fun c -> return c

let known c delegate =
  Storage.Contract.Manager.get_option
    c
    (Contract_repr.implicit_contract delegate)
  >>=? function
  | None | Some (Manager_repr.Hash _) ->
      return_false
  | Some (Manager_repr.Public_key _) ->
      return_true

(* A delegate is registered if its "implicit account" delegates to itself. *)
let registered c delegate =
  Storage.Contract.Delegate.get_option
    c
    (Contract_repr.implicit_contract delegate)
  >>=? function
  | Some current_delegate ->
      return @@ Signature.Public_key_hash.equal delegate current_delegate
  | None ->
      return_false

let init ctxt contract delegate =
  known ctxt delegate
  >>=? fun known_delegate ->
  fail_unless known_delegate (Roll_storage.Unregistered_delegate delegate)
  >>=? fun () ->
  registered ctxt delegate
  >>=? fun is_registered ->
  fail_unless is_registered (Roll_storage.Unregistered_delegate delegate)
  >>=? fun () ->
  Storage.Contract.Delegate.init ctxt contract delegate
  >>=? fun ctxt -> link ctxt contract delegate

let get = Roll_storage.get_contract_delegate

let set c contract delegate =
  match delegate with
  | None -> (
      let delete () =
        unlink c contract
        >>=? fun c ->
        Storage.Contract.Delegate.remove c contract >>= fun c -> return c
      in
      match Contract_repr.is_implicit contract with
      | Some pkh ->
          (* check if contract is a registered delegate *)
          registered c pkh
          >>=? fun is_registered ->
          if is_registered then fail (No_deletion pkh) else delete ()
      | None ->
          delete () )
  | Some delegate ->
      known c delegate
      >>=? fun known_delegate ->
      registered c delegate
      >>=? fun registered_delegate ->
      let self_delegation =
        match Contract_repr.is_implicit contract with
        | Some pkh ->
            Signature.Public_key_hash.equal pkh delegate
        | None ->
            false
      in
      if (not known_delegate) || not (registered_delegate || self_delegation)
      then fail (Roll_storage.Unregistered_delegate delegate)
      else
        Storage.Contract.Delegate.get_option c contract
        >>=? (function
               | Some current_delegate
                 when Signature.Public_key_hash.equal delegate current_delegate
                 ->
                   if self_delegation then
                     Roll_storage.Delegate.is_inactive c delegate
                     >>=? function
                     | true -> return_unit | false -> fail Active_delegate
                   else fail Current_delegate
               | None | Some _ ->
                   return_unit)
        >>=? fun () ->
        (* check if contract is a registered delegate *)
        ( match Contract_repr.is_implicit contract with
        | Some pkh ->
            registered c pkh
            >>=? fun is_registered ->
            (* allow self-delegation to re-activate *)
            if (not self_delegation) && is_registered then
              fail (No_deletion pkh)
            else return_unit
        | None ->
            return_unit )
        >>=? fun () ->
        Storage.Contract.Balance.mem c contract
        >>= fun exists ->
        fail_when
          (self_delegation && not exists)
          (Empty_delegate_account delegate)
        >>=? fun () ->
        unlink c contract
        >>=? fun c ->
        Storage.Contract.Delegate.init_set c contract delegate
        >>= fun c ->
        link c contract delegate
        >>=? fun c ->
        ( if self_delegation then
          Storage.Delegates.add c delegate
          >>= fun c ->
          Roll_storage.Delegate.set_active c delegate >>=? fun c -> return c
        else return c )
        >>=? fun c -> return c

let remove ctxt contract = unlink ctxt contract

let delegated_contracts ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  Storage.Contract.Delegated.elements (ctxt, contract)

let get_frozen_deposit ctxt contract cycle =
  Storage.Contract.Frozen_deposits.get_option (ctxt, contract) cycle
  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen

let credit_frozen_deposit ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun old_amount ->
  Lwt.return Tez_repr.(old_amount +? amount)
  >>=? fun new_amount ->
  Storage.Contract.Frozen_deposits.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt ->
  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
  >>= fun ctxt -> return ctxt

let freeze_deposit ctxt delegate amount =
  let {Level_repr.cycle; _} = Level_storage.current ctxt in
  Roll_storage.Delegate.set_active ctxt delegate
  >>=? fun ctxt ->
  let contract = Contract_repr.implicit_contract delegate in
  Storage.Contract.Balance.get ctxt contract
  >>=? fun balance ->
  Lwt.return
    (record_trace
       (Balance_too_low_for_deposit {delegate; deposit = amount; balance})
       Tez_repr.(balance -? amount))
  >>=? fun new_balance ->
  Storage.Contract.Balance.set ctxt contract new_balance
  >>=? fun ctxt -> credit_frozen_deposit ctxt delegate cycle amount

let get_frozen_fees ctxt contract cycle =
  Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle
  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen

let credit_frozen_fees ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_fees ctxt contract cycle
  >>=? fun old_amount ->
  Lwt.return Tez_repr.(old_amount +? amount)
  >>=? fun new_amount ->
  Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt ->
  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
  >>= fun ctxt -> return ctxt

let freeze_fees ctxt delegate amount =
  let {Level_repr.cycle; _} = Level_storage.current ctxt in
  Roll_storage.Delegate.add_amount ctxt delegate amount
  >>=? fun ctxt -> credit_frozen_fees ctxt delegate cycle amount

let burn_fees ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_fees ctxt contract cycle
  >>=? fun old_amount ->
  ( match Tez_repr.(old_amount -? amount) with
  | Ok new_amount ->
      Roll_storage.Delegate.remove_amount ctxt delegate amount
      >>=? fun ctxt -> return (new_amount, ctxt)
  | Error _ ->
      Roll_storage.Delegate.remove_amount ctxt delegate old_amount
      >>=? fun ctxt -> return (Tez_repr.zero, ctxt) )
  >>=? fun (new_amount, ctxt) ->
  Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt -> return ctxt

let get_frozen_rewards ctxt contract cycle =
  Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle
  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen

let credit_frozen_rewards ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_rewards ctxt contract cycle
  >>=? fun old_amount ->
  Lwt.return Tez_repr.(old_amount +? amount)
  >>=? fun new_amount ->
  Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt ->
  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
  >>= fun ctxt -> return ctxt

let freeze_rewards ctxt delegate amount =
  let {Level_repr.cycle; _} = Level_storage.current ctxt in
  credit_frozen_rewards ctxt delegate cycle amount

let burn_rewards ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_rewards ctxt contract cycle
  >>=? fun old_amount ->
  let new_amount =
    match Tez_repr.(old_amount -? amount) with
    | Error _ ->
        Tez_repr.zero
    | Ok new_amount ->
        new_amount
  in
  Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt -> return ctxt

let unfreeze ctxt delegate cycle =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun deposit ->
  get_frozen_fees ctxt contract cycle
  >>=? fun fees ->
  get_frozen_rewards ctxt contract cycle
  >>=? fun rewards ->
  Storage.Contract.Balance.get ctxt contract
  >>=? fun balance ->
  Lwt.return Tez_repr.(deposit +? fees)
  >>=? fun unfrozen_amount ->
  Lwt.return Tez_repr.(unfrozen_amount +? rewards)
  >>=? fun unfrozen_amount ->
  Lwt.return Tez_repr.(balance +? unfrozen_amount)
  >>=? fun balance ->
  Storage.Contract.Balance.set ctxt contract balance
  >>=? fun ctxt ->
  Roll_storage.Delegate.add_amount ctxt delegate rewards
  >>=? fun ctxt ->
  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  return
    ( ctxt,
      cleanup_balance_updates
        [ (Deposits (delegate, cycle), Debited deposit);
          (Fees (delegate, cycle), Debited fees);
          (Rewards (delegate, cycle), Debited rewards);
          ( Contract (Contract_repr.implicit_contract delegate),
            Credited unfrozen_amount ) ] )

let cycle_end ctxt last_cycle unrevealed =
  let preserved = Constants_storage.preserved_cycles ctxt in
  ( match Cycle_repr.pred last_cycle with
  | None ->
      return (ctxt, [])
  | Some revealed_cycle ->
      List.fold_left
        (fun acc (u : Nonce_storage.unrevealed) ->
          acc
          >>=? fun (ctxt, balance_updates) ->
          burn_fees ctxt u.delegate revealed_cycle u.fees
          >>=? fun ctxt ->
          burn_rewards ctxt u.delegate revealed_cycle u.rewards
          >>=? fun ctxt ->
          let bus =
            [ (Fees (u.delegate, revealed_cycle), Debited u.fees);
              (Rewards (u.delegate, revealed_cycle), Debited u.rewards) ]
          in
          return (ctxt, bus @ balance_updates))
        (return (ctxt, []))
        unrevealed )
  >>=? fun (ctxt, balance_updates) ->
  match Cycle_repr.sub last_cycle preserved with
  | None ->
      return (ctxt, balance_updates, [])
  | Some unfrozen_cycle ->
      Storage.Delegates_with_frozen_balance.fold
        (ctxt, unfrozen_cycle)
        ~init:(Ok (ctxt, balance_updates))
        ~f:(fun delegate acc ->
          Lwt.return acc
          >>=? fun (ctxt, bus) ->
          unfreeze ctxt delegate unfrozen_cycle
          >>=? fun (ctxt, balance_updates) ->
          return (ctxt, balance_updates @ bus))
      >>=? fun (ctxt, balance_updates) ->
      Storage.Delegates_with_frozen_balance.clear (ctxt, unfrozen_cycle)
      >>= fun ctxt ->
      Storage.Active_delegates_with_rolls.fold
        ctxt
        ~init:(Ok (ctxt, []))
        ~f:(fun delegate acc ->
          Lwt.return acc
          >>=? fun (ctxt, deactivated) ->
          Storage.Contract.Delegate_desactivation.get
            ctxt
            (Contract_repr.implicit_contract delegate)
          >>=? fun cycle ->
          if Cycle_repr.(cycle <= last_cycle) then
            Roll_storage.Delegate.set_inactive ctxt delegate
            >>=? fun ctxt -> return (ctxt, delegate :: deactivated)
          else return (ctxt, deactivated))
      >>=? fun (ctxt, deactivated) ->
      return (ctxt, balance_updates, deactivated)

let punish ctxt delegate cycle =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun deposit ->
  get_frozen_fees ctxt contract cycle
  >>=? fun fees ->
  get_frozen_rewards ctxt contract cycle
  >>=? fun rewards ->
  Roll_storage.Delegate.remove_amount ctxt delegate deposit
  >>=? fun ctxt ->
  Roll_storage.Delegate.remove_amount ctxt delegate fees
  >>=? fun ctxt ->
  (* Rewards are not accounted in the delegate's rolls yet... *)
  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle
  >>= fun ctxt -> return (ctxt, {deposit; fees; rewards})

let has_frozen_balance ctxt delegate cycle =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun deposit ->
  if Tez_repr.(deposit <> zero) then return_true
  else
    get_frozen_fees ctxt contract cycle
    >>=? fun fees ->
    if Tez_repr.(fees <> zero) then return_true
    else
      get_frozen_rewards ctxt contract cycle
      >>=? fun rewards -> return Tez_repr.(rewards <> zero)

let frozen_balance_by_cycle_encoding =
  let open Data_encoding in
  conv
    Cycle_repr.Map.bindings
    (List.fold_left
       (fun m (c, b) -> Cycle_repr.Map.add c b m)
       Cycle_repr.Map.empty)
    (list
       (merge_objs
          (obj1 (req "cycle" Cycle_repr.encoding))
          frozen_balance_encoding))

let empty_frozen_balance =
  {deposit = Tez_repr.zero; fees = Tez_repr.zero; rewards = Tez_repr.zero}

let frozen_balance_by_cycle ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  let map = Cycle_repr.Map.empty in
  Storage.Contract.Frozen_deposits.fold
    (ctxt, contract)
    ~init:map
    ~f:(fun cycle amount map ->
      Lwt.return
        (Cycle_repr.Map.add
           cycle
           {empty_frozen_balance with deposit = amount}
           map))
  >>= fun map ->
  Storage.Contract.Frozen_fees.fold
    (ctxt, contract)
    ~init:map
    ~f:(fun cycle amount map ->
      let balance =
        match Cycle_repr.Map.find_opt cycle map with
        | None ->
            empty_frozen_balance
        | Some balance ->
            balance
      in
      Lwt.return (Cycle_repr.Map.add cycle {balance with fees = amount} map))
  >>= fun map ->
  Storage.Contract.Frozen_rewards.fold
    (ctxt, contract)
    ~init:map
    ~f:(fun cycle amount map ->
      let balance =
        match Cycle_repr.Map.find_opt cycle map with
        | None ->
            empty_frozen_balance
        | Some balance ->
            balance
      in
      Lwt.return (Cycle_repr.Map.add cycle {balance with rewards = amount} map))
  >>= fun map -> Lwt.return map

let frozen_balance ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  let balance = Ok Tez_repr.zero in
  Storage.Contract.Frozen_deposits.fold
    (ctxt, contract)
    ~init:balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun balance ->
  Storage.Contract.Frozen_fees.fold
    (ctxt, contract)
    ~init:balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun balance ->
  Storage.Contract.Frozen_rewards.fold
    (ctxt, contract)
    ~init:balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun balance -> Lwt.return balance

let full_balance ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  frozen_balance ctxt delegate
  >>=? fun frozen_balance ->
  Storage.Contract.Balance.get ctxt contract
  >>=? fun balance -> Lwt.return Tez_repr.(frozen_balance +? balance)

let deactivated = Roll_storage.Delegate.is_inactive

let grace_period ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  Storage.Contract.Delegate_desactivation.get ctxt contract

let staking_balance ctxt delegate =
  let token_per_rolls = Constants_storage.tokens_per_roll ctxt in
  Roll_storage.get_rolls ctxt delegate
  >>=? fun rolls ->
  Roll_storage.get_change ctxt delegate
  >>=? fun change ->
  let rolls = Int64.of_int (List.length rolls) in
  Lwt.return Tez_repr.(token_per_rolls *? rolls)
  >>=? fun balance -> Lwt.return Tez_repr.(balance +? change)

let delegated_balance ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  staking_balance ctxt delegate
  >>=? fun staking_balance ->
  Storage.Contract.Balance.get ctxt contract
  >>= fun self_staking_balance ->
  Storage.Contract.Frozen_deposits.fold
    (ctxt, contract)
    ~init:self_staking_balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun self_staking_balance ->
  Storage.Contract.Frozen_fees.fold
    (ctxt, contract)
    ~init:self_staking_balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>=? fun self_staking_balance ->
  Lwt.return Tez_repr.(staking_balance -? self_staking_balance)

let fold = Storage.Delegates.fold

let list = Storage.Delegates.elements
Delegate_storage.v
(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Require Import Tezos.Environment.
Import Environment.Notations.
Require Tezos.Constants_storage.
Require Tezos.Contract_repr.
Require Tezos.Cycle_repr.
Require Tezos.Level_repr.
Require Tezos.Level_storage.
Require Tezos.Manager_repr.
Require Tezos.Nonce_storage.
Require Tezos.Raw_context.
Require Tezos.Roll_storage.
Require Tezos.Storage_mli. Module Storage := Storage_mli.
Require Tezos.Storage_sigs.
Require Tezos.Tez_repr.

Inductive balance : Set :=
| Contract : Contract_repr.t -> balance
| Rewards :
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> Cycle_repr.t ->
  balance
| Fees :
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> Cycle_repr.t ->
  balance
| Deposits :
  (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) -> Cycle_repr.t ->
  balance.

Definition balance_encoding : Data_encoding.encoding balance :=
  (let arg := Data_encoding.def "operation_metadata.alpha.balance" in
  fun eta => arg None None eta)
    (Data_encoding.union None
      [
        Data_encoding.__case_value "Contract" None (Data_encoding.Tag 0)
          (Data_encoding.obj2
            (Data_encoding.req None None "kind"
              (Data_encoding.constant "contract"))
            (Data_encoding.req None None "contract"
              Contract_repr.encoding))
          (fun function_parameter =>
            match function_parameter with
            | Contract c => Some (tt, c)
            | _ => None
            end)
          (fun function_parameter =>
            let '(_, c) := function_parameter in
            Contract c);
        Data_encoding.__case_value "Rewards" None (Data_encoding.Tag 1)
          (Data_encoding.obj4
            (Data_encoding.req None None "kind"
              (Data_encoding.constant "freezer"))
            (Data_encoding.req None None "category"
              (Data_encoding.constant "rewards"))
            (Data_encoding.req None None "delegate"
              (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding))
            (Data_encoding.req None None "cycle" Cycle_repr.encoding))
          (fun function_parameter =>
            match function_parameter with
            | Rewards d l => Some (tt, tt, d, l)
            | _ => None
            end)
          (fun function_parameter =>
            let '(_, _, d, l) := function_parameter in
            Rewards d l);
        Data_encoding.__case_value "Fees" None (Data_encoding.Tag 2)
          (Data_encoding.obj4
            (Data_encoding.req None None "kind"
              (Data_encoding.constant "freezer"))
            (Data_encoding.req None None "category"
              (Data_encoding.constant "fees"))
            (Data_encoding.req None None "delegate"
              (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding))
            (Data_encoding.req None None "cycle" Cycle_repr.encoding))
          (fun function_parameter =>
            match function_parameter with
            | Fees d l => Some (tt, tt, d, l)
            | _ => None
            end)
          (fun function_parameter =>
            let '(_, _, d, l) := function_parameter in
            Fees d l);
        Data_encoding.__case_value "Deposits" None (Data_encoding.Tag 3)
          (Data_encoding.obj4
            (Data_encoding.req None None "kind"
              (Data_encoding.constant "freezer"))
            (Data_encoding.req None None "category"
              (Data_encoding.constant "deposits"))
            (Data_encoding.req None None "delegate"
              (|Signature.Public_key_hash|).(S.SPublic_key_hash.encoding))
            (Data_encoding.req None None "cycle" Cycle_repr.encoding))
          (fun function_parameter =>
            match function_parameter with
            | Deposits d l => Some (tt, tt, d, l)
            | _ => None
            end)
          (fun function_parameter =>
            let '(_, _, d, l) := function_parameter in
            Deposits d l)
      ]).

Inductive balance_update : Set :=
| Debited : Tez_repr.t -> balance_update
| Credited : Tez_repr.t -> balance_update.

Definition balance_update_encoding : Data_encoding.encoding balance_update :=
  (let arg := Data_encoding.def "operation_metadata.alpha.balance_update" in
  fun eta => arg None None eta)
    (Data_encoding.obj1
      (Data_encoding.req None None "change"
        (Data_encoding.conv
          (fun function_parameter =>
            match function_parameter with
            | Credited v => Tez_repr.to_mutez v
            | Debited v => Int64.neg (Tez_repr.to_mutez v)
            end)
          (Data_encoding.Json.wrap_error
            (fun v =>
              if
                (|Compare.Int64|).(Compare.S.op_lt) v
                  (* ❌ Constant of type int64 is converted to int *)
                  0 then
                match Tez_repr.of_mutez (Int64.neg v) with
                | Some v => Debited v
                | None => Pervasives.failwith "Qty.of_mutez"
                end
              else
                match Tez_repr.of_mutez v with
                | Some v => Credited v
                | None => Pervasives.failwith "Qty.of_mutez"
                end)) None Data_encoding.__int64_value))).

Definition balance_updates : Set := list (balance * balance_update).

Definition balance_updates_encoding
  : Data_encoding.encoding (list (balance * balance_update)) :=
  (let arg := Data_encoding.def "operation_metadata.alpha.balance_updates" in
  fun eta => arg None None eta)
    (Data_encoding.__list_value None
      (Data_encoding.merge_objs balance_encoding balance_update_encoding)).

Definition cleanup_balance_updates {A : Set}
  (balance_updates : list (A * balance_update)) : list (A * balance_update) :=
  List.filter
    (fun function_parameter =>
      match function_parameter with
      | (_, (Credited update | Debited update)) =>
        Pervasives.not (Tez_repr.equal update Tez_repr.zero)
      end) balance_updates.

Module frozen_balance.
  Record record : Set := Build {
    deposit : Tez_repr.t;
    fees : Tez_repr.t;
    rewards : Tez_repr.t }.
  Definition with_deposit deposit (r : record) :=
    Build deposit r.(fees) r.(rewards).
  Definition with_fees fees (r : record) :=
    Build r.(deposit) fees r.(rewards).
  Definition with_rewards rewards (r : record) :=
    Build r.(deposit) r.(fees) rewards.
End frozen_balance.
Definition frozen_balance := frozen_balance.record.

Definition frozen_balance_encoding : Data_encoding.encoding frozen_balance :=
  Data_encoding.conv
    (fun function_parameter =>
      let '{|
        frozen_balance.deposit := deposit;
          frozen_balance.fees := fees;
          frozen_balance.rewards := rewards
          |} := function_parameter in
      (deposit, fees, rewards))
    (fun function_parameter =>
      let '(deposit, fees, rewards) := function_parameter in
      {| frozen_balance.deposit := deposit; frozen_balance.fees := fees;
        frozen_balance.rewards := rewards |}) None
    (Data_encoding.obj3
      (Data_encoding.req None None "deposit" Tez_repr.encoding)
      (Data_encoding.req None None "fees" Tez_repr.encoding)
      (Data_encoding.req None None "rewards" Tez_repr.encoding)).

(* ❌ Structure item `typext` not handled. *)
(* type_extension *)

(* ❌ Top-level evaluations are ignored *)
(* top_level_evaluation *)

Definition link
  (c : (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.key))
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let=? balance :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.get) c
      contract in
  let=? c := Roll_storage.Delegate.add_amount c delegate balance in
  let= c :=
    (|Storage.Contract.Delegated|).(Storage_sigs.Data_set_storage.add)
      (c, (Contract_repr.implicit_contract delegate)) contract in
  Error_monad.__return c.

Definition unlink
  (c : (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t
    (Error_monad.tzresult
      (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context)) :=
  let=? balance :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.get) c
      contract in
  let=? function_parameter :=
    (|Storage.Contract.Delegate|).(Storage_sigs.Indexed_data_storage.get_option)
      c contract in
  match function_parameter with
  | None => Error_monad.__return c
  | Some delegate =>
    let=? c := Roll_storage.Delegate.remove_amount c delegate balance in
    let= c :=
      (|Storage.Contract.Delegated|).(Storage_sigs.Data_set_storage.del)
        (c, (Contract_repr.implicit_contract delegate)) contract in
    Error_monad.__return c
  end.

Definition known
  (c : (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.context))
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult bool) :=
  let=? function_parameter :=
    (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.get_option)
      c (Contract_repr.implicit_contract delegate) in
  match function_parameter with
  | (None | Some (Manager_repr.Hash _)) => Error_monad.return_false
  | Some (Manager_repr.Public_key _) => Error_monad.return_true
  end.

Definition registered
  (c : (|Storage.Contract.Delegate|).(Storage_sigs.Indexed_data_storage.context))
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult bool) :=
  let=? function_parameter :=
    (|Storage.Contract.Delegate|).(Storage_sigs.Indexed_data_storage.get_option)
      c (Contract_repr.implicit_contract delegate) in
  match function_parameter with
  | Some current_delegate =>
    Error_monad.__return
      ((|Signature.Public_key_hash|).(S.SPublic_key_hash.equal) delegate
        current_delegate)
  | None => Error_monad.return_false
  end.

Definition init
  (ctxt :
    (|Storage.Contract.Manager|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Delegate|).(Storage_sigs.Indexed_data_storage.key))
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let=? known_delegate := known ctxt delegate in
  let=? '_ := Error_monad.fail_unless known_delegate extensible_type_value in
  let=? is_registered := registered ctxt delegate in
  let=? '_ := Error_monad.fail_unless is_registered extensible_type_value in
  let=? ctxt :=
    (|Storage.Contract.Delegate|).(Storage_sigs.Indexed_data_storage.init) ctxt
      contract delegate in
  link ctxt contract delegate.

Definition get
  : Raw_context.t -> Contract_repr.t ->
  Lwt.t
    (Error_monad.tzresult
      (option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))) :=
  Roll_storage.get_contract_delegate.

Definition set
  (c : (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.key))
  (delegate : option (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  match delegate with
  | None =>
    let delete (function_parameter : unit)
      : Lwt.t (Error_monad.tzresult Raw_context.t) :=
      let '_ := function_parameter in
      let=? c := unlink c contract in
      let= c :=
        (|Storage.Contract.Delegate|).(Storage_sigs.Indexed_data_storage.remove)
          c contract in
      Error_monad.__return c in
    match Contract_repr.is_implicit contract with
    | Some pkh =>
      let=? is_registered := registered c pkh in
      if is_registered then
        Error_monad.fail extensible_type_value
      else
        delete tt
    | None => delete tt
    end
  | Some delegate =>
    let=? known_delegate := known c delegate in
    let=? registered_delegate := registered c delegate in
    let self_delegation :=
      match Contract_repr.is_implicit contract with
      | Some pkh =>
        (|Signature.Public_key_hash|).(S.SPublic_key_hash.equal) pkh delegate
      | None => false
      end in
    if
      Pervasives.op_pipepipe (Pervasives.not known_delegate)
        (Pervasives.not
          (Pervasives.op_pipepipe registered_delegate self_delegation)) then
      Error_monad.fail extensible_type_value
    else
      let=? '_ :=
        let=? function_parameter :=
          (|Storage.Contract.Delegate|).(Storage_sigs.Indexed_data_storage.get_option)
            c contract in
        match
          (function_parameter,
            match function_parameter with
            | Some current_delegate =>
              (|Signature.Public_key_hash|).(S.SPublic_key_hash.equal) delegate
                current_delegate
            | _ => false
            end) with
        | (Some current_delegate, true) =>
          if self_delegation then
            let=? function_parameter :=
              Roll_storage.Delegate.is_inactive c delegate in
            match function_parameter with
            | true => Error_monad.return_unit
            | false => Error_monad.fail extensible_type_value
            end
          else
            Error_monad.fail extensible_type_value
        | ((None | Some _), _) => Error_monad.return_unit
        end in
      let=? '_ :=
        match Contract_repr.is_implicit contract with
        | Some pkh =>
          let=? is_registered := registered c pkh in
          if Pervasives.op_andand (Pervasives.not self_delegation) is_registered
            then
            Error_monad.fail extensible_type_value
          else
            Error_monad.return_unit
        | None => Error_monad.return_unit
        end in
      let= __exists :=
        (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.mem) c
          contract in
      let=? '_ :=
        Error_monad.fail_when
          (Pervasives.op_andand self_delegation (Pervasives.not __exists))
          extensible_type_value in
      let=? c := unlink c contract in
      let= c :=
        (|Storage.Contract.Delegate|).(Storage_sigs.Indexed_data_storage.init_set)
          c contract delegate in
      let=? c := link c contract delegate in
      let=? c :=
        if self_delegation then
          let= c :=
            (|Storage.Delegates|).(Storage_sigs.Data_set_storage.add) c delegate
            in
          let=? c := Roll_storage.Delegate.set_active c delegate in
          Error_monad.__return c
        else
          Error_monad.__return c in
      Error_monad.__return c
  end.

Definition remove
  (ctxt :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context))
  (contract :
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t
    (Error_monad.tzresult
      (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.context)) :=
  unlink ctxt contract.

Definition delegated_contracts
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t
    (list (|Storage.Contract.Delegated|).(Storage_sigs.Data_set_storage.elt)) :=
  let contract := Contract_repr.implicit_contract delegate in
  (|Storage.Contract.Delegated|).(Storage_sigs.Data_set_storage.elements)
    (ctxt, contract).

Definition get_frozen_deposit
  (ctxt : Raw_context.t) (contract : Contract_repr.t)
  (cycle :
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t (Error_monad.tzresult Tez_repr.t) :=
  let=? function_parameter :=
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.get_option)
      (ctxt, contract) cycle in
  match function_parameter with
  | None => Error_monad.__return Tez_repr.zero
  | Some frozen => Error_monad.__return frozen
  end.

Definition credit_frozen_deposit
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (cycle :
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.key))
  (amount : Tez_repr.t) : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  let=? old_amount := get_frozen_deposit ctxt contract cycle in
  let=? new_amount := Lwt.__return (Tez_repr.op_plusquestion old_amount amount)
    in
  let= ctxt :=
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.init_set)
      (ctxt, contract) cycle new_amount in
  let= ctxt :=
    (|Storage.Delegates_with_frozen_balance|).(Storage_sigs.Data_set_storage.add)
      (ctxt, cycle) delegate in
  Error_monad.__return ctxt.

Definition freeze_deposit
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (amount : Tez_repr.t) : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let '{| Level_repr.t.cycle := cycle |} := Level_storage.current ctxt in
  let=? ctxt := Roll_storage.Delegate.set_active ctxt delegate in
  let contract := Contract_repr.implicit_contract delegate in
  let=? balance :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.get) ctxt
      contract in
  let=? new_balance :=
    Lwt.__return
      (Error_monad.record_trace extensible_type_value
        (Tez_repr.op_minusquestion balance amount)) in
  let=? ctxt :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.set) ctxt
      contract new_balance in
  credit_frozen_deposit ctxt delegate cycle amount.

Definition get_frozen_fees
  (ctxt : Raw_context.t) (contract : Contract_repr.t)
  (cycle :
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t (Error_monad.tzresult Tez_repr.t) :=
  let=? function_parameter :=
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.get_option)
      (ctxt, contract) cycle in
  match function_parameter with
  | None => Error_monad.__return Tez_repr.zero
  | Some frozen => Error_monad.__return frozen
  end.

Definition credit_frozen_fees
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (cycle :
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.key))
  (amount : Tez_repr.t) : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  let=? old_amount := get_frozen_fees ctxt contract cycle in
  let=? new_amount := Lwt.__return (Tez_repr.op_plusquestion old_amount amount)
    in
  let= ctxt :=
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.init_set)
      (ctxt, contract) cycle new_amount in
  let= ctxt :=
    (|Storage.Delegates_with_frozen_balance|).(Storage_sigs.Data_set_storage.add)
      (ctxt, cycle) delegate in
  Error_monad.__return ctxt.

Definition freeze_fees
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (amount : Tez_repr.t) : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let '{| Level_repr.t.cycle := cycle |} := Level_storage.current ctxt in
  let=? ctxt := Roll_storage.Delegate.add_amount ctxt delegate amount in
  credit_frozen_fees ctxt delegate cycle amount.

Definition burn_fees
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (cycle :
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.key))
  (amount : Tez_repr.t) : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  let=? old_amount := get_frozen_fees ctxt contract cycle in
  let=? '(new_amount, ctxt) :=
    match Tez_repr.op_minusquestion old_amount amount with
    | Pervasives.Ok new_amount =>
      let=? ctxt := Roll_storage.Delegate.remove_amount ctxt delegate amount in
      Error_monad.__return (new_amount, ctxt)
    | Pervasives.Error _ =>
      let=? ctxt := Roll_storage.Delegate.remove_amount ctxt delegate old_amount
        in
      Error_monad.__return (Tez_repr.zero, ctxt)
    end in
  let= ctxt :=
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.init_set)
      (ctxt, contract) cycle new_amount in
  Error_monad.__return ctxt.

Definition get_frozen_rewards
  (ctxt : Raw_context.t) (contract : Contract_repr.t)
  (cycle :
    (|Storage.Contract.Frozen_rewards|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t (Error_monad.tzresult Tez_repr.t) :=
  let=? function_parameter :=
    (|Storage.Contract.Frozen_rewards|).(Storage_sigs.Indexed_data_storage.get_option)
      (ctxt, contract) cycle in
  match function_parameter with
  | None => Error_monad.__return Tez_repr.zero
  | Some frozen => Error_monad.__return frozen
  end.

Definition credit_frozen_rewards
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (cycle :
    (|Storage.Contract.Frozen_rewards|).(Storage_sigs.Indexed_data_storage.key))
  (amount : Tez_repr.t) : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  let=? old_amount := get_frozen_rewards ctxt contract cycle in
  let=? new_amount := Lwt.__return (Tez_repr.op_plusquestion old_amount amount)
    in
  let= ctxt :=
    (|Storage.Contract.Frozen_rewards|).(Storage_sigs.Indexed_data_storage.init_set)
      (ctxt, contract) cycle new_amount in
  let= ctxt :=
    (|Storage.Delegates_with_frozen_balance|).(Storage_sigs.Data_set_storage.add)
      (ctxt, cycle) delegate in
  Error_monad.__return ctxt.

Definition freeze_rewards
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (amount : Tez_repr.t) : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let '{| Level_repr.t.cycle := cycle |} := Level_storage.current ctxt in
  credit_frozen_rewards ctxt delegate cycle amount.

Definition burn_rewards
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (cycle :
    (|Storage.Contract.Frozen_rewards|).(Storage_sigs.Indexed_data_storage.key))
  (amount : Tez_repr.t) : Lwt.t (Error_monad.tzresult Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  let=? old_amount := get_frozen_rewards ctxt contract cycle in
  let new_amount :=
    match Tez_repr.op_minusquestion old_amount amount with
    | Pervasives.Error _ => Tez_repr.zero
    | Pervasives.Ok new_amount => new_amount
    end in
  let= ctxt :=
    (|Storage.Contract.Frozen_rewards|).(Storage_sigs.Indexed_data_storage.init_set)
      (ctxt, contract) cycle new_amount in
  Error_monad.__return ctxt.

Definition unfreeze
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (cycle :
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t
    (Error_monad.tzresult (Raw_context.t * list (balance * balance_update))) :=
  let contract := Contract_repr.implicit_contract delegate in
  let=? deposit := get_frozen_deposit ctxt contract cycle in
  let=? fees := get_frozen_fees ctxt contract cycle in
  let=? rewards := get_frozen_rewards ctxt contract cycle in
  let=? balance :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.get) ctxt
      contract in
  let=? unfrozen_amount := Lwt.__return (Tez_repr.op_plusquestion deposit fees)
    in
  let=? unfrozen_amount :=
    Lwt.__return (Tez_repr.op_plusquestion unfrozen_amount rewards) in
  let=? balance :=
    Lwt.__return (Tez_repr.op_plusquestion balance unfrozen_amount) in
  let=? ctxt :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.set) ctxt
      contract balance in
  let=? ctxt := Roll_storage.Delegate.add_amount ctxt delegate rewards in
  let= ctxt :=
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.remove)
      (ctxt, contract) cycle in
  let= ctxt :=
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.remove)
      (ctxt, contract) cycle in
  let= ctxt :=
    (|Storage.Contract.Frozen_rewards|).(Storage_sigs.Indexed_data_storage.remove)
      (ctxt, contract) cycle in
  Error_monad.__return
    (ctxt,
      (cleanup_balance_updates
        [
          ((Deposits delegate cycle), (Debited deposit));
          ((Fees delegate cycle), (Debited fees));
          ((Rewards delegate cycle), (Debited rewards));
          ((Contract (Contract_repr.implicit_contract delegate)),
            (Credited unfrozen_amount))
        ])).

Definition cycle_end
  (ctxt : Raw_context.context) (last_cycle : Cycle_repr.cycle)
  (unrevealed : list Nonce_storage.unrevealed)
  : Lwt.t
    (Error_monad.tzresult
      (Raw_context.context * list (balance * balance_update) *
        list
          (|Storage.Active_delegates_with_rolls|).(Storage_sigs.Data_set_storage.elt))) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  let=? '(ctxt, balance_updates) :=
    match Cycle_repr.pred last_cycle with
    | None => Error_monad.__return (ctxt, nil)
    | Some revealed_cycle =>
      List.fold_left
        (fun acc =>
          fun u =>
            let=? '(ctxt, balance_updates) := acc in
            let=? ctxt :=
              burn_fees ctxt u.(Storage.unrevealed_nonce.delegate)
                revealed_cycle u.(Storage.unrevealed_nonce.fees) in
            let=? ctxt :=
              burn_rewards ctxt u.(Storage.unrevealed_nonce.delegate)
                revealed_cycle u.(Storage.unrevealed_nonce.rewards) in
            let bus :=
              [
                ((Fees u.(Storage.unrevealed_nonce.delegate) revealed_cycle),
                  (Debited u.(Storage.unrevealed_nonce.fees)));
                ((Rewards u.(Storage.unrevealed_nonce.delegate) revealed_cycle),
                  (Debited u.(Storage.unrevealed_nonce.rewards)))
              ] in
            Error_monad.__return (ctxt, (Pervasives.op_at bus balance_updates)))
        (Error_monad.__return (ctxt, nil)) unrevealed
    end in
  match Cycle_repr.sub last_cycle preserved with
  | None => Error_monad.__return (ctxt, balance_updates, nil)
  | Some unfrozen_cycle =>
    let=? '(ctxt, balance_updates) :=
      (|Storage.Delegates_with_frozen_balance|).(Storage_sigs.Data_set_storage.fold)
        (ctxt, unfrozen_cycle) (Pervasives.Ok (ctxt, balance_updates))
        (fun delegate =>
          fun acc =>
            let=? '(ctxt, bus) := Lwt.__return acc in
            let=? '(ctxt, balance_updates) :=
              unfreeze ctxt delegate unfrozen_cycle in
            Error_monad.__return (ctxt, (Pervasives.op_at balance_updates bus)))
      in
    let= ctxt :=
      (|Storage.Delegates_with_frozen_balance|).(Storage_sigs.Data_set_storage.clear)
        (ctxt, unfrozen_cycle) in
    let=? '(ctxt, deactivated) :=
      (|Storage.Active_delegates_with_rolls|).(Storage_sigs.Data_set_storage.fold)
        ctxt (Pervasives.Ok (ctxt, nil))
        (fun delegate =>
          fun acc =>
            let=? '(ctxt, deactivated) := Lwt.__return acc in
            let=? cycle :=
              (|Storage.Contract.Delegate_desactivation|).(Storage_sigs.Indexed_data_storage.get)
                ctxt (Contract_repr.implicit_contract delegate) in
            if Cycle_repr.op_lteq cycle last_cycle then
              let=? ctxt := Roll_storage.Delegate.set_inactive ctxt delegate in
              Error_monad.__return (ctxt, (cons delegate deactivated))
            else
              Error_monad.__return (ctxt, deactivated)) in
    Error_monad.__return (ctxt, balance_updates, deactivated)
  end.

Definition punish
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (cycle :
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t (Error_monad.tzresult (Raw_context.t * frozen_balance)) :=
  let contract := Contract_repr.implicit_contract delegate in
  let=? deposit := get_frozen_deposit ctxt contract cycle in
  let=? fees := get_frozen_fees ctxt contract cycle in
  let=? rewards := get_frozen_rewards ctxt contract cycle in
  let=? ctxt := Roll_storage.Delegate.remove_amount ctxt delegate deposit in
  let=? ctxt := Roll_storage.Delegate.remove_amount ctxt delegate fees in
  let= ctxt :=
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.remove)
      (ctxt, contract) cycle in
  let= ctxt :=
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.remove)
      (ctxt, contract) cycle in
  let= ctxt :=
    (|Storage.Contract.Frozen_rewards|).(Storage_sigs.Indexed_data_storage.remove)
      (ctxt, contract) cycle in
  Error_monad.__return
    (ctxt,
      {| frozen_balance.deposit := deposit; frozen_balance.fees := fees;
        frozen_balance.rewards := rewards |}).

Definition has_frozen_balance
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  (cycle :
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.key))
  : Lwt.t (Error_monad.tzresult bool) :=
  let contract := Contract_repr.implicit_contract delegate in
  let=? deposit := get_frozen_deposit ctxt contract cycle in
  if Tez_repr.op_ltgt deposit Tez_repr.zero then
    Error_monad.return_true
  else
    let=? fees := get_frozen_fees ctxt contract cycle in
    if Tez_repr.op_ltgt fees Tez_repr.zero then
      Error_monad.return_true
    else
      let=? rewards := get_frozen_rewards ctxt contract cycle in
      Error_monad.__return (Tez_repr.op_ltgt rewards Tez_repr.zero).

Definition frozen_balance_by_cycle_encoding
  : Data_encoding.encoding ((|Cycle_repr.Map|).(S.MAP.t) frozen_balance) :=
  Data_encoding.conv (|Cycle_repr.Map|).(S.MAP.bindings)
    (List.fold_left
      (fun m =>
        fun function_parameter =>
          let '(c, __b_value) := function_parameter in
          (|Cycle_repr.Map|).(S.MAP.add) c __b_value m)
      (|Cycle_repr.Map|).(S.MAP.empty)) None
    (Data_encoding.__list_value None
      (Data_encoding.merge_objs
        (Data_encoding.obj1
          (Data_encoding.req None None "cycle" Cycle_repr.encoding))
        frozen_balance_encoding)).

Definition empty_frozen_balance : frozen_balance :=
  {| frozen_balance.deposit := Tez_repr.zero;
    frozen_balance.fees := Tez_repr.zero;
    frozen_balance.rewards := Tez_repr.zero |}.

Definition frozen_balance_by_cycle
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t ((|Cycle_repr.Map|).(S.MAP.t) frozen_balance) :=
  let contract := Contract_repr.implicit_contract delegate in
  let map {A : Set} : (|Cycle_repr.Map|).(S.MAP.t) A :=
    (|Cycle_repr.Map|).(S.MAP.empty) in
  let= map :=
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.fold)
      (ctxt, contract) map
      (fun cycle =>
        fun amount =>
          fun map =>
            Lwt.__return
              ((|Cycle_repr.Map|).(S.MAP.add) cycle
                (frozen_balance.with_deposit amount empty_frozen_balance) map))
    in
  let= map :=
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.fold)
      (ctxt, contract) map
      (fun cycle =>
        fun amount =>
          fun map =>
            let balance :=
              match (|Cycle_repr.Map|).(S.MAP.find_opt) cycle map with
              | None => empty_frozen_balance
              | Some balance => balance
              end in
            Lwt.__return
              ((|Cycle_repr.Map|).(S.MAP.add) cycle
                (frozen_balance.with_fees amount balance) map)) in
  let= map :=
    (|Storage.Contract.Frozen_rewards|).(Storage_sigs.Indexed_data_storage.fold)
      (ctxt, contract) map
      (fun cycle =>
        fun amount =>
          fun map =>
            let balance :=
              match (|Cycle_repr.Map|).(S.MAP.find_opt) cycle map with
              | None => empty_frozen_balance
              | Some balance => balance
              end in
            Lwt.__return
              ((|Cycle_repr.Map|).(S.MAP.add) cycle
                (frozen_balance.with_rewards amount balance) map)) in
  Lwt.__return map.

Definition __frozen_balance_value
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Pervasives.result Tez_repr.t (list Error_monad.__error)) :=
  let contract := Contract_repr.implicit_contract delegate in
  let balance {A : Set} : Pervasives.result Tez_repr.t A :=
    Pervasives.Ok Tez_repr.zero in
  let= balance :=
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.fold)
      (ctxt, contract) balance
      (fun _cycle =>
        fun amount =>
          fun acc =>
            let=? acc := Lwt.__return acc in
            Lwt.__return (Tez_repr.op_plusquestion acc amount)) in
  let= balance :=
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.fold)
      (ctxt, contract) balance
      (fun _cycle =>
        fun amount =>
          fun acc =>
            let=? acc := Lwt.__return acc in
            Lwt.__return (Tez_repr.op_plusquestion acc amount)) in
  let= balance :=
    (|Storage.Contract.Frozen_rewards|).(Storage_sigs.Indexed_data_storage.fold)
      (ctxt, contract) balance
      (fun _cycle =>
        fun amount =>
          fun acc =>
            let=? acc := Lwt.__return acc in
            Lwt.__return (Tez_repr.op_plusquestion acc amount)) in
  Lwt.__return balance.

Definition full_balance
  (ctxt : Raw_context.t)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult Tez_repr.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  let=? __frozen_balance_value := __frozen_balance_value ctxt delegate in
  let=? balance :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.get) ctxt
      contract in
  Lwt.__return (Tez_repr.op_plusquestion __frozen_balance_value balance).

Definition deactivated
  : Raw_context.t -> (|Signature.Public_key_hash|).(S.SPublic_key_hash.t) ->
  Lwt.t (Error_monad.tzresult bool) := Roll_storage.Delegate.is_inactive.

Definition grace_period
  (ctxt :
    (|Storage.Contract.Delegate_desactivation|).(Storage_sigs.Indexed_data_storage.context))
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t
    (Error_monad.tzresult
      (|Storage.Contract.Delegate_desactivation|).(Storage_sigs.Indexed_data_storage.value)) :=
  let contract := Contract_repr.implicit_contract delegate in
  (|Storage.Contract.Delegate_desactivation|).(Storage_sigs.Indexed_data_storage.get)
    ctxt contract.

Definition staking_balance
  (ctxt : Raw_context.context)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult Tez_repr.t) :=
  let token_per_rolls := Constants_storage.tokens_per_roll ctxt in
  let=? rolls := Roll_storage.get_rolls ctxt delegate in
  let=? change := Roll_storage.get_change ctxt delegate in
  let rolls := Int64.of_int (List.length rolls) in
  let=? balance := Lwt.__return (Tez_repr.op_starquestion token_per_rolls rolls)
    in
  Lwt.__return (Tez_repr.op_plusquestion balance change).

Definition delegated_balance
  (ctxt : Raw_context.context)
  (delegate : (|Signature.Public_key_hash|).(S.SPublic_key_hash.t))
  : Lwt.t (Error_monad.tzresult Tez_repr.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  let=? staking_balance := staking_balance ctxt delegate in
  let= self_staking_balance :=
    (|Storage.Contract.Balance|).(Storage_sigs.Indexed_data_storage.get) ctxt
      contract in
  let= self_staking_balance :=
    (|Storage.Contract.Frozen_deposits|).(Storage_sigs.Indexed_data_storage.fold)
      (ctxt, contract) self_staking_balance
      (fun _cycle =>
        fun amount =>
          fun acc =>
            let=? acc := Lwt.__return acc in
            Lwt.__return (Tez_repr.op_plusquestion acc amount)) in
  let=? self_staking_balance :=
    (|Storage.Contract.Frozen_fees|).(Storage_sigs.Indexed_data_storage.fold)
      (ctxt, contract) self_staking_balance
      (fun _cycle =>
        fun amount =>
          fun acc =>
            let=? acc := Lwt.__return acc in
            Lwt.__return (Tez_repr.op_plusquestion acc amount)) in
  Lwt.__return (Tez_repr.op_minusquestion staking_balance self_staking_balance).

Definition fold {A : Set}
  : (|Storage.Delegates|).(Storage_sigs.Data_set_storage.context) -> A ->
  ((|Storage.Delegates|).(Storage_sigs.Data_set_storage.elt) -> A -> Lwt.t A) ->
  Lwt.t A := (|Storage.Delegates|).(Storage_sigs.Data_set_storage.fold).

Definition __list_value
  : (|Storage.Delegates|).(Storage_sigs.Data_set_storage.context) ->
  Lwt.t (list (|Storage.Delegates|).(Storage_sigs.Data_set_storage.elt)) :=
  (|Storage.Delegates|).(Storage_sigs.Data_set_storage.elements).

Delegate_storage_mli

  • OCaml size: 191 lines
  • Coq size: 150 lines (-22% compared to OCaml)
delegate_storage.mli 1 warning
(*****************************************************************************)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Places where tezzies can be found in the ledger's state. *)
type balance =
  | Contract of Contract_repr.t
  | Rewards of Signature.Public_key_hash.t * Cycle_repr.t
  | Fees of Signature.Public_key_hash.t * Cycle_repr.t
  | Deposits of Signature.Public_key_hash.t * Cycle_repr.t

(** A credit or debit of tezzies to a balance. *)
type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t

(** A list of balance updates. Duplicates may happen. *)
type balance_updates = (balance * balance_update) list

val balance_updates_encoding : balance_updates Data_encoding.t

(** Remove zero-valued balances from a list of updates. *)
val cleanup_balance_updates : balance_updates -> balance_updates

type frozen_balance = {
  deposit : Tez_repr.t;
  fees : Tez_repr.t;
  rewards : Tez_repr.t;
}

(** Allow to register a delegate when creating an account. *)
val init :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t ->
  Raw_context.t tzresult Lwt.t

(** Cleanup delegation when deleting a contract. *)
val remove : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t

(** Reading the current delegate of a contract. *)
val get :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t option tzresult Lwt.t

val registered :
  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

(** Updating the delegate of a contract.

    When calling this function on an "implicit contract" and setting
    the delegate to the contract manager registers it as a delegate. One
    cannot unregister a delegate for now. The associate contract is now
    'undeletable'. *)
val set :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t opt