[CO-410] Add RequiresNetworkMagic and modify ProtocolMagic

chain/bench/block-bench.hs

@@ -20,15 +20,16 @@ import           Pos.Chain.Delegation (DlgPayload)
 import           Pos.Chain.Ssc (SscPayload)
 import           Pos.Chain.Txp (TxPayload (..))
 import           Pos.Chain.Update (UpdatePayload)
-import           Pos.Crypto (ProtocolMagic (..))
+import           Pos.Crypto (ProtocolMagic (..), ProtocolMagicId (..),
+                     RequiresNetworkMagic (..))
 
 import           Test.Pos.Chain.Block.Arbitrary.Generate (generateMainBlock)
 
 -- We need 'ProtocolMagic' and 'ProtocolConstants' in order to generate a
 -- 'MainBlock'.
 
 pm :: ProtocolMagic
-pm = ProtocolMagic 0
+pm = ProtocolMagic (ProtocolMagicId 0) RequiresNoMagic
 
 -- | A test subject: a MainBlock, and its various components, each paired with
 -- its serialization.

chain/src/Pos/Chain/Block/Configuration.hs

@@ -74,7 +74,7 @@ data BlockConfiguration = BlockConfiguration
       -- | Chain quality will be also calculated for this amount of seconds.
     , ccFixedTimeCQ            :: !Second
 
-    } deriving (Show, Generic)
+    } deriving (Eq, Generic, Show)
 
 instance ToJSON BlockConfiguration where
     toJSON = genericToJSON defaultOptions

chain/src/Pos/Chain/Block/Header.hs

