[CDEC-369] Remove HasProtocolConstants in favour of parameters

input-output-hk · Jun 26, 2018 · 7b630f1 · 7b630f1
1 parent 1a27109
commit 7b630f1
Show file tree

Hide file tree

Showing 191 changed files with 3,627 additions and 2,955 deletions.
diff --git a/auxx/Main.hs b/auxx/Main.hs
@@ -14,7 +14,7 @@ import           System.Wlog (LoggerName, logInfo)
 
 import qualified Pos.Client.CLI as CLI
 import           Pos.Context (NodeContext (..))
-import           Pos.Core (ConfigurationError, epochSlots)
+import           Pos.Core (ConfigurationError, ProtocolConstants, pcBlkSecurityParam)
 import           Pos.Crypto (ProtocolMagic)
 import           Pos.DB.DB (initNodeDBs)
 import           Pos.Infra.Diffusion.Types (Diffusion, hoistDiffusion)
@@ -70,64 +70,91 @@ correctNodeParams AuxxOptions {..} np = do
         , ncTcpAddr = TCP.Unaddressable
         }
 
-runNodeWithSinglePlugin ::
-       (HasConfigurations, HasCompileInfo)
+runNodeWithSinglePlugin
+    :: (HasConfigurations, HasCompileInfo)
     => ProtocolMagic
+    -> ProtocolConstants
     -> NodeResources EmptyMempoolExt
     -> (Diffusion AuxxMode -> AuxxMode ())
-    -> Diffusion AuxxMode -> AuxxMode ()
-runNodeWithSinglePlugin pm nr plugin =
-    runNode pm nr [plugin]
+    -> Diffusion AuxxMode
+    -> AuxxMode ()
+runNodeWithSinglePlugin pm pc nr plugin =
+    runNode pm pc nr [plugin]
 
-action :: HasCompileInfo => AuxxOptions -> Either WithCommandAction Text -> Production ()
+action
+    :: HasCompileInfo
+    => AuxxOptions
+    -> Either WithCommandAction Text
+    -> Production ()
 action opts@AuxxOptions {..} command = do
     let pa = either printAction (const putText) command
     case aoStartMode of
-        Automatic
-            ->
-                handle @_ @ConfigurationException (\_ -> runWithoutNode pa)
-              . handle @_ @ConfigurationError (\_ -> runWithoutNode pa)
-              $ withConfigurations Nothing conf (runWithConfig pa)
-        Light
-            -> runWithoutNode pa
-        _   -> withConfigurations Nothing conf (runWithConfig pa)
-
+        Automatic ->
+            handle @_ @ConfigurationException (\_ -> runWithoutNode pa)
+                . handle @_ @ConfigurationError (\_ -> runWithoutNode pa)
+                $ withConfigurations Nothing conf (runWithConfig pa)
+        Light -> runWithoutNode pa
+        _     -> withConfigurations Nothing conf (runWithConfig pa)
   where
     runWithoutNode :: PrintAction Production -> Production ()
-    runWithoutNode printAction = printAction "Mode: light" >> rawExec Nothing Nothing opts Nothing command
+    runWithoutNode printAction =
+        printAction "Mode: light"
+            >> rawExec Nothing Nothing Nothing opts Nothing command
 
-    runWithConfig :: HasConfigurations => PrintAction Production -> NtpConfiguration -> ProtocolMagic -> Production ()
-    runWithConfig printAction ntpConfig pm = do
+    runWithConfig
+        :: HasConfigurations
+        => PrintAction Production
+        -> NtpConfiguration
+        -> ProtocolMagic
+        -> ProtocolConstants
+        -> Production ()
+    runWithConfig printAction ntpConfig pm pc = do
         printAction "Mode: with-config"
         CLI.printInfoOnStart aoCommonNodeArgs ntpConfig
         (nodeParams, tempDbUsed) <-
             correctNodeParams opts =<< CLI.getNodeParams loggerName cArgs nArgs
 
-        let toRealMode :: AuxxMode a -> RealMode EmptyMempoolExt a
+        let
+            toRealMode :: AuxxMode a -> RealMode EmptyMempoolExt a
             toRealMode auxxAction = do
                 realModeContext <- ask
-                let auxxContext =
-                        AuxxContext
+                let auxxContext = AuxxContext
                         { acRealModeContext = realModeContext
-                        , acTempDbUsed = tempDbUsed }
+                        , acTempDbUsed      = tempDbUsed
+                        }
                 lift $ runReaderT auxxAction auxxContext
             vssSK = fromMaybe (error "no user secret given")
                               (npUserSecret nodeParams ^. usVss)
-            sscParams = CLI.gtSscParams cArgs vssSK (npBehaviorConfig nodeParams)
+            sscParams =
+                CLI.gtSscParams cArgs vssSK (npBehaviorConfig nodeParams)
 
