Make protocolInfoMorpho a pure function

input-output-hk · Feb 26, 2021 · 9f6a992 · 9f6a992
1 parent eb1eee7
commit 9f6a992
Show file tree

Hide file tree

Showing 2 changed files with 52 additions and 53 deletions.
diff --git a/morpho-checkpoint-node/src/Morpho/Node/ProtocolInfo.hs b/morpho-checkpoint-node/src/Morpho/Node/ProtocolInfo.hs
@@ -7,13 +7,10 @@ import Cardano.Crypto.DSIGN
 import Cardano.Crypto.ProtocolMagic
 import Cardano.Prelude
 import Cardano.Slotting.Slot (WithOrigin (..))
-import Control.Monad (fail)
-import Control.Monad.Class.MonadTime
 import qualified Data.Map as Map
 import qualified Data.Sequence.Strict as Seq
-import Morpho.Common.Conversions
 import Morpho.Config.Types
-import Morpho.Crypto.ECDSASignature (importPrivateKey, keyPairFromPrivate)
+import Morpho.Crypto.ECDSASignature (PrivateKey, keyPairFromPrivate)
 import Morpho.Ledger.Block
 import Morpho.Ledger.Forge ()
 import Morpho.Ledger.State
@@ -28,55 +25,46 @@ import Ouroboros.Consensus.NodeId (CoreNodeId (..), NodeId (..))
 import Ouroboros.Consensus.Protocol.BFT
 import Ouroboros.Network.Magic
 
-protocolInfoMorpho ::
-  (MonadIO m, MonadTime m) =>
-  NodeConfiguration ->
-  m (ProtocolInfo m (MorphoBlock MorphoMockHash ConsensusMockCrypto))
-protocolInfoMorpho nc = do
-  privKeyStr <- liftIO . readFile $ ncNodePrivKeyFile nc
-  start <- maybe (SystemStart <$> getCurrentTime) pure (ncSystemStart nc)
-  privKey <- case importPrivateKey $ bytesFromHex privKeyStr of
-    Nothing -> fail $ "Invalid private key in: " <> show (ncNodePrivKeyFile nc)
-    Just pk -> return pk
-  let ledgerConfig =
-        MorphoLedgerConfig
-          { checkpointingInterval = ncCheckpointInterval nc,
-            securityParam = secParam,
-            requiredMajority = ncRequiredMajority nc,
-            fedPubKeys = ncFedPubKeys nc,
-            slotLength = ncTimeslotLength nc,
-            nodeKeyPair = keyPairFromPrivate privKey
-          }
-      blockConfig =
-        MorphoBlockConfig
-          { systemStart = start,
-            networkMagic = NetworkMagic (ncNetworkMagic nc),
-            protocolMagicId = ProtocolMagicId (ncNetworkMagic nc)
-          }
-  pure
-    ProtocolInfo
-      { pInfoConfig =
-          TopLevelConfig
-            { topLevelConfigProtocol =
-                FullProtocolConfig
-                  { protocolConfigConsensus = bftConfig,
-                    protocolConfigIndep = ()
-                  },
-              topLevelConfigBlock =
-                FullBlockConfig
-                  { blockConfigLedger = ledgerConfig,
-                    blockConfigBlock = blockConfig,
-                    blockConfigCodec = MorphoCodecConfig ()
-                  }
-            },
-        pInfoInitLedger =
-          ExtLedgerState
-            { ledgerState = genesisMorphoLedgerState,
-              headerState = HeaderState () Seq.Empty Origin
-            },
-        pInfoLeaderCreds = Just (toCoreId (ncNodeId nc), defaultMaintainForgeState)
-      }
+protocolInfoMorpho :: Monad m => NodeConfiguration -> PrivateKey -> SystemStart -> ProtocolInfo m (MorphoBlock MorphoMockHash ConsensusMockCrypto)
+protocolInfoMorpho nc privKey start =
+  ProtocolInfo
+    { pInfoConfig =
+        TopLevelConfig
+          { topLevelConfigProtocol =
+              FullProtocolConfig
+                { protocolConfigConsensus = bftConfig,
+                  protocolConfigIndep = ()
+                },
+            topLevelConfigBlock =
+              FullBlockConfig
+                { blockConfigLedger = ledgerConfig,
+                  blockConfigBlock = blockConfig,
+                  blockConfigCodec = MorphoCodecConfig ()
+                }
+          },
+      pInfoInitLedger =
+        ExtLedgerState
+          { ledgerState = genesisMorphoLedgerState,
+            headerState = HeaderState () Seq.Empty Origin
+          },
+      pInfoLeaderCreds = Just (toCoreId (ncNodeId nc), defaultMaintainForgeState)
+    }
   where
