add fork number field to chainweb version

Author: larskuhtz

src/Chainweb/Version.hs

@@ -3,23 +3,24 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- |
 -- Module: Chainweb.Version
@@ -75,6 +76,7 @@ module Chainweb.Version
     , versionVerifierPluginNames
     , versionQuirks
     , versionServiceDate
+    , versionForkNumber
     , genesisBlockPayload
     , genesisBlockPayloadHash
     , genesisBlockTarget
@@ -151,27 +153,21 @@ module Chainweb.Version
 import Control.DeepSeq
 import Control.Lens hiding ((.=), (<.>), index)
 import Control.Monad.Catch
-
 import Data.Aeson hiding (pairs)
 import Data.Aeson.Types
 import Data.Foldable
 import Data.Hashable
 import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HM
-import qualified Data.HashSet as HS
+import Data.HashMap.Strict qualified as HM
+import Data.HashSet qualified as HS
 import Data.Set(Set)
 import Data.Proxy
-import qualified Data.Text as T
+import Data.Text qualified as T
 import Data.Word
-
 import GHC.Generics(Generic)
 import GHC.TypeLits
 import GHC.Stack
-
--- internal modules
-
 import Pact.Types.Runtime (Gas)
-
 import Chainweb.BlockCreationTime
 import Chainweb.BlockHeight
 import Chainweb.ChainId
@@ -181,17 +177,15 @@ import Chainweb.Graph
 import Chainweb.HostAddress
 import Chainweb.MerkleUniverse
 import Chainweb.Payload
-import qualified Chainweb.Pact4.Transaction as Pact4
-import qualified Chainweb.Pact5.Transaction as Pact5
+import Chainweb.Pact4.Transaction qualified as Pact4
+import Chainweb.Pact5.Transaction qualified as Pact5
+import Chainweb.ForkState (ForkNumber)
 import Chainweb.Utils
 import Chainweb.Utils.Rule
 import Chainweb.Utils.Serialization
-
-import Pact.Types.Verifier
-
 import Data.Singletons
-
 import P2P.Peer
+import Pact.Types.Verifier
 
 -- | Data type representing changes to block validation, whether in the payload
 -- or in the header. Always add new forks at the end, not in the middle of the
@@ -393,8 +387,8 @@ pattern ForPact5 :: f Pact5 -> ForSomePactVersion f
 pattern ForPact5 x = ForSomePactVersion Pact5T x
 {-# COMPLETE ForPact4, ForPact5 #-}
 data ForBothPactVersions f = ForBothPactVersions
-    { _forPact4 :: (f Pact4)
-    , _forPact5 :: (f Pact5)
+    { _forPact4 :: f Pact4
+    , _forPact5 :: f Pact5
     }
 deriving stock instance (Eq (f Pact4), Eq (f Pact5)) => Eq (ForBothPactVersions f)
 deriving stock instance (Show (f Pact4), Show (f Pact5)) => Show (ForBothPactVersions f)
@@ -435,7 +429,7 @@ instance NFData PactUpgrade where
 pact4Upgrade :: [Pact4.Transaction] -> PactUpgrade
 pact4Upgrade txs = Pact4Upgrade txs False
 
-data TxIdxInBlock = TxBlockIdx Word
+newtype TxIdxInBlock = TxBlockIdx Word
     deriving stock (Eq, Ord, Show, Generic)
     deriving anyclass (Hashable, NFData)
 
@@ -444,8 +438,8 @@ makePrisms ''TxIdxInBlock
 -- The type of quirks, i.e. special validation behaviors that are in some
 -- sense one-offs which can't be expressed as upgrade transactions and must be
 -- preserved.
-data VersionQuirks = VersionQuirks
-    { _quirkGasFees :: !(ChainMap (HashMap (BlockHeight, TxIdxInBlock) Gas))
+newtype VersionQuirks = VersionQuirks
+    { _quirkGasFees :: ChainMap (HashMap (BlockHeight, TxIdxInBlock) Gas)
     }
     deriving stock (Show, Eq, Ord, Generic)
     deriving anyclass (NFData)
@@ -515,6 +509,22 @@ data ChainwebVersion
         -- ^ Modifications to behavior at particular blockheights
     , _versionServiceDate :: Maybe String
         -- ^ The node service date for this version.
+    , _versionForkNumber :: ForkNumber
+        -- ^ The current fork number for this version. Starting with
+        -- chainweb-node version 2.33, fork numbers replace named forks. Fork
+        -- numbers are monotonically increasing in steps of one. Protocol
+        -- changes are guarded by minimum fork number. The fork number of a
+        -- version specifies what forks are supported by a version of
+        -- chainweb-node for a given chainweb version. Note, that it does /not/
+        -- specify what forks are active. Forks are only active if the the fork
+        -- number of the respective block header is at least the fork number of
+        -- the respective fork.
+        --
+        -- Changes to the protocol are introduced by releasing a chainweb-node
+        -- version that supports a fork number of the respecive change. Blocks
+        -- that are produced by the new chainweb-node version will then raise
+        -- the on-chain fork number in the block headers until the maximum
+        -- supported number is reached.
     }
     deriving stock (Generic)
     deriving anyclass NFData
@@ -539,6 +549,7 @@ instance Ord ChainwebVersion where
         -- , _versionGenesis v `compare` _versionGenesis v'
         , _versionCheats v `compare` _versionCheats v'
         , _versionVerifierPluginNames v `compare` _versionVerifierPluginNames v'
+        , _versionForkNumber v `compare` _versionForkNumber v'
         ]
 
 instance Eq ChainwebVersion where
@@ -722,7 +733,7 @@ genesisHeightAndGraph v c =
         -- the chain was in every graph down to the bottom,
         -- so the bottom has the genesis graph
         (False, z) -> ruleZipperHere z
-        (True, (BetweenZipper _ above))
+        (True, BetweenZipper _ above)
             -- the chain is not in this graph, and there is no graph above
             -- which could have it
             | [] <- above -> missingChainError

src/Chainweb/Version/Development.hs

@@ -65,4 +65,5 @@ devnet = ChainwebVersion
         (minBound, Set.fromList $ map VerifierName ["hyperlane_v3_message", "allow", "signed_list"])
     , _versionQuirks = noQuirks
     , _versionServiceDate = Nothing
+    , _versionForkNumber = 0
     }