@@ -5,7 +5,7 @@
 
 module Pos.Chain.Block.Header
        ( BlockHeader (..)
-       , blockHeaderProtocolMagic
+       , blockHeaderProtocolMagicId
        , blockHeaderHash
        , choosingBlockHeader
        , _BlockHeaderGenesis
@@ -22,7 +22,7 @@ module Pos.Chain.Block.Header
 
        , GenericBlockHeader
        , mkGenericBlockHeaderUnsafe
-       , gbhProtocolMagic
+       , gbhProtocolMagicId
        , gbhPrevBlock
        , gbhBodyProof
        , gbhConsensus
@@ -102,10 +102,10 @@ import           Pos.Core.Common (ChainDifficulty, HasDifficulty (..))
 import           Pos.Core.Slotting (EpochIndex (..), EpochOrSlot (..),
                      HasEpochIndex (..), HasEpochOrSlot (..), SlotId (..),
                      slotIdF)
-import           Pos.Crypto (Hash, ProtocolMagic (..), PublicKey, SecretKey,
-                     SignTag (..), Signature, checkSig, hashHexF,
-                     isSelfSignedPsk, proxySign, proxyVerify, psigPsk, sign,
-                     toPublic, unsafeHash)
+import           Pos.Crypto (Hash, ProtocolMagic (..), ProtocolMagicId (..),
+                     PublicKey, SecretKey, SignTag (..), Signature, checkSig,
+                     hashHexF, isSelfSignedPsk, proxySign, proxyVerify,
+                     psigPsk, sign, toPublic, unsafeHash)
 import           Pos.Util.Some (Some, applySome)
 import           Pos.Util.Util (cborError, cerealError)
 
@@ -159,9 +159,9 @@ instance Bi BlockHeader where
            _ -> cborError $ "decode@BlockHeader: unknown tag " <> pretty t
 
 -- | The 'ProtocolMagic' in a 'BlockHeader'.
-blockHeaderProtocolMagic :: BlockHeader -> ProtocolMagic
-blockHeaderProtocolMagic (BlockHeaderGenesis gbh) = _gbhProtocolMagic gbh
-blockHeaderProtocolMagic (BlockHeaderMain mbh)    = _gbhProtocolMagic mbh
+blockHeaderProtocolMagicId :: BlockHeader -> ProtocolMagicId
+blockHeaderProtocolMagicId (BlockHeaderGenesis gbh) = _gbhProtocolMagicId gbh
+blockHeaderProtocolMagicId (BlockHeaderMain mbh)    = _gbhProtocolMagicId mbh
 
 -- | Verify a BlockHeader in isolation. There is nothing to be done for
 -- genesis headers.
@@ -227,30 +227,30 @@ blockHeaderHash = unsafeHash
 -- general there may be some invariants which must hold for the
 -- contents of header.
 data GenericBlockHeader bodyProof consensus extra = GenericBlockHeader
-    { _gbhProtocolMagic :: !ProtocolMagic
+    { _gbhProtocolMagicId :: !ProtocolMagicId
       -- | Pointer to the header of the previous block.
-    , _gbhPrevBlock     :: !HeaderHash
+    , _gbhPrevBlock       :: !HeaderHash
     , -- | Proof of body.
-      _gbhBodyProof     :: !bodyProof
+      _gbhBodyProof       :: !bodyProof
     , -- | Consensus data to verify consensus algorithm.
-      _gbhConsensus     :: !consensus
+      _gbhConsensus       :: !consensus
     , -- | Any extra data.
-      _gbhExtra         :: !extra
+      _gbhExtra           :: !extra
     } deriving (Eq, Show, Generic, NFData)
 
 instance
     (Bi bodyProof, Bi consensus, Bi extra)
     => Bi (GenericBlockHeader bodyProof consensus extra)
   where
     encode bh =  encodeListLen 5
-              <> encode (getProtocolMagic (_gbhProtocolMagic bh))
+              <> encode (unProtocolMagicId (_gbhProtocolMagicId bh))
               <> encode (_gbhPrevBlock bh)
               <> encode (_gbhBodyProof bh)
               <> encode (_gbhConsensus bh)
               <> encode (_gbhExtra bh)
     decode = do
         enforceSize "GenericBlockHeader b" 5
-        _gbhProtocolMagic <- ProtocolMagic <$> decode
+        _gbhProtocolMagicId <- ProtocolMagicId <$> decode
         _gbhPrevBlock <- decode
         _gbhBodyProof <- decode
         _gbhConsensus <- decode
@@ -263,15 +263,15 @@ instance
   where
     getCopy =
         contain $
-        do _gbhProtocolMagic <- safeGet
+        do _gbhProtocolMagicId <- safeGet
            _gbhPrevBlock <- safeGet
            _gbhBodyProof <- safeGet
            _gbhConsensus <- safeGet
            _gbhExtra <- safeGet
            return $! GenericBlockHeader {..}
     putCopy GenericBlockHeader {..} =
         contain $
-        do safePut _gbhProtocolMagic
+        do safePut _gbhProtocolMagicId
            safePut _gbhPrevBlock
            safePut _gbhBodyProof
            safePut _gbhConsensus
@@ -285,7 +285,9 @@ mkGenericBlockHeaderUnsafe
     -> consensus
     -> extra
     -> GenericBlockHeader bodyProof consensus extra
-mkGenericBlockHeaderUnsafe = GenericBlockHeader
+mkGenericBlockHeaderUnsafe pm = GenericBlockHeader pmi
+  where
+    pmi = getProtocolMagicId pm
 
 
 --------------------------------------------------------------------------------
@@ -328,12 +330,13 @@ mkGenesisHeader
     -> GenesisBlockHeader
 mkGenesisHeader pm prevHeader epoch body =
     GenericBlockHeader
-        pm
+        pmi
         (either getGenesisHash headerHash prevHeader)
         (mkGenesisProof body)
         consensus
         (GenesisExtraHeaderData $ mkAttributes ())
   where
+    pmi = getProtocolMagicId pm
     difficulty = either (const 0) (view difficultyL) prevHeader
     consensus = GenesisConsensusData {_gcdEpoch = epoch, _gcdDifficulty = difficulty}
 
@@ -399,8 +402,9 @@ mkMainHeaderExplicit
     -> MainExtraHeaderData
     -> MainBlockHeader
 mkMainHeaderExplicit pm prevHash difficulty slotId sk pske body extra =
-    GenericBlockHeader pm prevHash proof consensus extra
+    GenericBlockHeader pmi prevHash proof consensus extra
   where
+    pmi = getProtocolMagicId pm
     proof = mkMainProof body
     makeSignature toSign (psk,_) =
         BlockPSignatureHeavy $ proxySign pm SignMainBlockHeavy sk psk toSign

chain/src/Pos/Chain/Block/Logic/Integrity.hs

@@ -31,7 +31,7 @@ import           Pos.Chain.Block.Block (Block, gbExtra, genBlockLeaders,
 import           Pos.Chain.Block.Genesis (gebAttributes, gehAttributes)
 import           Pos.Chain.Block.HasPrevBlock (prevBlockL)
 import           Pos.Chain.Block.Header (BlockHeader (..), HasHeaderHash (..),
-                     HeaderHash, blockHeaderProtocolMagic, gbhExtra,
+                     HeaderHash, blockHeaderProtocolMagicId, gbhExtra,
                      mainHeaderLeaderKey, verifyBlockHeader)
 import           Pos.Chain.Block.IsHeader (headerSlotL)
 import           Pos.Chain.Block.Main (mebAttributes, mehAttributes)
@@ -43,7 +43,8 @@ import           Pos.Core (ChainDifficulty, EpochOrSlot, HasDifficulty (..),
 import           Pos.Core.Attributes (areAttributesKnown)
 import           Pos.Core.Chrono (NewestFirst (..), OldestFirst)
 import           Pos.Core.Slotting (EpochIndex)
-import           Pos.Crypto (ProtocolMagic (..))
+import           Pos.Crypto (ProtocolMagic (..), ProtocolMagicId (..),
+                     getProtocolMagic)
 
 ----------------------------------------------------------------------------
 -- Header
@@ -100,7 +101,7 @@ verifyHeader pm VerifyHeaderParams {..} h =
   where
     checks =
         mconcat
-            [ checkProtocolMagic
+            [ checkProtocolMagicId
             , maybe mempty relatedToPrevHeader vhpPrevHeader
             , maybe mempty relatedToCurrentSlot vhpCurrentSlot
             , maybe mempty relatedToLeaders vhpLeaders
@@ -135,11 +136,11 @@ verifyHeader pm VerifyHeaderParams {..} h =
               ("two adjacent blocks are from different epochs ("%build%" != "%build%")")
               oldEpoch newEpoch
         )
-    checkProtocolMagic =
-        [ ( pm == blockHeaderProtocolMagic h
+    checkProtocolMagicId =
+        [ ( getProtocolMagicId pm == blockHeaderProtocolMagicId h
           , sformat
                 ("protocol magic number mismatch: got "%int%" but expected "%int)
-                (getProtocolMagic (blockHeaderProtocolMagic h))
+                (unProtocolMagicId (blockHeaderProtocolMagicId h))
                 (getProtocolMagic pm)
           )
         ]

chain/src/Pos/Chain/Genesis/Config.hs

@@ -70,7 +70,7 @@ import           Pos.Core.ProtocolConstants (ProtocolConstants (..),
                      pcBlkSecurityParam, pcChainQualityThreshold, pcEpochSlots,
                      pcSlotSecurityParam, vssMaxTTL, vssMinTTL)
 import           Pos.Core.Slotting (SlotCount, Timestamp)
-import           Pos.Crypto (ProtocolMagic)
+import           Pos.Crypto (ProtocolMagic (..), RequiresNetworkMagic)
 import           Pos.Crypto.Hashing (Hash, hashRaw, unsafeHash)
 import           Pos.Util.Json.Canonical (SchemaError)
 import           Pos.Util.Util (leftToPanic)
@@ -101,7 +101,7 @@ instance ToJSON StaticConfig where
 instance FromJSON StaticConfig where
     parseJSON (Object o)
         | HM.member "src" o  = GCSrc <$> ((o .: "src") >>= (.: "file"))
-                                      <*> ((o .: "src") >>= (.: "hash"))
+                                     <*> ((o .: "src") >>= (.: "hash"))
         | HM.member "spec" o = do
               -- GCSpec Object
               specO <- o .: "spec"
@@ -148,9 +148,9 @@ instance FromJSON StaticConfig where
                           avvmBalanceFactor
                           useHeavyDlg
                           seed)
-        | otherwise = fail "Incorrect JSON encoding for GenesisConfiguration"
+        | otherwise = fail "Incorrect JSON encoding for StaticConfig"
 
-    parseJSON invalid = typeMismatch "GenesisConfiguration" invalid
+    parseJSON invalid = typeMismatch "StaticConfig" invalid
 
 --------------------------------------------------------------------------------
 -- Config
@@ -256,9 +256,10 @@ mkConfigFromStaticConfig
     -> Maybe Integer
     -- ^ Optional seed which overrides one from testnet initializer if
     -- provided.
+    -> RequiresNetworkMagic
     -> StaticConfig
     -> m Config
-mkConfigFromStaticConfig confDir mSystemStart mSeed = \case
+mkConfigFromStaticConfig confDir mSystemStart mSeed rnm = \case
     -- If a 'GenesisData' source file is given, we check its hash against the
     -- given expected hash, parse it, and use the GenesisData to fill in all of
     -- the obligations.
@@ -276,10 +277,16 @@ mkConfigFromStaticConfig confDir mSystemStart mSeed = \case
         theGenesisData <- case Canonical.fromJSON gdataJSON of
             Left err -> throwM $ GenesisDataSchemaError err
             Right it -> return it
-
-        let (_, theGenesisHash) = canonicalGenesisJson theGenesisData
-            pc = genesisProtocolConstantsToProtocolConstants (gdProtocolConsts theGenesisData)
-            pm = gpcProtocolMagic (gdProtocolConsts theGenesisData)
+        -- Override the RequiresNetworkMagic in GenesisData with the value
+        -- specified in Configuration.
+        let overriddenGenesisData = updateGD theGenesisData
+
+        let (_, theGenesisHash) = canonicalGenesisJson overriddenGenesisData
+            pc = genesisProtocolConstantsToProtocolConstants (gdProtocolConsts overriddenGenesisData)
+            -- We must override the `getRequiresNetworkMagic` field of the `ProtocolMagic`,
+            -- in order to preserve backwards compatibility of configuration.
+            pm = (gpcProtocolMagic (gdProtocolConsts overriddenGenesisData))
+                     { getRequiresNetworkMagic = rnm }
         when (theGenesisHash /= expectedHash) $
             throwM $ GenesisHashMismatch
                      (show theGenesisHash) (show expectedHash)
@@ -288,7 +295,7 @@ mkConfigFromStaticConfig confDir mSystemStart mSeed = \case
             { configProtocolMagic     = pm
             , configProtocolConstants = pc
             , configGeneratedSecrets  = Nothing
-            , configGenesisData       = theGenesisData
+            , configGenesisData       = overriddenGenesisData
             , configGenesisHash       = GenesisHash $ coerce theGenesisHash
             }
 
@@ -310,8 +317,23 @@ mkConfigFromStaticConfig confDir mSystemStart mSeed = \case
                 Just newSeed -> spec
                     { gsInitializer = overrideSeed newSeed (gsInitializer spec)
                     }
+            -- Override the RequiresNetworkMagic in GenesisSpec with the value
+            -- specified in Configuration.
+            overriddenSpec = updateGS theSpec
 
-        pure $ mkConfig theSystemStart theSpec
+        pure $ mkConfig theSystemStart overriddenSpec
+  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 = rnm }
 
 mkConfig :: Timestamp -> GenesisSpec -> Config
 mkConfig theSystemStart spec = Config

chain/src/Pos/Chain/Genesis/Data.hs

@@ -6,7 +6,7 @@ module Pos.Chain.Genesis.Data
 
 import           Universum
 
-import           Control.Monad.Except (MonadError (..))
+import           Control.Monad.Except (MonadError)
 import           Text.JSON.Canonical (FromJSON (..), ToJSON (..), fromJSField,
                      mkObject)
 

chain/src/Pos/Chain/Genesis/ProtocolConstants.hs

@@ -16,7 +16,7 @@ import           Text.JSON.Canonical (FromJSON (..), Int54, JSValue (..),
 
 import           Pos.Core.ProtocolConstants (ProtocolConstants (..),
                      VssMaxTTL (..), VssMinTTL (..))
-import           Pos.Crypto.Configuration (ProtocolMagic (..))
+import           Pos.Crypto.Configuration (ProtocolMagic)
 import           Pos.Util.Json.Canonical (SchemaError)
 
 -- | 'GensisProtocolConstants' are not really part of genesis global state,
@@ -38,15 +38,15 @@ instance Monad m => ToJSON m GenesisProtocolConstants where
         mkObject
             -- 'k' definitely won't exceed the limit
             [ ("k", pure . JSNum . fromIntegral $ gpcK)
-            , ("protocolMagic", toJSON (getProtocolMagic gpcProtocolMagic))
+            , ("protocolMagic", toJSON gpcProtocolMagic)
             , ("vssMaxTTL", toJSON gpcVssMaxTTL)
             , ("vssMinTTL", toJSON gpcVssMinTTL)
             ]
 
 instance MonadError SchemaError m => FromJSON m GenesisProtocolConstants where
     fromJSON obj = do
         gpcK <- fromIntegral @Int54 <$> fromJSField obj "k"
-        gpcProtocolMagic <- ProtocolMagic <$> fromJSField obj "protocolMagic"
+        gpcProtocolMagic <- fromJSField obj "protocolMagic"
         gpcVssMaxTTL <- fromJSField obj "vssMaxTTL"
         gpcVssMinTTL <- fromJSField obj "vssMinTTL"
         return GenesisProtocolConstants {..}

chain/src/Pos/Chain/Ssc/Configuration.hs

@@ -37,7 +37,7 @@ data SscConfiguration = SscConfiguration
       -- | Don't print “SSC couldn't compute seed” for the first epoch.
     , ccNoReportNoSecretsForEpoch1    :: !Bool
     }
-    deriving (Show, Generic)
+    deriving (Eq, Generic, Show)
 
 instance FromJSON SscConfiguration where
     parseJSON = genericParseJSON defaultOptions

chain/src/Pos/Chain/Update/Configuration.hs

@@ -55,7 +55,7 @@ data UpdateConfiguration = UpdateConfiguration
       -- | System tag.
     , ccSystemTag             :: !SystemTag
     }
-    deriving (Show, Generic)
+    deriving (Eq, Generic, Show)
 
 instance ToJSON UpdateConfiguration where
     toJSON = genericToJSON defaultOptions