From 4f8c4ca52b1b4b403bd66723510b2fc5d08adcca Mon Sep 17 00:00:00 2001 From: Rupert Horlick Date: Wed, 13 Jun 2018 09:20:21 -0700 Subject: [PATCH] [CDEC-369] Remove HasProtocolConstants in favour of parameters --- cardano-sl-wallet-new.cabal | 1 + server/Main.hs | 47 +++++++++++-------- src/Cardano/Wallet/API/V0/Handlers.hs | 8 ++-- src/Cardano/Wallet/API/V1/LegacyHandlers.hs | 10 ++-- .../API/V1/LegacyHandlers/Transactions.hs | 31 ++++++------ .../Wallet/API/V1/LegacyHandlers/Wallets.hs | 17 +++---- src/Cardano/Wallet/Kernel/Mode.hs | 16 +++---- src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs | 32 ++++++------- src/Cardano/Wallet/Kernel/Restore.hs | 8 ++-- src/Cardano/Wallet/LegacyServer.hs | 10 ++-- src/Cardano/Wallet/Server/Plugins.hs | 19 ++++---- .../Wallet/WalletLayer/Kernel/Transactions.hs | 6 +-- test/MarshallingSpec.hs | 15 +++--- test/WalletHandlersSpec.hs | 23 ++++----- test/unit/UTxO/Context.hs | 14 +++--- test/unit/UTxO/Interpreter.hs | 19 ++++---- test/unit/UTxO/Translate.hs | 27 +++++------ test/unit/UTxO/Verify.hs | 33 +++++++------ 18 files changed, 164 insertions(+), 172 deletions(-) diff --git a/cardano-sl-wallet-new.cabal b/cardano-sl-wallet-new.cabal index 01365e9c972..f6164c3b641 100755 --- a/cardano-sl-wallet-new.cabal +++ b/cardano-sl-wallet-new.cabal @@ -496,6 +496,7 @@ test-suite wallet-unit-tests , cardano-sl-core , cardano-sl-core-test , cardano-sl-crypto + , cardano-sl-crypto-test , cardano-sl-db , cardano-sl-networking , cardano-sl-util diff --git a/server/Main.hs b/server/Main.hs index 2a311aa7fcf..b69f9bacfbb 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -16,9 +16,8 @@ import Pos.Chain.Ssc (SscParams) import Pos.Chain.Txp (TxpConfiguration) import qualified Pos.Client.CLI as CLI import Pos.Context (ncUserSecret) -import Pos.Core (Config (..), epochSlots) +import Pos.Core as Core (Config (..), configBlkSecurityParam) import Pos.Core.Genesis (GeneratedSecrets) -import Pos.Crypto (ProtocolMagic) import Pos.DB.DB (initNodeDBs) import Pos.DB.Txp (txpGlobalSettings) import Pos.Infra.Diffusion.Types (Diffusion) @@ -66,22 +65,25 @@ defaultLoggerName = "node" -- | The "workhorse" responsible for starting a Cardano edge node plus a number of extra plugins. actionWithWallet :: (HasConfigurations, HasCompileInfo) - => ProtocolMagic + => Core.Config -> TxpConfiguration -> SscParams -> NodeParams -> NtpConfiguration -> WalletBackendParams -> IO () -actionWithWallet pm txpConfig sscParams nodeParams ntpConfig wArgs@WalletBackendParams {..} = +actionWithWallet coreConfig txpConfig sscParams nodeParams ntpConfig wArgs@WalletBackendParams {..} = bracketWalletWebDB (walletDbPath walletDbOptions) (walletRebuildDb walletDbOptions) $ \db -> bracketWalletWS $ \conn -> - bracketNodeResources nodeParams sscParams - (txpGlobalSettings pm txpConfig) - (initNodeDBs pm epochSlots) $ \nr@NodeResources {..} -> do + bracketNodeResources + (configBlkSecurityParam coreConfig) + nodeParams + sscParams + (txpGlobalSettings (configProtocolMagic coreConfig) txpConfig) + (initNodeDBs coreConfig) $ \nr@NodeResources {..} -> do syncQueue <- liftIO newTQueueIO ntpStatus <- withNtpClient (ntpClientSettings ntpConfig) - runWRealMode pm txpConfig db conn syncQueue nr (mainAction ntpStatus nr) + runWRealMode coreConfig txpConfig db conn syncQueue nr (mainAction ntpStatus nr) where mainAction ntpStatus = runNodeWithInit ntpStatus $ do when (walletFlushDb walletDbOptions) $ do @@ -96,7 +98,7 @@ actionWithWallet pm txpConfig sscParams nodeParams ntpConfig wArgs@WalletBackend runNodeWithInit ntpStatus init' nr diffusion = do _ <- init' - runNode pm txpConfig nr (plugins ntpStatus) diffusion + runNode coreConfig txpConfig nr (plugins ntpStatus) diffusion syncWallets :: WalletWebMode () syncWallets = do @@ -107,40 +109,45 @@ actionWithWallet pm txpConfig sscParams nodeParams ntpConfig wArgs@WalletBackend plugins :: TVar NtpStatus -> Plugins.Plugin WalletWebMode plugins ntpStatus = mconcat [ Plugins.conversation wArgs - , Plugins.legacyWalletBackend pm txpConfig wArgs ntpStatus + , Plugins.legacyWalletBackend coreConfig txpConfig wArgs ntpStatus , Plugins.walletDocumentation wArgs , Plugins.acidCleanupWorker wArgs - , Plugins.syncWalletWorker - , Plugins.resubmitterPlugin pm txpConfig + , Plugins.syncWalletWorker (configBlkSecurityParam coreConfig) + , Plugins.resubmitterPlugin coreConfig txpConfig , Plugins.notifierPlugin ] actionWithNewWallet :: (HasConfigurations, HasCompileInfo) - => ProtocolMagic + => Core.Config -> TxpConfiguration -> SscParams -> NodeParams -> NtpConfiguration -> NewWalletBackendParams -> IO () -actionWithNewWallet pm txpConfig sscParams nodeParams ntpConfig params = +actionWithNewWallet coreConfig txpConfig sscParams nodeParams ntpConfig params = bracketNodeResources + (configBlkSecurityParam coreConfig) nodeParams sscParams (txpGlobalSettings pm txpConfig) - (initNodeDBs pm epochSlots) $ \nr -> do + (initNodeDBs coreConfig) $ \nr -> do ntpStatus <- withNtpClient (ntpClientSettings ntpConfig) userSecret <- readTVarIO (ncUserSecret $ nrContext nr) - let nodeState = NodeStateAdaptor.newNodeStateAdaptor nr ntpStatus + let nodeState = NodeStateAdaptor.newNodeStateAdaptor + (configProtocolConstants coreConfig) + nr + ntpStatus liftIO $ Keystore.bracketLegacyKeystore userSecret $ \keystore -> do WalletLayer.Kernel.bracketPassiveWallet logMessage' keystore nodeState $ \walletLayer passiveWallet -> do Kernel.init passiveWallet - Kernel.Mode.runWalletMode pm + Kernel.Mode.runWalletMode coreConfig txpConfig nr walletLayer (mainAction (walletLayer, passiveWallet) nr) where + pm = configProtocolMagic coreConfig mainAction :: (PassiveWalletLayer IO, PassiveWallet) -> NodeResources ext @@ -151,7 +158,7 @@ actionWithNewWallet pm txpConfig sscParams nodeParams ntpConfig params = :: (PassiveWalletLayer IO, PassiveWallet) -> NodeResources ext -> (Diffusion Kernel.Mode.WalletMode -> Kernel.Mode.WalletMode ()) - runNodeWithInit w nr = runNode pm txpConfig nr (plugins w) + runNodeWithInit w nr = runNode coreConfig txpConfig nr (plugins w) -- TODO: Don't know if we need any of the other plugins that are used -- in the legacy wallet (see 'actionWithWallet'). @@ -180,14 +187,14 @@ startEdgeNode wso = ntpConfig case wsoWalletBackendParams wso of WalletLegacy legacyParams -> actionWithWallet - (configProtocolMagic coreConfig) + coreConfig txpConfig sscParams nodeParams ntpConfig legacyParams WalletNew newParams -> actionWithNewWallet - (configProtocolMagic coreConfig) + coreConfig txpConfig sscParams nodeParams diff --git a/src/Cardano/Wallet/API/V0/Handlers.hs b/src/Cardano/Wallet/API/V0/Handlers.hs index a5b8dd8f005..f0a5472cbc6 100644 --- a/src/Cardano/Wallet/API/V0/Handlers.hs +++ b/src/Cardano/Wallet/API/V0/Handlers.hs @@ -4,7 +4,7 @@ module Cardano.Wallet.API.V0.Handlers where import qualified Cardano.Wallet.API.V0 as V0 import Ntp.Client (NtpStatus) import Pos.Chain.Txp (TxpConfiguration) -import Pos.Crypto (ProtocolMagic) +import Pos.Core as Core (Config) import Pos.Infra.Diffusion.Types (Diffusion (sendTx)) import Pos.Util.CompileInfo (HasCompileInfo) import Pos.Wallet.Web.Mode (MonadFullWalletWebMode) @@ -20,12 +20,12 @@ import Universum -- a Servant's @Handler@, I can give you back a "plain old" Server. handlers :: ( MonadFullWalletWebMode ctx m, HasCompileInfo ) => (forall a. m a -> Handler a) - -> ProtocolMagic + -> Core.Config -> TxpConfiguration -> Diffusion m -> TVar NtpStatus -> Server V0.API -handlers naturalTransformation pm txpConfig diffusion ntpStatus = hoistServer +handlers naturalTransformation coreConfig txpConfig diffusion ntpStatus = hoistServer (Proxy @V0.API) naturalTransformation - (V0.servantHandlers pm txpConfig ntpStatus (sendTx diffusion)) + (V0.servantHandlers coreConfig txpConfig ntpStatus (sendTx diffusion)) diff --git a/src/Cardano/Wallet/API/V1/LegacyHandlers.hs b/src/Cardano/Wallet/API/V1/LegacyHandlers.hs index c7294299c7b..980d791f7e3 100644 --- a/src/Cardano/Wallet/API/V1/LegacyHandlers.hs +++ b/src/Cardano/Wallet/API/V1/LegacyHandlers.hs @@ -11,7 +11,7 @@ import Universum import Ntp.Client (NtpStatus) import Pos.Chain.Txp (TxpConfiguration) -import Pos.Crypto (ProtocolMagic) +import Pos.Core as Core (Config, configBlkSecurityParam) import Pos.Infra.Diffusion.Types (Diffusion (sendTx)) import qualified Cardano.Wallet.API.V1 as V1 @@ -41,16 +41,16 @@ handlers :: ( HasConfigurations , HasCompileInfo ) => (forall a. MonadV1 a -> Handler a) - -> ProtocolMagic + -> Core.Config -> TxpConfiguration -> Diffusion MonadV1 -> TVar NtpStatus -> Server V1.API -handlers naturalTransformation pm txpConfig diffusion ntpStatus = +handlers naturalTransformation coreConfig txpConfig diffusion ntpStatus = hoist' (Proxy @Addresses.API) Addresses.handlers - :<|> hoist' (Proxy @Wallets.API) Wallets.handlers + :<|> hoist' (Proxy @Wallets.API) (Wallets.handlers $ configBlkSecurityParam coreConfig) :<|> hoist' (Proxy @Accounts.API) Accounts.handlers - :<|> hoist' (Proxy @Transactions.API) (Transactions.handlers pm txpConfig sendTx') + :<|> hoist' (Proxy @Transactions.API) (Transactions.handlers coreConfig txpConfig sendTx') :<|> hoist' (Proxy @Settings.API) Settings.handlers :<|> hoist' (Proxy @Info.API) (Info.handlers diffusion ntpStatus) where diff --git a/src/Cardano/Wallet/API/V1/LegacyHandlers/Transactions.hs b/src/Cardano/Wallet/API/V1/LegacyHandlers/Transactions.hs index 5526ec30df5..647088af388 100644 --- a/src/Cardano/Wallet/API/V1/LegacyHandlers/Transactions.hs +++ b/src/Cardano/Wallet/API/V1/LegacyHandlers/Transactions.hs @@ -11,7 +11,6 @@ import Pos.Client.Txp.Util (defaultInputSelectionPolicy) import qualified Pos.Client.Txp.Util as V0 import qualified Pos.Core as Core import Pos.Core.Txp (TxAux) -import Pos.Crypto (ProtocolMagic) import qualified Pos.Util.Servant as V0 import qualified Pos.Wallet.WalletMode as V0 import qualified Pos.Wallet.Web.ClientTypes.Types as V0 @@ -60,25 +59,25 @@ convertTxError err = case err of handlers :: HasConfigurations - => ProtocolMagic + => Core.Config -> TxpConfiguration -> (TxAux -> MonadV1 Bool) -> ServerT Transactions.API MonadV1 -handlers pm txpConfig submitTx = - newTransaction pm txpConfig submitTx +handlers coreConfig txpConfig submitTx = + newTransaction coreConfig txpConfig submitTx :<|> allTransactions - :<|> estimateFees pm - :<|> redeemAda pm txpConfig submitTx + :<|> estimateFees coreConfig + :<|> redeemAda coreConfig txpConfig submitTx newTransaction :: forall ctx m . (V0.MonadWalletTxFull ctx m) - => ProtocolMagic + => Core.Config -> TxpConfiguration -> (TxAux -> m Bool) -> Payment -> m (WalletResponse Transaction) -newTransaction pm txpConfig submitTx Payment {..} = do +newTransaction coreConfig txpConfig submitTx Payment {..} = do ws <- V0.askWalletSnapshot sourceWallet <- migrate (psWalletId pmtSource) @@ -101,7 +100,7 @@ newTransaction pm txpConfig submitTx Payment {..} = do addrCoinList <- migrate $ NE.toList pmtDestinations let (V1 policy) = fromMaybe (V1 defaultInputSelectionPolicy) pmtGroupingPolicy let batchPayment = V0.NewBatchPayment cAccountId addrCoinList policy - cTx <- V0.newPaymentBatch pm txpConfig submitTx spendingPw batchPayment + cTx <- V0.newPaymentBatch coreConfig txpConfig submitTx spendingPw batchPayment single <$> migrate cTx @@ -146,17 +145,17 @@ allTransactions mwalletId mAccIdx mAddr requestParams fops sops = estimateFees :: (MonadThrow m, V0.MonadFees ctx m) - => ProtocolMagic + => Core.Config -> Payment -> m (WalletResponse EstimatedFees) -estimateFees pm Payment{..} = do +estimateFees coreConfig Payment{..} = do ws <- V0.askWalletSnapshot let (V1 policy) = fromMaybe (V1 defaultInputSelectionPolicy) pmtGroupingPolicy pendingAddrs = V0.getPendingAddresses ws policy cAccountId <- migrate pmtSource utxo <- V0.getMoneySourceUtxo ws (V0.AccountMoneySource cAccountId) outputs <- V0.coinDistrToOutputs =<< mapM migrate pmtDestinations - efee <- V0.runTxCreator policy (V0.computeTxFee pm pendingAddrs utxo outputs) + efee <- V0.runTxCreator policy (V0.computeTxFee coreConfig pendingAddrs utxo outputs) case efee of Right fee -> single <$> migrate fee @@ -165,12 +164,12 @@ estimateFees pm Payment{..} = do redeemAda :: HasConfigurations - => ProtocolMagic + => Core.Config -> TxpConfiguration -> (TxAux -> MonadV1 Bool) -> Redemption -> MonadV1 (WalletResponse Transaction) -redeemAda pm txpConfig submitTx r = do +redeemAda coreConfig txpConfig submitTx r = do let ShieldedRedemptionCode seed = redemptionRedemptionCode r V1 spendingPassword = redemptionSpendingPassword r walletId = redemptionWalletId r @@ -185,10 +184,10 @@ redeemAda pm txpConfig submitTx r = do , V0.pvSeed = seed , V0.pvBackupPhrase = phrase } - V0.redeemAdaPaperVend pm txpConfig submitTx spendingPassword cpaperRedeem + V0.redeemAdaPaperVend coreConfig txpConfig submitTx spendingPassword cpaperRedeem Nothing -> do let cwalletRedeem = V0.CWalletRedeem { V0.crWalletId = caccountId , V0.crSeed = seed } - V0.redeemAda pm txpConfig submitTx spendingPassword cwalletRedeem + V0.redeemAda coreConfig txpConfig submitTx spendingPassword cwalletRedeem diff --git a/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs b/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs index 07e17339681..58690b2eea2 100644 --- a/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs +++ b/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs @@ -36,8 +36,8 @@ import Servant -- | All the @Servant@ handlers for wallet-specific operations. handlers :: HasConfigurations - => ServerT Wallets.API MonadV1 -handlers = newWallet + => Core.BlockCount -> ServerT Wallets.API MonadV1 +handlers k = newWallet k :<|> listWallets :<|> updatePassword :<|> deleteWallet @@ -55,14 +55,14 @@ handlers = newWallet -- or are struggling to keep up. Therefore we consider a node to be \"synced -- enough\" with the blockchain if we are not lagging more than @k@ slots, where -- @k@ comes from the 'blkSecurityParam'. -isNodeSufficientlySynced :: Core.HasProtocolConstants => V0.SyncProgress -> Bool -isNodeSufficientlySynced spV0 = +isNodeSufficientlySynced :: Core.BlockCount -> V0.SyncProgress -> Bool +isNodeSufficientlySynced k spV0 = let blockchainHeight = fromMaybe (Core.BlockCount maxBound) (Core.getChainDifficulty <$> V0._spNetworkCD spV0) localHeight = Core.getChainDifficulty . V0._spLocalCD $ spV0 remainingBlocks = blockchainHeight - localHeight - in remainingBlocks <= Core.blkSecurityParam + in remainingBlocks <= k -- | Creates a new or restores an existing @wallet@ given a 'NewWallet' payload. -- Returns to the client the representation of the created or restored @@ -74,16 +74,17 @@ newWallet , V0.MonadBlockchainInfo m , HasLens SyncQueue ctx SyncQueue ) - => NewWallet + => Core.BlockCount + -> NewWallet -> m (WalletResponse Wallet) -newWallet NewWallet{..} = do +newWallet k NewWallet{..} = do spV0 <- V0.syncProgress syncPercentage <- migrate spV0 -- Do not allow creation or restoration of wallets if the underlying node -- is still catching up. - unless (isNodeSufficientlySynced spV0) $ throwM (NodeIsStillSyncing syncPercentage) + unless (isNodeSufficientlySynced k spV0) $ throwM (NodeIsStillSyncing syncPercentage) let newWalletHandler CreateWallet = V0.newWalletNoThrow newWalletHandler RestoreWallet = V0.restoreWalletFromSeedNoThrow diff --git a/src/Cardano/Wallet/Kernel/Mode.hs b/src/Cardano/Wallet/Kernel/Mode.hs index a41e038b950..be88cece173 100644 --- a/src/Cardano/Wallet/Kernel/Mode.hs +++ b/src/Cardano/Wallet/Kernel/Mode.hs @@ -14,7 +14,7 @@ import Universum import Pos.Chain.Block import Pos.Chain.Txp import Pos.Context -import Pos.Core +import Pos.Core as Core (Config, HasConfiguration) import Pos.Core.Chrono import Pos.Core.JsonLog (CanJsonLog (..)) import Pos.Core.Reporting (HasMisbehaviorMetrics (..)) @@ -81,22 +81,22 @@ walletRollbackBlocks w bs = do return mempty instance MonadBListener WalletMode where - onApplyBlocks bs = getWallet >>= (`walletApplyBlocks` bs) - onRollbackBlocks bs = getWallet >>= (`walletRollbackBlocks` bs) + onApplyBlocks bs = getWallet >>= (`walletApplyBlocks` bs) + onRollbackBlocks _ bs = getWallet >>= (`walletRollbackBlocks` bs) {------------------------------------------------------------------------------- Run the wallet -------------------------------------------------------------------------------} runWalletMode :: forall a. (HasConfigurations, HasCompileInfo) - => ProtocolMagic + => Core.Config -> TxpConfiguration -> NodeResources () -> PassiveWalletLayer IO -> (Diffusion WalletMode -> WalletMode a) -> IO a -runWalletMode pm txpConfig nr wallet action = - runRealMode pm txpConfig nr $ \diffusion -> +runWalletMode coreConfig txpConfig nr wallet action = + runRealMode coreConfig txpConfig nr $ \diffusion -> walletModeToRealMode wallet (action (hoistDiffusion realModeToWalletMode (walletModeToRealMode wallet) diffusion)) walletModeToRealMode :: forall a. PassiveWalletLayer IO -> WalletMode a -> RealMode () a @@ -177,9 +177,7 @@ instance HasConfiguration => MonadDB WalletMode where dbDelete = dbDeleteDefault dbPutSerBlunds = dbPutSerBlundsRealDefault -instance ( HasConfiguration - , MonadSlotsData ctx WalletMode - ) => MonadSlots ctx WalletMode where +instance MonadSlotsData ctx WalletMode => MonadSlots ctx WalletMode where getCurrentSlot = getCurrentSlotSimple getCurrentSlotBlocking = getCurrentSlotBlockingSimple getCurrentSlotInaccurate = getCurrentSlotInaccurateSimple diff --git a/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs b/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs index a21f26f9d6b..232bae4e3cf 100644 --- a/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs +++ b/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs @@ -66,10 +66,9 @@ import Pos.Chain.Update (ConfirmedProposalState, import qualified Pos.Chain.Update as Upd import Pos.Context (NodeContext (..)) import Pos.Core (BlockCount, ProtocolConstants (pcK), SlotCount, - Timestamp, difficultyL, genesisBlockVersionData, - getChainDifficulty, pcEpochSlots) -import Pos.Core.Configuration (HasConfiguration, genesisHash, - protocolConstants) + Timestamp, configEpochSlots, difficultyL, + genesisBlockVersionData, getChainDifficulty, pcEpochSlots) +import Pos.Core.Configuration (HasConfiguration, genesisHash) import Pos.Core.Slotting (EpochIndex (..), HasSlottingVar (..), LocalSlotIndex (..), MonadSlots (..), SlotId (..)) import Pos.Core.Txp (TxIn, TxOutAux) @@ -346,7 +345,7 @@ instance ( NodeConstraints dbGetSerUndo = DB.dbGetSerUndoRealDefault dbGetSerBlund = DB.dbGetSerBlundRealDefault -instance (NodeConstraints, MonadIO m) => MonadSlots Res (WithNodeState m) where +instance MonadIO m => MonadSlots Res (WithNodeState m) where getCurrentSlot = S.getCurrentSlotSimple getCurrentSlotBlocking = S.getCurrentSlotBlockingSimple getCurrentSlotInaccurate = S.getCurrentSlotInaccurateSimple @@ -361,18 +360,19 @@ instance (NodeConstraints, MonadIO m) => MonadSlots Res (WithNodeState m) where -- NOTE: This captures the node constraints in the closure so that the adaptor -- can be used in a place where these constraints is not available. newNodeStateAdaptor :: forall m ext. (NodeConstraints, MonadIO m, MonadMask m) - => NodeResources ext + => ProtocolConstants + -> NodeResources ext -> TVar NtpStatus -> NodeStateAdaptor m -newNodeStateAdaptor nr ntpStatus = Adaptor { - withNodeState = run - , getTipSlotId = run $ \_lock -> defaultGetTipSlotId - , getMaxTxSize = run $ \_lock -> defaultGetMaxTxSize - , getSlotStart = \slotId -> run $ \_lock -> defaultGetSlotStart slotId - , getNextEpochSlotDuration = run $ \_lock -> defaultGetNextEpochSlotDuration +newNodeStateAdaptor pc nr ntpStatus = Adaptor + { withNodeState = run + , getTipSlotId = run $ \_lock -> defaultGetTipSlotId + , getMaxTxSize = run $ \_lock -> defaultGetMaxTxSize + , getSlotStart = \slotId -> run $ \_lock -> defaultGetSlotStart slotId + , getNextEpochSlotDuration = run $ \_lock -> defaultGetNextEpochSlotDuration , getNodeSyncProgress = \lockCtx -> run $ defaultSyncProgress lockCtx - , getSecurityParameter = return $ pcK' protocolConstants - , getSlotCount = return $ pcEpochSlots protocolConstants + , getSecurityParameter = return $ pcK' pc + , getSlotCount = return $ pcEpochSlots pc , curSoftwareVersion = return $ Upd.curSoftwareVersion , compileInfo = return $ Util.compileInfo , getNtpDrift = defaultGetNtpDrift ntpStatus @@ -541,7 +541,7 @@ instance Exception NodeStateUnavailable mockNodeState :: (HasCallStack, MonadThrow m) => MockNodeStateParams -> NodeStateAdaptor m mockNodeState MockNodeStateParams{..} = - withDefConfiguration $ \_pm -> + withDefConfiguration $ \coreConfig -> withDefUpdateConfiguration $ Adaptor { withNodeState = \_ -> throwM $ NodeStateUnavailable callStack @@ -551,7 +551,7 @@ mockNodeState MockNodeStateParams{..} = , getNodeSyncProgress = \_ -> return mockNodeStateSyncProgress , getSlotStart = return . mockNodeStateSlotStart , getMaxTxSize = return $ bvdMaxTxSize genesisBlockVersionData - , getSlotCount = return $ pcEpochSlots protocolConstants + , getSlotCount = return $ configEpochSlots coreConfig , curSoftwareVersion = return $ Upd.curSoftwareVersion , compileInfo = return $ Util.compileInfo , getNtpDrift = return . mockNodeStateNtpDrift diff --git a/src/Cardano/Wallet/Kernel/Restore.hs b/src/Cardano/Wallet/Kernel/Restore.hs index 70b0ed8ece2..f33c69bb206 100644 --- a/src/Cardano/Wallet/Kernel/Restore.hs +++ b/src/Cardano/Wallet/Kernel/Restore.hs @@ -49,8 +49,8 @@ import Cardano.Wallet.Kernel.Wallets (createWalletHdRnd) import Pos.Chain.Block (Block, Blund, HeaderHash, MainBlock, Undo, headerHash, mainBlockSlot) import Pos.Chain.Txp (GenesisUtxo (..), Utxo, genesisUtxo) -import Pos.Core (BlockCount (..), Coin, SlotId, flattenSlotIdExplicit, - mkCoin, unsafeIntegerToCoin) +import Pos.Core (BlockCount (..), Coin, SlotId, flattenSlotId, mkCoin, + unsafeIntegerToCoin) import Pos.Core.Txp (TxIn (..), TxOut (..), TxOutAux (..)) import Pos.Crypto (EncryptedSecretKey) import Pos.DB.Block (getFirstGenesisBlockHash, getUndo, @@ -93,7 +93,7 @@ restoreWallet pw spendingPass name assurance esk prefilter = do slotCount <- getSlotCount (pw ^. walletNode) let restoreInfo = WalletRestorationInfo { _wriCurrentSlot = 0 - , _wriTargetSlot = flattenSlotIdExplicit slotCount tgtSlot + , _wriTargetSlot = flattenSlotId slotCount tgtSlot , _wriThroughput = MeasuredIn 0 , _wriCancel = return () } @@ -235,7 +235,7 @@ restoreWalletHistoryAsync wallet rootId target tgtSlot prefilter = do -- Update our progress slotCount <- getSlotCount (wallet ^. walletNode) - let flat = flattenSlotIdExplicit slotCount + let flat = flattenSlotId slotCount blockPerSec = MeasuredIn . BlockCount . perSecond <$> rate throughputUpdate = maybe identity (set wriThroughput) blockPerSec slotId = mb ^. mainBlockSlot diff --git a/src/Cardano/Wallet/LegacyServer.hs b/src/Cardano/Wallet/LegacyServer.hs index 9325e483613..01fa158d863 100644 --- a/src/Cardano/Wallet/LegacyServer.hs +++ b/src/Cardano/Wallet/LegacyServer.hs @@ -13,7 +13,7 @@ import Cardano.Wallet.Server.CLI (RunMode (..)) import Ntp.Client (NtpStatus) import Pos.Chain.Txp (TxpConfiguration) import Pos.Chain.Update (curSoftwareVersion) -import Pos.Crypto (ProtocolMagic) +import Pos.Core as Core (Config) import Pos.Infra.Diffusion.Types (Diffusion (..)) import Pos.Util.CompileInfo (compileInfo) import Pos.Wallet.Web.Mode (WalletWebMode) @@ -29,20 +29,20 @@ import qualified Cardano.Wallet.API.V1.Swagger as Swagger -- with Servant. walletServer :: (HasConfigurations, HasCompileInfo) => (forall a. WalletWebMode a -> Handler a) - -> ProtocolMagic + -> Core.Config -> TxpConfiguration -> Diffusion WalletWebMode -> TVar NtpStatus -> RunMode -> Server WalletAPI -walletServer natV0 pm txpConfig diffusion ntpStatus runMode = +walletServer natV0 coreConfig txpConfig diffusion ntpStatus runMode = v0Handler :<|> v0Handler :<|> v1Handler :<|> internalHandler where - v0Handler = V0.handlers natV0 pm txpConfig diffusion ntpStatus - v1Handler = V1.handlers natV0 pm txpConfig diffusion ntpStatus + v0Handler = V0.handlers natV0 coreConfig txpConfig diffusion ntpStatus + v1Handler = V1.handlers natV0 coreConfig txpConfig diffusion ntpStatus internalHandler = Internal.handlers natV0 runMode diff --git a/src/Cardano/Wallet/Server/Plugins.hs b/src/Cardano/Wallet/Server/Plugins.hs index 5c2051c95c0..8cb5388362a 100644 --- a/src/Cardano/Wallet/Server/Plugins.hs +++ b/src/Cardano/Wallet/Server/Plugins.hs @@ -55,6 +55,7 @@ import Pos.Wallet.Web.Sockets (getWalletWebSockets, import qualified Servant import Pos.Context (HasNodeContext) +import Pos.Core as Core (BlockCount, Config) import Pos.Crypto (ProtocolMagic) import Pos.Util (lensOf) import Pos.Util.Wlog (logInfo, modifyLoggerName, usingLoggerName) @@ -117,12 +118,12 @@ walletDocumentation WalletBackendParams {..} = pure $ \_ -> -- | A @Plugin@ to start the wallet backend API. legacyWalletBackend :: (HasConfigurations, HasCompileInfo) - => ProtocolMagic + => Core.Config -> TxpConfiguration -> WalletBackendParams -> TVar NtpStatus -> Plugin WalletWebMode -legacyWalletBackend pm txpConfig WalletBackendParams {..} ntpStatus = pure $ \diffusion -> do +legacyWalletBackend coreConfig txpConfig WalletBackendParams {..} ntpStatus = pure $ \diffusion -> do modifyLoggerName (const "legacyServantBackend") $ do logInfo $ sformat ("Production mode for API: "%build) walletProductionApi @@ -153,7 +154,7 @@ legacyWalletBackend pm txpConfig WalletBackendParams {..} ntpStatus = pure $ \di $ Servant.serve API.walletAPI $ LegacyServer.walletServer (V0.convertHandler ctx) - pm + coreConfig txpConfig diffusion ntpStatus @@ -235,21 +236,21 @@ walletBackend protocolMagic (NewWalletBackendParams WalletBackendParams{..}) (pa -- | A @Plugin@ to resubmit pending transactions. resubmitterPlugin :: HasConfigurations - => ProtocolMagic + => Core.Config -> TxpConfiguration -> Plugin WalletWebMode -resubmitterPlugin pm txpConfig = [\diffusion -> askWalletDB >>= \db -> - startPendingTxsResubmitter pm txpConfig db (sendTx diffusion)] +resubmitterPlugin coreConfig txpConfig = [\diffusion -> askWalletDB >>= \db -> + startPendingTxsResubmitter coreConfig txpConfig db (sendTx diffusion)] -- | A @Plugin@ to notify frontend via websockets. notifierPlugin :: HasConfigurations => Plugin WalletWebMode notifierPlugin = [const V0.notifierPlugin] -- | The @Plugin@ responsible for the restoration & syncing of a wallet. -syncWalletWorker :: HasConfigurations => Plugin WalletWebMode -syncWalletWorker = pure $ const $ +syncWalletWorker :: HasConfigurations => BlockCount -> Plugin WalletWebMode +syncWalletWorker k = pure $ const $ modifyLoggerName (const "syncWalletWorker") $ - (view (lensOf @SyncQueue) >>= processSyncRequest) + (view (lensOf @SyncQueue) >>= processSyncRequest k) -- | "Attaches" the middleware to this 'Application', if any. -- When running in debug mode, chances are we want to at least allow CORS to test the API diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Transactions.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Transactions.hs index e4764fc8557..e95df0f50bb 100644 --- a/src/Cardano/Wallet/WalletLayer/Kernel/Transactions.hs +++ b/src/Cardano/Wallet/WalletLayer/Kernel/Transactions.hs @@ -9,7 +9,7 @@ import Control.Monad.Except import GHC.TypeLits (symbolVal) import Pos.Core (Address, Coin, SlotCount, SlotId, Timestamp, - decodeTextAddress, flattenSlotIdExplicit, getBlockCount) + decodeTextAddress, flattenSlotId, getBlockCount) import Pos.Core.Txp (TxId) import Cardano.Wallet.API.Indices @@ -150,8 +150,8 @@ buildDynamicTxMeta assuranceLevel slotCount mSlot currentSlot isPending = case i case mSlot of Nothing -> (V1.WontApply, 0) Just confirmedIn -> - let currentSlot' = flattenSlotIdExplicit slotCount currentSlot - confirmedIn' = flattenSlotIdExplicit slotCount confirmedIn + let currentSlot' = flattenSlotId slotCount currentSlot + confirmedIn' = flattenSlotId slotCount confirmedIn confirmations = currentSlot' - confirmedIn' in case (confirmations < getBlockCount (HD.assuredBlockDepth assuranceLevel)) of True -> (V1.InNewestBlocks, confirmations) diff --git a/test/MarshallingSpec.hs b/test/MarshallingSpec.hs index 7886867d64d..512d66028dd 100644 --- a/test/MarshallingSpec.hs +++ b/test/MarshallingSpec.hs @@ -52,7 +52,6 @@ import qualified Cardano.Wallet.Util as Util spec :: HasCallStack => Spec spec = parallel $ describe "Marshalling & Unmarshalling" $ do parallel $ describe "Roundtrips" $ do - pc <- runIO $ generate arbitrary aesonRoundtripProp @Account Proxy aesonRoundtripProp @AssuranceLevel Proxy aesonRoundtripProp @BackupPhrase Proxy @@ -157,14 +156,12 @@ spec = parallel $ describe "Marshalling & Unmarshalling" $ do safeCopyRoundTrip @(InDb (Core.AddressHash Core.Address')) safeCopyRoundTrip @(InDb (Core.Attributes Core.AddrAttributes)) safeCopyRoundTrip @(InDb (Core.AddrType)) - describe "Needing protocol constants ... " $ do - Core.withProtocolConstants pc $ do - safeCopyRoundTrip @(InDb Core.SlotId) - safeCopyRoundTrip @(InDb Core.LocalSlotIndex) - safeCopyRoundTrip @(InDb Core.BlockHeader) - safeCopyRoundTrip @(InDb Core.MainBlockHeader) - safeCopyRoundTrip @(InDb Core.MainConsensusData) - safeCopyRoundTrip @(InDb Core.BlockSignature) + safeCopyRoundTrip @(InDb Core.SlotId) + safeCopyRoundTrip @(InDb Core.LocalSlotIndex) + safeCopyRoundTrip @(InDb Core.BlockHeader) + safeCopyRoundTrip @(InDb Core.MainBlockHeader) + safeCopyRoundTrip @(InDb Core.MainConsensusData) + safeCopyRoundTrip @(InDb Core.BlockSignature) -- Other roundtrips generalRoundtripProp "UTC time" Util.showApiUtcTime Util.parseApiUtcTime diff --git a/test/WalletHandlersSpec.hs b/test/WalletHandlersSpec.hs index 1b8abb41a76..b2c90233086 100644 --- a/test/WalletHandlersSpec.hs +++ b/test/WalletHandlersSpec.hs @@ -8,6 +8,8 @@ import qualified Cardano.Wallet.API.V1.LegacyHandlers.Wallets as V1 import qualified Pos.Core as Core import qualified Pos.Wallet.Web.ClientTypes.Types as V0 +import Test.Pos.Core.Dummy (dummyK) + newSyncProgress :: Word64 -> Word64 -> V0.SyncProgress newSyncProgress localBlocks totalBlks = V0.SyncProgress { @@ -19,26 +21,19 @@ newSyncProgress localBlocks totalBlks = totalBlocks :: Word64 totalBlocks = 10000 -pc :: Core.ProtocolConstants -pc = Core.ProtocolConstants - { Core.pcK = 10 - , Core.pcVssMaxTTL = maxBound - , Core.pcVssMinTTL = minBound - } - spec :: Spec spec = describe "Wallet Handlers specs" $ do describe "the 'isNodeSufficientlySynced' function " $ do - Core.withProtocolConstants pc $ do it "should return True if we are within k blocks behind" $ do - let (Core.BlockCount k) = Core.blkSecurityParam + let (Core.BlockCount k) = dummyK let progress = newSyncProgress (totalBlocks - k) totalBlocks - V1.isNodeSufficientlySynced progress `shouldBe` True + V1.isNodeSufficientlySynced dummyK progress `shouldBe` True it "should return False if we are more than k blocks behind" $ do - let (Core.BlockCount k) = Core.blkSecurityParam + let (Core.BlockCount k) = dummyK let progress = newSyncProgress (totalBlocks - k - 1) totalBlocks - V1.isNodeSufficientlySynced progress `shouldBe` False + V1.isNodeSufficientlySynced dummyK progress `shouldBe` False it "should return False if we cannot fetch the blockchain height" $ do - let (Core.BlockCount k) = Core.blkSecurityParam + let (Core.BlockCount k) = dummyK let progress = newSyncProgress (totalBlocks - k - 1) totalBlocks - V1.isNodeSufficientlySynced (progress { V0._spNetworkCD = Nothing }) `shouldBe` False + V1.isNodeSufficientlySynced dummyK (progress { V0._spNetworkCD = Nothing }) + `shouldBe` False diff --git a/test/unit/UTxO/Context.hs b/test/unit/UTxO/Context.hs index 70e3a90c1e6..b7e2a274ec1 100644 --- a/test/unit/UTxO/Context.hs +++ b/test/unit/UTxO/Context.hs @@ -100,18 +100,18 @@ initCardanoContext coreConfig = CardanoContext , ccUtxo = ccUtxo , ccSecrets = fromMaybe (error "initCardanoContext: no secrets") $ configGeneratedSecrets coreConfig - , ccMagic = configProtocolMagic coreConfig + , ccMagic = ccMagic , ccInitLeaders = ccLeaders , ccBalances = utxoToAddressCoinPairs ccUtxo , ccHash0 = (blockHeaderHash . BlockHeaderGenesis . _gbHeader) ccBlock0 - , ccEpochSlots = epochSlots + , ccEpochSlots = ccEpochSlots } where - ccLeaders = genesisLeaders epochSlots - ccBlock0 = genesisBlock0 (configProtocolMagic coreConfig) - (GenesisHash genesisHash) - ccLeaders - ccUtxo = unGenesisUtxo genesisUtxo + ccEpochSlots = configEpochSlots coreConfig + ccLeaders = genesisLeaders ccEpochSlots + ccMagic = configProtocolMagic coreConfig + ccBlock0 = genesisBlock0 ccMagic (GenesisHash genesisHash) ccLeaders + ccUtxo = unGenesisUtxo genesisUtxo {------------------------------------------------------------------------------- More explicit representation of the various actors in the genesis block diff --git a/test/unit/UTxO/Interpreter.hs b/test/unit/UTxO/Interpreter.hs index dc4f66e2ce8..3a281963277 100644 --- a/test/unit/UTxO/Interpreter.hs +++ b/test/unit/UTxO/Interpreter.hs @@ -75,6 +75,8 @@ import UTxO.Crypto import qualified UTxO.DSL as DSL import UTxO.Translate +import Test.Pos.Core.Dummy (dummyConfig, dummyEpochSlots, dummyK) + {------------------------------------------------------------------------------- Errors that may occur during interpretation -------------------------------------------------------------------------------} @@ -351,9 +353,8 @@ mkCheckpoint :: Monad m -> RawResolvedBlock -- ^ The block just created -> TranslateT IntException m IntCheckpoint mkCheckpoint prev raw@(UnsafeRawResolvedBlock block _inputs _ ctxt) = do - pc <- asks constants gs <- asks weights - let isCrucial = give pc $ slot == crucialSlot (siEpoch slot) + let isCrucial = slot == crucialSlot dummyK (siEpoch slot) newStakes <- updateStakes gs (fromRawResolvedBlock raw) (icStakes prev) return IntCheckpoint { icSlotId = slot @@ -640,7 +641,6 @@ instance DSL.Hash h Addr => Interpret h (DSL.Block h Addr) where int (OldestFirst txs) = do (txs', resolvedTxInputs) <- unpack <$> mapM int txs pushCheckpoint $ \prev slot -> do - pc <- asks constants block <- mkBlock (icEpochLeaders prev) (icBlockHeader prev) @@ -654,17 +654,17 @@ instance DSL.Hash h Addr => Interpret h (DSL.Block h Addr) where } let raw = mkRawResolvedBlock block resolvedTxInputs currentTime ctxt checkpoint <- mkCheckpoint prev raw - if isEpochBoundary pc slot + if isEpochBoundary slot then second (\ebb -> (raw, Just ebb)) <$> createEpochBoundary checkpoint else return (checkpoint, (raw, Nothing)) where unpack :: [RawResolvedTx] -> ([TxAux], [ResolvedTxInputs]) unpack = unzip . map (rawResolvedTx &&& rawResolvedTxInputs) - isEpochBoundary :: ProtocolConstants -> SlotId -> Bool - isEpochBoundary pc slot = siSlot slot == localSlotIndexMaxBound pc + isEpochBoundary :: SlotId -> Bool + isEpochBoundary slot = siSlot slot == localSlotIndexMaxBound dummyEpochSlots - mkBlock :: (HasConfiguration, HasUpdateConfiguration) + mkBlock :: HasUpdateConfiguration => SlotLeaders -> BlockHeader -> SlotId @@ -680,9 +680,8 @@ instance DSL.Hash h Addr => Interpret h (DSL.Block h Addr) where -- figure out who needs to sign the block BlockSignInfo{..} <- asks $ blockSignInfoForSlot leaders slotId - pm <- asks magic createMainBlockPure - pm + dummyConfig blockSizeLimit prev (Just (bsiPSK, bsiLeader)) @@ -690,7 +689,7 @@ instance DSL.Hash h Addr => Interpret h (DSL.Block h Addr) where bsiKey (RawPayload (toList ts) - (defaultSscPayload (siSlot slotId)) -- TODO + (defaultSscPayload dummyK (siSlot slotId)) -- TODO dlgPayload updPayload ) diff --git a/test/unit/UTxO/Translate.hs b/test/unit/UTxO/Translate.hs index 2c4c4615937..84e8db909e6 100644 --- a/test/unit/UTxO/Translate.hs +++ b/test/unit/UTxO/Translate.hs @@ -33,7 +33,6 @@ import Pos.Chain.Txp import Pos.Chain.Update import Pos.Core import Pos.Core.Chrono -import Pos.Crypto (ProtocolMagic) import Pos.DB.Class (MonadGState (..)) import Util.Validated @@ -41,6 +40,8 @@ import UTxO.Context import UTxO.Verify (Verify) import qualified UTxO.Verify as Verify +import Test.Pos.Core.Dummy (dummyEpochSlots) + {------------------------------------------------------------------------------- Testing infrastructure from cardano-sl-core @@ -170,7 +171,7 @@ translateFirstSlot = SlotId 0 localSlotIndexMinBound -- TODO: Surely a function like this must already exist somewhere? translateNextSlot :: Monad m => SlotId -> TranslateT e m SlotId translateNextSlot (SlotId epoch lsi) = withConfig $ - return $ case addLocalSlotIndex 1 lsi of + return $ case addLocalSlotIndex dummyEpochSlots 1 lsi of Just lsi' -> SlotId epoch lsi' Nothing -> SlotId (epoch + 1) localSlotIndexMinBound @@ -216,32 +217,26 @@ verifyBlocksPrefix blocks = validatedFromExceptT . throwError $ VerifyBlocksError "No genesis epoch!" ESRValid genEpoch (OldestFirst succEpochs) -> do CardanoContext{..} <- asks tcCardano - verify $ validateGenEpoch ccMagic ccHash0 ccInitLeaders genEpoch >>= \genUndos -> do - epochUndos <- sequence $ validateSuccEpoch ccMagic <$> succEpochs + verify $ validateGenEpoch ccHash0 ccInitLeaders genEpoch >>= \genUndos -> do + epochUndos <- sequence $ validateSuccEpoch <$> succEpochs return $ foldl' (\a b -> a <> b) genUndos epochUndos where - validateGenEpoch :: ProtocolMagic - -> HeaderHash + validateGenEpoch :: HeaderHash -> SlotLeaders -> OldestFirst NE MainBlock - -> ( HasConfiguration - => Verify VerifyBlocksException (OldestFirst NE Undo)) - validateGenEpoch pm ccHash0 ccInitLeaders geb = do + -> Verify VerifyBlocksException (OldestFirst NE Undo) + validateGenEpoch ccHash0 ccInitLeaders geb = do Verify.verifyBlocksPrefix - pm ccHash0 Nothing ccInitLeaders (OldestFirst []) (Right <$> geb :: OldestFirst NE Block) - validateSuccEpoch :: ProtocolMagic - -> EpochBlocks NE - -> ( HasConfiguration - => Verify VerifyBlocksException (OldestFirst NE Undo)) - validateSuccEpoch pm (SuccEpochBlocks ebb emb) = do + validateSuccEpoch :: EpochBlocks NE + -> Verify VerifyBlocksException (OldestFirst NE Undo) + validateSuccEpoch (SuccEpochBlocks ebb emb) = do Verify.verifyBlocksPrefix - pm (ebb ^. headerHashG) Nothing (ebb ^. gbBody . gbLeaders) diff --git a/test/unit/UTxO/Verify.hs b/test/unit/UTxO/Verify.hs index c3d8d9556e7..9d18b1626db 100644 --- a/test/unit/UTxO/Verify.hs +++ b/test/unit/UTxO/Verify.hs @@ -36,6 +36,9 @@ import qualified Pos.Util.Modifier as MM import Pos.Util.Wlog import Serokell.Util.Verify +import Test.Pos.Core.Dummy (dummyConfig, dummyEpochSlots, dummyK) +import Test.Pos.Crypto.Dummy (dummyProtocolMagic) + {------------------------------------------------------------------------------- Verification environment -------------------------------------------------------------------------------} @@ -222,15 +225,13 @@ mapVerifyErrors f (Verify ma) = Verify $ mapStateT (withExceptT f) ma -- corresponding functions from the Cardano core. This didn't look very easy -- so I skipped it for now. verifyBlocksPrefix - :: HasConfiguration - => ProtocolMagic - -> HeaderHash -- ^ Expected tip + :: HeaderHash -- ^ Expected tip -> Maybe SlotId -- ^ Current slot -> SlotLeaders -- ^ Slot leaders for this epoch -> LastBlkSlots -- ^ Last block slots -> OldestFirst NE Block -> Verify VerifyBlocksException (OldestFirst NE Undo) -verifyBlocksPrefix pm tip curSlot leaders lastSlots blocks = do +verifyBlocksPrefix tip curSlot leaders lastSlots blocks = do when (tip /= blocks ^. _Wrapped . _neHead . prevBlockL) $ throwError $ VerifyBlocksError "the first block isn't based on the tip" @@ -238,7 +239,7 @@ verifyBlocksPrefix pm tip curSlot leaders lastSlots blocks = do -- Verify block envelope slogUndos <- mapVerifyErrors VerifyBlocksError $ - slogVerifyBlocks pm curSlot leaders lastSlots blocks + slogVerifyBlocks curSlot leaders lastSlots blocks -- We skip SSC verification {- @@ -248,7 +249,7 @@ verifyBlocksPrefix pm tip curSlot leaders lastSlots blocks = do -- Verify transactions txUndo <- mapVerifyErrors (VerifyBlocksError . pretty) $ - tgsVerifyBlocks pm $ map toTxpBlock blocks + tgsVerifyBlocks $ map toTxpBlock blocks -- Skip delegation verification {- @@ -292,14 +293,12 @@ verifyBlocksPrefix pm tip curSlot leaders lastSlots blocks = do -- * Uses 'gsAdoptedBVData' instead of 'getAdoptedBVFull' -- * Use hard-coded 'dataMustBeKnown' (instead of deriving this from 'adoptedBV') slogVerifyBlocks - :: HasConfiguration - => ProtocolMagic - -> Maybe SlotId -- ^ Current slot + :: Maybe SlotId -- ^ Current slot -> SlotLeaders -- ^ Slot leaders for this epoch -> LastBlkSlots -- ^ Last block slots -> OldestFirst NE Block -> Verify Text (OldestFirst NE SlogUndo) -slogVerifyBlocks pm curSlot leaders lastSlots blocks = do +slogVerifyBlocks curSlot leaders lastSlots blocks = do adoptedBVD <- gsAdoptedBVData -- We take head here, because blocks are in oldest first order and @@ -312,12 +311,12 @@ slogVerifyBlocks pm curSlot leaders lastSlots blocks = do _ -> pass let blocksList = OldestFirst (toList (getOldestFirst blocks)) verResToMonadError formatAllErrors $ - verifyBlocks pm curSlot dataMustBeKnown adoptedBVD leaders blocksList + verifyBlocks dummyConfig curSlot dataMustBeKnown adoptedBVD leaders blocksList -- Here we need to compute 'SlogUndo'. When we add apply a block, -- we can remove one of the last slots stored in -- 'BlockExtra'. This removed slot must be put into 'SlogUndo'. - let toFlatSlot = fmap (flattenSlotId . view mainBlockSlot) . rightToMaybe + let toFlatSlot = fmap (flattenSlotId dummyEpochSlots . view mainBlockSlot) . rightToMaybe -- these slots will be added if we apply all blocks let newSlots = mapMaybe toFlatSlot (toList blocks) let combinedSlots :: OldestFirst [] FlatSlotId @@ -327,7 +326,7 @@ slogVerifyBlocks pm curSlot leaders lastSlots blocks = do let removedSlots :: OldestFirst [] FlatSlotId removedSlots = combinedSlots & _Wrapped %~ - (take $ length combinedSlots - fromIntegral blkSecurityParam) + (take $ length combinedSlots - fromIntegral dummyK) -- Note: here we exploit the fact that genesis block can be only 'head'. -- If we have genesis block, then size of 'newSlots' will be less than -- number of blocks we verify. It means that there will definitely @@ -353,14 +352,14 @@ slogVerifyBlocks pm curSlot leaders lastSlots blocks = do -- * Does everything in a pure monad. -- I don't fully grasp the consequences of this. tgsVerifyBlocks - :: ProtocolMagic - -> OldestFirst NE TxpBlock + :: OldestFirst NE TxpBlock -> Verify ToilVerFailure (OldestFirst NE TxpUndo) -tgsVerifyBlocks pm newChain = do +tgsVerifyBlocks newChain = do bvd <- gsAdoptedBVData let epoch = NE.last (getOldestFirst newChain) ^. epochIndexL let verifyPure :: [TxAux] -> Verify ToilVerFailure TxpUndo - verifyPure = nat . verifyToil pm bvd mempty epoch dataMustBeKnown + verifyPure = nat . + verifyToil dummyProtocolMagic bvd mempty epoch dataMustBeKnown mapM (verifyPure . convertPayload) newChain where convertPayload :: TxpBlock -> [TxAux]