Skip to content

Commit 34eb664

Browse files
authored
Merge pull request IntersectMBO#5412 from input-output-hk/mgalazyn/fix/fix-stubbed-logformatting-instances-from-conway
Fix stubbed LogFormatting instances
2 parents 343f493 + 9806821 commit 34eb664

File tree

4 files changed

+152
-75
lines changed

4 files changed

+152
-75
lines changed

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

Lines changed: 94 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -27,11 +27,10 @@ import qualified Cardano.Ledger.Alonzo.PlutusScriptApi as Alonzo
2727
import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyPredFailure, AlonzoUtxoPredFailure,
2828
AlonzoUtxosPredFailure, AlonzoUtxowPredFailure (..))
2929
import qualified Cardano.Ledger.Alonzo.Rules as Alonzo
30-
import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
3130
import qualified Cardano.Ledger.AuxiliaryData as Ledger
3231
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure, BabbageUtxowPredFailure)
3332
import qualified Cardano.Ledger.Babbage.Rules as Babbage
34-
import Cardano.Ledger.BaseTypes (activeSlotLog)
33+
import Cardano.Ledger.BaseTypes (activeSlotLog, strictMaybeToMaybe)
3534
import Cardano.Ledger.Chain
3635
import Cardano.Ledger.Conway.Governance (govActionIdToText)
3736
import qualified Cardano.Ledger.Conway.Rules as Conway
@@ -42,6 +41,8 @@ import qualified Cardano.Ledger.SafeHash as SafeHash
4241
import Cardano.Ledger.Shelley.API
4342
import Cardano.Ledger.Shelley.Rules
4443
import Cardano.Logging
44+
import Cardano.Node.Tracing.Render (renderMissingRedeemers, renderScriptHash,
45+
renderScriptIntegrityHash)
4546
import Cardano.Protocol.TPraos.API (ChainTransitionError (ChainTransitionError))
4647
import Cardano.Protocol.TPraos.BHeader (LastAppliedBlock, labBlockNo)
4748
import Cardano.Protocol.TPraos.OCert (KESPeriod (KESPeriod))
@@ -66,8 +67,7 @@ import Ouroboros.Consensus.Util.Condense (condense)
6667
import Ouroboros.Network.Block (SlotNo (..), blockHash, blockNo, blockSlot)
6768
import Ouroboros.Network.Point (WithOrigin, withOriginToMaybe)
6869

69-
import Data.Aeson (ToJSON (..), Value (..), (.=))
70-
import qualified Data.Aeson as Aeson
70+
import Data.Aeson (ToJSON (..), Value (..), object, (.=))
7171
import Data.Set (Set)
7272
import qualified Data.Set as Set
7373
import Data.Text (Text)
@@ -89,18 +89,83 @@ instance
8989
: [ "tx" .= condense tx | dtal == DDetailed ]
9090

