[release/1.3.1] [CO-354] Override RequiresNetworkMagic from CoreConfiguration

core/src/Pos/Aeson/Core/Configuration.hs

@@ -6,9 +6,21 @@ module Pos.Aeson.Core.Configuration
     (
     ) where
 
-import           Data.Aeson.TH (deriveJSON)
+import           Universum
+
+import           Data.Aeson (FromJSON, parseJSON, withObject, (.!=), (.:), (.:?))
+import           Data.Aeson.TH (deriveToJSON)
 import           Serokell.Aeson.Options (defaultOptions)
 
 import           Pos.Core.Configuration.Core (CoreConfiguration (..))
+import           Pos.Crypto (RequiresNetworkMagic (..))
+
+deriveToJSON defaultOptions ''CoreConfiguration
 
-deriveJSON defaultOptions ''CoreConfiguration
+instance FromJSON CoreConfiguration where
+    parseJSON = withObject "core" $ \obj -> do
+        ccg   <- obj .: "genesis"
+        ccdsv <- obj .: "dbSerializeVersion"
+        -- If "requiresNetworkMagic" is not specified, default to NMMustBeJust
+        ccrnm <- obj .:? "requiresNetworkMagic" .!= NMMustBeJust
+        pure $ CoreConfiguration ccg ccdsv ccrnm

core/src/Pos/Core/Configuration.hs

@@ -105,18 +105,21 @@ withCoreConfigurations conf@CoreConfiguration{..} confDir mSystemStart mSeed act
         theGenesisData <- case Canonical.fromJSON gdataJSON of
             Left err -> throwM $ GenesisDataSchemaError err
             Right it -> return it
+        -- Override the RequiresNetworkMagic in GenesisData with the value
+        -- specified in CoreConfiguration.
+        let overriddenGenesisData = updateGD theGenesisData
 
-        let (_, theGenesisHash) = canonicalGenesisJson theGenesisData
-            pc = genesisProtocolConstantsToProtocolConstants (gdProtocolConsts theGenesisData)
-            pm = gpcProtocolMagic (gdProtocolConsts theGenesisData)
+        let (_, theGenesisHash) = canonicalGenesisJson overriddenGenesisData
+            pc = genesisProtocolConstantsToProtocolConstants (gdProtocolConsts overriddenGenesisData)
+            pm = gpcProtocolMagic (gdProtocolConsts overriddenGenesisData)
         when (theGenesisHash /= expectedHash) $
             throwM $ GenesisHashMismatch
                      (show theGenesisHash) (show expectedHash)
 
         withCoreConfiguration conf $
             withProtocolConstants pc $
-            withGenesisBlockVersionData (gdBlockVersionData theGenesisData) $
-            withGenesisData theGenesisData $
+            withGenesisBlockVersionData (gdBlockVersionData overriddenGenesisData) $
+            withGenesisData overriddenGenesisData $
             withGenesisHash theGenesisHash $
             withGeneratedSecrets Nothing $
             act pm
@@ -139,10 +142,25 @@ withCoreConfigurations conf@CoreConfiguration{..} confDir mSystemStart mSeed act
                 Just newSeed -> spec
                     { gsInitializer = overrideSeed newSeed (gsInitializer spec)
                     }
+        -- Override the RequiresNetworkMagic in GenesisSpec with the value
+        -- specified in CoreConfiguration.
+            overriddenSpec = updateGS theSpec
 
-        let theConf = conf {ccGenesis = GCSpec theSpec}
+        let theConf = conf {ccGenesis = GCSpec overriddenSpec}
 
         withGenesisSpec theSystemStart theConf act
+  where
+    updateGD :: GenesisData -> GenesisData
+    updateGD gd = gd { gdProtocolConsts = updateGPC (gdProtocolConsts gd) }
+    --
+    updateGS :: GenesisSpec -> GenesisSpec
+    updateGS gs = gs { gsProtocolConstants = updateGPC (gsProtocolConstants gs) }
+    --
+    updateGPC :: GenesisProtocolConstants -> GenesisProtocolConstants
+    updateGPC gpc = gpc { gpcProtocolMagic = updatePM (gpcProtocolMagic gpc) }
+    --
+    updatePM :: ProtocolMagic -> ProtocolMagic
+    updatePM pm = pm { getRequiresNetworkMagic = ccRequiresNetworkMagic }
 
 withGenesisSpec
     :: Timestamp

core/src/Pos/Core/Configuration/Core.hs

