Separate Alonzo genesis file

cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs

@@ -356,13 +356,16 @@ runGenesisCreate (GenesisDir rootdir)
   utxoAddrs <- readInitialFundAddresses utxodir network
   start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mStart
 
-  let finalGenesis = updateTemplate
-                       -- Shelley genesis parameters
-                       start genDlgs mAmount utxoAddrs mempty (Lovelace 0) [] [] template
-                       -- Alono genesis parameters TODO: Parameterize
-                       (Lovelace 10) (Lovelace 1, Lovelace 1) (1,1) (1,1) 1 1 1
-
-  writeShelleyGenesis (rootdir </> "genesis.json") finalGenesis
+  let (shelleyGenesis, alonzoGenesis) =
+        updateTemplate
+          -- Shelley genesis parameters
+          start genDlgs mAmount utxoAddrs mempty (Lovelace 0) [] [] template
+          -- Alono genesis parameters TODO: Parameterize
+          (Lovelace 10) (Lovelace 1, Lovelace 1) (1,1) (1,1) 1 1 1
+
+  writeFileGenesis (rootdir </> "genesis.json")        shelleyGenesis
+  writeFileGenesis (rootdir </> "genesis.alonzo.json") alonzoGenesis
+  --TODO: rationalise the naming convention on these genesis json files.
   where
     adjustTemplate t = t { sgNetworkMagic = unNetworkMagic (toNetworkMagic network) }
     gendir  = rootdir </> "genesis-keys"
@@ -443,13 +446,18 @@ runGenesisCreateStaked (GenesisDir rootdir)
   let poolMap :: Map (Ledger.KeyHash Ledger.Staking StandardCrypto) (Ledger.PoolParams StandardCrypto)
       poolMap = Map.fromList $ mkDelegationMapEntry <$> delegations
       delegAddrs = dInitialUtxoAddr <$> delegations
-      finalGenesis = updateTemplate
-                       -- Shelley genesis parameters
-                       start genDlgs mNonDlgAmount nonDelegAddrs poolMap stDlgAmount delegAddrs stuffedUtxoAddrs template
-                       -- Alonzo genesis parameters TODO: Parameterize
-                       (Lovelace 10) (Lovelace 1, Lovelace 1) (1,1) (1,1) 1 1 1
+      (shelleyGenesis, alonzoGenesis) =
+        updateTemplate
+          -- Shelley genesis parameters
+          start genDlgs mNonDlgAmount nonDelegAddrs poolMap
+          stDlgAmount delegAddrs stuffedUtxoAddrs template
+          -- Alonzo genesis parameters TODO: Parameterize
+          (Lovelace 10) (Lovelace 1, Lovelace 1) (1,1) (1,1) 1 1 1
+
+  writeFileGenesis (rootdir </> "genesis.json")        shelleyGenesis
+  writeFileGenesis (rootdir </> "genesis.alonzo.json") alonzoGenesis
+  --TODO: rationalise the naming convention on these genesis json files.
 
