Merge #2387

2387: Refresh and use era parameters using latest era genesis.  r=KtorZ a=KtorZ

# Issue Number

<!-- Put here a reference to the issue this PR relates to and which requirements it tackles -->

ADP-609

# Overview

<!-- Detail in a few bullet points the work accomplished in this PR -->

- 9a9f6a8
  📍 **rework management of genesis, protocol and slotting parameters**
    This commit introduces a few changes:

  1. It drops all the unused protocol parameters from the 'Checkpoint'
     table. This requires however a non-trivial database migration which
     is yet to be written.

  2. It moves the blockchain start time and genesis hash in the 'Wallet'
    table instead of the 'Checkpoint' table, since those don't change,
    they need not to be repeated in each checkpoint.

  3. It removes 'epochStability' from the 'GenesisParameters' and
     instead, adds 'securityParam' to the 'SlottingParameters'.
     'GenesisParameters' are now only referring to the 'Byron' genesis
     parameters used at the very beginning of the blockchain, whereas
     'SlottingParameters' are tied to each era.

  4. It renames 'getProtocolParameters' to 'currentProtocolParameters'
     in the network layer for consistency with other functions from the
     network layer.

  5. It moves and rename 'getSlottingParametersForTip' to the network
     layer as 'currentSlottingParameters' such that this can be
     implemented correctly in the network layer using the LSQ protocol
     and the 'GetGenesisConfig' query now available.

  6. It adjusts the block restoration loop to use the latest slotting
     parameters (instead of the Byron's genesis ones) and changes the
     checkpoint stability window to `3k` (the stability window is `3k/f`
     slots, but our checkpoint pruning operates on blocks, so `3k`).

- 6f4e9c3
  📍 **implement 'currentSlottingParameters' in the cardano-node's Network layer.**
  
- fb4b6d2
  📍 **add database migration for protocol parameters drop and associated unit test**
    This isn't an easy migration for there's no 'remove column' command available in SQLite. So instead, we have to re-create the table without the column we want and copy back all the previous checkpoints in the new table.

# Comments

<!-- Additional comments or screenshots to attach if any -->

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: KtorZ <matthias.benkort@gmail.com>

lib/core-integration/src/Test/Integration/Framework/DSL.hs

@@ -54,6 +54,7 @@ module Test.Integration.Framework.DSL
     -- * Constants
     , minUTxOValue
     , slotLengthValue
+    , securityParameterValue
     , epochLengthValue
     , defaultTxTTL
 
@@ -583,8 +584,16 @@ minUTxOValue :: Natural
 minUTxOValue = 1_000_000
 
 -- | Parameter in test cluster genesis.
+--
+-- FIXME: Adding this line to create a merge-conflict with #2391 to remind
+-- whoever resolving this merge conflict to also update the newly introduced
+-- 'securityParameterValue'. Cheers.
 slotLengthValue :: NominalDiffTime
-slotLengthValue = 0.2
+slotLengthValue =  0.2
+
+-- | Parameter in test cluster genesis.
+securityParameterValue :: Word32
+securityParameterValue = 10
 
 -- | Parameter in test cluster genesis.
 epochLengthValue :: Word32
@@ -2216,10 +2225,12 @@ getSlotParams ctx = do
     let (Quantity slotL) = getFromResponse #slotLength r2
     let (Quantity epochL) = getFromResponse #epochLength r2
     let (Quantity coeff) = getFromResponse #activeSlotCoefficient r2
+    let (Quantity k) = getFromResponse #securityParameter r2
     let sp = SlottingParameters
             (SlotLength slotL)
             (EpochLength epochL)
             (ActiveSlotCoefficient coeff)
+            (Quantity k)
 
     return (currentEpoch, sp)
 

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Network.hs

@@ -29,6 +29,7 @@ import Test.Integration.Framework.DSL
     , expectResponseCode
     , minUTxOValue
     , request
+    , securityParameterValue
     , slotLengthValue
     , verify
     )
@@ -53,8 +54,6 @@ spec = describe "SHELLEY_NETWORK" $ do
             , expectField #hardforkAt (`shouldNotBe` Nothing)
             , expectField #slotLength (`shouldBe` Quantity slotLengthValue)
             , expectField #epochLength (`shouldBe` Quantity epochLengthValue)
-            -- TODO: ADP-554 query activeSlotCoefficient from ledger
-            -- This value is hardcoded for mainnet (1.0 = 100%).
-            -- The integration test cluster value is (0.5 = 50%).
-            , expectField #activeSlotCoefficient (`shouldBe` Quantity 100.0)
+            , expectField #securityParameter (`shouldBe` Quantity securityParameterValue)
+            , expectField #activeSlotCoefficient (`shouldBe` Quantity 50.0)
             ]

lib/core/src/Cardano/Wallet.hs

