Make DijkstraGenesis optional in DbSynthesizer

Author: jasagredo

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/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