9191
instance LogFormatting (Set (Credential 'Staking StandardCrypto)) where
92-
forMachine _dtal creds = mconcat
93-
[ "stake credentials" .= Set.map show creds ] -- TODO: Conway era - render this in a nicer way
92+
forMachine _dtal creds =
93+
mconcat [ "kind" .= String "StakeCreds"
94+
, "stakeCreds" .= map forMachine' (Set.toList creds)
95+
]
96+
where
97+
forMachine' = object . \case
98+
ScriptHashObj sHash -> ["scriptHash" .= renderScriptHash sHash]
99+
KeyHashObj keyHash -> ["keyHash" .= textShow keyHash]
94100

95101
instance
96-
( Show (PredicateFailure (Ledger.EraRule "DELEG" era))
97-
, Show (PredicateFailure (Ledger.EraRule "POOL" era))
98-
, Show (PredicateFailure (Ledger.EraRule "VDEL" era))
102+
( LogFormatting (PredicateFailure (Ledger.EraRule "DELEG" era))
103+
, LogFormatting (PredicateFailure (Ledger.EraRule "POOL" era))
104+
, LogFormatting (PredicateFailure (Ledger.EraRule "VDEL" era))
99105
) => LogFormatting (Conway.ConwayCertPredFailure era) where
100-
forMachine _dtal cfail =
101-
mconcat [ "kind" .= String "ConwayCertPredFailure"
102-
, "failure" .= show cfail -- TODO: Conway era - render in a nicer way
103-
]
106+
forMachine dtal = mconcat . \case
107+
Conway.DelegFailure f ->
108+
[ "kind" .= String "DelegFailure " , "failure" .= forMachine dtal f ]
109+
Conway.PoolFailure f ->
110+
[ "kind" .= String "PoolFailure" , "failure" .= forMachine dtal f ]
111+
Conway.VDelFailure f ->
112+
[ "kind" .= String "VDelFailure" , "failure" .= forMachine dtal f ]
113+
114+
instance LogFormatting (Conway.ConwayVDelPredFailure era) where
115+
forMachine _dtal = mconcat . \case
116+
Conway.ConwayDRepAlreadyRegisteredVDEL credential ->
117+
[ "kind" .= String "ConwayDRepAlreadyRegisteredVDEL"
118+
, "credential" .= String (textShow credential)
119+
, "error" .= String "DRep is already registered"
120+
]
121+
Conway.ConwayDRepNotRegisteredVDEL credential ->
122+
[ "kind" .= String "ConwayDRepNotRegisteredVDEL"
123+
, "credential" .= String (textShow credential)
124+
, "error" .= String "DRep is not registered"
125+
]
126+
Conway.ConwayDRepIncorrectDepositVDEL coin ->
127+
[ "kind" .= String "ConwayDRepIncorrectDepositVDEL"
128+
, "coin" .= coin
129+
, "error" .= String "DRep delegation has incorrect deposit"
130+
]
131+
Conway.ConwayCommitteeHasResignedVDEL kHash ->
132+
[ "kind" .= String "ConwayCommitteeHasResignedVDEL"
133+
, "credential" .= String (textShow kHash)
134+
, "error" .= String "Committee has resigned"
135+
]
136+
137+
138+
instance LogFormatting (Conway.ConwayDelegPredFailure era) where
139+
forMachine _dtal = mconcat . \case
140+
Conway.IncorrectDepositDELEG coin ->
141+
[ "kind" .= String "IncorrectDepositDELEG"
142+
, "amount" .= coin
143+
, "error" .= String "Incorrect deposit amount"
144+
]
145+
Conway.StakeKeyAlreadyRegisteredDELEG credential ->
146+
[ "kind" .= String "StakeKeyAlreadyRegisteredDELEG"
147+
, "credential" .= String (textShow credential)
148+
, "error" .= String "Stake key already registered"
149+
]
150+
Conway.StakeKeyNotRegisteredDELEG credential ->
151+
[ "kind" .= String "StakeKeyNotRegisteredDELEG"
152+
, "amount" .= String (textShow credential)
153+
, "error" .= String "Stake key not registered"
154+
]
155+
Conway.StakeKeyHasNonZeroAccountBalanceDELEG coin ->
156+
[ "kind" .= String "StakeKeyHasNonZeroAccountBalanceDELEG"
157+
, "amount" .= coin
158+
, "error" .= String "Stake key has non-zero account balance"
159+
]
160+
Conway.DRepAlreadyRegisteredForStakeKeyDELEG credential ->
161+
[ "kind" .= String "DRepAlreadyRegisteredForStakeKeyDELEG"
162+
, "amount" .= String (textShow credential)
163+
, "error" .= String "DRep already registered for the stake key"
164+
]
165+
Conway.WrongCertificateTypeDELEG ->
166+
[ "kind" .= String "WrongCertificateTypeDELEG"
167+
, "error" .= String "Wrong certificate type"
168+
]
104169

105170
instance
106171
( ShelleyCompatible protocol era
@@ -278,14 +343,15 @@ instance
278343

279344
instance
280345
( Consensus.ShelleyBasedEra era
346+
, Ledger.EraCrypto era ~ StandardCrypto
281347
, LogFormatting (PPUPPredFailure era)
282348
, LogFormatting (PredicateFailure (Ledger.EraRule "UTXO" era))
283349
) => LogFormatting (AlonzoUtxowPredFailure era) where
284350
forMachine dtal (ShelleyInAlonzoUtxowPredFailure utxoPredFail) =
285351
forMachine dtal utxoPredFail
286-
forMachine _ (MissingRedeemers _scripts) =
352+
forMachine _ (MissingRedeemers scripts) =
287353
mconcat [ "kind" .= String "MissingRedeemers"
288-
, "scripts" .= String "TODO: Conway era" -- TODO: Conway era - need to parameterize renderMissingRedeemers over the era
354+
, "scripts" .= renderMissingRedeemers scripts
289355
]
290356
forMachine _ (MissingRequiredDatums required received) =
291357
mconcat [ "kind" .= String "MissingRequiredDatums"
@@ -294,10 +360,10 @@ instance
294360
, "received" .= map (Crypto.hashToTextAsHex . SafeHash.extractHash)
295361
(Set.toList received)
296362
]
297-
forMachine _ (PPViewHashesDontMatch _ppHashInTxBody _ppHashFromPParams) =
363+
forMachine _ (PPViewHashesDontMatch ppHashInTxBody ppHashFromPParams) =
298364
mconcat [ "kind" .= String "PPViewHashesDontMatch"
299-
, "fromTxBody" .= String "TODO: Conway error" -- renderScriptIntegrityHash (strictMaybeToMaybe ppHashInTxBody)
300-
, "fromPParams" .= String "TODO: Conway error" --renderScriptIntegrityHash (strictMaybeToMaybe ppHashFromPParams)
365+
, "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashInTxBody)
366+
, "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashFromPParams)
301367
]
302368
forMachine _ (MissingRequiredSigners missingKeyWitnesses) =
303369
mconcat [ "kind" .= String "MissingRequiredSigners"
@@ -313,18 +379,14 @@ instance
313379
, "acceptable" .= Set.toList acceptable
314380
]
315381
forMachine _ (ExtraRedeemers rdmrs) =
316-
mconcat [ "kind" .= String "ExtraRedeemers"
317-
, "rdmrs" .= map Api.fromAlonzoRdmrPtr rdmrs
318-
]
319-
320-
321-
_renderScriptIntegrityHash :: Maybe (Alonzo.ScriptIntegrityHash StandardCrypto) -> Aeson.Value
322-
_renderScriptIntegrityHash (Just witPPDataHash) =
323-
Aeson.String . Crypto.hashToTextAsHex $ SafeHash.extractHash witPPDataHash
324-
_renderScriptIntegrityHash Nothing = Aeson.Null
382+
mconcat
383+
[ "kind" .= String "ExtraRedeemers"
384+
, "rdmrs" .= map Api.fromAlonzoRdmrPtr rdmrs
385+
]
325386

326387
instance
327388
( Consensus.ShelleyBasedEra era
389+
, Ledger.EraCrypto era ~ StandardCrypto
328390
, ToJSON (Ledger.AuxiliaryDataHash (Ledger.EraCrypto era))
329391
, LogFormatting (PredicateFailure (ShelleyUTXO era))
330392
, LogFormatting (PredicateFailure (Ledger.EraRule "UTXO" era))
@@ -366,9 +428,9 @@ instance
366428
forMachine _dtal InvalidMetadata =
367429
mconcat [ "kind" .= String "InvalidMetadata"
368430
]
369-
forMachine _dtal (ExtraneousScriptWitnessesUTXOW _shashes) =
431+
forMachine _dtal (ExtraneousScriptWitnessesUTXOW scriptHashes) =
370432
mconcat [ "kind" .= String "ExtraneousScriptWitnessesUTXOW"
371-
, "scriptHashes" .= String "TODO: Conway era" -- Set.map Api.fromShelleyScriptHash shashes
433+
, "scriptHashes" .= Set.map renderScriptHash scriptHashes
372434
]
373435

374436
instance
@@ -952,9 +1014,9 @@ instance
9521014
, "isvalidating" .= isValidating
9531015
, "reason" .= reason
9541016
]
955-
forMachine _ (Alonzo.CollectErrors _errors) =
1017+
forMachine _ (Alonzo.CollectErrors errors) =
9561018
mconcat [ "kind" .= String "CollectErrors"
957-
, "errors" .= String "TODO: Conway era" --errors
1019+
, "errors" .= errors
9581020
]
9591021
forMachine dtal (Alonzo.UpdateFailure pFailure) =
9601022
forMachine dtal pFailure
@@ -994,6 +1056,7 @@ instance
9941056

9951057
instance
9961058
( Ledger.Era era
1059+
, Ledger.EraCrypto era ~ StandardCrypto
9971060
, ShelleyBasedEra era
9981061
, LogFormatting (PPUPPredFailure era)
9991062
, LogFormatting (ShelleyUtxowPredFailure era)

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

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE GADTs #-}
2+
{-# LANGUAGE LambdaCase #-}
13
{-# LANGUAGE ScopedTypeVariables #-}
24
{-# LANGUAGE TypeApplications #-}
35

@@ -22,17 +24,31 @@ module Cardano.Node.Tracing.Render
2224
, renderTxId
2325
, renderTxIdForDetails
2426
, renderWithOrigin
27+
, renderScriptHash
28+
, renderScriptIntegrityHash
29+
, renderScriptPurpose
30+
, renderMissingRedeemers
2531
) where
2632

33+
import qualified Cardano.Api.Shelley as Api
34+
import qualified Cardano.Crypto.Hash.Class as Crypto
2735
import qualified Data.ByteString.Base16 as B16
2836
import Data.Proxy (Proxy (..))
2937
import Data.Text (Text)
3038
import qualified Data.Text as Text
3139
import qualified Data.Text.Encoding as Text
3240

41+
import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
42+
import qualified Cardano.Ledger.Core as Ledger
43+
import Cardano.Ledger.Crypto (StandardCrypto)
44+
import qualified Cardano.Ledger.SafeHash as SafeHash
3345
import Cardano.Logging
3446
import Cardano.Node.Queries (ConvertTxId (..))
3547
import Cardano.Slotting.Slot (SlotNo (..), WithOrigin (..))
48+
import Data.Aeson ((.=))
49+
import qualified Data.Aeson as Aeson
50+
import qualified Data.Aeson.Key as Aeson
51+
import qualified Data.Aeson.Types as Aeson
3652
import Ouroboros.Consensus.Block (BlockNo (..), ConvertRawHash (..), RealPoint (..))
3753
import Ouroboros.Consensus.Block.Abstract (Point (..))
3854
import Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, TxId)
@@ -156,3 +172,41 @@ trimHashTextForDetails dtal =
156172
case dtal of
157173
DMinimal -> Text.take 7
158174
_ -> id
175+
176+
renderScriptIntegrityHash :: Maybe (Alonzo.ScriptIntegrityHash StandardCrypto) -> Aeson.Value
177+
renderScriptIntegrityHash (Just witPPDataHash) =
178+
Aeson.String . Crypto.hashToTextAsHex $ SafeHash.extractHash witPPDataHash
179+
renderScriptIntegrityHash Nothing = Aeson.Null
180+
181+
182+
renderMissingRedeemers :: ()
183+
=> Ledger.EraCrypto ledgerera ~ StandardCrypto
184+
=> [(Alonzo.ScriptPurpose ledgerera, Ledger.ScriptHash StandardCrypto)]
185+
-> Aeson.Value
186+
renderMissingRedeemers scripts = Aeson.object $ map renderTuple scripts
187+
where
188+
renderTuple :: ()
189+
=> Ledger.EraCrypto ledgerera ~ StandardCrypto
190+
=> (Alonzo.ScriptPurpose ledgerera, Ledger.ScriptHash StandardCrypto)
191+
-> Aeson.Pair
192+
renderTuple (scriptPurpose, sHash) =
193+
Aeson.fromText (renderScriptHash sHash) .= renderScriptPurpose scriptPurpose
194+
195+
renderScriptHash :: Ledger.ScriptHash StandardCrypto -> Text
196+
renderScriptHash = Api.serialiseToRawBytesHexText . Api.fromShelleyScriptHash
197+
198+
renderScriptPurpose :: ()
199+
=> Ledger.EraCrypto ledgerera ~ StandardCrypto
200+
=> Alonzo.ScriptPurpose ledgerera
201+
-> Aeson.Value
202+
renderScriptPurpose = \case
203+
Alonzo.Minting pid ->
204+
Aeson.object [ "minting" .= Aeson.toJSON pid]
205+
Alonzo.Spending txin ->
206+
Aeson.object [ "spending" .= Api.fromShelleyTxIn txin]
207+
Alonzo.Rewarding rwdAcct ->
208+
Aeson.object [ "rewarding" .= Aeson.String (Api.serialiseAddress $ Api.fromShelleyStakeAddr rwdAcct)]
209+
Alonzo.Certifying _cert ->
210+
Aeson.object
211+
[ "certifying" .= Aeson.toJSON @String "TODO CIP-1694 unimplemented" -- toJSON (Api.textEnvelopeDefaultDescr $ Api.fromShelleyCertificate sbe cert)
212+
]

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

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,13 +7,11 @@
77
{-# LANGUAGE PolyKinds #-}
88
{-# LANGUAGE QuantifiedConstraints #-}
99
{-# LANGUAGE ScopedTypeVariables #-}
10-
{-# LANGUAGE StandaloneDeriving #-}
1110
{-# LANGUAGE TypeApplications #-}
1211
{-# LANGUAGE TypeFamilies #-}
1312
{-# LANGUAGE UndecidableInstances #-}
1413

1514
{-# OPTIONS_GHC -Wno-orphans #-}
16-
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1715

1816
module Cardano.Tracing.OrphanInstances.Network () where
1917

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

Lines changed: 4 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,6 @@
1212
{-# LANGUAGE OverloadedStrings #-}
1313
{-# LANGUAGE ScopedTypeVariables #-}
1414
{-# LANGUAGE StandaloneDeriving #-}
15-
{-# LANGUAGE TypeApplications #-}
1615
{-# LANGUAGE TypeFamilies #-}
1716
{-# LANGUAGE UndecidableInstances #-}
1817

@@ -21,7 +20,6 @@
2120
module Cardano.Tracing.OrphanInstances.Shelley () where
2221

2322
import Cardano.Api (textShow)
24-
import qualified Cardano.Api as Api
2523
import qualified Cardano.Api.Shelley as Api
2624

2725
import qualified Cardano.Crypto.Hash.Class as Crypto
@@ -75,10 +73,10 @@ import Ouroboros.Consensus.Util.Condense (condense)
7573
import Ouroboros.Network.Block (SlotNo (..), blockHash, blockNo, blockSlot)
7674
import Ouroboros.Network.Point (WithOrigin, withOriginToMaybe)
7775

76+
import Cardano.Node.Tracing.Render (renderMissingRedeemers, renderScriptHash,
77+
renderScriptIntegrityHash, renderScriptPurpose)
7878
import Data.Aeson (Value (..), object)
7979
import qualified Data.Aeson as Aeson
80-
import qualified Data.Aeson.Key as Aeson
81-
import qualified Data.Aeson.Types as Aeson
8280
import Data.Set (Set)
8381
import qualified Data.Set as Set
8482
import Data.Text (Text)
@@ -403,52 +401,16 @@ instance
403401
, "rdmrs" .= map Api.fromAlonzoRdmrPtr rdmrs
404402
]
405403

406-
renderScriptIntegrityHash :: Maybe (Alonzo.ScriptIntegrityHash StandardCrypto) -> Aeson.Value
407-
renderScriptIntegrityHash (Just witPPDataHash) =
408-
Aeson.String . Crypto.hashToTextAsHex $ SafeHash.extractHash witPPDataHash
409-
renderScriptIntegrityHash Nothing = Aeson.Null
410-
411-
412-
renderMissingRedeemers :: ()
413-
=> Ledger.EraCrypto ledgerera ~ StandardCrypto
414-
=> [(Alonzo.ScriptPurpose ledgerera, ScriptHash StandardCrypto)]
415-
-> Aeson.Value
416-
renderMissingRedeemers scripts = Aeson.object $ map renderTuple scripts
417-
where
418-
renderTuple :: ()
419-
=> Ledger.EraCrypto ledgerera ~ StandardCrypto
420-
=> (Alonzo.ScriptPurpose ledgerera, ScriptHash StandardCrypto)
421-
-> Aeson.Pair
422-
renderTuple (scriptPurpose, sHash) =
423-
Aeson.fromText (renderScriptHash sHash) .= renderScriptPurpose scriptPurpose
424-
425-
renderScriptHash :: ScriptHash StandardCrypto -> Text
426-
renderScriptHash = Api.serialiseToRawBytesHexText . Api.fromShelleyScriptHash
427-
428-
renderScriptPurpose :: ()
429-
=> Ledger.EraCrypto ledgerera ~ StandardCrypto
430-
=> Alonzo.ScriptPurpose ledgerera
431-
-> Aeson.Value
432-
renderScriptPurpose = \case
433-
Alonzo.Minting pid ->
434-
Aeson.object [ "minting" .= toJSON pid]
435-
Alonzo.Spending txin ->
436-
Aeson.object [ "spending" .= Api.fromShelleyTxIn txin]
437-
Alonzo.Rewarding rwdAcct ->
438-
Aeson.object [ "rewarding" .= Aeson.String (Api.serialiseAddress $ Api.fromShelleyStakeAddr rwdAcct)]
439-
Alonzo.Certifying _cert ->
440-
Aeson.object
441-
[ "certifying" .= toJSON @String "TODO CIP-1694 unimplemented" -- toJSON (Api.textEnvelopeDefaultDescr $ Api.fromShelleyCertificate sbe cert)
442-
]
443404

444405
instance
445406
( ToObject (PredicateFailure (ShelleyUTXO ledgerera))
446407
, ToObject (PredicateFailure (Core.EraRule "UTXO" ledgerera))
408+
, Ledger.EraCrypto ledgerera ~ StandardCrypto
447409
, Core.Crypto (Ledger.EraCrypto ledgerera)
448410
) => ToObject (ShelleyUtxowPredFailure ledgerera) where
449411
toObject _verb (ExtraneousScriptWitnessesUTXOW extraneousScripts) =
450412
mconcat [ "kind" .= String "InvalidWitnessesUTXOW"
451-
, "extraneousScripts" .= extraneousScripts
413+
, "extraneousScripts" .= Set.map renderScriptHash extraneousScripts
452414
]
453415
toObject _verb (InvalidWitnessesUTXOW wits') =
454416
mconcat [ "kind" .= String "InvalidWitnessesUTXOW"

0 commit comments

Comments
 (0)