@@ -42,7 +42,7 @@ import           Pos.Core.Genesis (FakeAvvmOptions (..), GenesisAvvmBalances (..
 import           Pos.Core.ProtocolConstants (VssMaxTTL (..), VssMinTTL (..))
 import           Pos.Core.Slotting (EpochIndex (..))
 import           Pos.Core.Update (BlockVersionData (..), SoftforkRule (..))
-import           Pos.Crypto (ProtocolMagic (..))
+import           Pos.Crypto (ProtocolMagic (..), RequiresNetworkMagic (..))
 import           Pos.Crypto.Hashing (Hash)
 
 data GenesisConfiguration
@@ -123,17 +123,22 @@ instance FromJSON GenesisConfiguration where
 data CoreConfiguration = CoreConfiguration
     {
       -- | Specifies the genesis
-      ccGenesis            :: !GenesisConfiguration
+      ccGenesis              :: !GenesisConfiguration
 
       -- | Versioning for values in node's DB
-    , ccDbSerializeVersion :: !Word8
+    , ccDbSerializeVersion   :: !Word8
+
+      -- | Specifies whether address discrimination takes place on this chain
+    , ccRequiresNetworkMagic :: !RequiresNetworkMagic
 
     }
     deriving (Show, Generic)
 
 
 defaultCoreConfiguration :: ProtocolMagic -> CoreConfiguration
-defaultCoreConfiguration pm = CoreConfiguration (GCSpec (defaultGenesisSpec pm))  0
+defaultCoreConfiguration pm = CoreConfiguration (GCSpec (defaultGenesisSpec pm))
+                                                0
+                                                NMMustBeJust
 
 defaultGenesisSpec :: ProtocolMagic -> GenesisSpec
 defaultGenesisSpec pm = UnsafeGenesisSpec

core/src/Pos/Core/Genesis/Canonical.hs

@@ -196,12 +196,24 @@ instance Monad m => ToJSON m GenesisProtocolConstants where
             ]
 
 instance Monad m => ToJSON m ProtocolMagic where
-    toJSON (ProtocolMagic (ProtocolMagicId ident) rnm) = do
-        (\jsIdent jsRNM -> JSObject
-            [ ("pm", jsIdent)
-            , ("requiresNetworkMagic", jsRNM) ])
-        <$> toJSON ident
-        <*> toJSON rnm
+    -- | We only output the `ProtocolMagicId` such that we don't alter the
+    -- resulting hash digest of the genesis block.
+    --
+    -- In the function, `withCoreConfigurations`, we compare the hash of the
+    -- canonical JSON representation of a hardcoded genesis block with an
+    -- accompanying hardcoded hash of that same genesis block at its inception
+    -- (both of which can be found in lib/configuration.yaml). This allows us
+    -- to verify the integrity of the genesis block and ensure that it hasn't
+    -- been altered.
+    --
+    -- As a result of this addition of the `RequiresNetworkMagic` field to
+    -- `ProtocolMagic`, we cannot include the newly introduced
+    -- `RequiresNetworkMagic` field of `ProtocolMagic` as it would produce
+    -- invalid hashes for previously existing genesis blocks.
+    --
+    -- See the implementation of `withCoreConfigurations` for more detail on
+    -- how this works.
+    toJSON (ProtocolMagic (ProtocolMagicId ident) _rnm) = toJSON ident
 
 instance Monad m => ToJSON m GenesisAvvmBalances where
     toJSON = toJSON . getGenesisAvvmBalances

core/test/Test/Pos/Core/Arbitrary.hs

@@ -21,6 +21,8 @@ module Test.Pos.Core.Arbitrary
        , genVssCertificate
        , genSlotId
        , genLocalSlotIndex
+       , genGenesisData
+       , genGenesisProtocolConstants
        ) where
 
 import           Universum
@@ -558,15 +560,22 @@ instance Arbitrary ProtocolConstants where
         ProtocolConstants <$> choose (1, 20000) <*> pure vssMin <*> pure vssMax
 
 instance Arbitrary G.GenesisProtocolConstants where
-    arbitrary = do
-        pm <- arbitrary
-        flip G.genesisProtocolConstantsFromProtocolConstants pm <$> arbitrary
+    arbitrary = genGenesisProtocolConstants arbitrary
+
+genGenesisProtocolConstants
+    :: Gen ProtocolMagic
+    -> Gen G.GenesisProtocolConstants
+genGenesisProtocolConstants genPM =
+    flip G.genesisProtocolConstantsFromProtocolConstants <$> genPM <*> arbitrary
 
 instance (HasProtocolConstants) => Arbitrary G.GenesisData where
