Make DijkstraGenesis optional in unstable-cardano-tools (#1727)

Forwards-port of #1725

Author: jasagredo

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -566,6 +566,7 @@ library unstable-cardano-tools
     cardano-ledger-byron,
     cardano-ledger-conway,
     cardano-ledger-core,
+    cardano-ledger-dijkstra,
     cardano-ledger-mary,
     cardano-ledger-shelley,
     cardano-prelude,

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Cardano.hs

@@ -20,6 +20,8 @@ import Cardano.Api.Any (Error (..))
 import qualified Cardano.Chain.Update as Byron
 import qualified Cardano.Ledger.Api.Era as L
 import qualified Cardano.Ledger.Api.Transition as SL
+import Cardano.Ledger.BaseTypes
+import Cardano.Ledger.Dijkstra.PParams
 import qualified Cardano.Node.Protocol.Alonzo as Alonzo
 import qualified Cardano.Node.Protocol.Byron as Byron
 import qualified Cardano.Node.Protocol.Conway as Conway
@@ -28,6 +30,7 @@ import qualified Cardano.Node.Protocol.Shelley as Shelley
 import Cardano.Node.Types
 import Control.Monad.Trans.Except (ExceptT)
 import Control.Monad.Trans.Except.Extra (firstExceptT)
+import Data.Maybe (fromMaybe)
 import Ouroboros.Consensus.Cardano
 import qualified Ouroboros.Consensus.Cardano as Consensus
 import Ouroboros.Consensus.Cardano.Condense ()
@@ -56,7 +59,7 @@ mkConsensusProtocolCardano ::
   NodeShelleyProtocolConfiguration ->
   NodeAlonzoProtocolConfiguration ->
   NodeConwayProtocolConfiguration ->
-  NodeDijkstraProtocolConfiguration ->
+  Maybe NodeDijkstraProtocolConfiguration ->
   NodeHardForkProtocolConfiguration ->
   Maybe ProtocolFilepaths ->
   ExceptT CardanoProtocolInstantiationError IO (CardanoProtocolParams StandardCrypto)
@@ -84,10 +87,7 @@ mkConsensusProtocolCardano
     { npcConwayGenesisFile
     , npcConwayGenesisFileHash
     }
-  NodeDijkstraProtocolConfiguration
-    { npcDijkstraGenesisFile
-    , npcDijkstraGenesisFileHash
-    }
+  npcDijkstraProtocolConfig
   NodeHardForkProtocolConfiguration
     { npcTestEnableDevelopmentHardForkEras = _
     , -- During testing of the latest unreleased era, we conditionally
@@ -133,11 +133,20 @@ mkConsensusProtocolCardano
           npcConwayGenesisFile
           npcConwayGenesisFileHash
 
-    (dijkstraGenesis, _dijkstraGenesisHash) <-
-      firstExceptT CardanoProtocolInstantiationDijkstraGenesisReadError $
-        readGenesisAny
-          npcDijkstraGenesisFile
-          npcDijkstraGenesisFileHash
+    dijkstraGenesis <- case npcDijkstraProtocolConfig of
+      Nothing -> pure emptyDijkstraGenesis
+      Just
+        ( NodeDijkstraProtocolConfiguration
+            { npcDijkstraGenesisFile
+            , npcDijkstraGenesisFileHash
+            }
+          ) -> do
+          (dijkstraGenesis, _dijkstraGenesisHash) <-
+            firstExceptT CardanoProtocolInstantiationDijkstraGenesisReadError $
+              readGenesisAny
+                npcDijkstraGenesisFile
+                npcDijkstraGenesisFileHash
+          pure dijkstraGenesis
 
     shelleyLeaderCredentials <-
       firstExceptT CardanoProtocolInstantiationPraosLeaderCredentialsError $
@@ -247,6 +256,18 @@ mkConsensusProtocolCardano
         emptyCheckpointsMap
         (ProtVer (L.eraProtVerHigh @L.LatestKnownEra) 0)
 
+-- | An empty Dijkstra genesis to be provided when none is specified in the config.
+emptyDijkstraGenesis :: SL.DijkstraGenesis
+emptyDijkstraGenesis =
+  let upgradePParamsDef =
+        UpgradeDijkstraPParams
+          { udppMaxRefScriptSizePerBlock = 1048576
+          , udppMaxRefScriptSizePerTx = 204800
+          , udppRefScriptCostStride = unsafeNonZero 25600
+          , udppRefScriptCostMultiplier = fromMaybe (error "impossible") $ boundRational 1.2
+          }
+   in SL.DijkstraGenesis{SL.dgUpgradePParams = upgradePParamsDef}
+
 ------------------------------------------------------------------------------
 -- Errors
 --

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs

@@ -31,7 +31,9 @@ import qualified Cardano.Crypto.Hash.Class as CryptoClass
 import Cardano.Crypto.Raw (Raw)
 import qualified Cardano.Ledger.Api.Era as L
 import qualified Cardano.Ledger.Api.Transition as SL
+import Cardano.Ledger.BaseTypes (boundRational, unsafeNonZero)
 import Cardano.Ledger.Core (TxOut)
+import Cardano.Ledger.Dijkstra.PParams
 import qualified Cardano.Ledger.Shelley.LedgerState as Shelley.LedgerState
 import qualified Cardano.Ledger.Shelley.UTxO as Shelley.UTxO
 import Cardano.Ledger.TxIn (TxIn)
@@ -47,7 +49,7 @@ import qualified Data.ByteString as BS
 import qualified Data.Compact as Compact
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, fromMaybe)
 import Data.SOP.BasicFunctors
 import Data.SOP.Functors
 import Data.SOP.Strict
@@ -157,9 +159,11 @@ instance HasProtocolInfo (CardanoBlock StandardCrypto) where
     genesisConway <-
       either (error . show) return
         =<< Aeson.eitherDecodeFileStrict' (conwayGenesisPath cc)
-    genesisDijkstra <-
-      either (error . show) return
-        =<< Aeson.eitherDecodeFileStrict' (dijkstraGenesisPath cc)
+    genesisDijkstra <- case dijkstraGenesisPath cc of
+      Nothing -> pure emptyDijkstraGenesis
+      Just fp ->
+        either (error . show) return
+          =<< Aeson.eitherDecodeFileStrict' fp
 
     let transCfg =
           SL.mkLatestTransitionConfig genesisShelley genesisAlonzo genesisConway genesisDijkstra
@@ -182,6 +186,18 @@ instance HasProtocolInfo (CardanoBlock StandardCrypto) where
         initialNonce
         (cfgHardForkTriggers cc)
 
+-- | An empty Dijkstra genesis to be provided when none is specified in the config.
+emptyDijkstraGenesis :: SL.DijkstraGenesis
+emptyDijkstraGenesis =
+  let upgradePParamsDef =
+        UpgradeDijkstraPParams
+          { udppMaxRefScriptSizePerBlock = 1048576
+          , udppMaxRefScriptSizePerTx = 204800
+          , udppRefScriptCostStride = unsafeNonZero 25600
+          , udppRefScriptCostMultiplier = fromMaybe (error "impossible") $ boundRational 1.2
+          }
+   in SL.DijkstraGenesis{SL.dgUpgradePParams = upgradePParamsDef}
+
 data CardanoConfig = CardanoConfig
   { requiresNetworkMagic :: RequiresNetworkMagic
   -- ^ @RequiresNetworkMagic@ field
@@ -197,7 +213,7 @@ data CardanoConfig = CardanoConfig
   -- ^ @AlonzoGenesisFile@ field
   , conwayGenesisPath :: FilePath
   -- ^ @ConwayGenesisFile@ field
-  , dijkstraGenesisPath :: FilePath
+  , dijkstraGenesisPath :: Maybe FilePath
   -- ^ @DijkstraGenesisFile@ field
   , cfgHardForkTriggers :: CardanoHardForkTriggers
   -- ^ @Test*HardForkAtEpoch@ for each Shelley era
@@ -210,7 +226,7 @@ instance AdjustFilePaths CardanoConfig where
       , shelleyGenesisPath = f $ shelleyGenesisPath cc
       , alonzoGenesisPath = f $ alonzoGenesisPath cc
       , conwayGenesisPath = f $ conwayGenesisPath cc
-      , dijkstraGenesisPath = f $ dijkstraGenesisPath cc
+      , dijkstraGenesisPath = f <$> dijkstraGenesisPath cc
       -- Byron, Shelley, Alonzo, and Conway are the only eras that have genesis
       -- data. The actual genesis block is a Byron block, therefore we needed a
       -- genesis file. To transition to Shelley, we needed to add some additional
@@ -241,7 +257,7 @@ instance Aeson.FromJSON CardanoConfig where
 
     conwayGenesisPath <- v Aeson..: "ConwayGenesisFile"
 
-    dijkstraGenesisPath <- v Aeson..: "DijkstraGenesisFile"
+    dijkstraGenesisPath <- v Aeson..:? "DijkstraGenesisFile"
 
     triggers <- do
       let parseTrigger ::

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Orphans.hs

@@ -34,7 +34,7 @@ instance FromJSON NodeConfigStub where
         <*> v .: "ShelleyGenesisFile"
         <*> v .: "ByronGenesisFile"
         <*> v .: "ConwayGenesisFile"
-        <*> v .: "DijkstraGenesisFile"
+        <*> v .:? "DijkstraGenesisFile"
 
 instance AdjustFilePaths NodeConfigStub where
   adjustFilePaths f nc =
@@ -43,7 +43,7 @@ instance AdjustFilePaths NodeConfigStub where
       , ncsShelleyGenesisFile = f $ ncsShelleyGenesisFile nc
       , ncsByronGenesisFile = f $ ncsByronGenesisFile nc
       , ncsConwayGenesisFile = f $ ncsConwayGenesisFile nc
-      , ncsDijkstraGenesisFile = f $ ncsDijkstraGenesisFile nc
+      , ncsDijkstraGenesisFile = fmap f $ ncsDijkstraGenesisFile nc
       }
 
 instance AdjustFilePaths NodeCredentials where

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Run.hs

@@ -121,7 +121,10 @@ initialize NodeFilePaths{nfpConfig, nfpChainDB} creds synthOptions = do
     shelleyConfig = NodeShelleyProtocolConfiguration (GenesisFile $ ncsShelleyGenesisFile confConfigStub) Nothing
     alonzoConfig = NodeAlonzoProtocolConfiguration (GenesisFile $ ncsAlonzoGenesisFile confConfigStub) Nothing
     conwayConfig = NodeConwayProtocolConfiguration (GenesisFile $ ncsConwayGenesisFile confConfigStub) Nothing
-    dijkstraConfig = NodeDijkstraProtocolConfiguration (GenesisFile $ ncsDijkstraGenesisFile confConfigStub) Nothing
+    dijkstraConfig =
+      fmap
+        (\x -> NodeDijkstraProtocolConfiguration (GenesisFile x) Nothing)
+        (ncsDijkstraGenesisFile confConfigStub)
     hfConfig_ = eitherParseJson $ ncsNodeConfig confConfigStub
     byConfig_ = eitherParseJson $ ncsNodeConfig confConfigStub
 

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Types.hs

@@ -12,7 +12,7 @@ data NodeConfigStub = NodeConfigStub
   , ncsShelleyGenesisFile :: !FilePath
   , ncsByronGenesisFile :: !FilePath
   , ncsConwayGenesisFile :: !FilePath
-  , ncsDijkstraGenesisFile :: !FilePath
+  , ncsDijkstraGenesisFile :: !(Maybe FilePath)
   }
   deriving Show