bootstrap_storage.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
type error += Unrevealed_public_key of Signature.Public_key_hash.t
let () =
register_error_kind
`Permanent
~id:"bootstrap.unrevealed_public_key"
~title:"Forbidden delegation from unrevealed public key"
~description:"Tried to delegate from an unrevealed public key"
~pp:(fun ppf delegate ->
Format.fprintf
ppf
"Delegation from an unrevealed public key (for %a) is forbidden."
Signature.Public_key_hash.pp
delegate)
Data_encoding.(obj1 (req "delegator" Signature.Public_key_hash.encoding))
(function Unrevealed_public_key pkh -> Some pkh | _ -> None)
(fun pkh -> Unrevealed_public_key pkh)
let init_account (ctxt, balance_updates)
({public_key_hash; public_key; amount; delegate_to; consensus_key} :
Parameters_repr.bootstrap_account) =
let open Lwt_result_syntax in
let contract = Contract_repr.Implicit public_key_hash in
let* ctxt, new_balance_updates =
Token.transfer
~origin:Protocol_migration
ctxt
`Bootstrap
(`Contract contract)
amount
in
let+ ctxt, freeze_balance_updates =
match public_key with
| Some public_key -> (
let* ctxt =
Contract_manager_storage.reveal_manager_key
ctxt
public_key_hash
public_key
in
let* ctxt =
Delegate_storage.Contract.set
ctxt
contract
(Some (Option.value ~default:public_key_hash delegate_to))
in
let* ctxt =
match consensus_key with
| None -> return ctxt
| Some consensus_key ->
Delegate_consensus_key.init ctxt public_key_hash consensus_key
in
match delegate_to with
| Some delegate
when Signature.Public_key_hash.(delegate <> public_key_hash) ->
return (ctxt, [])
| _ ->
(* Self-delegated => contract is a delegate.
Freeze the largest amount of tokens to avoid over-delegation
according to the [limit_of_delegation_over_baking].
This is necessary so that the network (in tests too) starts with
accounts with baking rights. *)
let limit_of_delegation_over_baking =
Constants_storage.limit_of_delegation_over_baking ctxt
in
let amount_to_freeze =
let minimal_to_bake =
let minimal_stake = Constants_storage.minimal_stake ctxt in
let minimal_frozen_stake =
Constants_storage.minimal_frozen_stake ctxt
in
Tez_repr.max minimal_stake minimal_frozen_stake
in
let minimal_to_not_be_overdelegated =
Tez_repr.div_exn amount (limit_of_delegation_over_baking + 1)
in
Tez_repr.(
min amount (max minimal_to_bake minimal_to_not_be_overdelegated))
in
Token.transfer
~origin:Protocol_migration
ctxt
(`Contract contract)
(`Frozen_deposits (Frozen_staker_repr.baker public_key_hash))
amount_to_freeze)
| None ->
let* () =
fail_when
(Option.is_some delegate_to)
(Unrevealed_public_key public_key_hash)
in
return (ctxt, [])
in
(ctxt, freeze_balance_updates @ new_balance_updates @ balance_updates)
let init_contract ~typecheck_smart_contract (ctxt, balance_updates)
({delegate; amount; script; hash} : Parameters_repr.bootstrap_contract) =
let open Lwt_result_syntax in
let*? ctxt, contract_hash =
match hash with
| None -> Contract_storage.fresh_contract_from_current_nonce ctxt
| Some hash -> Result.return (ctxt, hash)
in
let* script, ctxt = typecheck_smart_contract ctxt script in
let* ctxt =
Contract_storage.raw_originate
ctxt
~prepaid_bootstrap_storage:true
contract_hash
~script
in
let contract = Contract_repr.Originated contract_hash in
let* ctxt =
match delegate with
| None -> return ctxt
| Some delegate -> Delegate_storage.Contract.init ctxt contract delegate
in
let origin = Receipt_repr.Protocol_migration in
let+ ctxt, new_balance_updates =
Token.transfer ~origin ctxt `Bootstrap (`Contract contract) amount
in
(ctxt, new_balance_updates @ balance_updates)
let init_smart_rollup ~typecheck_smart_rollup ctxt
({address; boot_sector; pvm_kind; parameters_ty; whitelist} :
Parameters_repr.bootstrap_smart_rollup) =
let open Lwt_result_syntax in
let*? ctxt =
let open Result_syntax in
let* parameters_ty = Script_repr.force_decode parameters_ty in
typecheck_smart_rollup ctxt parameters_ty
in
let*! genesis_hash = Sc_rollups.genesis_state_hash_of pvm_kind ~boot_sector in
let genesis_commitment : Sc_rollup_commitment_repr.t =
{
compressed_state = genesis_hash;
(* Level 0: Genesis block.
Level 1: Block on protocol genesis, that only activates protocols.
Level 2: First block on the activated protocol.
Therefore we originate the rollup at level 2 so the rollup node
doesn't ask a block on a different protocol.
*)
inbox_level = Raw_level_repr.of_int32_exn 2l;
predecessor = Sc_rollup_commitment_repr.Hash.zero;
number_of_ticks = Sc_rollup_repr.Number_of_ticks.zero;
}
in
let* _, _, ctxt =
Sc_rollup_storage.raw_originate
ctxt
~kind:pvm_kind
~genesis_commitment
~parameters_ty
~address
?whitelist
in
return ctxt
let init ctxt ~typecheck_smart_contract ~typecheck_smart_rollup
?no_reward_cycles accounts contracts smart_rollups =
let open Lwt_result_syntax in
let nonce = Operation_hash.hash_string ["Un festival de GADT."] in
let ctxt = Raw_context.init_origination_nonce ctxt nonce in
let* ctxt, balance_updates =
List.fold_left_es init_account (ctxt, []) accounts
in
let* ctxt, balance_updates =
List.fold_left_es
(init_contract ~typecheck_smart_contract)
(ctxt, balance_updates)
contracts
in
let* ctxt =
List.fold_left_es
(init_smart_rollup ~typecheck_smart_rollup)
ctxt
smart_rollups
in
let+ ctxt =
match no_reward_cycles with
| None -> return ctxt
| Some cycles ->
(* Store pending ramp ups. *)
let constants = Raw_context.constants ctxt in
(* Start without rewards *)
let*! ctxt =
Raw_context.patch_constants ctxt (fun c ->
{
c with
issuance_weights =
{
c.issuance_weights with
base_total_issued_per_minute = Tez_repr.zero;
};
})
in
(* Store the final reward. *)
Storage.Ramp_up.(
Rewards.init
ctxt
(Cycle_repr.of_int32_exn (Int32.of_int cycles))
{
(* Hack: we store the rewards here *)
baking_reward_fixed_portion =
constants.issuance_weights.base_total_issued_per_minute;
baking_reward_bonus_per_slot = Tez_repr.zero;
attesting_reward_per_slot = Tez_repr.zero;
})
in
(ctxt, balance_updates)
let cycle_end ctxt last_cycle =
let open Lwt_result_syntax in
let next_cycle = Cycle_repr.succ last_cycle in
let* result = Storage.Ramp_up.Rewards.find ctxt next_cycle in
match result with
| None -> return ctxt
| Some Storage.Ramp_up.{baking_reward_fixed_portion; _} ->
let* ctxt = Storage.Ramp_up.Rewards.remove_existing ctxt next_cycle in
let*! ctxt =
Raw_context.patch_constants ctxt (fun c ->
{
c with
issuance_weights =
{
c.issuance_weights with
base_total_issued_per_minute = baking_reward_fixed_portion;
};
})
in
return ctxt
