Check NetworkID in mined transactions

src/Chainweb/Mempool/Mempool.hs

@@ -243,6 +243,7 @@ data InsertError
   | InsertErrorPactParseError Text
   | InsertErrorWrongChain Text Text
   | InsertErrorDefPactComplete Text
+  | InsertErrorWrongNetworkId Text
   deriving (Generic, Eq, NFData)
 
 instance Show InsertError where
@@ -265,6 +266,7 @@ instance Show InsertError where
       InsertErrorWrongChain expected actual -> "Wrong chain, expected: " <> T.unpack expected <> ", actual: " <> T.unpack actual
       InsertErrorDefPactComplete i ->
         "This transaction is attempting to complete an already-completed defpact ID: " <> T.unpack i
+      InsertErrorWrongNetworkId wrongId -> "Wrong network ID: " <> T.unpack wrongId
 
 instance Exception InsertError
 

src/Chainweb/Pact/PactService.hs

@@ -1180,13 +1180,14 @@ execPreInsertCheckReq txs = pactLabel "execPreInsertCheckReq" $ do
                 let
                     parentTime = ParentCreationTime (view blockCreationTime $ _parentHeader ph)
                     currHeight = succ $ view blockHeight $ _parentHeader ph
+                    pForkNumber = (view blockForkNumber $ _parentHeader ph)
                     isGenesis = False
                 forM txs $ \tx ->
                     fmap (either Just (\_ -> Nothing)) $ runExceptT $ do
                         -- it's safe to use initialBlockHandle here because it's
                         -- only used to check for duplicate pending txs in a block
                         pact5Tx <- mapExceptT liftIO $ Pact5.validateRawChainwebTx
-                            logger v cid db initialBlockHandle parentTime currHeight isGenesis tx
+                            logger v cid db initialBlockHandle parentTime currHeight pForkNumber isGenesis tx
                         let logger' = addLabel ("transaction", "attemptBuyGas") logger
                         ExceptT $ Pact5.pactTransaction Nothing $ \pactDb -> runExceptT $ do
                             let txCtx = Pact5.TxContext ph noMiner

src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs

@@ -25,6 +25,7 @@ module Chainweb.Pact.PactService.Pact5.ExecBlock
 
 import Chainweb.BlockHeader
 import Chainweb.BlockHeight
+import Chainweb.ForkState
 import Chainweb.Logger
 import Chainweb.Mempool.Mempool(BlockFill (..), pact5RequestKeyToTransactionHash, InsertError (..))
 import Chainweb.MinerReward
@@ -328,11 +329,12 @@ continueBlock mpAccess blockInProgress = do
     cid <- view chainId
     logger <- view (psServiceEnv . psLogger)
     dbEnv <- view psBlockDbEnv
+    pForkNumber <- (view blockForkNumber . _parentHeader) <$> view psParentHeader
     let (pHash, pHeight, parentTime) = blockInProgressParent blockInProgress
     isGenesis <- view psIsGenesis
     let validate bhi _bha txs = do
           forM txs $
-            runExceptT . validateRawChainwebTx logger v cid dbEnv (_blockInProgressHandle blockInProgress) (ParentCreationTime parentTime) bhi isGenesis
+            runExceptT . validateRawChainwebTx logger v cid dbEnv (_blockInProgressHandle blockInProgress) (ParentCreationTime parentTime) bhi pForkNumber isGenesis
     liftIO $ mpaGetBlock mpAccess blockFillState validate
       (succ pHeight)
       pHash
@@ -480,21 +482,31 @@ validateParsedChainwebTx
         -- ^ reference time for tx validation.
     -> BlockHeight
         -- ^ Current block height
+    -> ForkNumber
+        -- ^ Current fork number
     -> Bool
         -- ^ Genesis?
     -> Pact5.Transaction
     -> ExceptT InsertError IO ()
