CAD-4157: Stash AVVM to allow on-disk UTxO.

eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs

@@ -164,6 +164,7 @@ instance
       )
       SNothing
       (PoolDistr Map.empty)
+      ()
     where
       initialEpochNo = 0
       initialUtxo = genesisUTxO sg

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs

@@ -70,7 +70,8 @@ instance
           nesBcur = nesBcur nes,
           nesEs = translateEra' ctxt $ nesEs nes,
           nesRu = nesRu nes,
-          nesPd = nesPd nes
+          nesPd = nesPd nes,
+          stashedAVVMAddresses = ()
         }
 
 instance Crypto c => TranslateEra (AlonzoEra c) ShelleyGenesis where

eras/babbage/impl/src/Cardano/Ledger/Babbage.hs

@@ -169,6 +169,7 @@ instance
       )
       SNothing
       (PoolDistr Map.empty)
+      ()
     where
       initialEpochNo = 0
       initialUtxo = genesisUTxO sg

eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs

@@ -71,7 +71,8 @@ instance
           nesBcur = nesBcur nes,
           nesEs = translateEra' ctxt $ nesEs nes,
           nesRu = nesRu nes,
-          nesPd = nesPd nes
+          nesPd = nesPd nes,
+          stashedAVVMAddresses = ()
         }
 
 instance Crypto c => TranslateEra (BabbageEra c) ShelleyGenesis where

eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs

@@ -72,6 +72,7 @@ instance
       )
       SNothing
       (PoolDistr Map.empty)
+      ()
     where
       initialEpochNo = 0
       initialUtxo = genesisUTxO sg

eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs

@@ -44,6 +44,14 @@ import qualified Data.Map.Strict as Map
 -- being total. Do not change it!
 --------------------------------------------------------------------------------
 
+-- | Return the subset of UTxO corresponding to Byron-era AVVM addresses, which
+-- are to be removed on the Shelley/Allegra boundary. This set will be passed
+-- _back_ to the translation functions as the UTxO, allowing these addresses to
+-- be removed. This is needed because we cannot do a full scan on the UTxO at
+-- this point, since it has been persisted to disk.
+shelleyToAllegraAVVMsToDelete :: NewEpochState (ShelleyEra c) -> UTxO (ShelleyEra c)
+shelleyToAllegraAVVMsToDelete = stashedAVVMAddresses
+
 type instance PreviousEra (AllegraEra c) = ShelleyEra c
 
 -- | Currently no context is needed to translate from Shelley to Allegra.
@@ -61,7 +69,11 @@ instance Crypto c => TranslateEra (AllegraEra c) NewEpochState where
           nesBcur = nesBcur nes,
           nesEs = translateEra' ctxt $ LS.returnRedeemAddrsToReserves . nesEs $ nes,
           nesRu = nesRu nes,
-          nesPd = nesPd nes
+          nesPd = nesPd nes,
+          -- At this point, the consensus layer has passed in our stashed AVVM
+          -- addresses as our UTxO, and we have deleted them above (with
+          -- 'returnRedeemAddrsToReserves'), so we may safely discard this map.
+          stashedAVVMAddresses = ()
         }
 
 instance forall c. Crypto c => TranslateEra (AllegraEra c) Tx where

eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs

@@ -65,6 +65,7 @@ instance Crypto c => CanStartFromGenesis (MaryEra c) where
       )
       SNothing
       (PoolDistr Map.empty)
+      ()
     where
       initialEpochNo = 0
       initialUtxo = genesisUTxO sg

eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Translation.hs

@@ -67,7 +67,8 @@ instance Crypto c => TranslateEra (MaryEra c) NewEpochState where
           nesBcur = nesBcur nes,
           nesEs = translateEra' ctxt $ nesEs nes,
           nesRu = nesRu nes,
-          nesPd = nesPd nes
+          nesPd = nesPd nes,
+          stashedAVVMAddresses = ()
         }
 
 instance Crypto c => TranslateEra (MaryEra c) Tx where

eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs

@@ -17,10 +17,12 @@ import qualified Cardano.Chain.Common as Byron
 import qualified Cardano.Chain.UTxO as Byron
 import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Crypto.Hashing as Hashing
+import Cardano.Ledger.Address (isBootstrapRedeemer)
 import Cardano.Ledger.BaseTypes (BlocksMade (..), TxIx (..))
 import Cardano.Ledger.Coin (CompactForm (CompactCoin))
 import Cardano.Ledger.CompactAddress (CompactAddr (UnsafeCompactAddr))
 import qualified Cardano.Ledger.Crypto as CC
+import Cardano.Ledger.Era (getTxOutBootstrapAddress)
 import Cardano.Ledger.SafeHash (unsafeMakeSafeHash)
 import Cardano.Ledger.Shelley (ShelleyEra)
 import Cardano.Ledger.Shelley.API.Types
@@ -99,7 +101,15 @@ translateToShelleyLedgerState genesisShelley epochNo cvs =
       nesBcur = BlocksMade Map.empty,
       nesEs = epochState,
       nesRu = SNothing,
-      nesPd = PoolDistr Map.empty
+      nesPd = PoolDistr Map.empty,
+      -- At this point, we compute the stashed AVVM addresses, while we are able
+      -- to do a linear scan of the UTxO, and stash them away for use at the
+      -- Shelley/Allegra boundary.
+      stashedAVVMAddresses =
+        let UTxO utxo = _utxo . lsUTxOState . esLState $ epochState
+            redeemers =
+              SplitMap.filter (maybe False isBootstrapRedeemer . getTxOutBootstrapAddress) utxo
+         in UTxO redeemers
     }
   where
     pparams :: PParams (ShelleyEra c)

eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs

@@ -79,6 +79,7 @@ instance
       )
       SNothing
       (PoolDistr Map.empty)
+      (UTxO mempty)
     where
       initialEpochNo = 0
       initialUtxo = genesisUTxO sg

eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs

@@ -13,10 +13,12 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 -- |
@@ -83,7 +85,9 @@ module Cardano.Ledger.Shelley.LedgerState
     startStep,
     pulseStep,
     completeStep,
-    NewEpochState (..),
+    NewEpochState (NewEpochState, nesEL, nesEs, nesRu, nesPd, nesBprev, nesBcur),
+    StashedAVVMAddresses,
+    stashedAVVMAddresses,
     getGKeys,
     updateNES,
     circulation,
@@ -138,6 +142,7 @@ import Cardano.Ledger.Keys
 import Cardano.Ledger.PoolDistr (PoolDistr (..))
 import Cardano.Ledger.SafeHash (HashAnnotated)
 import Cardano.Ledger.Serialization (decodeRecordNamedT, mapFromCBOR, mapToCBOR)
+import Cardano.Ledger.Shelley (ShelleyEra)
 import Cardano.Ledger.Shelley.Address.Bootstrap
   ( BootstrapWitness (..),
     bootstrapWitKeyHash,
@@ -723,31 +728,50 @@ data NewEpochState era = NewEpochState
     -- | Possible reward update
     nesRu :: !(StrictMaybe (PulsingRewUpdate (Crypto era))),
     -- | Stake distribution within the stake pool
-    nesPd :: !(PoolDistr (Crypto era))
+    nesPd :: !(PoolDistr (Crypto era)),
+    -- | AVVM addresses to be removed at the end of the Shelley era. Note that
+    -- the existence of this field is a hack, related to the transition of UTxO
+    -- to disk. We remove AVVM addresses from the UTxO on the Shelley/Allegra
+    -- boundary. However, by this point the UTxO will be moved to disk, and
+    -- hence doing a scan of the UTxO for AVVM addresses will be expensive. Our
+    -- solution to this is to do a scan of the UTxO on the Byron/Shelley
+    -- boundary (since Byron UTxO are still on disk), stash the results here,
+    -- and then remove them at the Shelley/Allegra boundary.
+    --
+    -- This is very much an awkward implementation hack, and hence we hide it
+    -- from as many places as possible.
+    stashedAVVMAddresses :: !(StashedAVVMAddresses era)
   }
   deriving (Generic)
 