-    arbitrary = G.GenesisData
+    arbitrary = genGenesisData arbitrary
+
+genGenesisData :: Gen G.GenesisProtocolConstants -> Gen G.GenesisData
+genGenesisData genGPC = G.GenesisData
         <$> arbitrary <*> arbitrary <*> arbitraryStartTime
         <*> arbitraryVssCerts <*> arbitrary <*> arbitraryBVD
-        <*> arbitrary <*> arbitrary <*> arbitrary
+        <*> genGPC <*> arbitrary <*> arbitrary
       where
         -- System start time should be multiple of a second.
         arbitraryStartTime = Timestamp . convertUnit @Second <$> arbitrary
@@ -576,6 +585,7 @@ instance (HasProtocolConstants) => Arbitrary G.GenesisData where
             True
         hasKnownFeePolicy _ = False
         arbitraryVssCerts = G.GenesisVssCertificatesMap . mkVssCertificatesMapLossy <$> arbitrary
+
 ----------------------------------------------------------------------------
 -- Arbitrary miscellaneous types
 ----------------------------------------------------------------------------

core/test/Test/Pos/Core/ExampleHelpers.hs

@@ -96,6 +96,7 @@ module Test.Pos.Core.ExampleHelpers
 
         -- Helpers
         , feedPM
+        , feedPMWithNMMustBeJust
         , feedPC
         , feedPMC
        ) where
@@ -168,7 +169,7 @@ import           Pos.Merkle (mkMerkleTree, mtRoot)
 
 import           Test.Pos.Core.Gen (genProtocolConstants)
 import           Test.Pos.Crypto.Bi (getBytes)
-import           Test.Pos.Crypto.Gen (genProtocolMagic)
+import           Test.Pos.Crypto.Gen (genProtocolMagic, genProtocolMagicId)
 
 --------------------------------------------------------------------------------
 -- Helpers
@@ -177,6 +178,11 @@ import           Test.Pos.Crypto.Gen (genProtocolMagic)
 feedPM :: (ProtocolMagic -> H.Gen a) -> H.Gen a
 feedPM genA = genA =<< genProtocolMagic
 
+feedPMWithNMMustBeJust :: (ProtocolMagic -> H.Gen a) -> H.Gen a
+feedPMWithNMMustBeJust genA = do
+    pm <- flip ProtocolMagic NMMustBeJust <$> genProtocolMagicId
+    genA pm
+
 feedPC :: (ProtocolConstants -> H.Gen a) -> H.Gen a
 feedPC genA = genA =<< genProtocolConstants
 

core/test/Test/Pos/Core/Gen.hs

@@ -218,8 +218,8 @@ import           Pos.Util.Util (leftToPanic)
 import           Serokell.Data.Memory.Units (Byte)
 
 import           Test.Pos.Crypto.Gen (genAbstractHash, genDecShare, genHDAddressPayload,
-                                      genProtocolMagic, genProxySignature, genPublicKey,
-                                      genRedeemPublicKey, genRedeemSignature, genSafeSigner,
+                                      genProxySignature, genPublicKey, genRedeemPublicKey,
+                                      genRedeemSignature, genRequiresNetworkMagic, genSafeSigner,
                                       genSecretKey, genSignTag, genSignature, genVssPublicKey)
 
 
@@ -494,6 +494,7 @@ genCoreConfiguration pm =
     CoreConfiguration
         <$> genGenesisConfiguration pm
         <*> genWord8
+        <*> genRequiresNetworkMagic
 
 ----------------------------------------------------------------------------
 -- Pos.Core.Delegation Generators
@@ -542,7 +543,7 @@ genGenesisData pm =
         <*> genGenesisVssCertificatesMap pm
         <*> genGenesisNonAvvmBalances
         <*> genBlockVersionDataByTxFP genLinearTxFP
-        <*> genGenesisProtocolConstants
+        <*> genGenesisProtocolConstants pm
         <*> genGenesisAvvmBalances
         <*> genSharedSeed
   where
@@ -586,11 +587,11 @@ genGenesisInitializer =
         <*> Gen.bool
         <*> Gen.integral (Range.constant 0 10)
 
