[release/1.3.1] [CO-354] Add RequiresNetworkMagic and modify ProtocolMagic

block/bench/Block.hs

@@ -24,17 +24,17 @@ import           Pos.Core (Block, BlockHeader, BlockVersionData (..), Body, Body
                            _mbUpdatePayload)
 import           Pos.Core.Block.Main ()
 import           Pos.Core.Common (CoinPortion, SharedSeed (..))
-import           Pos.Core.ProtocolConstants (ProtocolConstants (..))
 import           Pos.Core.Genesis
-import           Pos.Crypto (ProtocolMagic (..))
+import           Pos.Core.ProtocolConstants (ProtocolConstants (..))
+import           Pos.Crypto (ProtocolMagic (..), ProtocolMagicId (..), RequiresNetworkMagic (..))
 
 import           Test.Pos.Block.Arbitrary.Generate (generateMainBlock)
 
 -- We need 'ProtocolMagic' and 'ProtocolConstants' in order to generate a
 -- 'MainBlock'.
 
 pm :: ProtocolMagic
-pm = ProtocolMagic 0
+pm = ProtocolMagic (ProtocolMagicId 0) NMMustBeNothing
 
 pc :: ProtocolConstants
 pc = ProtocolConstants

block/src/Pos/Block/Logic/Integrity.hs

@@ -31,11 +31,11 @@ import           Pos.Core (BlockVersionData (..), ChainDifficulty, EpochOrSlot,
                            HasEpochIndex (..), HasEpochOrSlot (..), HasHeaderHash (..),
                            HasProtocolConstants, HeaderHash, SlotId (..), SlotLeaders, addressHash,
                            gbExtra, gbhExtra, getSlotIndex, headerSlotL, prevBlockL)
-import           Pos.Core.Block (Block, BlockHeader (..), blockHeaderProtocolMagic, gebAttributes,
+import           Pos.Core.Block (Block, BlockHeader (..), blockHeaderProtocolMagicId, gebAttributes,
                                  gehAttributes, genBlockLeaders, getBlockHeader,
                                  mainHeaderLeaderKey, mebAttributes, mehAttributes)
 import           Pos.Core.Chrono (NewestFirst (..), OldestFirst)
-import           Pos.Crypto (ProtocolMagic (getProtocolMagic))
+import           Pos.Crypto (ProtocolMagic (..), ProtocolMagicId (..), getProtocolMagic)
 import           Pos.Data.Attributes (areAttributesKnown)
 
 ----------------------------------------------------------------------------
@@ -91,7 +91,7 @@ verifyHeader pm VerifyHeaderParams {..} h =
   where
     checks =
         mconcat
-            [ checkProtocolMagic
+            [ checkProtocolMagicId
             , maybe mempty relatedToPrevHeader vhpPrevHeader
             , maybe mempty relatedToCurrentSlot vhpCurrentSlot
             , maybe mempty relatedToLeaders vhpLeaders
@@ -124,11 +124,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)
           )
         ]

core/src/Pos/Binary/Core/Blockchain.hs

@@ -15,7 +15,7 @@ import           Pos.Binary.Core.Block ()
 import           Pos.Binary.Core.Common ()
 import qualified Pos.Core.Block.Blockchain as T
 import           Pos.Core.Block.Union.Types (BlockHeader (..))