+type family StashedAVVMAddresses era where
+  StashedAVVMAddresses (ShelleyEra c) = UTxO (ShelleyEra c)
+  StashedAVVMAddresses _ = ()
+
 deriving stock instance
   ( CC.Crypto (Crypto era),
     Show (Core.TxOut era),
     Show (Core.PParams era),
-    Show (State (Core.EraRule "PPUP" era))
+    Show (State (Core.EraRule "PPUP" era)),
+    Show (StashedAVVMAddresses era)
   ) =>
   Show (NewEpochState era)
 
 deriving stock instance
   ( CC.Crypto (Crypto era),
     Eq (Core.TxOut era),
     Eq (Core.PParams era),
-    Eq (State (Core.EraRule "PPUP" era))
+    Eq (State (Core.EraRule "PPUP" era)),
+    Eq (StashedAVVMAddresses era)
   ) =>
   Eq (NewEpochState era)
 
 instance
   ( Era era,
     NFData (Core.TxOut era),
     NFData (Core.PParams era),
-    NFData (State (Core.EraRule "PPUP" era))
+    NFData (State (Core.EraRule "PPUP" era)),
+    NFData (StashedAVVMAddresses era)
   ) =>
   NFData (NewEpochState era)
 
@@ -757,6 +781,7 @@ instance
     NoThunks (Core.PParams era),
     NoThunks (State (Core.EraRule "PPUP" era)),
     NoThunks (Core.Value era),
+    NoThunks (StashedAVVMAddresses era),
     ToCBOR (Core.TxBody era),
     ToCBOR (Core.TxOut era),
     ToCBOR (Core.Value era)
@@ -767,22 +792,29 @@ instance
   ( Era era,
     ToCBOR (Core.TxOut era),
     ToCBOR (Core.PParams era),
-    ToCBOR (State (Core.EraRule "PPUP" era))
+    ToCBOR (State (Core.EraRule "PPUP" era)),
+    ToCBOR (StashedAVVMAddresses era)
   ) =>
   ToCBOR (NewEpochState era)
   where
-  toCBOR (NewEpochState e bp bc es ru pd) =
-    encodeListLen 6 <> toCBOR e <> toCBOR bp <> toCBOR bc <> toCBOR es
+  toCBOR (NewEpochState e bp bc es ru pd av) =
+    encodeListLen 7
+      <> toCBOR e
+      <> toCBOR bp
+      <> toCBOR bc
+      <> toCBOR es
       <> toCBOR ru
       <> toCBOR pd
+      <> toCBOR av
 
 instance
   ( Era era,
     FromCBOR (Core.PParams era),
     FromSharedCBOR (Core.TxOut era),
     Share (Core.TxOut era) ~ Interns (Credential 'Staking (Crypto era)),
     FromCBOR (Core.Value era),
-    FromCBOR (State (Core.EraRule "PPUP" era))
+    FromCBOR (State (Core.EraRule "PPUP" era)),
+    FromCBOR (StashedAVVMAddresses era)
   ) =>
   FromCBOR (NewEpochState era)
   where
@@ -795,13 +827,14 @@ instance
         <! From
         <! From
         <! From
+        <! From
 
 getGKeys ::
   NewEpochState era ->
   Set (KeyHash 'Genesis (Crypto era))
 getGKeys nes = Map.keysSet genDelegs
   where
-    NewEpochState _ _ _ es _ _ = nes
+    NewEpochState _ _ _ es _ _ _ = nes
     EpochState _ _ ls _ _ _ = es
     LedgerState _ (DPState (DState _ _ (GenDelegs genDelegs) _) _) = ls
 
@@ -1632,17 +1665,21 @@ updateNES ::
   LedgerState era ->
   NewEpochState era
 updateNES
-  ( NewEpochState
-      eL
-      bprev
-      _
-      (EpochState acnt ss _ pr pp nm)
-      ru
-      pd
-    )
+  oldNes@( NewEpochState
+             _eL
+             _bprev
+             _
+             (EpochState acnt ss _ pr pp nm)
+             _ru
+             _pd
+             _avvm
+           )
   bcur
   ls =
-    NewEpochState eL bprev bcur (EpochState acnt ss ls pr pp nm) ru pd
+    oldNes
+      { nesBcur = bcur,
+        nesEs = EpochState acnt ss ls pr pp nm
+      }
 
 returnRedeemAddrsToReserves ::
   forall era.

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs

@@ -98,7 +98,8 @@ instance
     Default (EpochState era),
     HasField "_protocolVersion" (Core.PParams era) ProtVer,
     Default (State (Core.EraRule "PPUP" era)),
-    Default (Core.PParams era)
+    Default (Core.PParams era),
+    Default (StashedAVVMAddresses era)
   ) =>
   STS (NEWEPOCH era)
   where
@@ -121,6 +122,7 @@ instance
           def
           SNothing
           (PoolDistr Map.empty)
+          def
     ]
 
   transitionRules = [newEpochTransition]
