Generalize forkUpgrades to indexByForkHeights (#1823)

kadena-io · Feb 15, 2024 · f13025b · f13025b
1 parent c97366d
commit f13025b
Show file tree

Hide file tree

Showing 6 changed files with 15 additions and 15 deletions.
diff --git a/src/Chainweb/Version.hs b/src/Chainweb/Version.hs
@@ -114,7 +114,7 @@ module Chainweb.Version
     , checkAdjacentChainIds
 
     -- ** Utilities for constructing Chainweb Version
-    , forkUpgrades
+    , indexByForkHeights
     , latestBehaviorAt
     , domainAddr2PeerInfo
 
@@ -553,17 +553,16 @@ instance HasChainGraph (ChainwebVersion, BlockHeight) where
 domainAddr2PeerInfo :: [HostAddress] -> [PeerInfo]
 domainAddr2PeerInfo = fmap (PeerInfo Nothing)
 
--- | Creates a map from fork heights to upgrades.
-forkUpgrades
+-- | A utility to allow indexing behavior by forks, returning that behavior
+-- indexed by the block heights of those forks.
+indexByForkHeights
     :: ChainwebVersion
-    -> [(Fork, ChainMap Upgrade)]
-    -> ChainMap (HashMap BlockHeight Upgrade)
-forkUpgrades v = OnChains . foldl' go (HM.empty <$ HS.toMap (chainIds v))
+    -> [(Fork, ChainMap a)]
+    -> ChainMap (HashMap BlockHeight a)
+indexByForkHeights v = OnChains . foldl' go (HM.empty <$ HS.toMap (chainIds v))
   where
     conflictError fork h =
-        error $ "conflicting upgrades at block height " <> show h <> " when adding upgrade for fork " <> show fork
-    emptyUpgradeError fork =
-        error $ "empty set of upgrade transactions for fork " <> show fork
+        error $ "conflicting behavior at block height " <> show h <> " when adding behavior for fork " <> show fork
     go acc (fork, txsPerChain) =
         HM.unionWith
             (HM.unionWithKey (conflictError fork))
@@ -573,7 +572,6 @@ forkUpgrades v = OnChains . foldl' go (HM.empty <$ HS.toMap (chainIds v))
             [ (cid, HM.singleton forkHeight upg)
             | cid <- HM.keys acc
             , Just upg <- [txsPerChain ^? onChain cid]
-            , not (null $ _upgradeTransactions upg) || emptyUpgradeError fork
             , ForkAtBlockHeight forkHeight <- [v ^?! versionForks . at fork . _Just . onChain cid]
             , forkHeight /= maxBound
             ]

diff --git a/src/Chainweb/Version/Mainnet.hs b/src/Chainweb/Version/Mainnet.hs
@@ -177,7 +177,7 @@ mainnet = ChainwebVersion
             ]
         }
     , _versionUpgrades = chainZip HM.union
-        (forkUpgrades mainnet
+        (indexByForkHeights mainnet
         [ (CoinV2, onChains
             [ (unsafeChainId 0, upgrade MN0.transactions)
             , (unsafeChainId 1, upgrade MN1.transactions)

diff --git a/src/Chainweb/Version/RecapDevelopment.hs b/src/Chainweb/Version/RecapDevelopment.hs
@@ -71,7 +71,7 @@ recapDevnet = ChainwebVersion
             Chainweb223Pact -> AllChains $ ForkAtBlockHeight $ BlockHeight 600
 
     , _versionUpgrades = foldr (chainZip HM.union) (AllChains mempty)
-        [ forkUpgrades recapDevnet
+        [ indexByForkHeights recapDevnet
             [ (CoinV2, onChains [(unsafeChainId i, upgrade RecapDevnet.transactions) | i <- [0..9]])
             , (Pact4Coin3, AllChains (Upgrade CoinV3.transactions True))
             , (Chainweb214Pact, AllChains (Upgrade CoinV4.transactions True))

diff --git a/src/Chainweb/Version/Registry.hs b/src/Chainweb/Version/Registry.hs
@@ -85,9 +85,11 @@ validateVersion v = do
                     , hasAllChains (_genesisBlockTarget $ _versionGenesis v)
                     , hasAllChains (_genesisTime $ _versionGenesis v)
                     ])]
+            , [ "validateVersion: some upgrade has no transactions"
+              | any (any (\upg -> null (_upgradeTransactions upg))) (_versionUpgrades v) ]
             ]
     unless (null errors) $
-        error $ unlines $ ["errors encountered validating version " <> show v <> ":"] <> errors
+        error $ unlines $ ["errors encountered validating version", show v] <> errors
 
 -- | Look up a version in the registry by code.
 lookupVersionByCode :: HasCallStack => ChainwebVersionCode -> ChainwebVersion

diff --git a/src/Chainweb/Version/Testnet.hs b/src/Chainweb/Version/Testnet.hs
@@ -148,7 +148,7 @@ testnet = ChainwebVersion
             ]
         }
     , _versionUpgrades = chainZip HM.union
-        (forkUpgrades testnet
+        (indexByForkHeights testnet
         [ (CoinV2, onChains $
             [ (unsafeChainId 0, upgrade MN0.transactions)
             , (unsafeChainId 1, upgrade MN1.transactions)

diff --git a/test/Chainweb/Test/TestVersions.hs b/test/Chainweb/Test/TestVersions.hs
@@ -227,7 +227,7 @@ cpmTestVersion g v = v
         , _genesisTime = AllChains $ BlockCreationTime epoch
         }
     & versionUpgrades .~ chainZip HM.union
-        (forkUpgrades v
+        (indexByForkHeights v
             [ (CoinV2, AllChains (upgrade Other.transactions))
             , (Pact4Coin3, AllChains (Upgrade CoinV3.transactions True))
             , (Chainweb214Pact, AllChains (Upgrade CoinV4.transactions True))