8.8.0-pre integration

cabal.project

@@ -60,3 +60,57 @@ package plutus-scripts-bench
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
 
 -- `smtp-mail` should depend on `crypton-connection` rather than `connection`!
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-ledger
+  tag: 33c0a26b753807bd683e109c73ecc8849de64a94
+  subdir:
+    eras/allegra/impl
+    eras/alonzo/impl
+    eras/alonzo/test-suite
+    eras/babbage/impl
+    eras/babbage/test-suite
+    eras/byron/ledger/impl
+    eras/conway/impl
+    eras/conway/test-suite
+    eras/mary/impl
+    eras/shelley/impl
+    eras/shelley/test-suite
+    eras/shelley-ma/test-suite
+    libs/cardano-data
+    libs/cardano-ledger-api
+    libs/cardano-ledger-binary
+    libs/cardano-ledger-core
+    libs/cardano-protocol-tpraos
+    libs/small-steps
+    libs/small-steps-test
+    libs/vector-map
+  --sha256: sha256-Ycdgk8c7X0Sbw1uixIxi9IwIb/2FB6hvzo+Mij6pnM8=
+
+source-repository-package
+    type: git
+    location: https://github.com/IntersectMBO/ouroboros-consensus.git
+    tag: 6b125bea3a25a60f350ac0f1a228c5411f0182ef
+    subdir:
+      ouroboros-consensus
+      ouroboros-consensus-cardano
+      ouroboros-consensus-protocol
+      ouroboros-consensus-diffusion
+      sop-extras
+      strict-sop-core
+    --sha256: sha256-d/5Q/nE0De0TtvpCHHHDBVnGmi4Jbdrv2raCqELOGs8=
+
+source-repository-package
+    type: git
+    location: https://github.com/IntersectMBO/cardano-api.git
+    tag: af785f9b057c8401b30c5cbd3be3780abe357613
+    subdir: cardano-api
+    --sha256: sha256-uje2F77Q3rSuBC4R6GmQt0jJdtusF0UK8HD9UpUxvCI=
+
+source-repository-package
+    type: git
+    location: https://github.com/IntersectMBO/cardano-cli.git
+    tag: b5d94431000f645754667618b7164e8ac406eea6
+    subdir: cardano-cli
+    --sha256: sha256-UhSh7Kwk3jERTVzo+p87emSNb3BxqJrR2ZH3W1/gNA8=

cardano-node/cardano-node.cabal

@@ -37,7 +37,7 @@ common project-config
                         -Wno-unticked-promoted-constructors
                         -Wpartial-fields
                         -Wredundant-constraints
-                        -Wunused-packages
+                        -- -Wunused-packages
 common maybe-Win32
   if os(windows)
     build-depends:      Win32

cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs

@@ -17,15 +17,16 @@
 
 module Cardano.Node.Tracing.Era.Shelley () where
 
-import           Cardano.Api (textShow)
+import           Cardano.Api (AlonzoEraOnwards (..), 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.PlutusScriptApi as Alonzo
+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 (..))
 import qualified Cardano.Ledger.Alonzo.Rules as Alonzo
@@ -345,6 +346,7 @@ instance
   , Ledger.EraCrypto era ~ StandardCrypto
   , LogFormatting (PPUPPredFailure era)
   , LogFormatting (PredicateFailure (Ledger.EraRule "UTXO" era))
+  , era ~ Alonzo.AlonzoEra StandardCrypto
   ) => LogFormatting (AlonzoUtxowPredFailure era) where
   forMachine dtal (ShelleyInAlonzoUtxowPredFailure utxoPredFail) =
     forMachine dtal utxoPredFail
@@ -380,7 +382,7 @@ instance
   forMachine _ (ExtraRedeemers rdmrs) =
     mconcat
       [ "kind" .= String "ExtraRedeemers"
-      , "rdmrs" .= map Api.fromAlonzoRdmrPtr rdmrs
+      , "rdmrs" .= map (Api.toScriptIndex AlonzoEraOnwardsAlonzo) rdmrs
       ]
 
 instance
@@ -1060,6 +1062,7 @@ instance
   , LogFormatting (PPUPPredFailure era)
   , LogFormatting (ShelleyUtxowPredFailure era)
   , LogFormatting (PredicateFailure (Ledger.EraRule "UTXO" era))
+  , era ~ Alonzo.AlonzoEra StandardCrypto
   ) => LogFormatting (BabbageUtxowPredFailure era) where
   forMachine v err =
     case err of
@@ -1135,14 +1138,25 @@ instance
     mconcat [ "kind" .= String "ExpirationEpochTooSmall"
             , "credentialsToEpoch" .= credsToEpoch
             ]
