607 lines
25 KiB
OCaml
607 lines
25 KiB
OCaml
(*****************************************************************************)
|
|
(* *)
|
|
(* 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
|
|
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 -> begin
|
|
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 ()
|
|
end
|
|
| 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
|
|
begin
|
|
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
|
|
end >>=? fun () ->
|
|
(* check if contract is a registered delegate *)
|
|
begin
|
|
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
|
|
end >>=? 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 ->
|
|
begin
|
|
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
|
|
end >>=? 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 ->
|
|
begin
|
|
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)
|
|
end >>=? 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
|
|
begin
|
|
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
|
|
end >>=? 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
|