-  writeShelleyGenesis (rootdir </> "genesis.json") finalGenesis
   liftIO $ Text.putStrLn $ mconcat $
     [ "generated genesis with: "
     , textShow genNumGenesisKeys, " genesis keys, "
@@ -824,23 +832,16 @@ updateTemplate (SystemStart start)
     unLovelace :: Integral a => Lovelace -> a
     unLovelace (Lovelace coin) = fromIntegral coin
 
--- We need to include Alonzo genesis parameters
-writeShelleyGenesis
-  :: FilePath
-  -> (ShelleyGenesis StandardShelley, Alonzo.AlonzoGenesis)
+writeFileGenesis
+  :: ToJSON genesis
+  => FilePath
+  -> genesis
   -> ExceptT ShelleyGenesisCmdError IO ()
-writeShelleyGenesis fpath (sg, ag) = do
-  let sgValue = toJSON sg
-      agValue = toJSON ag
-  genesisCombined <- hoistEither $ combineAndEncode sgValue agValue
-  handleIOExceptT
-    (ShelleyGenesisCmdGenesisFileError . FileIOError fpath)
-    $ LBS.writeFile fpath genesisCombined
- where
-  combineAndEncode :: Aeson.Value -> Aeson.Value -> Either ShelleyGenesisCmdError LBS.ByteString
-  combineAndEncode (Object sgO) (Object agO) = Right $ encodePretty $ sgO <> agO
-  combineAndEncode _sgWrong _agWrong = panic "combineAndEncode: Implement ShelleyGenesisCmdError constuctor"
--- -------------------------------------------------------------------------------------------------
+writeFileGenesis fpath genesis =
+  handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $
+    LBS.writeFile fpath (encodePretty genesis)
+
+-- ----------------------------------------------------------------------------
 
 readGenDelegsMap :: FilePath -> FilePath
                  -> ExceptT ShelleyGenesisCmdError IO

cardano-node-chairman/src/Testnet/ByronShelley.hs

@@ -370,9 +370,13 @@ testnet testnetOptions H.Conf {..} = do
   -- Generated genesis keys and genesis files
   H.noteEachM_ . H.listDirectory $ tempAbsPath </> "shelley"
 
-  -- Generated genesis.json
+  -- Generated shelley/genesis.json
   H.cat $ tempAbsPath </> "shelley/genesis.json"
 
+  -- Generated alonzo/genesis.json
+  --TODO: rationalise the naming convention on these genesis json files.
+  H.cat $ tempAbsPath </> "shelley/genesis.alonzo.json"
+
   -- Make the pool operator cold keys
   -- This was done already for the BFT nodes as part of the genesis creation
   forM_ poolNodes $ \node -> do

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -165,6 +165,7 @@ instance FromJSON PartialNodeConfiguration where
           CardanoProtocol ->
             Last . Just  <$> (NodeProtocolConfigurationCardano <$> parseByronProtocol v
                                                                <*> parseShelleyProtocol v
+                                                               <*> parseAlonzoProtocol v
                                                                <*> parseHardForkProtocol v)
       pure PartialNodeConfiguration {
              pncProtocolConfig
@@ -242,6 +243,15 @@ instance FromJSON PartialNodeConfiguration where
              , npcShelleyGenesisFileHash
              }
 
+      parseAlonzoProtocol v = do
+        npcAlonzoGenesisFile     <- v .:  "AlonzoGenesisFile"
+        npcAlonzoGenesisFileHash <- v .:? "AlonzoGenesisHash"
+
+        pure NodeAlonzoProtocolConfiguration {
+               npcAlonzoGenesisFile
+             , npcAlonzoGenesisFileHash
+             }
+
       parseHardForkProtocol v = do
         npcTestEnableDevelopmentHardForkEras
           <- v .:? "TestEnableDevelopmentHardForkEras"

cardano-node/src/Cardano/Node/Protocol.hs

@@ -4,13 +4,14 @@ module Cardano.Node.Protocol
   ( mkConsensusProtocol
   , SomeConsensusProtocol(..)
   , ProtocolInstantiationError(..)
-  , renderProtocolInstantiationError
   ) where
 
 import           Cardano.Prelude
 
 import           Control.Monad.Trans.Except.Extra (firstExceptT)
 
+import           Cardano.Api
+
 import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
 import           Cardano.Node.Types
 
@@ -19,6 +20,8 @@ import           Cardano.Node.Protocol.Byron
 import           Cardano.Node.Protocol.Cardano
 import           Cardano.Node.Protocol.Shelley
 import           Cardano.Node.Protocol.Types (SomeConsensusProtocol (..))
+
+
 ------------------------------------------------------------------------------
 -- Conversions from configuration into specific protocols and their params
 --
@@ -39,11 +42,13 @@ mkConsensusProtocol NodeConfiguration{ncProtocolConfig, ncProtocolFiles} =
 
       NodeProtocolConfigurationCardano byronConfig
                                        shelleyConfig
+                                       alonzoConfig
                                        hardForkConfig ->
         firstExceptT CardanoProtocolInstantiationError $
           mkSomeConsensusProtocolCardano
             byronConfig
             shelleyConfig
+            alonzoConfig
             hardForkConfig
             (Just ncProtocolFiles)
 
@@ -58,14 +63,8 @@ data ProtocolInstantiationError =
   deriving Show
 
 
-renderProtocolInstantiationError :: ProtocolInstantiationError -> Text
-renderProtocolInstantiationError pie =
-  case pie of
-    ByronProtocolInstantiationError bpie ->
-      renderByronProtocolInstantiationError bpie
-
-    ShelleyProtocolInstantiationError spie ->
-      renderShelleyProtocolInstantiationError spie
+instance Error ProtocolInstantiationError where
+  displayError (ByronProtocolInstantiationError   err) = displayError err
+  displayError (ShelleyProtocolInstantiationError err) = displayError err
+  displayError (CardanoProtocolInstantiationError err) = displayError err
 
-    CardanoProtocolInstantiationError cpie ->
-      renderCardanoProtocolInstantiationError cpie

cardano-node/src/Cardano/Node/Protocol/Alonzo.hs

@@ -3,80 +3,54 @@
 
 module Cardano.Node.Protocol.Alonzo
   ( AlonzoProtocolInstantiationError(..)
-  , renderAlonzoProtocolInstantiationError
     -- * Reusable parts
-  , readAlonzoGenesis
+  , readGenesis
+  , validateGenesis
   ) where
 
+import           Prelude (String)
 import           Cardano.Prelude
 
 import           Cardano.Api
 
-import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left)
-import qualified Data.Aeson as Aeson
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Text as Text
-import           System.IO.Error (isDoesNotExistError)
-
 import qualified Cardano.Ledger.Alonzo.Genesis as Alonzo
 
