[ADP-3344] Add currentPParams to NetworkLayer. (#4819)

This pull request changes the `NetworkLayer` to retrieve era-indexed
protocol parameters.

In particular, this pull request removes the field
`currentProtocolParametersInRecentEras` from `NetworkLayer` and adds a
field `currentPParams` instead.

This pull request also refactors the local state query for
`currentProtocolParameters` to use a conversion on top of `PParams era`
instead of trying to mingle conversion and query.

### Issue Number

ADP-3344

cabal.project

@@ -157,8 +157,8 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/cardano-foundation/cardano-wallet-agda
-    tag: 6de42514a16ed2c059fc9899d9bcc271ce842a95
-    --sha256: 05yqr5vpzckcrcpfvypgy5cbim2xdgixcky30mls74mmd64q2p3s
+    tag: 20b263d494ee91d2f353e2645c045f728d7eb076
+    --sha256: 1j8mph2frsxqwq5ajsfhg0ixwxrs73dls34kbf0s0gh0y1gchvkb
     subdir:
       lib/customer-deposit-wallet-pure
       lib/cardano-wallet-read

lib/benchmarks/exe/api-bench.hs

@@ -200,9 +200,6 @@ import qualified Cardano.Wallet.DB.Layer as Sqlite
 import qualified Cardano.Wallet.Primitive.Types.UTxOStatistics as UTxOStatistics
 import qualified Cardano.Wallet.Read as Read
 import qualified Cardano.Wallet.Transaction as Tx
-import qualified Cardano.Write.Eras as Write
-    ( MaybeInRecentEra (InRecentEraBabbage)
-    )
 import qualified Data.Aeson as Aeson
 import Data.Functor
     ( (<&>)
@@ -620,9 +617,11 @@ mockNetworkLayer :: NetworkLayer IO Read.ConsensusBlock
 mockNetworkLayer = dummyNetworkLayer
     { timeInterpreter = hoistTimeInterpreter liftIO mockTimeInterpreter
     , currentSlottingParameters = pure dummySlottingParameters
+    , currentPParams = pure $ Read.EraValue
+        ( Read.PParams dummyLedgerProtocolParameters
+            :: Read.PParams Read.Babbage
+        )
     , currentProtocolParameters = pure dummyProtocolParameters
-    , currentProtocolParametersInRecentEras =
-        pure $ Write.InRecentEraBabbage dummyLedgerProtocolParameters
     , currentNodeEra = pure $ Cardano.anyCardanoEra Cardano.BabbageEra
     , currentNodeTip = pure Read.BlockTip
         { Read.slotNo = Read.SlotNo 123456789

lib/customer-deposit-wallet/customer-deposit-wallet.cabal

@@ -161,6 +161,7 @@ library rest
     , crypto-primitives
     , customer-deposit-wallet
     , customer-deposit-wallet-pure
+    , deepseq
     , delta-store
     , directory
     , filepath

lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST.hs

@@ -86,6 +86,9 @@ import Codec.Serialise
     ( deserialise
     , serialise
     )
+import Control.DeepSeq
+    ( deepseq
+    )
 import Control.Monad.IO.Class
     ( MonadIO (..)
     )
@@ -332,8 +335,8 @@ initXPubWallet tr bootEnv dir xpub users = do
                         xpub
                         users
                     $ \i -> do
-                        ls <- WalletIO.listCustomers i
-                        last ls `seq` f i
+                        addresses <- map snd <$> WalletIO.listCustomers i
+                        addresses `deepseq` f i
             Nothing ->
                 pure
                     $ Left

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/API/TxHistory/Mock.hs

@@ -24,14 +24,13 @@ import Cardano.Wallet.Deposit.Pure.API.TxHistory
     )
 import Cardano.Wallet.Deposit.Read
     ( Address
-    , Value
-    , WithOrigin (..)
     )
 import Cardano.Wallet.Read
     ( Coin
     , SlotNo (..)
     , TxId
     , Value (..)
+    , WithOrigin (..)
     , txIdFromHash
     )
 import Cardano.Wallet.Read.Hash
@@ -125,7 +124,7 @@ valueTransferG g = do
     spentOrReceived <- uniformRM (0, 11) g
     spent <- createSpent g spentOrReceived
     received <- createReceived g spentOrReceived
-    pure $ ValueTransfer{..}
+    pure $ ValueTransferC{..}
 
 unsafeMkTxId :: String -> TxId
 unsafeMkTxId = txIdFromHash . fromJust . hashFromStringAsHex

lib/network-layer/src/Cardano/Wallet/Network.hs

@@ -130,13 +130,14 @@ data NetworkLayer m block = NetworkLayer
     , currentNodeEra
         :: m AnyCardanoEra
     -- ^ Get the era the node is currently in.
+    , currentPParams
+        :: m (Read.EraValue Read.PParams)
+    -- ^ Get the last known protocol parameters. In principle, these can
+    -- only change once per epoch.
     , currentProtocolParameters
         :: m ProtocolParameters
     -- ^ Get the last known protocol parameters. In principle, these can
     -- only change once per epoch.
-    , currentProtocolParametersInRecentEras
-        :: m (MaybeInRecentEra Write.PParams)
-    -- ^ Get the last known protocol parameters for recent eras.
     , currentSlottingParameters
         :: m SlottingParameters
     -- ^ Get the last known slotting parameters. In principle, these can

lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs

@@ -392,7 +392,6 @@ import qualified Data.ByteString as BS
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
-import qualified Internal.Cardano.Write.Tx as Write
 import qualified Ouroboros.Consensus.Cardano.Block as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger.Mempool as Consensus
 
@@ -430,7 +429,7 @@ withNetworkLayer tr pipeliningStrategy np conn ver tol action = do
 
 -- | Network parameters and protocol parameters for the node's current tip.
 data NetworkParams = NetworkParams
-    { protocolParams :: MaybeInRecentEra Write.PParams
+    { protocolParams :: Read.EraValue Read.PParams
     , protocolParamsLegacy :: ProtocolParameters
     , slottingParamsLegacy :: SlottingParameters
     }
@@ -514,11 +513,11 @@ withNodeNetworkLayerBase
                     readCurrentNodeEra
                 , watchNodeTip =
                     _watchNodeTip readNodeTip
+                , currentPParams =
+                    protocolParams <$> atomically (readTMVar networkParamsVar)
                 , currentProtocolParameters =
                     protocolParamsLegacy
                         <$> atomically (readTMVar networkParamsVar)
-                , currentProtocolParametersInRecentEras =
-                    protocolParams <$> atomically (readTMVar networkParamsVar)
                 , currentSlottingParameters =
                     slottingParamsLegacy
                         <$> atomically (readTMVar networkParamsVar)

lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/Extra.hs

@@ -11,6 +11,7 @@
 module Cardano.Wallet.Network.LocalStateQuery.Extra
     ( byronOrShelleyBased
     , onAnyEra
+    , onAnyEra'
     , shelleyBased
     , currentEra
     ) where
@@ -24,6 +25,15 @@ import Cardano.Api
 import Cardano.Wallet.Network.Implementation.Ouroboros
     ( LSQ (..)
     )
+import Cardano.Wallet.Read
+    ( Allegra
+    , Alonzo
+    , Babbage
+    , Byron
+    , Conway
+    , Mary
+    , Shelley
+    )
 import Ouroboros.Consensus.Cardano
     ( CardanoBlock
     )
@@ -55,6 +65,7 @@ import Ouroboros.Consensus.Shelley.Eras
     , StandardShelley
     )
 
+import qualified Cardano.Wallet.Read as Read
 import qualified Ouroboros.Consensus.Byron.Ledger as Byron
 import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
 
@@ -83,6 +94,26 @@ byronOrShelleyBased onByron onShelleyBased =
         onShelleyBased
         onShelleyBased
 
+-- | Combine era-specific local state queries into an era-agnostic one.
+onAnyEra'
+    :: LSQ Byron.ByronBlock m (f Byron)
+    -> LSQ (Shelley.ShelleyBlock (TPraos StandardCrypto) Shelley) m (f Shelley)
+    -> LSQ (Shelley.ShelleyBlock (TPraos StandardCrypto) Allegra) m (f Allegra)
+    -> LSQ (Shelley.ShelleyBlock (TPraos StandardCrypto) Mary) m (f Mary)
+    -> LSQ (Shelley.ShelleyBlock (TPraos StandardCrypto) Alonzo) m (f Alonzo)
+    -> LSQ (Shelley.ShelleyBlock (Praos StandardCrypto) Babbage) m (f Babbage)
+    -> LSQ (Shelley.ShelleyBlock (Praos StandardCrypto) Conway) m (f Conway)
+    -> LSQ (CardanoBlock StandardCrypto) m (Read.EraValue f)
+onAnyEra' a b c d e f g =
+    onAnyEra
+        (Read.EraValue <$> a)
+        (Read.EraValue <$> b)
+        (Read.EraValue <$> c)
+        (Read.EraValue <$> d)
+        (Read.EraValue <$> e)
+        (Read.EraValue <$> f)
+        (Read.EraValue <$> g)
+
 -- | Create a local state query specific to the each era.
 --
 -- This combinator treats @MismatchEraInfo@ as impossible, which is true if the

lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/PParams.hs

@@ -18,19 +18,13 @@ import Cardano.Wallet.Network.Implementation.Ouroboros
     )
 import Cardano.Wallet.Network.LocalStateQuery.Extra
     ( byronOrShelleyBased
-    , onAnyEra
+    , onAnyEra'
     )
-import Cardano.Wallet.Primitive.Ledger.Byron
-    ( protocolParametersFromUpdateState
+import Cardano.Wallet.Primitive.Ledger.Read.PParams
+    ( primitiveProtocolParameters
     )
 import Cardano.Wallet.Primitive.Ledger.Shelley
-    ( fromAllegraPParams
-    , fromAlonzoPParams
-    , fromBabbagePParams
-    , fromConwayPParams
-    , fromMaryPParams
-    , fromShelleyPParams
-    , slottingParametersFromGenesis
+    ( slottingParametersFromGenesis
     )
 import Cardano.Wallet.Primitive.Types.EraInfo
     ( EraInfo (..)
@@ -44,9 +38,6 @@ import Cardano.Wallet.Primitive.Types.ProtocolParameters
 import Cardano.Wallet.Primitive.Types.SlottingParameters
     ( SlottingParameters
     )
-import Cardano.Write.Eras
-    ( MaybeInRecentEra (..)
-    )
 import Ouroboros.Consensus.Cardano
     ( CardanoBlock
     )
@@ -63,7 +54,10 @@ import Ouroboros.Consensus.Shelley.Ledger.Config
     ( getCompactGenesis
     )
 
-import qualified Internal.Cardano.Write.Tx as Write
+import qualified Cardano.Chain.Update.Validation.Interface as Byron
+    ( adoptedProtocolParameters
+    )
+import qualified Cardano.Wallet.Read as Read
 import qualified Ouroboros.Consensus.Byron.Ledger as Byron
 import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
 
@@ -72,16 +66,18 @@ import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
 ------------------------------------------------------------------------------}
 type LSQ' m = LSQ (CardanoBlock StandardCrypto) m
 
-protocolParams :: LSQ' m (MaybeInRecentEra Write.PParams)
+protocolParams :: LSQ' m (Read.EraValue Read.PParams)
 protocolParams =
-    onAnyEra
-        (pure InNonRecentEraByron)
-        (pure InNonRecentEraShelley)
-        (pure InNonRecentEraAllegra)
-        (pure InNonRecentEraMary)
-        (pure InNonRecentEraAlonzo)
-        (InRecentEraBabbage <$> LSQry Shelley.GetCurrentPParams)
-        (InRecentEraConway <$> LSQry Shelley.GetCurrentPParams)
+    onAnyEra'
+        (fromByron <$> LSQry Byron.GetUpdateInterfaceState)
+        (Read.PParams <$> LSQry Shelley.GetCurrentPParams)
+        (Read.PParams <$> LSQry Shelley.GetCurrentPParams)
+        (Read.PParams <$> LSQry Shelley.GetCurrentPParams)
+        (Read.PParams <$> LSQry Shelley.GetCurrentPParams)
+        (Read.PParams <$> LSQry Shelley.GetCurrentPParams)
+        (Read.PParams <$> LSQry Shelley.GetCurrentPParams)
+  where
+    fromByron = Read.PParams . Byron.adoptedProtocolParameters
 
 slottingParamsLegacy :: NetworkParameters -> LSQ' m SlottingParameters
 slottingParamsLegacy np =
@@ -102,25 +98,5 @@ protocolParamsLegacy = do
             <*> LSQry (QueryAnytimeAlonzo GetEraStart)
             <*> LSQry (QueryAnytimeBabbage GetEraStart)
 
-    onAnyEra
-        ( protocolParametersFromUpdateState eraBounds
-            <$> LSQry Byron.GetUpdateInterfaceState
-        )
-        ( fromShelleyPParams eraBounds
-            <$> LSQry Shelley.GetCurrentPParams
-        )
-        ( fromAllegraPParams eraBounds
-            <$> LSQry Shelley.GetCurrentPParams
-        )
-        ( fromMaryPParams eraBounds
-            <$> LSQry Shelley.GetCurrentPParams
-        )
-        ( fromAlonzoPParams eraBounds
-            <$> LSQry Shelley.GetCurrentPParams
-        )
-        ( fromBabbagePParams eraBounds
-            <$> LSQry Shelley.GetCurrentPParams
-        )
-        ( fromConwayPParams eraBounds
-            <$> LSQry Shelley.GetCurrentPParams
-        )
+    Read.EraValue pparams <- protocolParams
+    pure $ primitiveProtocolParameters eraBounds pparams

lib/primitive/cardano-wallet-primitive.cabal

@@ -121,6 +121,7 @@ library
     Cardano.Wallet.Primitive.Ledger.Read.Block
     Cardano.Wallet.Primitive.Ledger.Read.Block.Header
     Cardano.Wallet.Primitive.Ledger.Read.Eras
+    Cardano.Wallet.Primitive.Ledger.Read.PParams
     Cardano.Wallet.Primitive.Ledger.Read.Tx
     Cardano.Wallet.Primitive.Ledger.Read.Tx.TxExtended
     Cardano.Wallet.Primitive.Ledger.Read.Tx.Features.Certificates

lib/primitive/lib/Cardano/Wallet/Primitive/Ledger/Byron.hs

@@ -28,7 +28,7 @@ module Cardano.Wallet.Primitive.Ledger.Byron
     , fromProtocolMagicId
     , fromByronTxIn
     , fromByronTxOut
-    , protocolParametersFromUpdateState
+    , protocolParametersFromPP
     ) where
 
 import Prelude
@@ -99,7 +99,6 @@ import Ouroboros.Network.Block
     )
 
 import qualified Cardano.Chain.Update as Update
-import qualified Cardano.Chain.Update.Validation.Interface as Update
 import qualified Cardano.Crypto.Hashing as CC
 import qualified Cardano.Slotting.Slot as Slotting
 import qualified Cardano.Wallet.Primitive.Slotting as W
@@ -294,6 +293,8 @@ fromMaxSize :: Natural -> Quantity "byte" Word16
 fromMaxSize =
     Quantity . fromIntegral
 
+-- | Extract the protocol parameters relevant to the wallet
+-- from the Byron 'ProtocolParameters'.
 protocolParametersFromPP
     :: W.EraInfo Bound
     -> Update.ProtocolParameters
@@ -320,15 +321,6 @@ protocolParametersFromPP eraInfo pp =
     fromBound (Bound _relTime _slotNo (O.EpochNo e)) =
         W.EpochNo $ fromIntegral e
 
--- | Extract the protocol parameters relevant to the wallet out of the
---   cardano-chain update state record.
-protocolParametersFromUpdateState
-    :: W.EraInfo Bound
-    -> Update.State
-    -> W.ProtocolParameters
-protocolParametersFromUpdateState b =
-    (protocolParametersFromPP b) . Update.adoptedProtocolParameters
-
 -- | Convert non AVVM balances to genesis UTxO.
 fromNonAvvmBalances :: GenesisNonAvvmBalances -> [W.TxOut]
 fromNonAvvmBalances (GenesisNonAvvmBalances m) =