-import           Pos.Crypto.Configuration (ProtocolMagic (..))
+import           Pos.Crypto.Configuration (ProtocolMagicId (..))
 import           Pos.Util.Util (cborError)
 
 instance ( Typeable b
@@ -26,14 +26,14 @@ instance ( Typeable b
          ) =>
          Bi (T.GenericBlockHeader b) where
     encode bh =  encodeListLen 5
-              <> encode (getProtocolMagic (T._gbhProtocolMagic bh))
+              <> encode (unProtocolMagicId (T._gbhProtocolMagicId bh))
               <> encode (T._gbhPrevBlock bh)
               <> encode (T._gbhBodyProof bh)
               <> encode (T._gbhConsensus bh)
               <> encode (T._gbhExtra bh)
     decode = do
         enforceSize "GenericBlockHeader b" 5
-        _gbhProtocolMagic <- ProtocolMagic <$> decode
+        _gbhProtocolMagicId <- ProtocolMagicId <$> decode
         _gbhPrevBlock <- decode
         _gbhBodyProof <- decode
         _gbhConsensus <- decode

core/src/Pos/Core/Block/Blockchain.hs

@@ -15,7 +15,7 @@ module Pos.Core.Block.Blockchain
 
        -- * Lenses
        -- ** Header
-       , gbhProtocolMagic
+       , gbhProtocolMagicId
        , gbhPrevBlock
        , gbhBodyProof
        , gbhConsensus
@@ -36,7 +36,7 @@ import           Control.Lens (makeLenses)
 import           Control.Monad.Except (MonadError (throwError))
 import           Formatting (build, sformat, (%))
 
-import           Pos.Crypto (ProtocolMagic)
+import           Pos.Crypto (ProtocolMagic (..), ProtocolMagicId)
 
 ----------------------------------------------------------------------------
 -- Blockchain class
@@ -94,15 +94,15 @@ class Blockchain p where
 -- general there may be some invariants which must hold for the
 -- contents of header.
 data GenericBlockHeader b = UnsafeGenericBlockHeader
-    { _gbhProtocolMagic :: !ProtocolMagic
+    { _gbhProtocolMagicId :: !ProtocolMagicId
       -- | Pointer to the header of the previous block.
-    , _gbhPrevBlock     :: !(BHeaderHash b)
+    , _gbhPrevBlock       :: !(BHeaderHash b)
     , -- | Proof of body.
-      _gbhBodyProof     :: !(BodyProof b)
+      _gbhBodyProof       :: !(BodyProof b)
     , -- | Consensus data to verify consensus algorithm.
-      _gbhConsensus     :: !(ConsensusData b)
+      _gbhConsensus       :: !(ConsensusData b)
     , -- | Any extra data.
-      _gbhExtra         :: !(ExtraHeaderData b)
+      _gbhExtra           :: !(ExtraHeaderData b)
     } deriving (Generic)
 
 deriving instance
@@ -179,8 +179,9 @@ mkGenericHeader
     -> ExtraHeaderData b
     -> GenericBlockHeader b
 mkGenericHeader pm hashPrev body consensus extra =
-    UnsafeGenericBlockHeader pm hashPrev proof (consensus proof) extra
+    UnsafeGenericBlockHeader pmId hashPrev proof (consensus proof) extra
   where
+    pmId = getProtocolMagicId pm
     proof = mkBodyProof @b body
 
 -- | Smart constructor for 'GenericBlock'.

core/src/Pos/Core/Block/Union/Types.hs

@@ -33,7 +33,7 @@ module Pos.Core.Block.Union.Types
        , HasPrevBlock (..)
 
        , blockHeaderHash
-       , blockHeaderProtocolMagic
+       , blockHeaderProtocolMagicId
 
        -- * IsHeader classes
        , IsHeader
@@ -64,7 +64,7 @@ import           Pos.Core.Slotting (HasEpochIndex (..), HasEpochOrSlot (..), Slo
 import           Pos.Core.Ssc (mkSscProof)
 import           Pos.Core.Txp (mkTxProof)
 import           Pos.Core.Update (HasBlockVersion (..), HasSoftwareVersion (..), mkUpdateProof)
-import           Pos.Crypto (Hash, ProtocolMagic, PublicKey, Signature, hash, unsafeHash)
+import           Pos.Crypto (Hash, ProtocolMagicId, PublicKey, Signature, hash, unsafeHash)
 import           Pos.Util.Some (Some, applySome, liftLensSome)
 
 ----------------------------------------------------------------------------
@@ -264,9 +264,9 @@ instance (BHeaderHash b ~ HeaderHash) =>
     prevBlockL = gbHeader . gbhPrevBlock
 
 -- | 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
 
 makePrisms 'BlockHeaderGenesis
 

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

@@ -131,11 +131,12 @@ data CoreConfiguration = CoreConfiguration
     }
     deriving (Show, Generic)
 
-defaultCoreConfiguration :: CoreConfiguration
-defaultCoreConfiguration = CoreConfiguration (GCSpec defaultGenesisSpec)  0
 
-defaultGenesisSpec :: GenesisSpec
-defaultGenesisSpec = UnsafeGenesisSpec
+defaultCoreConfiguration :: ProtocolMagic -> CoreConfiguration
+defaultCoreConfiguration pm = CoreConfiguration (GCSpec (defaultGenesisSpec pm))  0
+
+defaultGenesisSpec :: ProtocolMagic -> GenesisSpec
+defaultGenesisSpec pm = UnsafeGenesisSpec
   (GenesisAvvmBalances HM.empty)
   (SharedSeed "c2tvdm9yb2RhIEdndXJkYSBib3JvZGEgcHJvdm9kYSA=")
   noGenesisDelegation
@@ -159,7 +160,7 @@ defaultGenesisSpec = UnsafeGenesisSpec
     (EpochIndex maxBound)
   )
   (GenesisProtocolConstants 10
-                            (ProtocolMagic 55550001)
+                            pm
                             (VssMaxTTL 6)
                             (VssMinTTL 2)
   )

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

@@ -11,6 +11,7 @@ import           Universum
 import           Control.Lens (_Left)
 import           Data.Fixed (Fixed (..))
 import qualified Data.HashMap.Strict as HM
+import           Data.List (lookup)
 import           Data.Time.Units (Millisecond, Second, convertUnit)
 import           Data.Typeable (typeRep)
 import           Formatting (formatToString)
@@ -39,7 +40,8 @@ import           Pos.Crypto (ProxyCert, ProxySecretKey (..), PublicKey, RedeemPu
                              decodeAbstractHash, fromAvvmPk, fullProxyCertHexF, fullPublicKeyF,
                              fullSignatureHexF, hashHexF, parseFullProxyCert, parseFullPublicKey,
                              parseFullSignature, redeemPkB64UrlF)
-import           Pos.Crypto.Configuration (ProtocolMagic (..))
+import           Pos.Crypto.Configuration (ProtocolMagic (..), ProtocolMagicId (..),
+                                           RequiresNetworkMagic (..))
 
 import           Pos.Core.Genesis.AvvmBalances (GenesisAvvmBalances (..))
 import           Pos.Core.Genesis.Data (GenesisData (..))
@@ -188,11 +190,19 @@ 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 Monad m => ToJSON m ProtocolMagic where
+    toJSON (ProtocolMagic (ProtocolMagicId ident) rnm) = do
+        (\jsIdent jsRNM -> JSObject
+            [ ("pm", jsIdent)
+            , ("requiresNetworkMagic", jsRNM) ])
+        <$> toJSON ident
+        <*> toJSON rnm
+
 instance Monad m => ToJSON m GenesisAvvmBalances where
     toJSON = toJSON . getGenesisAvvmBalances
 
@@ -419,11 +429,26 @@ instance ReportSchemaErrors m => FromJSON m GenesisDelegation where
 instance ReportSchemaErrors 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 {..}
 
+-- Here we default to `NMMustBeJust` (what testnets use) if only
+-- a ProtocolMagic identifier is provided.
+instance ReportSchemaErrors m => FromJSON m ProtocolMagic where
+    fromJSON = \case
+        (JSNum n) -> pure (ProtocolMagic (ProtocolMagicId (fromIntegral n))
+                                         NMMustBeJust)
+        (JSObject dict) -> ProtocolMagic
+            <$> (ProtocolMagicId <$> expectLookup "pm: <int>" "pm" dict)
+            <*> expectLookup "requiresNetworkMagic: <NMMustBeNothing | \
+                             \NMMustBeJust>"
+                             "requiresNetworkMagic"
+                             dict
+        other ->
+            expected "NMMustBeNothing | NMMustBeJust" (Just (show other))
+
 instance ReportSchemaErrors m => FromJSON m GenesisAvvmBalances where
     fromJSON = fmap GenesisAvvmBalances . fromJSON
 
@@ -465,3 +490,12 @@ instance (ReportSchemaErrors m) => FromJSON m GenesisData where
         gdAvvmDistr <- fromJSField obj "avvmDistr"
         gdFtsSeed <- fromJSField obj "ftsSeed"
         return GenesisData {..}
+
+
+-- Helpers
+
+expectLookup :: (ReportSchemaErrors m, FromJSON m a)
+             => String -> String -> [(String, JSValue)] -> m a
+expectLookup msg key dict = case lookup key dict of
+    Nothing -> expected msg Nothing
+    Just x  -> fromJSON x

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

@@ -34,7 +34,7 @@ import           Pos.Core.Slotting (EpochIndex (..), EpochOrSlot (..), FlatSlotI
 import           Pos.Core.Ssc (SscPayload (..), SscProof (..))
 import           Pos.Core.Txp (Tx (..), TxInWitness (..), TxOutAux (..))
 import           Pos.Core.Update (ApplicationName (..), SoftforkRule (..))
-import           Pos.Crypto (Hash, ProtocolMagic (..), PublicKey (..), SignTag (..), abstractHash,
+import           Pos.Crypto (Hash, ProtocolMagic (..), ProtocolMagicId (..), RequiresNetworkMagic (..), PublicKey (..), SignTag (..), abstractHash,
                              createPsk, hash, proxySign, redeemDeterministicKeyGen, sign, toPublic)
 import           Pos.Data.Attributes (mkAttributes)
 import           Pos.Merkle (mkMerkleTree, mtRoot)
@@ -1066,8 +1066,12 @@ roundTripTxProof = eachOf 50 (feedPM genTxProof) roundTripsBiBuildable
 golden_TxSig :: Property
 golden_TxSig = goldenTestBi txSigGold "test/golden/TxSig"
     where
-        txSigGold = sign (ProtocolMagic 0) SignForTestingOnly
-                         exampleSecretKey exampleTxSigData
+        txSigGold = sign (ProtocolMagic { getProtocolMagicId = ProtocolMagicId 0
+                                        , getRequiresNetworkMagic = NMMustBeNothing
+                                        })
+                         SignForTestingOnly
+                         exampleSecretKey
+                         exampleTxSigData
 
 roundTripTxSig :: Property
 roundTripTxSig = eachOf 50 (feedPM genTxSig) roundTripsBiBuildable
@@ -1242,32 +1246,46 @@ exampleBlockHeaderGenesis = (BlockHeaderGenesis exampleGenesisBlockHeader)
 
 exampleBlockHeaderMain :: MainBlockHeader
 exampleBlockHeaderMain =
-  mkMainHeaderExplicit (ProtocolMagic 0) exampleHeaderHash
-                       exampleChainDifficulty exampleSlotId
-                       exampleSecretKey Nothing
-                       exampleMainBody exampleMainExtraHeaderData
+  mkMainHeaderExplicit (ProtocolMagic { getProtocolMagicId = ProtocolMagicId 0
+                                      , getRequiresNetworkMagic = NMMustBeNothing
+                                      })
+                       exampleHeaderHash
+                       exampleChainDifficulty
+                       exampleSlotId
+                       exampleSecretKey
+                       Nothing
+                       exampleMainBody
+                       exampleMainExtraHeaderData
 
 exampleBlockSignature :: BlockSignature
-exampleBlockSignature = BlockSignature (sign (ProtocolMagic 7)
-                                              SignMainBlock
-                                              exampleSecretKey
-                                              exampleMainToSign)
+exampleBlockSignature = BlockSignature (sign pm
+                                             SignMainBlock
+                                             exampleSecretKey
+                                             exampleMainToSign)
+  where
+    pm = ProtocolMagic { getProtocolMagicId = ProtocolMagicId 7
+                       , getRequiresNetworkMagic = NMMustBeNothing
+                       }
 
 exampleBlockPSignatureLight :: BlockSignature
 exampleBlockPSignatureLight = BlockPSignatureLight sig
   where
     sig = proxySign pm SignProxySK delegateSk psk exampleMainToSign
     [delegateSk, issuerSk] = exampleSecretKeys 5 2
     psk = createPsk pm issuerSk (toPublic delegateSk) exampleLightDlgIndices
-    pm = ProtocolMagic 2
+    pm = ProtocolMagic { getProtocolMagicId = ProtocolMagicId 2
+                       , getRequiresNetworkMagic = NMMustBeNothing
+                       }
 
 exampleBlockPSignatureHeavy :: BlockSignature
 exampleBlockPSignatureHeavy = BlockPSignatureHeavy sig
   where
     sig = proxySign pm SignProxySK delegateSk psk exampleMainToSign
     [delegateSk, issuerSk] = exampleSecretKeys 5 2
     psk = createPsk pm issuerSk (toPublic delegateSk) (staticHeavyDlgIndexes !! 0)
-    pm = ProtocolMagic 2
+    pm = ProtocolMagic { getProtocolMagicId = ProtocolMagicId 2
+                       , getRequiresNetworkMagic = NMMustBeNothing
+                       }
 
 exampleMainConsensusData :: MainConsensusData
 exampleMainConsensusData = MainConsensusData exampleSlotId
@@ -1283,24 +1301,31 @@ exampleMainExtraHeaderData =
                         (abstractHash (MainExtraBodyData (mkAttributes ())))
 
 exampleGenesisBlockHeader :: GenesisBlockHeader
-exampleGenesisBlockHeader = mkGenesisHeader (ProtocolMagic 0)
+exampleGenesisBlockHeader = mkGenesisHeader pm
                                             (Left (GenesisHash prevHash))
                                             (EpochIndex 11)
                                             exampleGenesisBody
   where
+    pm = ProtocolMagic { getProtocolMagicId = ProtocolMagicId 0
+                       , getRequiresNetworkMagic = NMMustBeNothing
+                       }
     prevHash = coerce (hash ("genesisHash" :: Text)) :: Hash a
 
 -- We use `Nothing` as the ProxySKBlockInfo to avoid clashing key errors
 -- (since we use example keys which aren't related to each other)
 exampleMainBlockHeader :: MainBlockHeader
-exampleMainBlockHeader = mkMainHeaderExplicit (ProtocolMagic 7)
+exampleMainBlockHeader = mkMainHeaderExplicit pm
                                               exampleHeaderHash
                                               exampleChainDifficulty
                                               exampleSlotId
                                               exampleSecretKey
                                               Nothing
                                               exampleMainBody
                                               exampleMainExtraHeaderData
+  where
+    pm = ProtocolMagic { getProtocolMagicId = ProtocolMagicId 7
+                       , getRequiresNetworkMagic = NMMustBeNothing
+                       }
 
 exampleMainProof :: MainProof
 exampleMainProof = MainProof exampleTxProof exampleSscProof