cardano-node patch

cardano-node/app/cardano-node.hs

@@ -18,7 +18,7 @@ import           System.Info (arch, compilerName, compilerVersion, os)
 import           Cardano.Node.Configuration.POM (PartialNodeConfiguration)
 import           Cardano.Node.Handlers.TopLevel
 import           Cardano.Node.Parsers (nodeCLIParser, parserHelpHeader, parserHelpOptions,
-                     renderHelpDoc)
+                   renderHelpDoc)
 import           Cardano.Node.Run (runNode)
 
 main :: IO ()

cardano-node/cardano-node.cabal

@@ -66,6 +66,7 @@ library
                        Cardano.Node.Handlers.TopLevel
                        Cardano.Node.Orphans
                        Cardano.Node.Protocol
+                       Cardano.Node.Protocol.Alonzo
                        Cardano.Node.Protocol.Byron
                        Cardano.Node.Protocol.Cardano
                        Cardano.Node.Protocol.Shelley
@@ -136,6 +137,8 @@ library
                       , ouroboros-consensus-shelley
                       , ouroboros-network
                       , ouroboros-network-framework
+                      , plutus-core
+                      , plutus-ledger-api
                       , process
                       , safe-exceptions
                       , scientific

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

@@ -13,7 +13,7 @@ import           Prelude (fail)
 
 import           Cardano.Api.Orphans ()
 
-import           Data.Aeson (FromJSON (..), ToJSON (..), ToJSONKey, Value (..))
+import           Data.Aeson (FromJSON (..), ToJSON (..), ToJSONKey, Value (..), withObject, (.:))
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Short as SBS
 import qualified Data.Text as Text
@@ -26,7 +26,7 @@ import qualified Cardano.Ledger.Alonzo as Alonzo
 import qualified Cardano.Ledger.Alonzo.Language as Alonzo
 import qualified Cardano.Ledger.Alonzo.PParams as Alonzo
 import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
-import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo
+import           Cardano.Ledger.Alonzo.Translation (AlonzoGenesis (..))
 import qualified Cardano.Ledger.Compactible as Ledger
 import qualified Cardano.Ledger.Mary.Value as Mary
 import qualified Data.MemoBytes as MemoBytes
@@ -63,9 +63,11 @@ deriving instance ToJSONKey SBS.ShortByteString
 deriving instance ToJSONKey ByteString
 deriving instance ToJSONKey Alonzo.Language
 deriving instance ToJSON Alonzo.CostModel
+deriving instance ToJSON (MemoBytes.MemoBytes (Map Text Integer))
+deriving instance FromJSON Alonzo.Prices
+deriving instance FromJSON Alonzo.ExUnits
 
-
-deriving instance ToJSON (Alonzo.TxOut (Alonzo.AlonzoEra StandardCrypto))
+--deriving instance ToJSON (Alonzo.TxOut (Alonzo.AlonzoEra StandardCrypto))
 
 deriving instance ToJSON (Shelley.CompactAddr StandardCrypto)
 deriving instance Generic (Shelley.CompactAddr StandardCrypto)
@@ -78,3 +80,22 @@ instance FromJSON Update.ApplicationName where
   parseJSON invalid  =
     fail $ "Parsing of application name failed due to type mismatch. "
     <> "Encountered: " <> show invalid
+
+-- We defer parsing of the cost model so that we can
+-- read it as a filepath. This is to reduce further pollution
+-- of the genesis file.
+instance FromJSON AlonzoGenesis where
+  parseJSON = withObject "Alonzo Genesis" $ \o -> do
+    adaPerWord <-  o .: "alonzoAdaPerUTxOWord"
+    execPrices <-  o .: "alonzoExecutionPrices"
+    maxTxExUnits' <-  o .: "alonzoMaxTxExUnits"
+    maxBlockExUnits' <-  o .: "alonzoMaxBlockExUnits"
+    maxMaSize <-  o .: "alonzoMaxMultiAssetSize"
+    return $ AlonzoGenesis
+               { adaPerUTxOWord = adaPerWord
+               , costmdls = mempty
+               , prices = execPrices
+               , maxTxExUnits = maxTxExUnits'
+               , maxBlockExUnits = maxBlockExUnits'
+               , maxValSize = maxMaSize
+               }

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

@@ -14,11 +14,12 @@ import           Control.Monad.Trans.Except.Extra (firstExceptT)
 import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
 import           Cardano.Node.Types
 
+import           Cardano.Node.Orphans ()
+import           Cardano.Node.Protocol.Alonzo
 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
 --
