diff --git a/cabal.project b/cabal.project index ab122b3de12..8f472ac467e 100644 --- a/cabal.project +++ b/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= diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 5142527ef0d..f1f7a9f0d2a 100644 --- a/cardano-node/cardano-node.cabal +++ b/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 diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index 2b3638e88c1..259972509ab 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -14,10 +14,11 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -w #-} 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 @@ -25,7 +26,8 @@ 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 +347,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 +383,7 @@ instance forMachine _ (ExtraRedeemers rdmrs) = mconcat [ "kind" .= String "ExtraRedeemers" - , "rdmrs" .= map Api.fromAlonzoRdmrPtr rdmrs + , "rdmrs" .= map (Api.toScriptIndex AlonzoEraOnwardsAlonzo) rdmrs ] instance @@ -1060,6 +1063,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,9 +1139,9 @@ 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" diff --git a/cardano-node/src/Cardano/Node/Tracing/Render.hs b/cardano-node/src/Cardano/Node/Tracing/Render.hs index a2b89b63fad..76bd3db529f 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Render.hs +++ b/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) ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs index e31fc51422b..a6a309ed8c2 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs +++ b/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] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index 7a2ef35bb68..f4a65b89850 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -17,10 +17,11 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -w #-} 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 @@ -28,8 +29,9 @@ 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 qualified Cardano.Ledger.Alonzo.Plutus.TxInfo as Alonzo -import qualified Cardano.Ledger.Alonzo.PlutusScriptApi as Alonzo import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyPredFailure (..), AlonzoUtxoPredFailure, AlonzoUtxosPredFailure, AlonzoUtxowPredFailure (..)) import qualified Cardano.Ledger.Alonzo.Rules as Alonzo @@ -376,14 +378,21 @@ 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 _ _) = undefined instance ( Core.Crypto (Consensus.EraCrypto era) @@ -404,6 +413,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 +449,7 @@ instance toObject _ (ExtraRedeemers rdmrs) = mconcat [ "kind" .= String "ExtraRedeemers" - , "rdmrs" .= map Api.fromAlonzoRdmrPtr rdmrs + , "rdmrs" .= map (Api.toScriptIndex AlonzoEraOnwardsAlonzo) rdmrs ] @@ -1133,58 +1143,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 +1211,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 diff --git a/cardano-node/src/Cardano/Tracing/Peer.hs b/cardano-node/src/Cardano/Tracing/Peer.hs index feff0469095..81e143eed8f 100644 --- a/cardano-node/src/Cardano/Tracing/Peer.hs +++ b/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]