@@ -274,7 +274,6 @@ import Cardano.Wallet.Primitive.Model
     ( Wallet
     , applyBlocks
     , availableUTxO
-    , blockchainParameters
     , currentTip
     , getState
     , initWallet
@@ -309,6 +308,7 @@ import Cardano.Wallet.Primitive.Types
     , ProtocolParameters (..)
     , Range (..)
     , Signature (..)
+    , SlottingParameters (..)
     , SortOrder (..)
     , WalletDelegation (..)
     , WalletDelegationStatus (..)
@@ -595,7 +595,7 @@ createWallet
     -> s
     -> ExceptT ErrWalletAlreadyExists IO WalletId
 createWallet ctx wid wname s = db & \DBLayer{..} -> do
-    let (hist, cp) = initWallet block0 gp s
+    let (hist, cp) = initWallet block0 s
     now <- lift getCurrentTime
     let meta = WalletMetadata
             { name = wname
@@ -604,7 +604,7 @@ createWallet ctx wid wname s = db & \DBLayer{..} -> do
             , delegation = WalletDelegation NotDelegating []
             }
     mapExceptT atomically $
-        initializeWallet (PrimaryKey wid) cp meta hist pp $> wid
+        initializeWallet (PrimaryKey wid) cp meta hist gp pp $> wid
   where
     db = ctx ^. dbLayer @s @k
     (block0, NetworkParameters gp _sp pp, _) = ctx ^. genesisData
@@ -631,7 +631,7 @@ createIcarusWallet
 createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do
     let s = mkSeqStateFromRootXPrv @n credentials purposeBIP44 $
             mkUnboundedAddressPoolGap 10000
-    let (hist, cp) = initWallet block0 gp s
+    let (hist, cp) = initWallet block0 s
     let addrs = map (view #address) . concatMap (view #outputs . fst) $ hist
     let g  = defaultAddressPoolGap
     let s' = Seq.SeqState
@@ -650,7 +650,7 @@ createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do
             }
     let pk = PrimaryKey wid
     mapExceptT atomically $
-        initializeWallet pk (updateState s' cp) meta hist pp $> wid
+        initializeWallet pk (updateState s' cp) meta hist gp pp $> wid
   where
     db = ctx ^. dbLayer @s @k
     (block0, NetworkParameters gp _sp pp, _) = ctx ^. genesisData
@@ -663,12 +663,13 @@ checkWalletIntegrity
     -> GenesisParameters
     -> ExceptT ErrCheckWalletIntegrity IO ()
 checkWalletIntegrity ctx wid gp = db & \DBLayer{..} -> mapExceptT atomically $ do
-    cp <- withExceptT ErrCheckWalletIntegrityNoSuchWallet $ withNoSuchWallet wid $
-        readCheckpoint (PrimaryKey wid)
-    whenDifferentGenesis (blockchainParameters cp) gp $ throwE $
+    gp' <- withExceptT ErrCheckWalletIntegrityNoSuchWallet $ withNoSuchWallet wid $
+        readGenesisParameters (PrimaryKey wid)
+
+    whenDifferentGenesis gp gp $ throwE $
         ErrCheckIntegrityDifferentGenesis
             (getGenesisBlockHash gp)
-            (getGenesisBlockHash (blockchainParameters cp))
+            (getGenesisBlockHash gp')
   where
     db = ctx ^. dbLayer @s @k
     whenDifferentGenesis bp1 bp2 = when $
@@ -835,10 +836,10 @@ restoreBlocks
     :: forall ctx s k.
         ( HasLogger WalletLog ctx
         , HasDBLayer s k ctx
+        , HasNetworkLayer ctx
         , HasGenesisData ctx
         , IsOurs s Address
         , IsOurs s RewardAccount
-        , HasNetworkLayer ctx
         )
     => ctx
     -> WalletId
@@ -848,7 +849,7 @@ restoreBlocks
 restoreBlocks ctx wid blocks nodeTip = db & \DBLayer{..} -> mapExceptT atomically $ do
     cp   <- withNoSuchWallet wid (readCheckpoint $ PrimaryKey wid)
     meta <- withNoSuchWallet wid (readWalletMeta $ PrimaryKey wid)
-    let gp = blockchainParameters cp
+    sp   <- liftIO $ currentSlottingParameters nl
 
     unless (cp `isParentOf` NE.head blocks) $ fail $ T.unpack $ T.unwords
         [ "restoreBlocks: given chain isn't a valid continuation."
@@ -866,7 +867,7 @@ restoreBlocks ctx wid blocks nodeTip = db & \DBLayer{..} -> mapExceptT atomicall
             , cert <- certs
             ]
     let txs = fold $ view #transactions <$> filteredBlocks
-    let k = gp ^. #getEpochStability
+    let epochStability = (3*) <$> getSecurityParameter sp
     let localTip = currentTip $ NE.last cps
 
     putTxHistory (PrimaryKey wid) txs
@@ -890,7 +891,7 @@ restoreBlocks ctx wid blocks nodeTip = db & \DBLayer{..} -> mapExceptT atomicall
                 -- Rollback may still occur during this short period, but
                 -- rolling back from a few hundred blocks is relatively fast
                 -- anyway.
-                cfg = (defaultSparseCheckpointsConfig k) { edgeSize = 0 }
+                cfg = (defaultSparseCheckpointsConfig epochStability) { edgeSize = 0 }
 
     forM_ (NE.init cps) $ \cp' -> do
         let (Quantity h) = currentTip cp' ^. #blockHeight
@@ -901,7 +902,7 @@ restoreBlocks ctx wid blocks nodeTip = db & \DBLayer{..} -> mapExceptT atomicall
     liftIO $ logCheckpoint (NE.last cps)
     putCheckpoint (PrimaryKey wid) (NE.last cps)
 
-    prune (PrimaryKey wid)
+    prune (PrimaryKey wid) epochStability
 
     liftIO $ do
         progress <- walletSyncProgress @ctx @s ctx (NE.last cps)
@@ -912,6 +913,7 @@ restoreBlocks ctx wid blocks nodeTip = db & \DBLayer{..} -> mapExceptT atomicall
         traceWith tr $ MsgBlocks blocks
         traceWith tr $ MsgDiscoveredTxsContent txs
   where
+    nl = ctx ^. networkLayer
     db = ctx ^. dbLayer @s @k
     tr = ctx ^. logger @WalletLog
 

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -1778,8 +1778,8 @@ getNetworkParameters
     -> NetworkLayer IO Block
     -> Handler ApiNetworkParameters
 getNetworkParameters (_block0, genesisNp, _st) nl = do
-    pp <- liftIO $ NW.getProtocolParameters nl
-    sp <- liftIO $ NW.getSlottingParametersForTip nl
+    pp <- liftIO $ NW.currentProtocolParameters nl
+    sp <- liftIO $ NW.currentSlottingParameters nl
     let (apiNetworkParams, epochNoM) = toApiNetworkParameters genesisNp
             { protocolParameters = pp, slottingParameters = sp }
     case epochNoM of

lib/core/src/Cardano/Wallet/Api/Types.hs

@@ -702,7 +702,7 @@ data ApiNetworkParameters = ApiNetworkParameters
     , blockchainStartTime :: !(ApiT StartTime)
     , slotLength :: !(Quantity "second" NominalDiffTime)
     , epochLength :: !(Quantity "slot" Word32)
-    , epochStability :: !(Quantity "block" Word32)
+    , securityParameter :: !(Quantity "block" Word32)
     , activeSlotCoefficient :: !(Quantity "percent" Double)
     , decentralizationLevel :: !(Quantity "percent" Percentage)
     , desiredPoolNumber :: !Word16
@@ -720,7 +720,7 @@ toApiNetworkParameters (NetworkParameters gp sp pp) = (np, view #hardforkEpochNo
         , blockchainStartTime = ApiT $ getGenesisBlockDate gp
         , slotLength = Quantity $ unSlotLength $ getSlotLength sp
         , epochLength = Quantity $ unEpochLength $ getEpochLength sp
-        , epochStability = getEpochStability gp
+        , securityParameter = getSecurityParameter sp
         , activeSlotCoefficient = Quantity
             $ (*100)
             $ unActiveSlotCoefficient

lib/core/src/Cardano/Wallet/DB.hs

@@ -43,6 +43,7 @@ import Cardano.Wallet.Primitive.Model
 import Cardano.Wallet.Primitive.Types
     ( BlockHeader
     , DelegationCertificate
+    , GenesisParameters
     , ProtocolParameters
     , Range (..)
     , SlotNo (..)
@@ -121,6 +122,7 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
         -> Wallet s
         -> WalletMetadata
         -> [(Tx, TxMeta)]
+        -> GenesisParameters
         -> ProtocolParameters
         -> ExceptT ErrWalletAlreadyExists stm ()
         -- ^ Initialize a database entry for a given wallet. 'putCheckpoint',
@@ -283,6 +285,11 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
         -> stm (Maybe ProtocolParameters)
         -- ^ Read the previously stored node tip protocol parameters.
 
+    , readGenesisParameters
+        :: PrimaryKey WalletId
+        -> stm (Maybe GenesisParameters)
+        -- ^ Read the *Byron* genesis parameters.
+
     , rollbackTo
         :: PrimaryKey WalletId
         -> SlotNo
@@ -296,8 +303,12 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
 
     , prune
         :: PrimaryKey WalletId
+        -> Quantity "block" Word32
         -> ExceptT ErrNoSuchWallet stm ()
         -- ^ Prune database entities and remove entities that can be discarded.
+        --
+        -- The second argument represents the stability window, or said
+        -- length of the deepest rollback.
 
     , atomically
         :: forall a. stm a -> m a

lib/core/src/Cardano/Wallet/DB/MVar.hs

@@ -46,6 +46,7 @@ import Cardano.Wallet.DB.Model
     , mPutWalletMeta
     , mReadCheckpoint
     , mReadDelegationRewardBalance
+    , mReadGenesisParameters
     , mReadPrivateKey
     , mReadProtocolParameters
     , mReadTxHistory
@@ -91,9 +92,9 @@ newDBLayer timeInterpreter = do
                                       Wallets
         -----------------------------------------------------------------------}
 
-        { initializeWallet = \pk cp meta txs txp -> ExceptT $ do
+        { initializeWallet = \pk cp meta txs gp txp -> ExceptT $ do
             cp `deepseq` meta `deepseq`
-                alterDB errWalletAlreadyExists db (mInitializeWallet pk cp meta txs txp)
+                alterDB errWalletAlreadyExists db (mInitializeWallet pk cp meta txs gp txp)
 
         , removeWallet = ExceptT . alterDB errNoSuchWallet db . mRemoveWallet
 
@@ -113,7 +114,7 @@ newDBLayer timeInterpreter = do
         , rollbackTo = \pk pt -> ExceptT $
             alterDB errNoSuchWallet db (mRollbackTo pk pt)
 
-        , prune = \_ -> error "MVar.prune: not implemented"
+        , prune = \_ _ -> error "MVar.prune: not implemented"
 
         {-----------------------------------------------------------------------
                                    Wallet Metadata
@@ -194,6 +195,8 @@ newDBLayer timeInterpreter = do
 
         , readProtocolParameters = readDB db . mReadProtocolParameters
 
+        , readGenesisParameters = readDB db . mReadGenesisParameters
+
         {-----------------------------------------------------------------------
                                  Delegation Rewards
         -----------------------------------------------------------------------}

lib/core/src/Cardano/Wallet/DB/Model.hs

@@ -59,6 +59,7 @@ module Cardano.Wallet.DB.Model
     , mReadPrivateKey
     , mPutProtocolParameters
     , mReadProtocolParameters
+    , mReadGenesisParameters
     , mPutDelegationRewardBalance
     , mReadDelegationRewardBalance
     , mCheckWallet
@@ -74,6 +75,7 @@ import Cardano.Wallet.Primitive.Types
     ( BlockHeader (blockHeight, slotNo)
     , DelegationCertificate (..)
     , EpochNo (..)
+    , GenesisParameters (..)
     , PoolId
     , ProtocolParameters (..)
     , Range (..)
@@ -157,6 +159,7 @@ data WalletDatabase s xprv = WalletDatabase
     , metadata :: !WalletMetadata
     , txHistory :: !(Map (Hash "Tx") TxMeta)
     , xprv :: !(Maybe xprv)
+    , genesisParameters :: !GenesisParameters
     , protocolParameters :: !ProtocolParameters
     , rewardAccountBalance :: !(Quantity "lovelace" Word64)
     } deriving (Show, Eq, Generic)
@@ -204,9 +207,10 @@ mInitializeWallet
     -> Wallet s
     -> WalletMetadata
     -> TxHistory
+    -> GenesisParameters
     -> ProtocolParameters
     -> ModelOp wid s xprv ()
-mInitializeWallet wid cp meta txs0 pp db@Database{wallets,txs}
+mInitializeWallet wid cp meta txs0 gp pp db@Database{wallets,txs}
     | wid `Map.member` wallets = (Left (WalletAlreadyExists wid), db)
     | otherwise =
         let
@@ -217,6 +221,7 @@ mInitializeWallet wid cp meta txs0 pp db@Database{wallets,txs}
                 , metadata = meta
                 , txHistory = history
                 , xprv = Nothing
+                , genesisParameters = gp
                 , protocolParameters = pp
                 , rewardAccountBalance = minBound
                 }
@@ -488,6 +493,11 @@ mReadProtocolParameters
 mReadProtocolParameters wid db@(Database wallets _) =
     (Right (protocolParameters <$> Map.lookup wid wallets), db)
 
+mReadGenesisParameters
+    :: Ord wid => wid -> ModelOp wid s xprv (Maybe GenesisParameters)
+mReadGenesisParameters wid db@(Database wallets _) =
+    (Right (genesisParameters <$> Map.lookup wid wallets), db)
+
 mPutDelegationRewardBalance
     :: Ord wid => wid -> Quantity "lovelace" Word64 -> ModelOp wid s xprv ()
 mPutDelegationRewardBalance wid amt = alterModel wid $ \wal ->