Merge pull request #3482 from input-output-hk/ruhatch/CDEC-509

[CDEC-369] Remove HasProtocolConstants in favour of parameters
input-output-hk · Aug 28, 2018 · 7686dfc · 7686dfc
2 parents 0057d33 + 4f8c4ca
commit 7686dfc
Show file tree

Hide file tree

Showing 18 changed files with 164 additions and 172 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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