Update NodeConfig's JSON instance to optionally parse ConwayGenesisFi…

…le and ConwayGenesisHash
IntersectMBO · Jun 19, 2024 · 122fb48 · 122fb48
1 parent 068dbd7
commit 122fb48
Showing 1 changed file with 36 additions and 19 deletions.
diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs
@@ -212,7 +212,6 @@ import qualified Data.Yaml as Yaml
 import           Formatting.Buildable (build)
 import           Lens.Micro
 import           Network.TypedProtocol.Pipelined (Nat (..))
-import           System.Directory (doesFileExist)
 import           System.FilePath
 
 data InitialLedgerStateError
@@ -888,12 +887,16 @@ readNodeConfig
   => NodeConfigFile 'In
   -> m NodeConfig
 readNodeConfig (File ncf) = do
-    ncfg <- (liftEither . parseNodeConfig) =<< readByteString ncf "node"
+    ncfg <- liftEither . parseNodeConfig =<< readByteString ncf "node"
     return ncfg
-      { ncByronGenesisFile = mapFile (mkAdjustPath ncf) (ncByronGenesisFile ncfg)
-      , ncShelleyGenesisFile = mapFile (mkAdjustPath ncf) (ncShelleyGenesisFile ncfg)
-      , ncAlonzoGenesisFile = mapFile (mkAdjustPath ncf) (ncAlonzoGenesisFile ncfg)
-      , ncConwayGenesisFile = mapFile (mkAdjustPath ncf) (ncConwayGenesisFile ncfg)
+      { ncByronGenesisFile =
+          mapFile (mkAdjustPath ncf) (ncByronGenesisFile ncfg)
+      , ncShelleyGenesisFile =
+          mapFile (mkAdjustPath ncf) (ncShelleyGenesisFile ncfg)
+      , ncAlonzoGenesisFile =
+          mapFile (mkAdjustPath ncf) (ncAlonzoGenesisFile ncfg)
+      , ncConwayGenesisFile =
+          mapFile (mkAdjustPath ncf) <$> ncConwayGenesisFile ncfg
       }
 
 data NodeConfig = NodeConfig
@@ -904,8 +907,8 @@ data NodeConfig = NodeConfig
   , ncShelleyGenesisHash :: !GenesisHashShelley
   , ncAlonzoGenesisFile :: !(File AlonzoGenesis 'In)
   , ncAlonzoGenesisHash :: !GenesisHashAlonzo
-  , ncConwayGenesisFile :: !(File ConwayGenesisConfig 'In)
-  , ncConwayGenesisHash :: !GenesisHashConway
+  , ncConwayGenesisFile :: !(Maybe (File ConwayGenesisConfig 'In))
+  , ncConwayGenesisHash :: !(Maybe GenesisHashConway)
   , ncRequiresNetworkMagic :: !Cardano.Crypto.RequiresNetworkMagic
   , ncByronProtocolVersion :: !Cardano.Chain.Update.ProtocolVersion
   , ncHardForkTriggers :: !Consensus.CardanoHardForkTriggers
@@ -925,8 +928,8 @@ instance FromJSON NodeConfig where
           <*> fmap GenesisHashShelley (o .: "ShelleyGenesisHash")
           <*> fmap File (o .: "AlonzoGenesisFile")
           <*> fmap GenesisHashAlonzo (o .: "AlonzoGenesisHash")
-          <*> fmap File (o .: "ConwayGenesisFile")
-          <*> fmap GenesisHashConway (o .: "ConwayGenesisHash")
+          <*> (fmap . fmap) File (o .:? "ConwayGenesisFile")
+          <*> (fmap . fmap) GenesisHashConway (o .:? "ConwayGenesisHash")
           <*> o .: "RequiresNetworkMagic"
           <*> parseByronProtocolVersion o
           <*> parseHardForkTriggers o
@@ -1264,12 +1267,12 @@ readConwayGenesisConfig
   => NodeConfig
   -> t m (ConwayGenesis Consensus.StandardCrypto)
 readConwayGenesisConfig enc = do
-  let file = ncConwayGenesisFile enc
-  fileExists <- liftIO . doesFileExist $ unFile file
-  if fileExists
-  then modifyError (NEConwayConfig (unFile file) . renderConwayGenesisError)
-         $ readConwayGenesis file (ncConwayGenesisHash enc)
-  else return conwayGenesisDefaults
+  let mFile = ncConwayGenesisFile enc
+  case mFile of
+    Nothing -> return conwayGenesisDefaults
+    Just fp ->
+      modifyError (NEConwayConfig (unFile fp) . renderConwayGenesisError)
+        $ readConwayGenesis (ncConwayGenesisFile enc) (ncConwayGenesisHash enc)
 
 readShelleyGenesis
   :: forall m t. MonadIOTransError ShelleyGenesisError t m
@@ -1368,10 +1371,13 @@ renderAlonzoGenesisError sge =
 
 readConwayGenesis
   :: forall m t. MonadIOTransError ConwayGenesisError t m
-  => ConwayGenesisFile 'In
-  -> GenesisHashConway
+  => Maybe (ConwayGenesisFile 'In)
+  -> Maybe GenesisHashConway
   -> t m (ConwayGenesis Consensus.StandardCrypto)
-readConwayGenesis (File file) expectedGenesisHash = do
+readConwayGenesis Nothing Nothing = return conwayGenesisDefaults
+readConwayGenesis (Just fp) Nothing = throwError $ ConwayGenesisHashMissing $ unFile fp
+readConwayGenesis Nothing (Just _) = throwError ConwayGenesisFileMissing
+readConwayGenesis (Just (File file)) (Just expectedGenesisHash) = do
     content <- modifyError id $ handleIOExceptT (ConwayGenesisReadError file . textShow) $ BS.readFile file
     let genesisHash = GenesisHashConway (Cardano.Crypto.Hash.Class.hashWith id content)
     checkExpectedGenesisHash genesisHash
@@ -1385,6 +1391,8 @@ readConwayGenesis (File file) expectedGenesisHash = do
 data ConwayGenesisError
      = ConwayGenesisReadError !FilePath !Text
      | ConwayGenesisHashMismatch !GenesisHashConway !GenesisHashConway -- actual, expected
+     | ConwayGenesisHashMissing !FilePath
+     | ConwayGenesisFileMissing
      | ConwayGenesisDecodeError !FilePath !Text
      deriving Show
 
@@ -1393,6 +1401,15 @@ instance Exception ConwayGenesisError
 renderConwayGenesisError :: ConwayGenesisError -> Text
 renderConwayGenesisError sge =
     case sge of
+      ConwayGenesisFileMissing ->
+        mconcat
+          [ "\"ConwayGenesisFile\" is missing from node configuration. "
+          ]
+      ConwayGenesisHashMissing fp ->
+        mconcat
+          [ "\"ConwayGenesisHash\" is missing from node configuration: "
+          , Text.pack fp
+          ]
       ConwayGenesisReadError fp err ->
         mconcat
           [ "There was an error reading the genesis file: ", Text.pack fp