src/Chainweb/Version/Guards.hs

@@ -1,8 +1,5 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 -- |

src/Chainweb/Version/Mainnet.hs

@@ -223,7 +223,7 @@ mainnet = ChainwebVersion
         , _disableMempoolSync = False
         }
     , _versionVerifierPluginNames = AllChains $
-        (4_577_530, Set.fromList $ map VerifierName ["hyperlane_v3_message"]) `Above`
+        (4_577_530, Set.fromList [VerifierName "hyperlane_v3_message"]) `Above`
         Bottom (minBound, mempty)
     , _versionQuirks = VersionQuirks
         { _quirkGasFees = onChains
@@ -232,4 +232,5 @@ mainnet = ChainwebVersion
             ]
         }
     , _versionServiceDate = Just "2026-01-07T00:00:00Z"
+    , _versionForkNumber = 0
     }

src/Chainweb/Version/RecapDevelopment.hs

@@ -129,4 +129,5 @@ recapDevnet = ChainwebVersion
         Bottom (minBound, mempty)
     , _versionQuirks = noQuirks
     , _versionServiceDate = Nothing
+    , _versionForkNumber = 0
     }

src/Chainweb/Version/Testnet04.hs

@@ -135,7 +135,7 @@ testnet04 = ChainwebVersion
         Chainweb228Pact -> AllChains $ ForkAtBlockHeight $ BlockHeight 5_155_146 -- 2025-03-11 00:00:00+00:00
         Chainweb229Pact -> AllChains $ ForkAtBlockHeight $ BlockHeight 5_300_466 -- 2025-04-30 12:00:00+00:00
         Chainweb230Pact -> AllChains $ ForkAtBlockHeight $ BlockHeight 5_542_190 -- 2025-07-23 12:00:00+00:00
-        Chainweb231Pact -> AllChains $ ForkAtBlockHeight $ BlockHeight 5_783_985 -- 2025-10-15 12:00:00+00:00 
+        Chainweb231Pact -> AllChains $ ForkAtBlockHeight $ BlockHeight 5_783_985 -- 2025-10-15 12:00:00+00:00
         Chainweb232Pact -> AllChains ForkNever
 
     , _versionGraphs =
@@ -191,7 +191,7 @@ testnet04 = ChainwebVersion
         { _disablePeerValidation = False
         , _disableMempoolSync = False
         }
-    , _versionVerifierPluginNames = AllChains $ (4_100_681, Set.fromList $ map VerifierName ["hyperlane_v3_message"]) `Above`
+    , _versionVerifierPluginNames = AllChains $ (4_100_681, Set.fromList [VerifierName "hyperlane_v3_message"]) `Above`
         Bottom (minBound, mempty)
     , _versionQuirks = VersionQuirks
         { _quirkGasFees = onChains
@@ -200,4 +200,5 @@ testnet04 = ChainwebVersion
             ]
         }
     , _versionServiceDate = Just "2026-01-07T00:00:00Z"
+    , _versionForkNumber = 0
     }