+    ledgerConfig =
+      MorphoLedgerConfig
+        { checkpointingInterval = ncCheckpointInterval nc,
+          securityParam = secParam,
+          requiredMajority = ncRequiredMajority nc,
+          fedPubKeys = ncFedPubKeys nc,
+          slotLength = ncTimeslotLength nc,
+          nodeKeyPair = keyPairFromPrivate privKey
+        }
+    blockConfig =
+      MorphoBlockConfig
+        { systemStart = start,
+          networkMagic = NetworkMagic (ncNetworkMagic nc),
+          protocolMagicId = ProtocolMagicId (ncNetworkMagic nc)
+        }
     secParam = SecurityParam $ ncSecurityParameter nc
     bftConfig =
       BftConfig

diff --git a/morpho-checkpoint-node/src/Morpho/Node/Run.hs b/morpho-checkpoint-node/src/Morpho/Node/Run.hs
@@ -20,12 +20,15 @@ import Cardano.BM.Tracing
 import Cardano.Crypto.Hash
 import Cardano.Prelude hiding (atomically, take, trace, traceId, unlines)
 import Cardano.Shell.Lib (CardanoApplication (..), runCardanoApplicationWithFeatures)
+import Control.Monad (fail)
 import Control.Monad.Class.MonadSTM.Strict (MonadSTM (atomically), newTVar, readTVar)
+import Control.Monad.Class.MonadTime
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.List as List
 import qualified Data.List.NonEmpty as NE
 import Data.Map.Strict (size)
 import Data.Text (Text, breakOn, pack, take)
+import Morpho.Common.Conversions
 import Morpho.Common.Socket
 import Morpho.Config.Logging (loggingFeatures)
 import Morpho.Config.Logging hiding (hostname)
@@ -49,6 +52,7 @@ import Morpho.Tracing.Types
 import Network.HTTP.Client hiding (Proxy)
 import Network.HostName (getHostName)
 import Ouroboros.Consensus.Block.Abstract
+import Ouroboros.Consensus.BlockchainTime.WallClock.Types
 import Ouroboros.Consensus.Config
 import Ouroboros.Consensus.Config.SupportsNode
 import Ouroboros.Consensus.Fragment.InFuture (defaultClockSkew)
@@ -89,7 +93,14 @@ runNode loggingLayer nc nCli = do
   let trace =
         setHostname hn $
           appendName "node" (llBasicTrace loggingLayer)
-  pInfo <- protocolInfoMorpho nc
+
+  start <- maybe (SystemStart <$> getCurrentTime) pure (ncSystemStart nc)
+  privKeyStr <- liftIO . readFile $ ncNodePrivKeyFile nc
+  privKey <- case importPrivateKey $ bytesFromHex privKeyStr of
+    Nothing -> fail $ "Invalid private key in: " <> show (ncNodePrivKeyFile nc)
+    Just pk -> return pk
+
+  let pInfo = protocolInfoMorpho nc privKey start
   tracers <- mkTracers (ncTraceOpts nc) trace
   handleSimpleNode pInfo trace tracers nCli nc
   where