@@ -56,6 +57,7 @@ mkConsensusProtocol NodeConfiguration{ncProtocolConfig, ncProtocolFiles} =
 data ProtocolInstantiationError =
     ByronProtocolInstantiationError   ByronProtocolInstantiationError
   | ShelleyProtocolInstantiationError ShelleyProtocolInstantiationError
+  | AlonzoProtocolInstantiationError AlonzoProtocolInstantiationError
   | CardanoProtocolInstantiationError CardanoProtocolInstantiationError
   deriving Show
 
@@ -71,3 +73,4 @@ renderProtocolInstantiationError pie =
 
     CardanoProtocolInstantiationError cpie ->
       renderCardanoProtocolInstantiationError cpie
+    AlonzoProtocolInstantiationError _ -> panic "FIX ME"

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

@@ -0,0 +1,109 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Cardano.Node.Protocol.Alonzo
+  ( AlonzoProtocolInstantiationError(..)
+    -- * Reusable parts
+  , readAlonzoGenesis
+  ) where
+
+import           Cardano.Prelude
+
+import           Cardano.Api
+
+import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left)
+import           Data.Aeson (FromJSON (..), withObject, (.:))
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Types as Aeson
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+import           System.IO.Error (isDoesNotExistError)
+
+import qualified Cardano.Ledger.Alonzo.Language as Alonzo
+import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
+import qualified Cardano.Ledger.Alonzo.Translation as Alonzo
+import qualified Plutus.V1.Ledger.Api as Plutus
+import qualified PlutusCore.Evaluation.Machine.ExBudgeting as Plutus
+
+
+import           Cardano.Node.Orphans ()
+
+import           Cardano.Tracing.OrphanInstances.HardFork ()
+import           Cardano.Tracing.OrphanInstances.Shelley ()
+
+
+--
+-- 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
+  alonzoGenWrapper <- readAndDecode
+                       `catchError` \err ->
+                         case err of
+                           AlonzoGenesisFileError (FileIOError _ ioe)
+                             | isDoesNotExistError ioe -> panic "Shelley genesis file not found."
+                           _                           -> left err
+  createAlonzoGenesis alonzoGenWrapper
+
+ where
+  readAndDecode :: ExceptT AlonzoProtocolInstantiationError IO AlonzoGenWrapper
+  readAndDecode = do
+      lbs <- handleIOExceptT (AlonzoGenesisFileError . FileIOError fpath) $ LBS.readFile fpath
+      firstExceptT (AlonzoGenesisDecodeError fpath . Text.pack)
+        . hoistEither $ Aeson.eitherDecode' lbs
+
+
+createAlonzoGenesis
+  :: AlonzoGenWrapper
+  -> ExceptT AlonzoProtocolInstantiationError IO Alonzo.AlonzoGenesis
+createAlonzoGenesis (AlonzoGenWrapper costModelFp' alonzoGenesis) = do
+  costModel <- readAndDecode
+  case Plutus.extractModelParams costModel of
+    Just m -> if Plutus.validateCostModelParams m
+              then left $ InvalidCostModelError costModelFp'
+              else return $ alonzoGenesis { Alonzo.costmdls = Map.singleton Alonzo.PlutusV1 $ Alonzo.CostModel m }
+
+    Nothing -> left CostModelExtractionError -- TODO: costModel
+ where
+  readAndDecode :: ExceptT AlonzoProtocolInstantiationError IO Plutus.CostModel
+  readAndDecode = do
+      lbs <- handleIOExceptT (AlonzoCostModelFileError . FileIOError costModelFp') $ LBS.readFile costModelFp'
+      firstExceptT (AlonzoCostModelDecodeError costModelFp' . Text.pack)
+        . hoistEither $ Aeson.eitherDecode' lbs
+
+
+data AlonzoGenWrapper =
+  AlonzoGenWrapper { costModelFp :: FilePath
+                   , genesis :: Alonzo.AlonzoGenesis
+                   }
+
+instance FromJSON AlonzoGenWrapper where
+  parseJSON = withObject "Alonzo Genesis Wrapper" $ \o -> do
+                -- NB: This has an empty map for the cost model
+                alonzoGenensis <- parseJSON (Aeson.Object o) :: Aeson.Parser Alonzo.AlonzoGenesis
+                cModelFp <- o .: "alonzoCostModel"
+                return $ AlonzoGenWrapper
+                           { costModelFp = cModelFp
+                           , genesis = alonzoGenensis
+                           }
+
+data AlonzoProtocolInstantiationError
+  = InvalidCostModelError !FilePath
+  | CostModelExtractionError
+  | AlonzoCostModelFileError !(FileError ())
+  | AlonzoCostModelDecodeError !FilePath !Text
+  | AlonzoGenesisFileError !(FileError ())
+  | AlonzoGenesisDecodeError !FilePath !Text
+  deriving Show
+
+

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

@@ -14,7 +14,7 @@ module Cardano.Node.Protocol.Byron
 
 import           Cardano.Prelude
 import           Control.Monad.Trans.Except.Extra (bimapExceptT, firstExceptT, hoistEither,
-                     hoistMaybe, left)
+                   hoistMaybe, left)
 import qualified Data.ByteString.Lazy as LB
 import qualified Data.Text as Text
 
@@ -26,19 +26,19 @@ import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Crypto.Hashing as Byron.Crypto
 
 import qualified Cardano.Chain.Genesis as Genesis
-import qualified Cardano.Chain.Update as Update
 import qualified Cardano.Chain.UTxO as UTxO
+import qualified Cardano.Chain.Update as Update
 import           Cardano.Crypto.ProtocolMagic (RequiresNetworkMagic)
 
 import           Ouroboros.Consensus.Cardano
 import qualified Ouroboros.Consensus.Cardano as Consensus
 
 import           Cardano.Node.Types
 
+import           Cardano.Node.Protocol.Types
 import           Cardano.Tracing.OrphanInstances.Byron ()
 import           Cardano.Tracing.OrphanInstances.HardFork ()
-
-import           Cardano.Node.Protocol.Types
+import           Cardano.Tracing.OrphanInstances.Shelley ()
 
 
 ------------------------------------------------------------------------------

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

@@ -36,6 +36,7 @@ import           Cardano.Node.Types
 import           Cardano.Tracing.OrphanInstances.Byron ()
 import           Cardano.Tracing.OrphanInstances.Shelley ()
 
+import           Cardano.Node.Protocol.Alonzo (AlonzoProtocolInstantiationError, readAlonzoGenesis)
 import qualified Cardano.Node.Protocol.Byron as Byron
 import qualified Cardano.Node.Protocol.Shelley as Shelley
 
@@ -79,9 +80,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
                              npcShelleyGenesisFile,
                              npcShelleyGenesisFileHash
                            }
-                           NodeAlonzoProtocolConfiguration {
-                             npcAlonzoGenesisFile
-                           }
+                           (NodeAlonzoProtocolConfiguration _)
                            NodeHardForkProtocolConfiguration {
                              npcTestShelleyHardForkAtEpoch,
                              npcTestShelleyHardForkAtVersion,
@@ -112,8 +111,13 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
       firstExceptT CardanoProtocolInstantiationErrorShelley $
         Shelley.readLeaderCredentials files
 
-    -- AlonzoGenesis is the translation context see: TranslationContext type family
-    _alonzoGenesis <- readAlonzoGenesis npcShelleyGenesisFile
+    -- In order to avoid creating another genesis file, we can include
+    -- the Alonzo relevant fields in the Shelley genesis and therefore
+    --
+    let GenesisFile shelleyGenFile = npcShelleyGenesisFile
+    alonzoGen <- firstExceptT CardanoProtocolInstantiationErrorAlonzo
+                   $ readAlonzoGenesis shelleyGenFile
+
     --TODO: all these protocol versions below are confusing and unnecessary.
     -- It could and should all be automated and these config entries eliminated.
     return $!
@@ -147,8 +151,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
           shelleyBasedGenesis = shelleyGenesis,
           shelleyBasedInitialNonce =
             Shelley.genesisHashToPraosNonce shelleyGenesisHash,
-          shelleyBasedLeaderCredentials = shelleyLeaderCredentials,
-          shelleyTranslationContext = ()
+            shelleyBasedLeaderCredentials = shelleyLeaderCredentials
         }
         Consensus.ProtocolParamsShelley {
           -- This is /not/ the Shelley protocol version. It is the protocol
@@ -164,7 +167,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
           -- is in the Allegra era. That is, it is the version of protocol
           -- /after/ Allegra, i.e. Mary.
           allegraProtVer =
-            ProtVer 4 0
+            ProtVer 3 0
         }
         Consensus.ProtocolParamsMary {
           -- This is /not/ the Mary protocol version. It is the protocol
@@ -178,11 +181,11 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
           -- This is /not/ the Alonzo protocol version. It is the protocol
           -- version that this node will declare that it understands, when it
           -- is in the Alonzo era. Since Alonzo is currently the last known
-          -- protocol version then this is also the Alonzo protocol version.
-          alonzoProtVer =
-            ProtVer 4 0,
-          alonzoTranslationContext = 42
+          -- protocol version then this is a        Consensus.ProtocolParamsTransition {
+          alonzoGenesis = alonzoGen,
+          alonzoProtVer = ProtVer 5 0
         }
+
         -- ProtocolParamsTransition specifies the parameters needed to transition between two eras
         -- The comments below also apply for the Shelley -> Allegra and Allegra -> Mary hard forks.
         -- Byron to Shelley hard fork parameters
@@ -245,6 +248,8 @@ data CardanoProtocolInstantiationError =
 
      | CardanoProtocolInstantiationErrorShelley
          Shelley.ShelleyProtocolInstantiationError
+     | CardanoProtocolInstantiationErrorAlonzo
+         AlonzoProtocolInstantiationError
   deriving Show
 
 renderCardanoProtocolInstantiationError :: CardanoProtocolInstantiationError
@@ -256,3 +261,6 @@ renderCardanoProtocolInstantiationError
 renderCardanoProtocolInstantiationError
   (CardanoProtocolInstantiationErrorShelley err) =
     Shelley.renderShelleyProtocolInstantiationError err
+
+renderCardanoProtocolInstantiationError
+  (CardanoProtocolInstantiationErrorAlonzo _) = error "FIX ME"

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

@@ -81,8 +81,7 @@ mkSomeConsensusProtocolShelley NodeShelleyProtocolConfiguration {
         shelleyBasedGenesis = genesis,
         shelleyBasedInitialNonce = genesisHashToPraosNonce genesisHash,
         shelleyBasedLeaderCredentials =
-            leaderCredentials,
-        shelleyTranslationContext = ()
+            leaderCredentials
       }
       Consensus.ProtocolParamsShelley {
         shelleyProtVer =

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

@@ -54,7 +54,7 @@ import           Cardano.Node.Configuration.POM (NodeConfiguration (..),
 import           Cardano.Node.Types
 import           Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..))
 import           Cardano.Tracing.Constraints (TraceConstraints)
-import           Cardano.Tracing.Metrics (HasKESMetricsData (..), HasKESInfo (..))
+import           Cardano.Tracing.Metrics (HasKESInfo (..), HasKESMetricsData (..))
 
 import qualified Ouroboros.Consensus.Config as Consensus
 import           Ouroboros.Consensus.Config.SupportsNode (getNetworkMagic)

cardano-node/src/Cardano/Tracing/Constraints.hs

@@ -13,7 +13,12 @@ import           Cardano.BM.Tracing (ToObject)
 import           Cardano.Tracing.ConvertTxId (ConvertTxId)
 import           Cardano.Tracing.Queries (LedgerQueries)
 
-import           Cardano.Node.Orphans ()
+import           Cardano.Ledger.Alonzo (AlonzoEra)
+import           Cardano.Ledger.Alonzo.PParams (PParamsUpdate)
+import           Cardano.Ledger.Alonzo.Rules.Bbody (AlonzoBbodyPredFail)
+import           Cardano.Ledger.Alonzo.Rules.Utxo (UtxoPredicateFailure)
+import           Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoPredFail)
+import           Cardano.Ledger.Alonzo.TxBody (TxOut)
 import           Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ForgeStateUpdateError,
                    Header)
 import           Ouroboros.Consensus.HeaderValidation (OtherHeaderEnvelopeError)