-genGenesisProtocolConstants :: Gen GenesisProtocolConstants
-genGenesisProtocolConstants =
+genGenesisProtocolConstants :: ProtocolMagic -> Gen GenesisProtocolConstants
+genGenesisProtocolConstants pm =
     GenesisProtocolConstants
         <$> Gen.int (Range.constant 0 100)
-        <*> genProtocolMagic
+        <*> pure pm
         <*> genVssMaxTTL
         <*> genVssMinTTL
 
@@ -602,7 +603,7 @@ genGenesisSpec pm = mkGenSpec >>=  either (error . toText) pure
                       <*> genSharedSeed
                       <*> genGenesisDelegation pm
                       <*> genBlockVersionData
-                      <*> genGenesisProtocolConstants
+                      <*> genGenesisProtocolConstants pm
                       <*> genGenesisInitializer
 
 genTestnetBalanceOptions :: Gen TestnetBalanceOptions

core/test/Test/Pos/Core/Json.hs

@@ -21,7 +21,8 @@ import           Test.Pos.Core.ExampleHelpers (exampleAddress, exampleAddress1,
                                                exampleGenesisProtocolConstants0,
                                                exampleGenesisProtocolConstants0YesNetworkMagic,
                                                exampleGenesisProtocolConstants1,
-                                               exampleGenesisProtocolConstants2, feedPM)
+                                               exampleGenesisProtocolConstants2, feedPM,
+                                               feedPMWithNMMustBeJust)
 import           Test.Pos.Core.Gen (genAddress, genBlockVersionData, genByte, genCoin,
                                     genCoinPortion, genEpochIndex, genFlatSlotId,
                                     genGenesisAvvmBalances, genGenesisConfiguration, genGenesisData,
@@ -138,7 +139,7 @@ golden_GenesisDataDec2 =
 
 roundTripGenesisData :: Property
 roundTripGenesisData =
-    eachOf 100 (feedPM genGenesisData) roundTripsCanonicalJSONShow
+    eachOf 100 (feedPMWithNMMustBeJust genGenesisData) roundTripsCanonicalJSONShow
 
 --------------------------------------------------------------------------------
 -- GenesisAvvmBalances
@@ -264,7 +265,7 @@ golden_GenesisProtocolConstants2Dec =
 
 roundTripGenesisProtocolConstants :: Property
 roundTripGenesisProtocolConstants =
-    eachOf 1000 genGenesisProtocolConstants roundTripsAesonShow
+    eachOf 1000 (feedPM genGenesisProtocolConstants) roundTripsAesonShow
 
 --------------------------------------------------------------------------------
 -- GenesisInitializer

crypto/test/Test/Pos/Crypto/Gen.hs

@@ -3,6 +3,7 @@ module Test.Pos.Crypto.Gen
         -- Protocol Magic Generator
           genProtocolMagic
         , genProtocolMagicId
+        , genRequiresNetworkMagic
 
         -- Sign Tag Generator
         , genSignTag

lib/cardano-sl.cabal

@@ -279,6 +279,7 @@ test-suite cardano-test
 
                        -- Everything else
                        Test.Pos.Cbor.CborSpec
+                       Test.Pos.ConfigurationSpec
                        Test.Pos.ConstantsSpec
                        Test.Pos.CryptoSpec
                        Test.Pos.Diffusion.BlockSpec
@@ -331,6 +332,7 @@ test-suite cardano-test
                      , generic-arbitrary
                      , hspec
                      , lens
+                     , log-warper
                      , mtl
                      , network-transport
                      , network-transport-inmemory

lib/configuration.yaml

@@ -14776,6 +14776,8 @@ mainnet_full: &mainnet_full
         file: mainnet-genesis.json
         hash: 5f20df933584822601f9e3f8c024eb5eb252fe8cefb24d1317dc3d432e940ebb
 
+    requiresNetworkMagic: NMMustBeNothing
+
 mainnet_wallet_win64: &mainnet_wallet_win64
   <<: *mainnet_full
   update:
@@ -14900,6 +14902,8 @@ mainnet_dryrun_full: &mainnet_dryrun_full
         file: mainnet-genesis-dryrun-with-stakeholders.json
         hash: c6a004d3d178f600cd8caa10abbebe1549bef878f0665aea2903472d5abf7323
 
+    requiresNetworkMagic: NMMustBeNothing
+
 mainnet_dryrun_wallet_win64: &mainnet_dryrun_wallet_win64
   <<: *mainnet_dryrun_full
   update: