Account for consensus and ledger changes (WIP)

bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs

@@ -204,13 +204,13 @@ preExecutePlutusV2 (major, _minor) (PlutusScript _ (PlutusScriptSerialised scrip
       , PlutusV2.txInfoFee = mempty
       , PlutusV2.txInfoMint = mempty
       , PlutusV2.txInfoDCert = []
-      , PlutusV2.txInfoWdrl = PlutusV2.fromList []
+      , PlutusV2.txInfoWdrl = PlutusV2.unsafeFromList []
       , PlutusV2.txInfoValidRange = PlutusV2.always
       , PlutusV2.txInfoSignatories = []
-      , PlutusV2.txInfoData = PlutusV2.fromList []
+      , PlutusV2.txInfoData = PlutusV2.unsafeFromList []
       , PlutusV2.txInfoId = PlutusV2.TxId ""
       , PlutusV2.txInfoReferenceInputs = []
-      , PlutusV2.txInfoRedeemers = PlutusV2.fromList []
+      , PlutusV2.txInfoRedeemers = PlutusV2.unsafeFromList []
       }
 
 preExecutePlutusV3 ::
@@ -255,13 +255,13 @@ preExecutePlutusV3 (major, _minor) (PlutusScript _ (PlutusScriptSerialised (scri
       , PlutusV3.txInfoFee = 0
       , PlutusV3.txInfoMint = mempty
       , PlutusV3.txInfoTxCerts = []
-      , PlutusV3.txInfoWdrl = PlutusV3.fromList []
+      , PlutusV3.txInfoWdrl = PlutusV3.unsafeFromList []
       , PlutusV3.txInfoValidRange = PlutusV3.always
       , PlutusV3.txInfoSignatories = []
-      , PlutusV3.txInfoData = PlutusV3.fromList []
+      , PlutusV3.txInfoData = PlutusV3.unsafeFromList []
       , PlutusV3.txInfoId = PlutusV3.TxId ""
       , PlutusV3.txInfoReferenceInputs = []
-      , PlutusV3.txInfoRedeemers = PlutusV3.fromList []
+      , PlutusV3.txInfoRedeemers = PlutusV3.unsafeFromList []
       , PlutusV3.txInfoVotes = AssocMap.empty
       , PlutusV3.txInfoProposalProcedures = []
       , PlutusV3.txInfoCurrentTreasuryAmount = Nothing

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

@@ -1175,6 +1175,15 @@ instance
             , "actualPolicyHash" .= actualPolicyHash
             , "expectedPolicyHash" .= expectedPolicyHash
             ]
+  forMachine _ (Conway.DisallowedProposalDuringBootstrap proposal) =
+    mconcat [ "kind" .= String "DisallowedProposalDuringBootstrap"
+            , "proposal" .= proposal
+            ]
+  forMachine _ (Conway.DisallowedVotesDuringBootstrap votes) =
+    mconcat [ "kind" .= String "DisallowedVotesDuringBootstrap"
+            , "votes" .= votes
+            ]
+
 
 instance
   ( Consensus.ShelleyBasedEra era
@@ -1321,6 +1330,210 @@ instance LogFormatting (Ledger.VoidEraRule rule era) where
   -- NOTE: There are no values of type 'Ledger.VoidEraRule rule era'
   forMachine _ = \case
 
+instance
+  ( Api.ShelleyLedgerEra era ~ ledgerera
+  , Api.IsShelleyBasedEra era
+  , Consensus.ShelleyBasedEra ledgerera
+  , Ledger.EraCrypto ledgerera ~ StandardCrypto
+  , LogFormatting (PredicateFailure (Ledger.EraRule "UTXOS" ledgerera))
+  ) => LogFormatting (Conway.ConwayUtxoPredFailure ledgerera) where
+  forMachine dtal = \case
+    Conway.UtxosFailure utxosPredFailure -> forMachine dtal utxosPredFailure
+    Conway.BadInputsUTxO badInputs ->
+      mconcat [ "kind" .= String "BadInputsUTxO"
+              , "badInputs" .= badInputs
+              , "error" .= renderBadInputsUTxOErr badInputs
+              ]
+    Conway.OutsideValidityIntervalUTxO validityInterval slot ->
+      mconcat [ "kind" .= String "ExpiredUTxO"
+              , "validityInterval" .= validityInterval
+              , "slot" .= slot
+              ]
+    Conway.MaxTxSizeUTxO txsize maxtxsize ->
+      mconcat [ "kind" .= String "MaxTxSizeUTxO"
+              , "size" .= txsize
+              , "maxSize" .= maxtxsize
+              ]
+    Conway.InputSetEmptyUTxO ->
+      mconcat [ "kind" .= String "InputSetEmptyUTxO" ]
+    Conway.FeeTooSmallUTxO minfee txfee ->
+      mconcat [ "kind" .= String "FeeTooSmallUTxO"
+              , "minimum" .= minfee
+              , "fee" .= txfee
+              ]
+    Conway.ValueNotConservedUTxO consumed produced ->
+      mconcat [ "kind" .= String "ValueNotConservedUTxO"
+              , "consumed" .= consumed
+              , "produced" .= produced
+              , "error" .= renderValueNotConservedErr consumed produced
+              ]
+    Conway.WrongNetwork network addrs ->
+      mconcat [ "kind" .= String "WrongNetwork"
+              , "network" .= network
+              , "addrs"   .= addrs
+              ]
+    Conway.WrongNetworkWithdrawal network addrs ->
+      mconcat [ "kind" .= String "WrongNetworkWithdrawal"
+              , "network" .= network
+              , "addrs"   .= addrs
+              ]
+    Conway.OutputTooSmallUTxO badOutputs ->
+      mconcat [ "kind" .= String "OutputTooSmallUTxO"
+              , "outputs" .= badOutputs
+              , "error" .= String
+                ( mconcat
+                  [ "The output is smaller than the allow minimum "
+                  , "UTxO value defined in the protocol parameters"
+                  ]
+                )
+              ]
+    Conway.OutputBootAddrAttrsTooBig badOutputs ->
+      mconcat [ "kind" .= String "OutputBootAddrAttrsTooBig"
+              , "outputs" .= badOutputs
+              , "error" .= String "The Byron address attributes are too big"
+              ]
+    Conway.OutputTooBigUTxO badOutputs ->
+      mconcat [ "kind" .= String "OutputTooBigUTxO"
+              , "outputs" .= badOutputs
+              , "error" .= String "Too many asset ids in the tx output"
+              ]
+    Conway.InsufficientCollateral computedBalance suppliedFee ->
+      mconcat [ "kind" .= String "InsufficientCollateral"
+              , "balance" .= computedBalance
+              , "txfee" .= suppliedFee
+              ]
+    Conway.ScriptsNotPaidUTxO utxos ->
+      mconcat [ "kind" .= String "ScriptsNotPaidUTxO"
+              , "utxos" .= utxos
+              ]
+    Conway.ExUnitsTooBigUTxO pParamsMaxExUnits suppliedExUnits ->
+      mconcat [ "kind" .= String "ExUnitsTooBigUTxO"
+              , "maxexunits" .= pParamsMaxExUnits
+              , "exunits" .= suppliedExUnits
+              ]
+    Conway.CollateralContainsNonADA inputs ->
+      mconcat [ "kind" .= String "CollateralContainsNonADA"
+              , "inputs" .= inputs
+              ]
+    Conway.WrongNetworkInTxBody actualNetworkId netIdInTxBody ->
+      mconcat [ "kind" .= String "WrongNetworkInTxBody"
+              , "networkid" .= actualNetworkId
+              , "txbodyNetworkId" .= netIdInTxBody
+              ]
+    Conway.OutsideForecast slotNum ->
+      mconcat [ "kind" .= String "OutsideForecast"
+              , "slot" .= slotNum
+              ]
+    Conway.TooManyCollateralInputs maxCollateralInputs numberCollateralInputs ->
+      mconcat [ "kind" .= String "TooManyCollateralInputs"
+              , "max" .= maxCollateralInputs
+              , "inputs" .= numberCollateralInputs
+              ]
+    Conway.NoCollateralInputs ->
+      mconcat [ "kind" .= String "NoCollateralInputs" ]
+    Conway.IncorrectTotalCollateralField provided declared ->
+      mconcat [ "kind" .= String "UnequalCollateralReturn"
+              , "collateralProvided" .= provided
+              , "collateralDeclared" .= declared
+              ]
+    Conway.BabbageOutputTooSmallUTxO outputs ->
+      mconcat [ "kind" .= String "BabbageOutputTooSmall"
+              , "outputs" .= outputs
+              ]
+    Conway.BabbageNonDisjointRefInputs nonDisjointInputs ->
+      mconcat [ "kind" .= String "BabbageNonDisjointRefInputs"
+              , "outputs" .= nonDisjointInputs
+              ]
+
+instance
+  ( Api.ShelleyLedgerEra era ~ ledgerera
+  , Api.IsShelleyBasedEra era
+  , Consensus.ShelleyBasedEra ledgerera
+  , Ledger.EraCrypto ledgerera ~ StandardCrypto
+  , LogFormatting (PredicateFailure (Ledger.EraRule "UTXO" ledgerera))
+  ) => LogFormatting (Conway.ConwayUtxowPredFailure ledgerera) where
+   forMachine dtal = \case
+    Conway.UtxoFailure utxoPredFail -> forMachine dtal utxoPredFail
+    Conway.InvalidWitnessesUTXOW ws ->
+      mconcat [ "kind" .= String "InvalidWitnessesUTXOW"
+              , "invalidWitnesses" .= map textShow ws
+              ]
+    Conway.MissingVKeyWitnessesUTXOW ws ->
+      mconcat [ "kind" .= String "MissingVKeyWitnessesUTXOW"
+              , "missingWitnesses" .= ws
+              ]
+    Conway.MissingScriptWitnessesUTXOW scripts ->
+      mconcat [ "kind" .= String "MissingScriptWitnessesUTXOW"
+              , "missingScripts" .= scripts
+              ]
+    Conway.ScriptWitnessNotValidatingUTXOW failedScripts ->
+      mconcat [ "kind" .= String "ScriptWitnessNotValidatingUTXOW"
+              , "failedScripts" .= failedScripts
+              ]
+    Conway.MissingTxBodyMetadataHash hash ->
+      mconcat [ "kind" .= String "MissingTxMetadata"
+              , "txBodyMetadataHash" .= hash
+              ]
+    Conway.MissingTxMetadata hash ->
+      mconcat [ "kind" .= String "MissingTxMetadata"
+              , "txBodyMetadataHash" .= hash
+              ]
+    Conway.ConflictingMetadataHash txBodyMetadataHash fullMetadataHash ->
+      mconcat [ "kind" .= String "ConflictingMetadataHash"
+              , "txBodyMetadataHash" .= txBodyMetadataHash
+              , "fullMetadataHash" .= fullMetadataHash
+              ]
+    Conway.InvalidMetadata ->
+      mconcat [ "kind" .= String "InvalidMetadata"
+              ]
+    Conway.ExtraneousScriptWitnessesUTXOW scripts ->
+      mconcat [ "kind" .= String "InvalidWitnessesUTXOW"
+              , "extraneousScripts" .= Set.map renderScriptHash scripts
+              ]
+    Conway.MissingRedeemers scripts ->
+      mconcat [ "kind" .= String "MissingRedeemers"
+              , "scripts" .= renderMissingRedeemers Api.shelleyBasedEra scripts
+              ]
+    Conway.MissingRequiredDatums required received ->
+      mconcat [ "kind" .= String "MissingRequiredDatums"
+              , "required" .= map (Crypto.hashToTextAsHex . SafeHash.extractHash)
+                                      (Set.toList required)
+              , "received" .= map (Crypto.hashToTextAsHex . SafeHash.extractHash)
+                                      (Set.toList received)
+              ]
+    Conway.NotAllowedSupplementalDatums disallowed acceptable ->
+      mconcat [ "kind" .= String "NotAllowedSupplementalDatums"
+              , "disallowed" .= Set.toList disallowed
+              , "acceptable" .= Set.toList acceptable
+              ]
+    Conway.PPViewHashesDontMatch ppHashInTxBody ppHashFromPParams ->
+      mconcat [ "kind" .= String "PPViewHashesDontMatch"
+              , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashInTxBody)
+              , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashFromPParams)
+              ]
+    Conway.UnspendableUTxONoDatumHash ins ->
+      mconcat [ "kind" .= String "MissingRequiredSigners"
+              , "txins" .= Set.toList ins
+              ]
+    Conway.ExtraRedeemers rs ->
+      Api.caseShelleyToMaryOrAlonzoEraOnwards
+        (const mempty)
+        (\alonzoOnwards ->
+           mconcat
+             [ "kind" .= String "ExtraRedeemers"
+             , "rdmrs" .=  map (Api.toScriptIndex alonzoOnwards) rs
+             ]
+        )
+        (Api.shelleyBasedEra :: Api.ShelleyBasedEra era)
+    Conway.MalformedScriptWitnesses scripts ->
+      mconcat [ "kind" .= String "MalformedScriptWitnesses"
+              , "scripts" .= scripts
+              ]
+    Conway.MalformedReferenceScripts scripts ->
+      mconcat [ "kind" .= String "MalformedReferenceScripts"
+              , "scripts" .= scripts
+              ]
+
 --------------------------------------------------------------------------------
 -- Helper functions
 --------------------------------------------------------------------------------

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

@@ -208,7 +208,7 @@ traceNodeStateChainDB _scp tr ev =
           traceWith tr $ NodeOpeningDbs $ OpenedImmutableDB (pointSlot p) chunk
         ChainDB.StartedOpeningVolatileDB ->
           traceWith tr $ NodeOpeningDbs StartedOpeningVolatileDB
-        ChainDB.OpenedVolatileDB ->
+        ChainDB.OpenedVolatileDB _maxSlotN ->
           traceWith tr $ NodeOpeningDbs OpenedVolatileDB
         ChainDB.StartedOpeningLgrDB ->
           traceWith tr $ NodeOpeningDbs StartedOpeningLgrDB

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

@@ -504,10 +504,17 @@ instance ( LogFormatting (Header blk)
   forMachine _dtal ChainDB.PoppedReprocessLoEBlocksFromQueue =
       mconcat [ "kind" .= String "PoppedReprocessLoEBlocksFromQueue" ]
   forMachine dtal (ChainDB.ChainSelectionLoEDebug curChain loeFrag) =
-      mconcat [ "kind" .= String "ChainSelectionLoEDebug"
-              , "curChain" .= headAndAnchor curChain
-              , "loeFrag" .= headAndAnchor loeFrag
-              ]
+      case loeFrag of
+        ChainDB.LoEEnabled loeF ->
+          mconcat [ "kind" .= String "ChainSelectionLoEDebug"
+                  , "curChain" .= headAndAnchor curChain
+                  , "loeFrag" .= headAndAnchor loeF
+                  ]
+        ChainDB.LoEDisabled ->
+          mconcat [ "kind" .= String "ChainSelectionLoEDebug"
+                  , "curChain" .= headAndAnchor curChain
+                  , "loeFrag" .= String "LoE is disabled"
+                  ]
     where
       headAndAnchor frag = object
         [ "anchor" .= forMachine dtal (AF.anchorPoint frag)
@@ -1179,7 +1186,8 @@ instance ConvertRawHash blk
   forHuman (ChainDB.OpenedImmutableDB immTip chunk) =
           "Opened imm db with immutable tip at " <> renderPointAsPhrase immTip <>
           " and chunk " <> showT chunk
-  forHuman ChainDB.OpenedVolatileDB = "Opened vol db"
+  forHuman (ChainDB.OpenedVolatileDB maxSlotN) =
+    "Opened vol db with max slot number " <> showT maxSlotN
   forHuman ChainDB.OpenedLgrDB = "Opened lgr db"
   forHuman ChainDB.StartedOpeningDB = "Started opening Chain DB"
   forHuman ChainDB.StartedOpeningImmutableDB = "Started opening Immutable DB"
@@ -1198,8 +1206,9 @@ instance ConvertRawHash blk
     mconcat [ "kind" .= String "OpenedImmutableDB"
              , "immtip" .= forMachine dtal immTip
              , "epoch" .= String ((Text.pack . show) epoch) ]
-  forMachine _dtal ChainDB.OpenedVolatileDB =
-      mconcat [ "kind" .= String "OpenedVolatileDB" ]
+  forMachine _dtal (ChainDB.OpenedVolatileDB maxSlotN) =
+      mconcat [ "kind" .= String "OpenedVolatileDB"
+               , "maxSlotNo" .= String (showT maxSlotN) ]
   forMachine _dtal ChainDB.OpenedLgrDB =
       mconcat [ "kind" .= String "OpenedLgrDB" ]
   forMachine _dtal ChainDB.StartedOpeningDB =
@@ -1989,17 +1998,21 @@ instance StandardHash blk => LogFormatting (VolDB.TraceEvent blk) where
       mconcat [ "kind" .= String "InvalidFileNames"
                , "files" .= String (Text.pack . show $ map show fsPaths)
               ]
+    forMachine _dtal VolDB.DBClosed =
+      mconcat [ "kind" .= String "DBClosed" ]
 
 instance MetaTrace (VolDB.TraceEvent blk) where
     namespaceFor VolDB.DBAlreadyClosed {} = Namespace [] ["DBAlreadyClosed"]
     namespaceFor VolDB.BlockAlreadyHere {} = Namespace [] ["BlockAlreadyHere"]
     namespaceFor VolDB.Truncate {} = Namespace [] ["Truncate"]
     namespaceFor VolDB.InvalidFileNames {} = Namespace [] ["InvalidFileNames"]
+    namespaceFor VolDB.DBClosed {} = Namespace [] ["DBClosed"]
 
     severityFor  (Namespace _ ["DBAlreadyClosed"]) _ = Just Debug
     severityFor  (Namespace _ ["BlockAlreadyHere"]) _ = Just Debug
     severityFor  (Namespace _ ["Truncate"]) _ = Just Debug
     severityFor  (Namespace _ ["InvalidFileNames"]) _ = Just Debug
+    severityFor  (Namespace _ ["DBClosed"]) _ = Just Debug
     severityFor _ _ = Nothing
 
     documentFor  (Namespace _ ["DBAlreadyClosed"]) = Just
@@ -2010,13 +2023,16 @@ instance MetaTrace (VolDB.TraceEvent blk) where
       "Truncates a file up to offset because of the error."
     documentFor  (Namespace _ ["InvalidFileNames"]) = Just
       "Reports a list of invalid file paths."
+    documentFor  (Namespace _ ["DBClosed"]) = Just
+      "Closing the volatile DB"
     documentFor _ = Nothing
 
     allNamespaces =
       [ Namespace [] ["DBAlreadyClosed"]
       , Namespace [] ["BlockAlreadyHere"]
       , Namespace [] ["Truncate"]
       , Namespace [] ["InvalidFileNames"]
+      , Namespace [] ["DBClosed"]
       ]
 
 

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

@@ -14,7 +14,7 @@ import           Cardano.Logging hiding (traceWith)
 import           Cardano.Node.Orphans ()
 import           Cardano.Node.Queries
 import           Ouroboros.Consensus.Block (Header)
-import           Ouroboros.Consensus.Util.NormalForm.StrictTVar (StrictTVar, readTVar)
+import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client (viewChainSyncState, csCandidate)
 import           Ouroboros.Consensus.Util.Orphans ()
 import qualified Ouroboros.Network.AnchoredFragment as Net
 import           Ouroboros.Network.Block (unSlotNo)
@@ -33,7 +33,6 @@ import           "contra-tracer" Control.Tracer
 import           Data.Aeson (ToJSON (..), Value (..), toJSON, (.=))
 import           Data.Functor ((<&>))
 import qualified Data.List as List
-import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import           Data.Text (Text)
@@ -101,10 +100,10 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd
   tuple3pop :: (a, b, c) -> (a, b)
   tuple3pop (a, b, _) = (a, b)
 
-  getCandidates
-    :: StrictTVar IO (Map peer (StrictTVar IO (Net.AnchoredFragment (Header blk))))
-    -> STM.STM IO (Map peer (Net.AnchoredFragment (Header blk)))
-  getCandidates var = readTVar var >>= traverse readTVar
+  -- getCandidates
+  --   :: StrictTVar IO (Map peer (StrictTVar IO (Net.AnchoredFragment (Header blk))))
+  --   -> STM.STM IO (Map peer (Net.AnchoredFragment (Header blk)))
+  getCandidates handle = viewChainSyncState handle csCandidate
 
   extractPeers :: NodeKernel IO RemoteAddress LocalConnectionId blk
                 -> IO [PeerT blk]
@@ -114,7 +113,7 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd
                                        . Net.readFetchClientsStateVars
                                        . getFetchClientRegistry $ kernel
                                      )
-    candidates <- STM.atomically . getCandidates . getNodeCandidates $ kernel
+    candidates <- STM.atomically . getCandidates . getChainSyncHandles $ kernel
 
     let peers = flip Map.mapMaybeWithKey candidates $ \cid af ->
                   maybe Nothing