@@ -141,13 +143,14 @@ newEpochTransition ::
     UsesValue era,
     Default (State (Core.EraRule "PPUP" era)),
     Default (Core.PParams era),
+    Default (StashedAVVMAddresses era),
     Event (Core.EraRule "RUPD" era) ~ RupdEvent (Crypto era)
   ) =>
   TransitionRule (NEWEPOCH era)
 newEpochTransition = do
   TRC
     ( _,
-      src@(NewEpochState (EpochNo eL) _ bcur es ru _pd),
+      src@(NewEpochState (EpochNo eL) _ bcur es ru _pd _),
       e@(EpochNo e_)
       ) <-
     judgmentContext
@@ -175,13 +178,14 @@ newEpochTransition = do
       let EpochState _acnt ss _ls _pr _ _ = es'''
           pd' = calculatePoolDistr (_pstakeSet ss)
       pure $
-        NewEpochState
-          e
-          bcur
-          (BlocksMade Map.empty)
-          es'''
-          SNothing
-          pd'
+        src
+          { nesEL = e,
+            nesBprev = bcur,
+            nesBcur = BlocksMade mempty,
+            nesEs = es''',
+            nesRu = SNothing,
+            nesPd = pd'
+          }
 
 -- | tell a RupdEvent as a DeltaRewardEvent only if the map is non-empty
 tellReward :: (Event (Core.EraRule "RUPD" era) ~ RupdEvent (Crypto era)) => NewEpochEvent era -> Rule (NEWEPOCH era) rtype ()

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs

@@ -179,7 +179,7 @@ bheadTransition ::
   ) =>
   TransitionRule (TICK era)
 bheadTransition = do
-  TRC ((), nes@(NewEpochState _ bprev _ es _ _), slot) <-
+  TRC ((), nes@(NewEpochState _ bprev _ es _ _ _), slot) <-
     judgmentContext
 
   nes' <- validatingTickTransition @TICK nes slot

eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs

@@ -89,6 +89,7 @@ import Data.Coders (decodeSplitMap, encodeSplitMap)
 import Data.Coerce (coerce)
 import qualified Data.Compact.SplitMap as SplitMap
 import Data.Constraint (Constraint)
+import Data.Default.Class (Default)
 import Data.Foldable (foldMap', toList)
 import Data.Kind (Type)
 import Data.Map.Strict (Map)
@@ -108,7 +109,7 @@ import Quiet
 
 -- | The unspent transaction outputs.
 newtype UTxO era = UTxO {unUTxO :: SplitMap.SplitMap (TxIn (Crypto era)) (Core.TxOut era)}
-  deriving (Generic, Semigroup)
+  deriving (Default, Generic, Semigroup)
 
 type TransUTxO (c :: Type -> Constraint) era = (c (Core.TxOut era), TransTxId c era)