Fix more breaking changes

IntersectMBO · Feb 1, 2024 · 7091e82 · 7091e82
1 parent 66ea888
commit 7091e82
Show file tree

Hide file tree

Showing 7 changed files with 48 additions and 41 deletions.
diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
@@ -73,6 +73,7 @@ import           Cardano.Benchmarking.Script.Env hiding (Error (TxGenError))
 import qualified Cardano.Benchmarking.Script.Env as Env (Error (TxGenError))
 import           Cardano.Benchmarking.Script.Types
 import           Cardano.Benchmarking.Version as Version
+import           Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..))
 
 liftCoreWithEra :: AnyCardanoEra -> (forall era. IsShelleyBasedEra era => AsType era -> ExceptT TxGenError IO x) -> ActionM (Either TxGenError x)
 liftCoreWithEra era coreCall = withEra era ( liftIO . runExceptT . coreCall)
@@ -167,7 +168,7 @@ queryEra :: ActionM AnyCardanoEra
 queryEra = do
   localNodeConnectInfo <- getLocalConnectInfo
   chainTip  <- liftIO $ getLocalChainTip localNodeConnectInfo
-  ret <- liftIO $ queryNodeLocalState localNodeConnectInfo (Just $ chainTipToChainPoint chainTip) QueryCurrentEra
+  ret <- liftIO $ queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) QueryCurrentEra
   case ret of
     Right era -> return era
     Left err -> liftTxGenError $ TxGenError $ show err
@@ -182,7 +183,7 @@ queryRemoteProtocolParameters = do
                  QueryInEra era (Ledger.PParams (ShelleyLedgerEra era))
               -> ActionM ProtocolParameters
     callQuery query@(QueryInShelleyBasedEra shelleyEra _) = do
-        res <- liftIO $ queryNodeLocalState localNodeConnectInfo (Just $ chainTipToChainPoint chainTip) (QueryInEra query)
+        res <- liftIO $ queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) (QueryInEra query)
         case res of
           Right (Right pp) -> do
             let pp' = fromLedgerPParams shelleyEra pp

diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs
@@ -27,7 +27,7 @@ import           Cardano.CLI.Read (readFileScriptInAnyLang)
 import           Cardano.Api
 import           Cardano.Api.Shelley (PlutusScript (..), ProtocolParameters (..), fromAlonzoExUnits,
                    protocolParamCostModels, toPlutusData)
-import           Cardano.Ledger.Alonzo.Plutus.TxInfo (exBudgetToExUnits)
+import           Cardano.Ledger.Plutus.TxInfo (exBudgetToExUnits)
 
 import qualified PlutusLedgerApi.V1 as PlutusV1
 import qualified PlutusLedgerApi.V2 as PlutusV2