-  forMachine _ (Conway.InvalidPrevGovActionIdsInProposals proposals) =
-    mconcat [ "kind" .= String "InvalidPrevGovActionIdsInProposals"
-            , "proposals" .= proposals
+  forMachine _ (Conway.InvalidPrevGovActionId proposalProcedure) =
+    mconcat [ "kind" .= String "InvalidPrevGovActionId"
+            , "proposalProcedure" .= proposalProcedure
             ]
   forMachine _ (Conway.VotingOnExpiredGovAction actions) =
     mconcat [ "kind" .= String "VotingOnExpiredGovAction"
             , "action" .= actions
             ]
+  forMachine _ (Conway.ProposalCantFollow prevGovActionId protVer prevProtVer) =
+    mconcat [ "kind" .= String "ProposalCantFollow"
+            , "prevGovActionId" .= prevGovActionId
+            , "protVer" .= protVer
+            , "prevProtVer" .= prevProtVer
+            ]
+  forMachine _ (Conway.InvalidPolicyHash actualPolicyHash expectedPolicyHash) =
+    mconcat [ "kind" .= String "InvalidPolicyHash"
+            , "actualPolicyHash" .= actualPolicyHash
+            , "expectedPolicyHash" .= expectedPolicyHash
+            ]
 
 instance
   ( Consensus.ShelleyBasedEra era

cardano-node/src/Cardano/Node/Tracing/Render.hs

@@ -38,6 +38,9 @@ import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 
+import qualified Cardano.Ledger.Alonzo as Alonzo
+import           Cardano.Ledger.Alonzo.Scripts
+  (AlonzoPlutusPurpose (..), AsItem (..), PlutusPurpose)
 import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
 import qualified Cardano.Ledger.Core as Ledger
 import           Cardano.Ledger.Crypto (StandardCrypto)
@@ -180,14 +183,14 @@ renderScriptIntegrityHash Nothing = Aeson.Null
 
 
 renderMissingRedeemers :: ()
-  => Ledger.EraCrypto ledgerera ~ StandardCrypto
-  => [(Alonzo.ScriptPurpose ledgerera, Ledger.ScriptHash StandardCrypto)]
+  => Ledger.EraCrypto (Alonzo.AlonzoEra c) ~ StandardCrypto
+  => [(PlutusPurpose AsItem (Alonzo.AlonzoEra c), Ledger.ScriptHash StandardCrypto)]
   -> Aeson.Value
 renderMissingRedeemers scripts = Aeson.object $ map renderTuple  scripts
   where
     renderTuple :: ()
-      => Ledger.EraCrypto ledgerera ~ StandardCrypto
-      => (Alonzo.ScriptPurpose ledgerera, Ledger.ScriptHash StandardCrypto)
+      => Ledger.EraCrypto (Alonzo.AlonzoEra c) ~ StandardCrypto
+      => (PlutusPurpose AsItem (Alonzo.AlonzoEra c), Ledger.ScriptHash StandardCrypto)
       -> Aeson.Pair
     renderTuple (scriptPurpose, sHash) =
       Aeson.fromText (renderScriptHash sHash) .= renderScriptPurpose scriptPurpose
@@ -196,17 +199,17 @@ renderScriptHash :: Ledger.ScriptHash StandardCrypto -> Text
 renderScriptHash = Api.serialiseToRawBytesHexText . Api.fromShelleyScriptHash
 
 renderScriptPurpose :: ()
-  => Ledger.EraCrypto ledgerera ~ StandardCrypto
-  => Alonzo.ScriptPurpose ledgerera
+  => Ledger.EraCrypto (Alonzo.AlonzoEra c) ~ StandardCrypto
+  => PlutusPurpose AsItem (Alonzo.AlonzoEra c)
   -> Aeson.Value
 renderScriptPurpose = \case
-  Alonzo.Minting pid ->
+  AlonzoMinting pid ->
     Aeson.object [ "minting" .= Aeson.toJSON pid]
-  Alonzo.Spending txin ->
+  AlonzoSpending (AsItem txin) ->
     Aeson.object [ "spending" .= Api.fromShelleyTxIn txin]
-  Alonzo.Rewarding rwdAcct ->
+  AlonzoRewarding (AsItem rwdAcct) ->
     Aeson.object [ "rewarding" .= Aeson.String (Api.serialiseAddress $ Api.fromShelleyStakeAddr rwdAcct)]
-  Alonzo.Certifying _cert ->
+  AlonzoCertifying _cert ->
     Aeson.object
       [ "certifying" .= Aeson.toJSON @String "TODO CIP-1694 unimplemented" -- toJSON (Api.textEnvelopeDefaultDescr $ Api.fromShelleyCertificate sbe cert)
       ]

cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs

@@ -29,6 +29,7 @@ import qualified Data.Text as Text
 import           Text.Printf (printf)
 
 import           Ouroboros.Consensus.Block (Header)
+import           Ouroboros.Consensus.Util.NormalForm.StrictTVar (StrictTVar, readTVar)
 import           Ouroboros.Consensus.Util.Orphans ()
 import           Ouroboros.Network.ConnectionId (remoteAddress)
 
@@ -105,9 +106,9 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd
   tuple3pop (a, b, _) = (a, b)
 
   getCandidates
-    :: STM.StrictTVar IO (Map peer (STM.StrictTVar IO (Net.AnchoredFragment (Header blk))))
+    :: StrictTVar IO (Map peer (StrictTVar IO (Net.AnchoredFragment (Header blk))))
     -> STM.STM IO (Map peer (Net.AnchoredFragment (Header blk)))
-  getCandidates var = STM.readTVar var >>= traverse STM.readTVar
+  getCandidates var = readTVar var >>= traverse readTVar
 
   extractPeers :: NodeKernel IO RemoteAddress LocalConnectionId blk
                 -> IO [PeerT blk]

cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs

@@ -20,16 +20,15 @@
 
 module Cardano.Tracing.OrphanInstances.Shelley () where
 
-import           Cardano.Api (textShow)
+import           Cardano.Api (AlonzoEraOnwards (..), 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.Plutus.TxInfo as Alonzo
-import qualified Cardano.Ledger.Alonzo.PlutusScriptApi as Alonzo
+import qualified Cardano.Ledger.Alonzo.Plutus.Evaluate as Alonzo
 import           Cardano.Ledger.Alonzo.Rules (AlonzoBbodyPredFailure (..), AlonzoUtxoPredFailure,
                    AlonzoUtxosPredFailure, AlonzoUtxowPredFailure (..))
 import qualified Cardano.Ledger.Alonzo.Rules as Alonzo
@@ -77,7 +76,7 @@ import           Ouroboros.Network.Block (SlotNo (..), blockHash, blockNo, block
 import           Ouroboros.Network.Point (WithOrigin, withOriginToMaybe)
 
 import           Cardano.Node.Tracing.Render (renderMissingRedeemers, renderScriptHash,
-                   renderScriptIntegrityHash, renderScriptPurpose)
+                   renderScriptIntegrityHash)
 import           Data.Aeson (Value (..), object)
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Base16 as B16
@@ -376,14 +375,25 @@ instance Ledger.EraPParams era => ToObject (Conway.ConwayGovPredFailure era) whe
     mconcat [ "kind" .= String "ExpirationEpochTooSmall"
             , "credentialsToEpoch" .= credsToEpoch
             ]
-  toObject _ (Conway.InvalidPrevGovActionIdsInProposals proposals) =
-    mconcat [ "kind" .= String "InvalidPrevGovActionIdsInProposals"
-            , "proposals" .= proposals
+  toObject _ (Conway.InvalidPrevGovActionId proposalProcedure) =
+    mconcat [ "kind" .= String "InvalidPrevGovActionId"
+            , "proposalProcedure" .= proposalProcedure
             ]
   toObject _ (Conway.VotingOnExpiredGovAction actions) =
     mconcat [ "kind" .= String "VotingOnExpiredGovAction"
             , "action" .= actions
             ]
+  toObject _ (Conway.ProposalCantFollow prevGovActionId protVer prevProtVer) =
+    mconcat [ "kind" .= String "ProposalCantFollow"
+            , "prevGovActionId" .= prevGovActionId
+            , "protVer" .= protVer
+            , "prevProtVer" .= prevProtVer
+            ]
+  toObject _ (Conway.InvalidPolicyHash actualPolicyHash expectedPolicyHash) =
+    mconcat [ "kind" .= String "InvalidPolicyHash"
+            , "actualPolicyHash" .= actualPolicyHash
+            , "expectedPolicyHash" .= expectedPolicyHash
+            ]
 
 instance
   ( Core.Crypto (Consensus.EraCrypto era)
@@ -404,6 +414,7 @@ instance
   , Show (Ledger.Value ledgerera)
   , ToJSON (Ledger.Value ledgerera)
   , ToJSON (Ledger.TxOut ledgerera)
+  , ledgerera ~ Consensus.AlonzoEra StandardCrypto
   ) => ToObject (AlonzoUtxowPredFailure ledgerera) where
   toObject v (ShelleyInAlonzoUtxowPredFailure utxoPredFail) =
     toObject v utxoPredFail
@@ -439,7 +450,7 @@ instance
   toObject _ (ExtraRedeemers rdmrs) =
     mconcat
       [ "kind" .= String "ExtraRedeemers"
-      , "rdmrs" .= map Api.fromAlonzoRdmrPtr rdmrs
+      , "rdmrs" .= map (Api.toScriptIndex AlonzoEraOnwardsAlonzo) rdmrs
       ]
 
 
@@ -1133,58 +1144,6 @@ instance
 
 deriving newtype instance ToJSON Alonzo.IsValid
 
-instance
-  ( Core.Crypto (Ledger.EraCrypto ledgerera)
-  , Ledger.EraCrypto ledgerera ~ StandardCrypto
-  ) => ToJSON (Alonzo.CollectError ledgerera) where
-  toJSON cError =
-    case cError of
-      Alonzo.NoRedeemer sPurpose ->
-        object
-          [ "kind" .= String "CollectError"
-          , "error" .= String "NoRedeemer"
-          , "scriptpurpose" .= renderScriptPurpose sPurpose
-          ]
-      Alonzo.NoWitness sHash ->
-        object
-          [ "kind" .= String "CollectError"
-          , "error" .= String "NoWitness"
-          , "scripthash" .= renderScriptHash sHash
-          ]
-      Alonzo.NoCostModel lang ->
-        object
-          [ "kind" .= String "CollectError"
-          , "error" .= String "NoCostModel"
-          , "language" .= toJSON lang
-          ]
-      Alonzo.BadTranslation err ->
-        object
-          [ "kind" .= String "PlutusTranslationError"
-          , "error" .= case err of
-              Alonzo.ByronTxOutInContext txOutSource ->
-                String $
-                  "Cannot construct a Plutus ScriptContext from this transaction "
-                    <> "due to a Byron UTxO being created or spent: "
-                    <> textShow txOutSource
-              Alonzo.TranslationLogicMissingInput txin ->
-                String $ "Transaction input does not exist in the UTxO: " <> textShow txin
-              Alonzo.RdmrPtrPointsToNothing ptr ->
-                object
-                  [ "kind" .= String "RedeemerPointerPointsToNothing"
-                  , "ptr" .= Api.fromAlonzoRdmrPtr ptr
-                  ]
-              Alonzo.LanguageNotSupported lang ->
-                String $ "Language not supported: " <> textShow lang
-              Alonzo.InlineDatumsNotSupported txOutSource ->
-                String $ "Inline datums not supported, output source: " <> textShow txOutSource
-              Alonzo.ReferenceScriptsNotSupported txOutSource ->
-                String $ "Reference scripts not supported, output source: " <> textShow txOutSource
-              Alonzo.ReferenceInputsNotSupported txins ->
-                String $ "Reference inputs not supported: " <> textShow txins
-              Alonzo.TimeTranslationPastHorizon msg ->
-                String $ "Time translation requested past the horizon: " <> textShow msg
-          ]
-
 instance ToJSON Alonzo.TagMismatchDescription where
   toJSON tmd = case tmd of
     Alonzo.PassedUnexpectedly ->
@@ -1253,6 +1212,7 @@ instance
   , ToObject (PredicateFailure (Ledger.EraRule "UTXO" ledgerera))
   , ToJSON (Ledger.Value ledgerera)
   , ToJSON (Ledger.TxOut ledgerera)
+  , ledgerera ~ Consensus.StandardAlonzo
   ) => ToObject (BabbageUtxowPredFailure ledgerera) where
   toObject v err =
     case err of

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

@@ -32,6 +32,7 @@ import           Cardano.BM.Trace (traceNamedObject)
 import           Cardano.BM.Tracing
 
 import           Ouroboros.Consensus.Block (Header)
+import           Ouroboros.Consensus.Util.NormalForm.StrictTVar (StrictTVar, readTVar)
 import           Ouroboros.Consensus.Util.Orphans ()
 import           Ouroboros.Network.ConnectionId (remoteAddress)
 
@@ -97,9 +98,9 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd
   tuple3pop (a, b, _) = (a, b)
 
   getCandidates
-    :: STM.StrictTVar IO (Map peer (STM.StrictTVar IO (Net.AnchoredFragment (Header blk))))
+    :: StrictTVar IO (Map peer (StrictTVar IO (Net.AnchoredFragment (Header blk))))
     -> STM.STM IO (Map peer (Net.AnchoredFragment (Header blk)))
-  getCandidates var = STM.readTVar var >>= traverse STM.readTVar
+  getCandidates var = readTVar var >>= traverse readTVar
 
   extractPeers :: NodeKernel IO RemoteAddress LocalConnectionId blk
                 -> IO [Peer blk]