@@ -22,6 +27,7 @@ import           Ouroboros.Consensus.Ledger.Inspect (LedgerEvent)
 import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, HasTxId, HasTxs (..))
 import           Ouroboros.Consensus.Protocol.Abstract (ValidationErr)
 import           Ouroboros.Consensus.Shelley.Ledger.Mempool (GenTx, TxId)
+import           Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto)
 
 -- | Tracing-related constraints for monitoring purposes.
 type TraceConstraints blk =
@@ -30,6 +36,8 @@ type TraceConstraints blk =
     , HasTxId (GenTx blk)
     , LedgerQueries blk
     , ToJSON   (TxId (GenTx blk))
+    , ToJSON   (TxOut (AlonzoEra StandardCrypto))
+    , ToJSON   (PParamsUpdate (AlonzoEra StandardCrypto))
     , ToObject (ApplyTxErr blk)
     , ToObject (GenTx blk)
     , ToObject (Header blk)
@@ -39,6 +47,9 @@ type TraceConstraints blk =
     , ToObject (ValidationErr (BlockProtocol blk))
     , ToObject (CannotForge blk)
     , ToObject (ForgeStateUpdateError blk)
+    , ToObject (UtxoPredicateFailure (AlonzoEra StandardCrypto))
+    , ToObject (AlonzoBbodyPredFail (AlonzoEra StandardCrypto))
+    , ToObject (AlonzoPredFail (AlonzoEra StandardCrypto))
     , Show blk
     , Show (Header blk)
     )