@@ -252,7 +252,7 @@ preExecutePlutusV3 (major, _minor) (PlutusScript _ (PlutusScriptSerialised (scri
     dummyTxInfo = PlutusV3.TxInfo
       { PlutusV3.txInfoInputs = []
       , PlutusV3.txInfoOutputs = []
-      , PlutusV3.txInfoFee = mempty
+      , PlutusV3.txInfoFee = 0
       , PlutusV3.txInfoMint = mempty
       , PlutusV3.txInfoTxCerts = []
       , PlutusV3.txInfoWdrl = PlutusV3.fromList []

diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs
@@ -140,7 +140,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
 
     --TODO: all these protocol versions below are confusing and unnecessary.
     -- It could and should all be automated and these config entries eliminated.
-    return $! undefined {-
+    return $!
       SomeConsensusProtocol CardanoBlockType $ ProtocolInfoArgsCardano $ CardanoProtocolParams {
         paramsByron =
         Consensus.ProtocolParamsByron {
@@ -310,7 +310,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
                 Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo
         }
       }
--}
+
         ----------------------------------------------------------------------
         -- WARNING When adding new entries above, be aware that if there is an
         -- intra-era fork, then the numbering is not consecutive.

diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs
@@ -17,15 +17,14 @@
 
 module Cardano.Node.Tracing.Era.Shelley () where
 
-import           Cardano.Api (AlonzoEraOnwards (..), textShow)
+import           Cardano.Api (textShow)
 import qualified Cardano.Api.Shelley as Api
 
 import qualified Cardano.Crypto.Hash.Class as Crypto
 import qualified Cardano.Crypto.VRF.Class as Crypto
 import           Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure)
 import qualified Cardano.Ledger.Allegra.Rules as Allegra
 import qualified Cardano.Ledger.Allegra.Scripts as Allegra
-import qualified Cardano.Ledger.Alonzo as Alonzo
 import qualified Cardano.Ledger.Alonzo.Plutus.Evaluate as Alonzo
 import           Cardano.Ledger.Alonzo.Rules (AlonzoBbodyPredFailure, AlonzoUtxoPredFailure,
                    AlonzoUtxosPredFailure, AlonzoUtxowPredFailure (..))
@@ -73,7 +72,7 @@ import           Ouroboros.Network.Point (WithOrigin, withOriginToMaybe)
 
 import           Data.Aeson (ToJSON (..), Value (..), (.=))
 import qualified Data.ByteString.Base16 as B16
-import qualified Data.Map.Strict as Map
+import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Text (Text)
@@ -342,18 +341,18 @@ instance
     DelegsFailure f -> forMachine dtal f
 
 instance
-  ( IsShelleyBasedEra era
-  , Consensus.ShelleyBasedEra (ShelleyLedgerEra era)
-  , Ledger.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
-  , LogFormatting (PPUPPredFailure (ShelleyLedgerEra era))
-  , LogFormatting (PredicateFailure (Ledger.EraRule "UTXO" (ShelleyLedgerEra era)))
-  -- , era ~ Alonzo.AlonzoEra StandardCrypto
-  ) => LogFormatting (AlonzoUtxowPredFailure (ShelleyLedgerEra era)) where
+  ( Api.ShelleyLedgerEra era ~ ledgerera
+  , Api.IsShelleyBasedEra era
+  , Consensus.ShelleyBasedEra ledgerera
+  , Ledger.EraCrypto ledgerera ~ StandardCrypto
+  , LogFormatting (PPUPPredFailure ledgerera)
+  , LogFormatting (PredicateFailure (Ledger.EraRule "UTXO" ledgerera))
+  ) => LogFormatting (AlonzoUtxowPredFailure ledgerera) where
   forMachine dtal (ShelleyInAlonzoUtxowPredFailure utxoPredFail) =
     forMachine dtal utxoPredFail
   forMachine _ (MissingRedeemers scripts) =
     mconcat [ "kind" .= String "MissingRedeemers"
-             , "scripts" .= renderMissingRedeemers scripts
+             , "scripts" .= renderMissingRedeemers Api.shelleyBasedEra scripts
              ]
   forMachine _ (MissingRequiredDatums required received) =
     mconcat [ "kind" .= String "MissingRequiredDatums"
@@ -381,10 +380,15 @@ instance
              , "acceptable" .= Set.toList acceptable
              ]
   forMachine _ (ExtraRedeemers rdmrs) =
-    mconcat
-      [ "kind" .= String "ExtraRedeemers"
-      , "rdmrs" .= map (Api.toScriptIndex AlonzoEraOnwardsAlonzo) rdmrs
-      ]
+    Api.caseShelleyToMaryOrAlonzoEraOnwards
+      (const mempty)
+      (\alonzoOnwards ->
+         mconcat
+           [ "kind" .= String "ExtraRedeemers"
+           , "rdmrs" .=  map (Api.toScriptIndex alonzoOnwards) rdmrs
+           ]
+      )
+      (Api.shelleyBasedEra :: Api.ShelleyBasedEra era)
 
 instance
   ( Consensus.ShelleyBasedEra era
@@ -1057,14 +1061,15 @@ instance
                 ]
 
 instance
-  ( Ledger.Era era
-  , Ledger.EraCrypto era ~ StandardCrypto
-  , ShelleyBasedEra era
-  , LogFormatting (PPUPPredFailure era)
-  , LogFormatting (ShelleyUtxowPredFailure era)
-  , LogFormatting (PredicateFailure (Ledger.EraRule "UTXO" era))
-  , era ~ Alonzo.AlonzoEra StandardCrypto
-  ) => LogFormatting (BabbageUtxowPredFailure era) where
+  ( Api.ShelleyLedgerEra era ~ ledgerera
+  , Api.IsShelleyBasedEra era
+  , Ledger.Era ledgerera
+  , Ledger.EraCrypto ledgerera ~ StandardCrypto
+  , ShelleyBasedEra ledgerera
+  , LogFormatting (PPUPPredFailure ledgerera)
+  , LogFormatting (ShelleyUtxowPredFailure ledgerera)
+  , LogFormatting (PredicateFailure (Ledger.EraRule "UTXO" ledgerera))
+  ) => LogFormatting (BabbageUtxowPredFailure ledgerera) where
   forMachine v err =
     case err of
       Babbage.AlonzoInBabbageUtxowPredFailure alonzoFail ->
@@ -1106,7 +1111,7 @@ instance
   ) => LogFormatting (Conway.ConwayGovPredFailure era) where
   forMachine _ (Conway.GovActionsDoNotExist govActionIds) =
     mconcat [ "kind" .= String "GovActionsDoNotExist"
-            , "govActionId" .= map govActionIdToText (Set.toList govActionIds)
+            , "govActionId" .= map govActionIdToText (NonEmpty.toList govActionIds)
             ]
   forMachine _ (Conway.MalformedProposal govAction) =
     mconcat [ "kind" .= String "MalformedProposal"
@@ -1129,7 +1134,7 @@ instance
             ]
   forMachine _ (Conway.DisallowedVoters govActionIdToVoter) =
     mconcat [ "kind" .= String "DisallowedVoters"
-            , "govActionIdToVoter" .= Map.toList govActionIdToVoter
+            , "govActionIdToVoter" .= NonEmpty.toList govActionIdToVoter
             ]
   forMachine _ (Conway.ConflictingCommitteeUpdate creds) =
     mconcat [ "kind" .= String "ConflictingCommitteeUpdate"

diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs
@@ -867,7 +867,10 @@ instance
   forMachine dtal (TraceMempoolRemoveTxs txs mpSz) =
     mconcat
       [ "kind" .= String "TraceMempoolRemoveTxs"
-      , "txs" .= map (forMachine dtal . txForgetValidated) txs
+      , "txs" .=
+          foldMap
+            (\(tx, err) -> [forMachine dtal (txForgetValidated tx), forMachine dtal err])
+            txs
       , "mempoolSize" .= forMachine dtal mpSz
       ]
   forMachine dtal (TraceMempoolManuallyRemovedTxs txs0 txs1 mpSz) =

diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs
@@ -41,7 +41,7 @@ import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch
                    OneEraValidationErr (..), mkEraMismatch)
 import           Ouroboros.Consensus.HardFork.Combinator.Condense ()
 import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
-                   (EraNodeToClientVersion (..), EraNodeToNodeVersion (..),
+                   (EraNodeToClientVersion (..),
                    HardForkNodeToClientVersion (..), HardForkNodeToNodeVersion (..),
                    HardForkSpecificNodeToClientVersion (..), HardForkSpecificNodeToNodeVersion (..))
 import           Ouroboros.Consensus.HardFork.History.EraParams (EraParams (..), SafeZone)
@@ -406,7 +406,7 @@ instance (ToJSON (BlockNodeToClientVersion blk)) => ToJSON (EraNodeToClientVersi
 -- Instances for HardForkNodeToNodeVersion
 --
 instance ( ToJSON (BlockNodeToNodeVersion x)
-         , All (ToJSON `Compose` EraNodeToNodeVersion) (x ': xs)
+         , All (ToJSON `Compose` WrapNodeToNodeVersion) (x ': xs)
          ) => ToJSON (HardForkNodeToNodeVersion (x ': xs)) where
     toJSON (HardForkNodeToNodeDisabled blockNodeToNodeVersion) =
         object [ "tag" .= String "HardForkNodeToNodeDisabled"
@@ -419,16 +419,15 @@ instance ( ToJSON (BlockNodeToNodeVersion x)
                ]
       where
         eraNodeToNodeVersionsAsJSON :: NP (K Value) (x ': xs)
-        eraNodeToNodeVersionsAsJSON = hcmap (Proxy @(ToJSON `Compose` EraNodeToNodeVersion))
+        eraNodeToNodeVersionsAsJSON = hcmap (Proxy @(ToJSON `Compose` WrapNodeToNodeVersion))
                                             (K . toJSON)
                                             eraNodeToNodeVersions
 
 instance ToJSON HardForkSpecificNodeToNodeVersion where
     toJSON HardForkSpecificNodeToNodeVersion1 = "HardForkSpecificNodeToNodeVersion1"
 
-instance (ToJSON (BlockNodeToNodeVersion blk)) => ToJSON (EraNodeToNodeVersion blk) where
-    toJSON EraNodeToNodeDisabled = String "EraNodeToNodeDisabled"
-    toJSON (EraNodeToNodeEnabled blockNodeToNodeVersion) = toJSON blockNodeToNodeVersion
+instance (ToJSON (BlockNodeToNodeVersion blk)) => ToJSON (WrapNodeToNodeVersion blk) where
+    toJSON (WrapNodeToNodeVersion blockNodeToNodeVersion) = toJSON blockNodeToNodeVersion
 
 --
 -- instances for HardForkSelectView

diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs
@@ -21,7 +21,7 @@
 
 module Cardano.Tracing.OrphanInstances.Shelley () where
 
-import           Cardano.Api (AlonzoEraOnwards (..), textShow)
+import           Cardano.Api (textShow)
 import qualified Cardano.Api.Shelley as Api
 
 import qualified Cardano.Crypto.Hash.Class as Crypto
@@ -82,7 +82,6 @@ import           Data.Aeson (Value (..), object)
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Base16 as B16
 import qualified Data.List.NonEmpty as NonEmpty
-import qualified Data.Map.Strict as Map
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Text (Text)
@@ -459,7 +458,7 @@ instance
            , "rdmrs" .=  map (Api.toScriptIndex alonzoOnwards) rdmrs
            ]
       )
-    (Api.shelleyBasedEra :: Api.ShelleyBasedEra era)
+      (Api.shelleyBasedEra :: Api.ShelleyBasedEra era)
 
 instance
   ( ToObject (PredicateFailure (ShelleyUTXO ledgerera))