-
+import           Cardano.Node.Types
 import           Cardano.Node.Orphans ()
 
 import           Cardano.Tracing.OrphanInstances.HardFork ()
 import           Cardano.Tracing.OrphanInstances.Shelley ()
 
+import           Cardano.Node.Protocol.Shelley (readGenesisAny, GenesisReadError)
 
 --
 -- Alonzo genesis
 --
 
--- | In order to avoid introducing a separate Alonzo genesis file, we
--- have added additional fields to the Shelley genesis that are required
--- when hardforking to Alonzo. Unfortunately the 'ShelleyGenesis' 'FromJSON'
--- instance exists in cardano-ledger-specs so we must duplicate code for now.
-
-readAlonzoGenesis
-  :: FilePath
-  -> ExceptT AlonzoProtocolInstantiationError IO Alonzo.AlonzoGenesis
-readAlonzoGenesis fpath = do
-  readAndDecode
-    `catchError` \err ->
-      case err of
-        AlonzoGenesisFileError (FileIOError _ ioe)
-          | isDoesNotExistError ioe -> left $ GenesisFileNotFound fpath
-        _                           -> left err
- where
-  readAndDecode :: ExceptT AlonzoProtocolInstantiationError IO Alonzo.AlonzoGenesis
-  readAndDecode = do
-      lbs <- handleIOExceptT (AlonzoGenesisFileError . FileIOError fpath) $ LBS.readFile fpath
-      firstExceptT (AlonzoGenesisDecodeError fpath . Text.pack)
-        . hoistEither $ Aeson.eitherDecode' lbs
+readGenesis :: GenesisFile
+            -> Maybe GenesisHash
+            -> ExceptT GenesisReadError IO
+                       (Alonzo.AlonzoGenesis, GenesisHash)
+readGenesis = readGenesisAny
 
+validateGenesis :: Alonzo.AlonzoGenesis
+                -> ExceptT AlonzoProtocolInstantiationError IO ()
+validateGenesis _ = return () --TODO alonzo: do the validation
 
 data AlonzoProtocolInstantiationError
   = InvalidCostModelError !FilePath
   | CostModelExtractionError !FilePath
   | AlonzoCostModelFileError !(FileError ())
-  | AlonzoCostModelDecodeError !FilePath !Text
-  | AlonzoGenesisFileError !(FileError ())
-  | AlonzoGenesisDecodeError !FilePath !Text
-  | GenesisFileNotFound !FilePath
+  | AlonzoCostModelDecodeError !FilePath !String
   deriving Show
 