-        bracketNodeResources nodeParams sscParams (txpGlobalSettings pm) (initNodeDBs pm epochSlots) $ \nr -> Production $
-            let NodeContext {..} = nrContext nr
-                modifier = if aoStartMode == WithNode
-                           then runNodeWithSinglePlugin pm nr
-                           else identity
-                auxxModeAction = modifier (auxxPlugin pm opts command)
-             in runRealMode pm nr $ \diffusion ->
-                    toRealMode (auxxModeAction (hoistDiffusion realModeToAuxx toRealMode diffusion))
+        bracketNodeResources (pcBlkSecurityParam pc)
+                             nodeParams
+                             sscParams
+                             (txpGlobalSettings pm)
+                             (initNodeDBs pm pc)
+            $ \nr ->
+                  Production
+                      $ let
+                            NodeContext {..} = nrContext nr
+                            modifier         = if aoStartMode == WithNode
+                                then runNodeWithSinglePlugin pm pc nr
+                                else identity
+                            auxxModeAction =
+                                modifier (auxxPlugin pm pc opts command)
+                        in
+                            runRealMode pm pc nr $ \diffusion ->
+                                toRealMode
+                                    (auxxModeAction
+                                        (hoistDiffusion realModeToAuxx
+                                                        toRealMode
+                                                        diffusion
+                                        )
+                                    )
 
     cArgs@CLI.CommonNodeArgs {..} = aoCommonNodeArgs
     conf = CLI.configurationOptions (CLI.commonArgs cArgs)
-    nArgs =
-        CLI.NodeArgs {behaviorConfigPath = Nothing}
+    nArgs = CLI.NodeArgs {behaviorConfigPath = Nothing}
 
 main :: IO ()
 main = withCompileInfo $(retrieveCompileTimeInfo) $ do

diff --git a/auxx/src/Command/BlockGen.hs b/auxx/src/Command/BlockGen.hs
@@ -13,7 +13,7 @@ import           System.Wlog (logInfo)
 
 import           Pos.AllSecrets (mkAllSecretsSimple)
 import           Pos.Client.KeyStorage (getSecretKeysPlain)
-import           Pos.Core (gdBootStakeholders, genesisData)
+import           Pos.Core (ProtocolConstants, gdBootStakeholders, genesisData)
 import           Pos.Crypto (ProtocolMagic, encToSecret)
 import           Pos.Generator.Block (BlockGenParams (..), genBlocks, tgpTxCountRange)
 import           Pos.Infra.StateLock (Priority (..), withStateLock)
@@ -24,26 +24,33 @@ import           Pos.Util.CompileInfo (withCompileInfo)
 import           Lang.Value (GenBlocksParams (..))
 import           Mode (MonadAuxxMode)
 
-
-generateBlocks :: MonadAuxxMode m => ProtocolMagic -> GenBlocksParams -> m ()
-generateBlocks pm GenBlocksParams{..} = withStateLock HighPriority ApplyBlock $ \_ -> do
-    seed <- liftIO $ maybe randomIO pure bgoSeed
-    logInfo $ "Generating with seed " <> show seed
-
-    allSecrets <- mkAllSecretsSimple . map encToSecret <$> getSecretKeysPlain
-
-    let bgenParams =
-            BlockGenParams
-                { _bgpSecrets         = allSecrets
-                , _bgpGenStakeholders = gdBootStakeholders genesisData
-                , _bgpBlockCount      = fromIntegral bgoBlockN
-                -- tx generation is disalbed for now
-                , _bgpTxGenParams     = def & tgpTxCountRange .~ (0,0)
-                , _bgpInplaceDB       = True
-                , _bgpSkipNoKey       = True
+generateBlocks
+    :: MonadAuxxMode m
+    => ProtocolMagic
+    -> ProtocolConstants
+    -> GenBlocksParams
+    -> m ()
+generateBlocks pm pc GenBlocksParams {..} =
+    withStateLock HighPriority ApplyBlock $ \_ -> do
+        seed <- liftIO $ maybe randomIO pure bgoSeed
+        logInfo $ "Generating with seed " <> show seed
+
+        allSecrets <-
+            mkAllSecretsSimple . map encToSecret <$> getSecretKeysPlain
+
+        let bgenParams = BlockGenParams
+                { _bgpSecrets           = allSecrets
+                , _bgpGenStakeholders   = gdBootStakeholders genesisData
+                , _bgpBlockCount        = fromIntegral bgoBlockN
+                    -- tx generation is disabled for now
+                , _bgpTxGenParams       = def & tgpTxCountRange .~ (0, 0)
+                , _bgpInplaceDB         = True
+                , _bgpSkipNoKey         = True
                 , _bgpTxpGlobalSettings = txpGlobalSettings pm
                 }
-    withCompileInfo def $ evalRandT (genBlocks pm bgenParams (const ())) (mkStdGen seed)
-    -- We print it twice because there can be a ton of logs and
-    -- you don't notice the first message.
-    logInfo $ "Generated with seed " <> show seed
+        withCompileInfo def $ evalRandT
+            (genBlocks pm pc bgenParams (const ()))
+            (mkStdGen seed)
+        -- We print it twice because there can be a ton of logs and
+        -- you don't notice the first message.
+        logInfo $ "Generated with seed " <> show seed