-validateParsedChainwebTx _logger v cid db _blockHandle txValidationTime bh isGenesis tx
+validateParsedChainwebTx _logger v cid db _blockHandle txValidationTime bh fn isGenesis tx
   | isGenesis = pure ()
   | otherwise = do
       checkUnique tx
       checkTxHash tx
       checkChain
       checkTxSigs tx
       checkTimes tx
+      checkNetworkId
       return ()
   where
 
+    checkNetworkId :: ExceptT InsertError IO ()
+    checkNetworkId = unless (skipNetworkBlockValidation v cid fn) $
+      unless (Pact5.assertNetworkId v nid) $
+        throwError $ InsertErrorWrongNetworkId (sshow nid)
+        where
+          nid = tx ^. Pact5.cmdPayload . Pact5.payloadObj . Pact5.pNetworkId
+
     checkChain :: ExceptT InsertError IO ()
     checkChain = unless (Pact5.assertChainId cid txCid) $
         throwError $ InsertErrorWrongChain (chainIdToText cid) (Pact5._chainId txCid)
@@ -561,15 +573,17 @@ validateRawChainwebTx
         -- ^ reference time for tx validation.
     -> BlockHeight
         -- ^ Current block height
+    -> ForkNumber
+        -- ^ Current fork number
     -> Bool
         -- ^ Genesis?
     -> Pact4.UnparsedTransaction
     -> ExceptT InsertError IO Pact5.Transaction
-validateRawChainwebTx logger v cid db blockHandle parentTime bh isGenesis tx = do
+validateRawChainwebTx logger v cid db blockHandle parentTime bh fn isGenesis tx = do
   tx' <- either (throwError . InsertErrorPactParseError . either id Pact5.renderText) return $ Pact5.parsePact4Command tx
   liftIO $ do
     logDebug_ logger $ "validateRawChainwebTx: parse succeeded"
-  validateParsedChainwebTx logger v cid db blockHandle parentTime bh isGenesis tx'
+  validateParsedChainwebTx logger v cid db blockHandle parentTime bh fn isGenesis tx'
   return $! tx'
 
 execExistingBlock
@@ -590,12 +604,20 @@ execExistingBlock currHeader payload = do
   db <- view psBlockDbEnv
   isGenesis <- view psIsGenesis
   blockHandlePreCoinbase <- use pbBlockHandle
+
+  let pForkNumber = parentBlockHeader ^. blockForkNumber
+
+  unless (skipNetworkBlockValidation v cid pForkNumber) $
+    when (V.length txs /= (S.size . S.fromList . fmap Pact5._cmdHash . V.toList) txs) $
+      throwM (BlockValidationFailure $ BlockValidationFailureMsg "Invalid Block content")
+
   let
     txValidationTime = ParentCreationTime (parentBlockHeader ^. blockCreationTime)
   errors <- liftIO $ flip foldMap txs $ \tx -> do
     errorOrSuccess <- runExceptT $
       validateParsedChainwebTx logger v cid db blockHandlePreCoinbase txValidationTime
         (view blockHeight currHeader)
+        pForkNumber
         isGenesis
         tx
     case errorOrSuccess of

src/Chainweb/Version/Guards.hs

@@ -53,6 +53,7 @@ module Chainweb.Version.Guards
     , chainweb31
     , chainweb32
     , migratePlatformShare
+    , skipNetworkBlockValidation
     , pact5
     , pact44NewTrans
     , pact4ParserVersion
@@ -329,6 +330,10 @@ chainweb31 = checkFork atOrAfter Chainweb31
 chainweb32 :: ChainwebVersion -> ChainId -> ForkNumber -> Bool
 chainweb32 = checkFork' atOrAfter Chainweb32
 
+-- TODO == TO NOT FORGET To be set for next Fork
+skipNetworkBlockValidation :: ChainwebVersion -> ChainId -> ForkNumber -> Bool
+skipNetworkBlockValidation _ _ _= False
+
 migratePlatformShare :: ChainwebVersion -> ChainId -> BlockHeight -> Bool
 migratePlatformShare = checkFork atNotGenesis MigratePlatformShare