-renderAlonzoProtocolInstantiationError :: AlonzoProtocolInstantiationError -> Text
-renderAlonzoProtocolInstantiationError (InvalidCostModelError fp) =
-  "Invalid cost model: " <> Text.pack (show fp)
-renderAlonzoProtocolInstantiationError (CostModelExtractionError fp) =
-  "Error extracting the cost model at: " <> Text.pack (show fp)
-renderAlonzoProtocolInstantiationError (AlonzoCostModelFileError err) =
-  Text.pack $ displayError err
-renderAlonzoProtocolInstantiationError (AlonzoCostModelDecodeError fp err) =
-  "Error decoding cost model at: " <> Text.pack (show fp) <> " Error: " <> err
-renderAlonzoProtocolInstantiationError (AlonzoGenesisFileError err) =
-  Text.pack $ displayError err
-renderAlonzoProtocolInstantiationError (AlonzoGenesisDecodeError fp err) =
-  "Error decoding genesis at: " <> Text.pack fp <> " Error: " <> err
-renderAlonzoProtocolInstantiationError (GenesisFileNotFound fp) =
-  "Genesis file not found at: " <> Text.pack fp
+instance Error AlonzoProtocolInstantiationError where
+  displayError (InvalidCostModelError fp) =
+    "Invalid cost model: " <> show fp
+  displayError (CostModelExtractionError fp) =
+    "Error extracting the cost model at: " <> show fp
+  displayError (AlonzoCostModelFileError err) =
+    displayError err
+  displayError (AlonzoCostModelDecodeError fp err) =
+    "Error decoding cost model at: " <> show fp <> " Error: " <> err
 

cardano-node/src/Cardano/Node/Protocol/Byron.hs

@@ -4,7 +4,6 @@ module Cardano.Node.Protocol.Byron
   ( mkSomeConsensusProtocolByron
     -- * Errors
   , ByronProtocolInstantiationError(..)
-  , renderByronProtocolInstantiationError
 
     -- * Reusable parts
   , readGenesis
@@ -177,23 +176,27 @@ data ByronProtocolInstantiationError =
   | SigningKeyFilepathNotSpecified
   deriving Show
 
-
-renderByronProtocolInstantiationError :: ByronProtocolInstantiationError -> Text
-renderByronProtocolInstantiationError pie =
-  case pie of
-    CanonicalDecodeFailure fp failure -> "Canonical decode failure in " <> toS fp
-                                         <> " Canonical failure: " <> failure
-    GenesisHashMismatch actual expected ->
+instance Error ByronProtocolInstantiationError where
+  displayError (CanonicalDecodeFailure fp failure) =
+        "Canonical decode failure in " <> fp
+     <> " Canonical failure: " <> Text.unpack failure
+  displayError (GenesisHashMismatch actual expected) =
         "Wrong Byron genesis file: the actual hash is " <> show actual
      <> ", but the expected Byron genesis hash given in the node configuration "
      <> "file is " <> show expected
-    DelegationCertificateFilepathNotSpecified -> "Delegation certificate filepath not specified"
+  displayError DelegationCertificateFilepathNotSpecified =
+        "Delegation certificate filepath not specified"
     --TODO: Implement configuration error render function in cardano-ledger
-    GenesisConfigurationError fp genesisConfigError -> "Genesis configuration error in: " <> toS fp
-                                                       <> " Error: " <> Text.pack (show genesisConfigError)
-    GenesisReadError fp err ->  "There was an error parsing the genesis file: " <> toS fp
-                                <> " Error: " <> Text.pack (show err)
+  displayError (GenesisConfigurationError fp genesisConfigError) =
+        "Genesis configuration error in: " <> toS fp
+     <> " Error: " <> show genesisConfigError
+  displayError (GenesisReadError fp err) =
+        "There was an error parsing the genesis file: " <> toS fp
+     <> " Error: " <> show err
     -- TODO: Implement ByronLeaderCredentialsError render function in ouroboros-network
-    CredentialsError byronLeaderCredentialsError -> "Byron leader credentials error: " <> Text.pack (show byronLeaderCredentialsError)
-    SigningKeyDeserialiseFailure fp -> "Signing key deserialisation error in: " <> toS fp
-    SigningKeyFilepathNotSpecified -> "Signing key filepath not specified"
+  displayError (CredentialsError byronLeaderCredentialsError) =
+        "Byron leader credentials error: " <> show byronLeaderCredentialsError
+  displayError (SigningKeyDeserialiseFailure fp) =
+        "Signing key deserialisation error in: " <> toS fp
+  displayError SigningKeyFilepathNotSpecified =
+        "Signing key filepath not specified"