EPOCH and NEWEPOCH Transition Systems for Dijkstra¶

Modelled on the Conway.Conformance.Epoch module, adapted for Dijkstra:

Deposits live in CertState (not UTxOState)
SNAP and POOLREAP operate on CertState and Acnt rather than UTxOState and CertState.
govAction deposit returns are taken from GState.deposits.

{-# OPTIONS --safe #-}

open import Ledger.Dijkstra.Specification.Abstract
open import Ledger.Dijkstra.Specification.Transaction

module Ledger.Dijkstra.Specification.Epoch
  (txs : TransactionStructure) (open TransactionStructure txs)
  (abs : AbstractFunctions txs) (open AbstractFunctions abs)
  where

import Data.Integer as ℤ
open import Data.Integer using () renaming (+_ to pos)
open import Data.Integer.Properties         using (module ≤-Reasoning; +-mono-≤; neg-mono-≤; +-identityˡ)
                                            renaming (nonNegative⁻¹ to nonNegative⁻¹ℤ)
open import Data.Integer.Tactic.RingSolver  using (solve-∀)
open import Data.Rational                   using (ℚ; floor; _*_; _÷_; _/_; _⊓_; _≟_; ≢-nonZero)
open import Data.Rational.Literals          using (number; fromℤ)
open import Data.Rational.Properties        using (nonNegative⁻¹; pos⇒nonNeg; ⊓-glb)

open import stdlib.Data.Rational.Properties using (0≤⇒0≤floor; ÷-0≤⇒0≤; fromℕ-0≤; *-0≤⇒0≤; fromℤ-0≤)


open import Ledger.Prelude hiding (iterate; _/_; _*_; _⊓_; _≟_; ≢-nonZero)
open import Ledger.Prelude.Numeric.UnitInterval using (fromUnitInterval; UnitInterval-*-0≤)

open import Data.Nat.Properties using (+-0-monoid; +-0-commutativeMonoid)
open import Data.List using (filter)

open import Agda.Builtin.FromNat
open import Data.Nat.GeneralisedArithmetic using (iterate)

open import Data.Maybe                      using (fromMaybe)

open import Ledger.Dijkstra.Specification.Certs govStructure
open import Ledger.Dijkstra.Specification.Enact govStructure
open import Ledger.Dijkstra.Specification.Gov govStructure
open import Ledger.Dijkstra.Specification.Ledger txs abs
open import Ledger.Dijkstra.Specification.PoolReap txs abs
open import Ledger.Dijkstra.Specification.Ratify govStructure
open import Ledger.Dijkstra.Specification.Rewards txs abs
open import Ledger.Dijkstra.Specification.Utxo txs abs

open Number number renaming (fromNat to fromℕ)

getOrphans : EnactState → GovState → GovState
getOrphans es govSt = proj₁ $ iterate step ([] , govSt) (length govSt)
  where
    step : GovState × GovState → GovState × GovState
    step (orps , govSt) =
      let
        isOrphan? a prev = ¬? (hasParent? es govSt a prev)
        (orps' , govSt') = partition
          (λ (_ , record {action = a ; prevAction = prev}) → isOrphan? (a .gaType) prev)
          govSt
      in
        (orps ++ orps' , govSt')

getStakeCred : TxOut → Maybe Credential
getStakeCred (a , _ , _ , _) = stakeCred a

open GovActionState using (returnAddr)
-- open RewardAddress using (stake)

PoolDelegatedStake : Type
PoolDelegatedStake = KeyHash ⇀ Coin

record EpochState : Type where
  constructor ⟦_,_,_,_,_⟧ᵉ'
  field
    acnt       : Acnt
    ss         : Snapshots
    ls         : LedgerState
    es         : EnactState
    fut        : RatifyState

record HasEpochState {a} (A : Type a) : Type a where
  field EpochStateOf : A → EpochState
open HasEpochState ⦃...⦄ public

instance
  HasAccount-EpochState : HasAccount EpochState
  HasAccount-EpochState .AccountOf = EpochState.acnt

  HasSnapshots-EpochState : HasSnapshots EpochState
  HasSnapshots-EpochState .SnapshotsOf = EpochState.ss

  HasLedgerState-EpochState : HasLedgerState EpochState
  HasLedgerState-EpochState .LedgerStateOf = EpochState.ls

  HasGovState-EpochState : HasGovState EpochState
  HasGovState-EpochState .GovStateOf = GovStateOf ∘ LedgerStateOf

  HasEnactState-EpochState : HasEnactState EpochState
  HasEnactState-EpochState .EnactStateOf = EpochState.es

  HasDReps-EpochState : HasDReps EpochState
  HasDReps-EpochState .DRepsOf = DRepsOf ∘ CertStateOf ∘ LedgerStateOf

  HasTreasury-EpochState : HasTreasury EpochState
  HasTreasury-EpochState .TreasuryOf = Acnt.treasury ∘ EpochState.acnt

  HasReserves-EpochState : HasReserves EpochState
  HasReserves-EpochState .ReservesOf = Acnt.reserves ∘ EpochState.acnt

  HasPParams-EpochState : HasPParams EpochState
  HasPParams-EpochState .PParamsOf = PParamsOf ∘ EnactStateOf

  HasRatifyState-EpochState : HasRatifyState EpochState
  HasRatifyState-EpochState .RatifyStateOf = EpochState.fut

  HasPState-EpochState : HasPState EpochState
  HasPState-EpochState .PStateOf = PStateOf ∘ CertStateOf ∘ LedgerStateOf

  HasRetiring-EpochState : HasRetiring EpochState
  HasRetiring-EpochState .RetiringOf = RetiringOf ∘ PStateOf

record NewEpochState : Type where
  field
    lastEpoch   : Epoch
    bprev       : BlocksMade
    bcur        : BlocksMade
    epochState  : EpochState
    ru          : Maybe RewardUpdate
    pd          : PoolDelegatedStake

record HasNewEpochState {a} (A : Type a) : Type a where
  field NewEpochStateOf : A → NewEpochState
open HasNewEpochState ⦃...⦄ public

record HasLastEpoch {a} (A : Type a) : Type a where
  field LastEpochOf : A → Epoch
open HasLastEpoch ⦃...⦄ public


instance
  HasLastEpoch-NewEpochState : HasLastEpoch NewEpochState
  HasLastEpoch-NewEpochState .LastEpochOf = NewEpochState.lastEpoch

  HasEpochState-NewEpochState : HasEpochState NewEpochState
  HasEpochState-NewEpochState .EpochStateOf = NewEpochState.epochState

  HasEnactState-NewEpochState : HasEnactState NewEpochState
  HasEnactState-NewEpochState .EnactStateOf = EnactStateOf ∘ EpochStateOf

  Hastreasury-NewEpochState : HasTreasury NewEpochState
  Hastreasury-NewEpochState .TreasuryOf = TreasuryOf ∘ EpochStateOf

  HasLedgerState-NewEpochState : HasLedgerState NewEpochState
  HasLedgerState-NewEpochState .LedgerStateOf = LedgerStateOf ∘ EpochStateOf

  HasGovState-NewEpochState : HasGovState NewEpochState
  HasGovState-NewEpochState .GovStateOf = GovStateOf ∘ LedgerStateOf

  HasCertState-NewEpochState : HasCertState NewEpochState
  HasCertState-NewEpochState .CertStateOf = CertStateOf ∘ LedgerStateOf

  HasDReps-NewEpochState : HasDReps NewEpochState
  HasDReps-NewEpochState .DRepsOf = DRepsOf ∘ CertStateOf

  HasRewards-NewEpochState : HasRewards NewEpochState
  HasRewards-NewEpochState .RewardsOf = RewardsOf ∘ CertStateOf

  HasPParams-NewEpochState : HasPParams NewEpochState
  HasPParams-NewEpochState .PParamsOf = PParamsOf ∘ EpochStateOf

  unquoteDecl HasCast-EpochState HasCast-NewEpochState = derive-HasCast
    ( (quote EpochState     , HasCast-EpochState)
    ∷ [ (quote NewEpochState  , HasCast-NewEpochState)])

opaque
  createRUpd : ℕ → BlocksMade → EpochState → Coin → RewardUpdate
  createRUpd slotsPerEpoch b es total =
    record  { Δt = Δt₁
            ; Δr = 0 - Δr₁ + Δr₂
            ; Δf = 0 - pos feeSS
            ; rs = rs
            ; flowConservation = flowConservation
            ; Δt-nonnegative = Δt-nonneg
            ; Δf-nonpositive = Δf-nonpos
            }
    where
      prevPp : PParams
      prevPp = PParamsOf es

      reserves : Reserves
      reserves = ReservesOf es

      pstakego : Snapshot
      pstakego = (SnapshotsOf es) .Snapshots.go

      feeSS : Fees
      feeSS = FeesOf (SnapshotsOf es)

      stake : Stake
      stake = StakeOf pstakego

      delegs : StakeDelegs
      delegs = StakeDelegsOf pstakego

      poolParams : Pools
      poolParams = PoolsOf pstakego

      blocksMade : ℕ
      blocksMade = ∑[ m ← b ] m

      ρ η τ : ℚ
      ρ = fromUnitInterval (prevPp .PParams.monetaryExpansion)
      η = fromℕ blocksMade ÷₀ (fromℕ slotsPerEpoch * ActiveSlotCoeff)
      τ = fromUnitInterval (prevPp .PParams.treasuryCut)

      Δr₁ rewardPot Δt₁ R : ℤ
      Δr₁ = floor (1 ⊓ η * ρ * fromℕ reserves)
      rewardPot = pos feeSS + Δr₁
      Δt₁ = floor (fromℤ rewardPot * τ)
      R = rewardPot - Δt₁

      circulation : Coin
      circulation = total - reserves

      rs : Rewards
      rs = reward prevPp b (posPart R) poolParams stake delegs circulation

      Δr₂ : ℤ
      Δr₂ = R - pos (∑[ c ← rs ] c)

      -- Proofs
      -- Note: Overloading of + and - seems to interfere with the ring solver.
      lemmaFlow : ∀ (t₁ r₁ f z : ℤ)
        → (t₁ ℤ.+ (0 ℤ.- r₁ ℤ.+ ((f ℤ.+ r₁ ℤ.- t₁) ℤ.- z)) ℤ.+ (0 ℤ.- f) ℤ.+ z) ≡ 0
      lemmaFlow = solve-∀
      flowConservation :
        let t₁ = Δt₁
            r₁ = Δr₁
            f  = pos feeSS
            z  = pos (∑[ c ← rs ] c)
         in
            (t₁ ℤ.+ (0 ℤ.- r₁ ℤ.+ ((f ℤ.+ r₁ ℤ.- t₁) ℤ.- z)) ℤ.+ (0 ℤ.- f) ℤ.+ z) ≡ 0
      flowConservation = lemmaFlow Δt₁ Δr₁ (pos feeSS) (pos (∑[ c ← rs ] c))

      ÷₀-0≤⇒0≤ : ∀ (x y : ℚ) → 0 ≤ x → 0 ≤ y → 0 ≤ (x ÷₀ y)
      ÷₀-0≤⇒0≤ x y 0≤x 0≤y with y ≟ 0
      ... | (yes y≡0) = nonNegative⁻¹ 0
      ... | (no y≢0)  = ÷-0≤⇒0≤ x y {{≢-nonZero y≢0}} 0≤x 0≤y

      η-nonneg : 0 ≤ η
      η-nonneg = ÷₀-0≤⇒0≤ _ _ (fromℕ-0≤ blocksMade)
        (*-0≤⇒0≤ _ _
          (fromℕ-0≤ slotsPerEpoch)
          (nonNegative⁻¹ ActiveSlotCoeff {{pos⇒nonNeg ActiveSlotCoeff}}))

      min1η-nonneg : 0 ≤ 1 ⊓ η
      min1η-nonneg = ⊓-glb (nonNegative⁻¹ 1) η-nonneg

      Δr₁-nonneg : 0 ≤ Δr₁
      Δr₁-nonneg = 0≤⇒0≤floor _
        (*-0≤⇒0≤ (1 ⊓ η * ρ) (fromℕ reserves)
          (UnitInterval-*-0≤ (1 ⊓ η) (prevPp .PParams.monetaryExpansion) min1η-nonneg)
          (fromℕ-0≤ reserves))

      rewardPot-nonneg : 0 ≤ rewardPot
      rewardPot-nonneg = +-mono-≤ (nonNegative⁻¹ℤ (pos feeSS)) Δr₁-nonneg

      Δt-nonneg : 0 ≤ Δt₁
      Δt-nonneg = 0≤⇒0≤floor _
        (UnitInterval-*-0≤ (fromℤ rewardPot) (prevPp .PParams.treasuryCut)
          (fromℤ-0≤ rewardPot rewardPot-nonneg))

      Δf-nonpos : (0 - pos feeSS) ≤ 0
      Δf-nonpos = begin
          0 - pos feeSS ≡⟨ +-identityˡ _ ⟩
          ℤ.- pos feeSS ≤⟨ neg-mono-≤ (ℤ.+≤+ z≤n) ⟩
          0             ∎
        where open ≤-Reasoning

open RewardAddress using (stake)

applyRUpd : RewardUpdate → EpochState → EpochState
applyRUpd rewardUpdate
  $\begin{pmatrix} \begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#10350}{\htmlId{10350}{\htmlClass{Bound}{\text{treasury}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10361}{\htmlId{10361}{\htmlClass{Bound}{\text{reserves}}}}\, \end{pmatrix} \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10375}{\htmlId{10375}{\htmlClass{Bound}{\text{ss}}}}\, \\ \begin{pmatrix} \begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#10384}{\htmlId{10384}{\htmlClass{Bound}{\text{utxo}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10391}{\htmlId{10391}{\htmlClass{Bound}{\text{fees}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10398}{\htmlId{10398}{\htmlClass{Bound}{\text{donations}}}}\, \end{pmatrix} \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10413}{\htmlId{10413}{\htmlClass{Bound}{\text{govSt}}}}\, \\ \begin{pmatrix} \begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#10425}{\htmlId{10425}{\htmlClass{Bound}{\text{voteDelegs}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10438}{\htmlId{10438}{\htmlClass{Bound}{\text{stakeDelegs}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10452}{\htmlId{10452}{\htmlClass{Bound}{\text{rewards}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10462}{\htmlId{10462}{\htmlClass{Bound}{\text{deposits}}}}\, \end{pmatrix} \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10476}{\htmlId{10476}{\htmlClass{Bound}{\text{pState}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10485}{\htmlId{10485}{\htmlClass{Bound}{\text{gState}}}}\, \end{pmatrix} \end{pmatrix} \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10501}{\htmlId{10501}{\htmlClass{Bound}{\text{es}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10506}{\htmlId{10506}{\htmlClass{Bound}{\text{fut}}}}\, \end{pmatrix}$ = $\begin{pmatrix}  \begin{pmatrix} \,\href{Prelude.html#3404}{\htmlId{10521}{\htmlClass{Function}{\text{posPart}}}}\, \,\htmlId{10529}{\htmlClass{Symbol}{\text{(}}}\,\,\href{Ledger.Dijkstra.Specification.Epoch.html#1034}{\htmlId{10530}{\htmlClass{InductiveConstructor}{\text{pos}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#10350}{\htmlId{10534}{\htmlClass{Bound}{\text{treasury}}}}\, \,\href{Class.HasAdd.Core.html#162}{\htmlId{10543}{\htmlClass{Field Operator}{\text{+}}}}\, \,\href{Ledger.Dijkstra.Specification.Rewards.html#6508}{\htmlId{10545}{\htmlClass{Function}{\text{Δt}}}}\, \,\href{Class.HasAdd.Core.html#162}{\htmlId{10548}{\htmlClass{Field Operator}{\text{+}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#1034}{\htmlId{10550}{\htmlClass{InductiveConstructor}{\text{pos}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#10895}{\htmlId{10554}{\htmlClass{Function}{\text{unregRU'}}}}\,\,\htmlId{10562}{\htmlClass{Symbol}{\text{)}}}\, \\ \,\href{Prelude.html#3404}{\htmlId{10566}{\htmlClass{Function}{\text{posPart}}}}\, \,\htmlId{10574}{\htmlClass{Symbol}{\text{(}}}\,\,\href{Ledger.Dijkstra.Specification.Epoch.html#1034}{\htmlId{10575}{\htmlClass{InductiveConstructor}{\text{pos}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#10361}{\htmlId{10579}{\htmlClass{Bound}{\text{reserves}}}}\, \,\href{Class.HasAdd.Core.html#162}{\htmlId{10588}{\htmlClass{Field Operator}{\text{+}}}}\, \,\href{Ledger.Dijkstra.Specification.Rewards.html#6511}{\htmlId{10590}{\htmlClass{Function}{\text{Δr}}}}\,\,\htmlId{10592}{\htmlClass{Symbol}{\text{)}}}\, \end{pmatrix} \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10375}{\htmlId{10598}{\htmlClass{Bound}{\text{ss}}}}\, \\ \begin{pmatrix} \begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#10384}{\htmlId{10607}{\htmlClass{Bound}{\text{utxo}}}}\, \\ \,\href{Prelude.html#3404}{\htmlId{10614}{\htmlClass{Function}{\text{posPart}}}}\, \,\htmlId{10622}{\htmlClass{Symbol}{\text{(}}}\,\,\href{Ledger.Dijkstra.Specification.Epoch.html#1034}{\htmlId{10623}{\htmlClass{InductiveConstructor}{\text{pos}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#10391}{\htmlId{10627}{\htmlClass{Bound}{\text{fees}}}}\, \,\href{Class.HasAdd.Core.html#162}{\htmlId{10632}{\htmlClass{Field Operator}{\text{+}}}}\, \,\href{Ledger.Dijkstra.Specification.Rewards.html#6514}{\htmlId{10634}{\htmlClass{Function}{\text{Δf}}}}\,\,\htmlId{10636}{\htmlClass{Symbol}{\text{)}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10398}{\htmlId{10640}{\htmlClass{Bound}{\text{donations}}}}\, \end{pmatrix} \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10413}{\htmlId{10654}{\htmlClass{Bound}{\text{govSt}}}}\, \\ \begin{pmatrix} \begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#10425}{\htmlId{10666}{\htmlClass{Bound}{\text{voteDelegs}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10438}{\htmlId{10679}{\htmlClass{Bound}{\text{stakeDelegs}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10452}{\htmlId{10693}{\htmlClass{Bound}{\text{rewards}}}}\, \,\href{Axiom.Set.Map.Dec.html#2149}{\htmlId{10701}{\htmlClass{Function Operator}{\text{∪⁺}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#10831}{\htmlId{10704}{\htmlClass{Function}{\text{regRU}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10462}{\htmlId{10712}{\htmlClass{Bound}{\text{deposits}}}}\, \end{pmatrix} \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10476}{\htmlId{10726}{\htmlClass{Bound}{\text{pState}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10485}{\htmlId{10735}{\htmlClass{Bound}{\text{gState}}}}\, \end{pmatrix}  \end{pmatrix} \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10501}{\htmlId{10752}{\htmlClass{Bound}{\text{es}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#10506}{\htmlId{10757}{\htmlClass{Bound}{\text{fut}}}}\, \end{pmatrix}$
  where
  open RewardUpdate rewardUpdate using (Δt; Δr; Δf; rs)
  regRU     = rs ∣ dom rewards
  unregRU   = rs ∣ dom rewards ᶜ
  unregRU'  = ∑[ x ← unregRU ] x

opaque
  calculatePoolDelegatedStake : Snapshot → PoolDelegatedStake
  calculatePoolDelegatedStake ss = sd ∣ dom (ss .pools)
    -- Shelley spec: the output map must contain keys appearing in both
    -- sd and the pool parameters.
    where
      open Snapshot
      -- stake credentials delegating to each pool
      stakeCredentialsPerPool : Rel KeyHash Credential
      stakeCredentialsPerPool = (StakeDelegsOf ss ˢ) ⁻¹ʳ
      -- delegated stake per pool
      sd : KeyHash ⇀ Coin
      sd = aggregate₊ ((stakeCredentialsPerPool ∘ʳ (StakeOf ss ˢ)) ᶠˢ)

  -- In Dijkstra, look up each gov action's deposit from GState.deposits
  -- using the stake credential of the proposal's returnAddr.
  stakeFromGADeposits : GovState → GState → Stake
  stakeFromGADeposits govSt gState =
    aggregateBy
      (mapˢ (λ (gaid , addr) → (gaid , addr) , stake addr) govSt')
      (mapFromPartialFun (λ (_ , addr) → lookupᵐ? (DepositsOf gState) (stake addr)) govSt')
    where
      govSt' : ℙ (GovActionID × RewardAddress)
      govSt' = mapˢ (map₂ returnAddr) (fromList govSt)

module VDelegDelegatedStake
  (currentEpoch : Epoch)
  (utxoSt       : UTxOState)
  (govSt        : GovState)
  (gState       : GState)
  (dState       : DState)
  where
  activeDReps : ℙ Credential
  activeDReps = dom (activeDRepsOf gState currentEpoch)
  activeVDelegs : ℙ VDeleg
  activeVDelegs = mapˢ vDelegCredential activeDReps ∪ ❴ vDelegNoConfidence ❵ ∪ ❴ vDelegAbstain ❵
  stakePerCredential : Credential → Coin
  stakePerCredential c =
      cbalance ((UTxOOf utxoSt) ∣^' λ txout → getStakeCred txout ≡ just c)
    + fromMaybe 0 (lookupᵐ? (stakeFromGADeposits govSt gState) c)  -- ← gState, not utxoSt
    + fromMaybe 0 (lookupᵐ? (RewardsOf dState) c)
  calculate : VDeleg ⇀ Coin
  calculate =
    mapFromFun
      (λ vd → ∑ˢ[ c ← (VoteDelegsOf dState) ⁻¹ vd ] stakePerCredential c)
      activeVDelegs


opaque
  calculateVDelegDelegatedStake : Epoch → UTxOState → GovState → GState → DState → VDeleg ⇀ Coin
  calculateVDelegDelegatedStake = VDelegDelegatedStake.calculate

  -- Pool-delegated stake for voting:
  -- also uses gState instead of utxoSt for gov-action deposit component.
  calculatePoolDelegatedStakeForVoting : Snapshot → GovState → GState → KeyHash ⇀ Coin
  calculatePoolDelegatedStakeForVoting ss govSt gState =
    calculatePoolDelegatedStake ss ∪⁺ (stakeFromDeposits ∣ dom (PoolsOf ss))
    where
    stakeFromDeposits : KeyHash ⇀ Coin
    stakeFromDeposits = aggregate₊ (((StakeDelegsOf ss ˢ) ⁻¹ʳ ∘ʳ (stakeFromGADeposits govSt gState ˢ)) ᶠˢ)

-- mkStakeDistrs no longer takes utxoSt for the deposit lookup,
-- but still takes it for the UTxO-balance part of VDeleg stake.
mkStakeDistrs : Snapshot → Epoch → UTxOState → GovState → GState → DState → StakeDistrs
mkStakeDistrs ss currentEpoch utxoSt govSt gState dState =
  $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#12834}{\htmlId{13765}{\htmlClass{Function}{\text{calculateVDelegDelegatedStake}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#13719}{\htmlId{13795}{\htmlClass{Bound}{\text{currentEpoch}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#13732}{\htmlId{13808}{\htmlClass{Bound}{\text{utxoSt}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#13739}{\htmlId{13815}{\htmlClass{Bound}{\text{govSt}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#13745}{\htmlId{13821}{\htmlClass{Bound}{\text{gState}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#13752}{\htmlId{13828}{\htmlClass{Bound}{\text{dState}}}}\,
  \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#13109}{\htmlId{13839}{\htmlClass{Function}{\text{calculatePoolDelegatedStakeForVoting}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#13716}{\htmlId{13876}{\htmlClass{Bound}{\text{ss}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#13739}{\htmlId{13879}{\htmlClass{Bound}{\text{govSt}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#13745}{\htmlId{13885}{\htmlClass{Bound}{\text{gState}}}}\,   \,\htmlId{13894}{\htmlClass{Comment}{\text{-- ← no utxoSt here}}}\,
  \end{pmatrix}$


private variable
  e lastEpoch : Epoch
  fut fut' : RatifyState
  eps eps' eps'' : EpochState
  ls : LedgerState
  acnt : Acnt
  es₀ : EnactState
  ss ss' : Snapshots
  ru : RewardUpdate
  mru : Maybe RewardUpdate

data _⊢_⇀⦇_,EPOCH⦈_ : ⊤ → EpochState → Epoch → EpochState → Type where

  EPOCH : let
      open LedgerState ls
      open RatifyState fut renaming (es to esW)

      es : EnactState
      es = record esW { withdrawals = ∅ }

      tmpGovSt = filter (λ x → ¿ proj₁ x ∉ mapˢ proj₁ removed ¿) govSt

      orphans : ℙ (GovActionID × GovActionState)
      orphans  = fromList (getOrphans es tmpGovSt)

      removed' : ℙ (GovActionID × GovActionState)
      removed' = removed ∪ orphans

      govSt' = filter (λ x → ¿ proj₁ x ∉ mapˢ proj₁ removed' ¿) govSt

      removedGovActions : ℙ (RewardAddress × Coin)
      removedGovActions =
          mapPartial
            (λ (gaid , gaSt) →
              let ra   = GovActionState.returnAddr gaSt
                  cred = RewardAddress.stake ra
              in  (ra ,_) <$> lookupᵐ? (DepositsOf (GStateOf ls)) cred)
            removed'

      govActionReturns : RewardAddress ⇀ Coin
      govActionReturns =
        aggregate₊ (mapˢ (λ (a , d) → a , d) removedGovActions ᶠˢ)

      trWithdrawals   = WithdrawalsOf esW
      totWithdrawals  = ∑[ x ← trWithdrawals ] x

      retired    = (RetiringOf (PStateOf ls)) ⁻¹ e
      payout     = govActionReturns ∪⁺ trWithdrawals
      refunds    = pullbackMap payout toRewardAddress (dom (RewardsOf (DStateOf ls)))
      unclaimed  = getCoin payout - getCoin refunds

      dState' : DState
      dState' = record (DStateOf ls) { rewards = (RewardsOf (DStateOf ls)) ∪⁺ refunds }

      pState' : PState
      pState' = let ps = PStateOf ls in
        $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Certs.html#3501}{\htmlId{15693}{\htmlClass{Field}{\text{PoolsOf}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#15663}{\htmlId{15701}{\htmlClass{Bound}{\text{ps}}}}\, \,\href{Axiom.Set.Map.html#13606}{\htmlId{15704}{\htmlClass{Function Operator}{\text{∣}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#15271}{\htmlId{15706}{\htmlClass{Bound}{\text{retired}}}}\, \,\href{Axiom.Set.Map.html#13606}{\htmlId{15714}{\htmlClass{Function Operator}{\text{ᶜ}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Certs.html#2695}{\htmlId{15718}{\htmlClass{Field}{\text{PState.fPools}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#15663}{\htmlId{15732}{\htmlClass{Bound}{\text{ps}}}}\, \,\href{Axiom.Set.Map.html#13606}{\htmlId{15735}{\htmlClass{Function Operator}{\text{∣}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#15271}{\htmlId{15737}{\htmlClass{Bound}{\text{retired}}}}\, \,\href{Axiom.Set.Map.html#13606}{\htmlId{15745}{\htmlClass{Function Operator}{\text{ᶜ}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Certs.html#3608}{\htmlId{15749}{\htmlClass{Field}{\text{RetiringOf}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#15663}{\htmlId{15760}{\htmlClass{Bound}{\text{ps}}}}\, \,\href{Axiom.Set.Map.html#13606}{\htmlId{15763}{\htmlClass{Function Operator}{\text{∣}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#15271}{\htmlId{15765}{\htmlClass{Bound}{\text{retired}}}}\, \,\href{Axiom.Set.Map.html#13606}{\htmlId{15773}{\htmlClass{Function Operator}{\text{ᶜ}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Certs.html#3268}{\htmlId{15777}{\htmlClass{Field}{\text{DepositsOf}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#15663}{\htmlId{15788}{\htmlClass{Bound}{\text{ps}}}}\, \,\href{Axiom.Set.Map.html#13606}{\htmlId{15791}{\htmlClass{Function Operator}{\text{∣}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#15271}{\htmlId{15793}{\htmlClass{Bound}{\text{retired}}}}\, \,\href{Axiom.Set.Map.html#13606}{\htmlId{15801}{\htmlClass{Function Operator}{\text{ᶜ}}}}\, \end{pmatrix}$

      gState' : GState
      gState' = $\begin{pmatrix} \,\htmlId{15847}{\htmlClass{Symbol}{\text{(}}}\,\,\href{Class.ToBool.html#342}{\htmlId{15848}{\htmlClass{Function Operator}{\text{if}}}}\, \,\href{Data.List.Base.html#4681}{\htmlId{15851}{\htmlClass{Function}{\text{null}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#14642}{\htmlId{15856}{\htmlClass{Bound}{\text{govSt'}}}}\, \,\href{Class.ToBool.html#342}{\htmlId{15863}{\htmlClass{Function Operator}{\text{then}}}}\, \,\href{Axiom.Set.Map.html#7108}{\htmlId{15868}{\htmlClass{Function}{\text{mapValues}}}}\, \,\htmlId{15878}{\htmlClass{Symbol}{\text{(}}}\,\,\htmlId{15879}{\htmlClass{Number}{\text{1}}}\, \,\href{Class.HasAdd.Core.html#162}{\htmlId{15881}{\htmlClass{Field Operator}{\text{+\_}}}}\,\,\htmlId{15883}{\htmlClass{Symbol}{\text{)}}}\, \,\htmlId{15885}{\htmlClass{Symbol}{\text{(}}}\,\,\href{Ledger.Dijkstra.Specification.Gov.Actions.html#5421}{\htmlId{15886}{\htmlClass{Field}{\text{DRepsOf}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#14016}{\htmlId{15894}{\htmlClass{Generalizable}{\text{ls}}}}\,\,\htmlId{15896}{\htmlClass{Symbol}{\text{)}}}\, \,\href{Class.ToBool.html#342}{\htmlId{15898}{\htmlClass{Function Operator}{\text{else}}}}\, \,\htmlId{15903}{\htmlClass{Symbol}{\text{(}}}\,\,\href{Ledger.Dijkstra.Specification.Gov.Actions.html#5421}{\htmlId{15904}{\htmlClass{Field}{\text{DRepsOf}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#14016}{\htmlId{15912}{\htmlClass{Generalizable}{\text{ls}}}}\,\,\htmlId{15914}{\htmlClass{Symbol}{\text{))}}}\,
                , \,\href{Ledger.Dijkstra.Specification.Certs.html#3385}{\htmlId{15935}{\htmlClass{Field}{\text{CCHotKeysOf}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#14016}{\htmlId{15947}{\htmlClass{Generalizable}{\text{ls}}}}\, \,\href{Axiom.Set.Map.html#13536}{\htmlId{15950}{\htmlClass{Function Operator}{\text{∣}}}}\, \,\href{Ledger.Dijkstra.Specification.Enact.html#1770}{\htmlId{15952}{\htmlClass{Function}{\text{ccCreds}}}}\, \,\htmlId{15960}{\htmlClass{Symbol}{\text{(}}}\,\,\href{Ledger.Dijkstra.Specification.Enact.html#857}{\htmlId{15961}{\htmlClass{Field}{\text{EnactState.cc}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#14318}{\htmlId{15975}{\htmlClass{Bound}{\text{es}}}}\,\,\htmlId{15977}{\htmlClass{Symbol}{\text{)}}}\,
                , \,\href{Ledger.Dijkstra.Specification.Certs.html#3268}{\htmlId{15997}{\htmlClass{Field}{\text{DepositsOf}}}}\, \,\htmlId{16008}{\htmlClass{Symbol}{\text{(}}}\,\,\href{Ledger.Dijkstra.Specification.Certs.html#4284}{\htmlId{16009}{\htmlClass{Field}{\text{GStateOf}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#14016}{\htmlId{16018}{\htmlClass{Generalizable}{\text{ls}}}}\,\,\htmlId{16020}{\htmlClass{Symbol}{\text{)}}}\,
                  \,\htmlId{16040}{\htmlClass{Comment}{\text{-- ∣ mapˢ (RewardAddress.stake ∘ GovActionState.returnAddr ∘ proj₂) removed' ᶜ}}}\,
                \end{pmatrix}$

      certState' : CertState
      certState' = record { dState = dState' ; pState = pState' ; gState = gState' }

      -- utxoSt' = ⟦ utxoSt .utxo , utxoSt .fees , utxoSt .deposits ∣ mapˢ (proj₁ ∘ proj₂) removedGovActions ᶜ , 0 ⟧
      utxoSt' = UTxOStateOf ls

      acnt' = record acnt
        { treasury  = TreasuryOf acnt ∸ totWithdrawals + DonationsOf utxoSt + unclaimed }

      stakeDistrs : StakeDistrs
      stakeDistrs = mkStakeDistrs (Snapshots.mark ss') e utxoSt' govSt' (GStateOf ls) (DStateOf ls)

      ratifyΓ : RatifyEnv
      ratifyΓ = record { stakeDistrs  = stakeDistrs
                       ; currentEpoch = e
                       ; dreps        = DRepsOf ls
                       ; ccHotKeys    = CCHotKeysOf ls
                       ; treasury     = TreasuryOf acnt
                       ; pools        = PoolsOf ls
                       ; delegatees   = VoteDelegsOf ls }

    in
    ∙ ratifyΓ ⊢ $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#14318}{\htmlId{17069}{\htmlClass{Bound}{\text{es}}}}\, \\ \,\href{Class.HasEmptySet.html#287}{\htmlId{17074}{\htmlClass{Field}{\text{∅}}}}\, \\ \,\href{Agda.Builtin.Bool.html#192}{\htmlId{17078}{\htmlClass{InductiveConstructor}{\text{false}}}}\, \end{pmatrix}$ ⇀⦇ govSt' ,RATIFIES⦈ fut'
    ∙ ls ⊢ ss ⇀⦇ tt ,SNAP⦈ ss'
      ────────────────────────────────
      _ ⊢ $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#14035}{\htmlId{17194}{\htmlClass{Generalizable}{\text{acnt}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#14068}{\htmlId{17201}{\htmlClass{Generalizable}{\text{ss}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#14016}{\htmlId{17206}{\htmlClass{Generalizable}{\text{ls}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#14049}{\htmlId{17211}{\htmlClass{Generalizable}{\text{es₀}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#13961}{\htmlId{17217}{\htmlClass{Generalizable}{\text{fut}}}}\, \end{pmatrix}$ ⇀⦇ e ,EPOCH⦈ $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#16408}{\htmlId{17238}{\htmlClass{Bound}{\text{acnt'}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#14071}{\htmlId{17246}{\htmlClass{Generalizable}{\text{ss'}}}}\, \\ \begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#16376}{\htmlId{17254}{\htmlClass{Bound}{\text{utxoSt'}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#14642}{\htmlId{17264}{\htmlClass{Bound}{\text{govSt'}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#16144}{\htmlId{17273}{\htmlClass{Bound}{\text{certState'}}}}\, \end{pmatrix} \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#14318}{\htmlId{17288}{\htmlClass{Bound}{\text{es}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#13965}{\htmlId{17293}{\htmlClass{Generalizable}{\text{fut'}}}}\, \end{pmatrix}$

data _⊢_⇀⦇_,NEWEPOCH⦈_ : ⊤ → NewEpochState → Epoch → NewEpochState → Type where

  NEWEPOCH-New :
    ∀ {bprev bcur : BlocksMade} {pd : PoolDelegatedStake} →
    let
       eps' = applyRUpd ru eps
       ss   = EpochState.ss eps''
       pd'  = calculatePoolDelegatedStake (Snapshots.set ss)
     in
       ∙ e ≡ lastEpoch + 1
       ∙ _ ⊢ eps' ⇀⦇ e ,EPOCH⦈ eps''
       ────────────────────────────────
       _ ⊢ $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#13941}{\htmlId{17718}{\htmlClass{Generalizable}{\text{lastEpoch}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17406}{\htmlId{17730}{\htmlClass{Bound}{\text{bprev}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17412}{\htmlId{17738}{\htmlClass{Bound}{\text{bcur}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#13986}{\htmlId{17745}{\htmlClass{Generalizable}{\text{eps}}}}\, \\ \,\href{Agda.Builtin.Maybe.html#173}{\htmlId{17751}{\htmlClass{InductiveConstructor}{\text{just}}}}\, \,\href{Ledger.Dijkstra.Specification.Epoch.html#14089}{\htmlId{17756}{\htmlClass{Generalizable}{\text{ru}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17432}{\htmlId{17761}{\htmlClass{Bound}{\text{pd}}}}\, \end{pmatrix}$ ⇀⦇ e ,NEWEPOCH⦈ $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#13939}{\htmlId{17784}{\htmlClass{Generalizable}{\text{e}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17412}{\htmlId{17788}{\htmlClass{Bound}{\text{bcur}}}}\, \\ \,\href{Axiom.Set.Map.html#2671}{\htmlId{17795}{\htmlClass{Function}{\text{∅ᵐ}}}}\,  \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#13995}{\htmlId{17801}{\htmlClass{Generalizable}{\text{eps''}}}}\, \\ \,\href{Agda.Builtin.Maybe.html#194}{\htmlId{17809}{\htmlClass{InductiveConstructor}{\text{nothing}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17539}{\htmlId{17819}{\htmlClass{Bound}{\text{pd'}}}}\, \end{pmatrix}$

  NEWEPOCH-Not-New : ∀ {bprev bcur : BlocksMade} {pd : PoolDelegatedStake} →
    ∙ e ≢ lastEpoch + 1
      ────────────────────────────────
      _ ⊢ $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#13941}{\htmlId{17978}{\htmlClass{Generalizable}{\text{lastEpoch}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17850}{\htmlId{17990}{\htmlClass{Bound}{\text{bprev}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17856}{\htmlId{17998}{\htmlClass{Bound}{\text{bcur}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#13986}{\htmlId{18005}{\htmlClass{Generalizable}{\text{eps}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#14109}{\htmlId{18011}{\htmlClass{Generalizable}{\text{mru}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17876}{\htmlId{18017}{\htmlClass{Bound}{\text{pd}}}}\, \end{pmatrix}$ ⇀⦇ e ,NEWEPOCH⦈ $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#13941}{\htmlId{18040}{\htmlClass{Generalizable}{\text{lastEpoch}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17850}{\htmlId{18052}{\htmlClass{Bound}{\text{bprev}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17856}{\htmlId{18060}{\htmlClass{Bound}{\text{bcur}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#13986}{\htmlId{18067}{\htmlClass{Generalizable}{\text{eps}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#14109}{\htmlId{18073}{\htmlClass{Generalizable}{\text{mru}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#17876}{\htmlId{18079}{\htmlClass{Bound}{\text{pd}}}}\, \end{pmatrix}$

  NEWEPOCH-No-Reward-Update :
    ∀ {bprev bcur : BlocksMade} {pd : PoolDelegatedStake} →
    let
      ss  = EpochState.ss eps'
      pd' = calculatePoolDelegatedStake (Snapshots.set ss)
    in
      ∙ e ≡ lastEpoch + 1
      ∙ _ ⊢ eps ⇀⦇ e ,EPOCH⦈ eps'
      ────────────────────────────────
      _ ⊢ $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#13941}{\htmlId{18391}{\htmlClass{Generalizable}{\text{lastEpoch}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#18122}{\htmlId{18403}{\htmlClass{Bound}{\text{bprev}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#18128}{\htmlId{18411}{\htmlClass{Bound}{\text{bcur}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#13986}{\htmlId{18418}{\htmlClass{Generalizable}{\text{eps}}}}\, \\ \,\href{Agda.Builtin.Maybe.html#194}{\htmlId{18424}{\htmlClass{InductiveConstructor}{\text{nothing}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#18148}{\htmlId{18434}{\htmlClass{Bound}{\text{pd}}}}\, \end{pmatrix}$ ⇀⦇ e ,NEWEPOCH⦈ $\begin{pmatrix} \,\href{Ledger.Dijkstra.Specification.Epoch.html#13939}{\htmlId{18457}{\htmlClass{Generalizable}{\text{e}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#18128}{\htmlId{18461}{\htmlClass{Bound}{\text{bcur}}}}\, \\ \,\href{Axiom.Set.Map.html#2671}{\htmlId{18468}{\htmlClass{Function}{\text{∅ᵐ}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#13990}{\htmlId{18473}{\htmlClass{Generalizable}{\text{eps'}}}}\, \\ \,\href{Agda.Builtin.Maybe.html#194}{\htmlId{18480}{\htmlClass{InductiveConstructor}{\text{nothing}}}}\, \\ \,\href{Ledger.Dijkstra.Specification.Epoch.html#18220}{\htmlId{18490}{\htmlClass{Bound}{\text{pd'}}}}\, \end{pmatrix}$