@@ -49,7 +49,7 @@ import qualified Cardano.Api.Ledger as Ledger
4949import Cardano.Api.Shelley (Hash (.. ),
5050 KeyWitness (ShelleyBootstrapWitness , ShelleyKeyWitness ), Proposal (.. ),
5151 ShelleyLedgerEra , StakeAddress (.. ), Tx (ShelleyTx ),
52- fromShelleyPaymentCredential , fromShelleyStakeReference ,
52+ fromShelleyPaymentCredential , fromShelleyStakeReference , getTxBodyAndWitnesses ,
5353 toShelleyStakeCredential )
5454
5555import Cardano.CLI.Orphans ()
@@ -180,8 +180,10 @@ friendlyTxImpl
180180 => CardanoEra era
181181 -> Tx era
182182 -> m [Aeson. Pair ]
183- friendlyTxImpl era ( Tx body witnesses) =
183+ friendlyTxImpl era tx =
184184 ((" witnesses" .= map friendlyKeyWitness witnesses) : ) <$> friendlyTxBodyImpl era body
185+ where
186+ (body, witnesses) = getTxBodyAndWitnesses tx
185187
186188friendlyKeyWitness :: KeyWitness era -> Aeson. Value
187189friendlyKeyWitness =
@@ -198,97 +200,92 @@ friendlyTxBodyImpl
198200 => CardanoEra era
199201 -> TxBody era
200202 -> m [Aeson. Pair ]
201- friendlyTxBodyImpl
202- era
203- tb@ ( TxBody
204- -- Enumerating the fields, so that we are warned by GHC when we add a new one
205- ( TxBodyContent
206- txIns
207- txInsCollateral
208- txInsReference
209- txOuts
210- txTotalCollateral
211- txReturnCollateral
212- txFee
213- txValidityLowerBound
214- txValidityUpperBound
215- txMetadata
216- txAuxScripts
217- txExtraKeyWits
218- _txProtocolParams
219- txWithdrawals
220- txCertificates
221- txUpdateProposal
222- txMintValue
223- _txScriptValidity
224- txProposalProcedures
225- txVotingProcedures
226- txCurrentTreasuryValue
227- txTreasuryDonation
228- )
229- ) =
230- do
231- return $
232- cardanoEraConstraints
233- era
234- ( [ " auxiliary scripts" .= friendlyAuxScripts txAuxScripts
235- , " certificates" .= forEraInEon era Null (`friendlyCertificates` txCertificates)
236- , " collateral inputs" .= friendlyCollateralInputs txInsCollateral
237- , " era" .= era
238- , " fee" .= friendlyFee txFee
239- , " inputs" .= friendlyInputs txIns
240- , " metadata" .= friendlyMetadata txMetadata
241- , " mint" .= friendlyMintValue txMintValue
242- , " outputs" .= map (friendlyTxOut era) txOuts
243- , " reference inputs" .= friendlyReferenceInputs txInsReference
244- , " total collateral" .= friendlyTotalCollateral txTotalCollateral
245- , " return collateral" .= friendlyReturnCollateral era txReturnCollateral
246- , " required signers (payment key hashes needed for scripts)"
247- .= friendlyExtraKeyWits txExtraKeyWits
248- , " update proposal" .= friendlyUpdateProposal txUpdateProposal
249- , " validity range" .= friendlyValidityRange era (txValidityLowerBound, txValidityUpperBound)
250- , " withdrawals" .= friendlyWithdrawals txWithdrawals
251- ]
252- ++ ( monoidForEraInEon @ AlonzoEraOnwards
253- era
254- (`getScriptWitnessDetails` tb)
255- )
256- ++ ( monoidForEraInEon @ ConwayEraOnwards
257- era
258- ( \ cOnwards ->
259- conwayEraOnwardsConstraints cOnwards $
260- case txProposalProcedures of
261- Nothing -> []
262- Just (Featured _ TxProposalProceduresNone ) -> []
263- Just (Featured _ pp) -> do
264- let lProposals = toList $ convProposalProcedures pp
265- [" governance actions" .= (friendlyLedgerProposals cOnwards lProposals)]
266- )
267- )
268- ++ ( monoidForEraInEon @ ConwayEraOnwards
269- era
270- ( \ cOnwards ->
271- case txVotingProcedures of
272- Nothing -> []
273- Just (Featured _ TxVotingProceduresNone ) -> []
274- Just (Featured _ (TxVotingProcedures votes _witnesses)) ->
275- [" voters" .= friendlyVotingProcedures cOnwards votes]
276- )
277- )
278- ++ ( monoidForEraInEon @ ConwayEraOnwards
279- era
280- (const [" currentTreasuryValue" .= toJSON (unFeatured <$> txCurrentTreasuryValue)])
281- )
282- ++ ( monoidForEraInEon @ ConwayEraOnwards
283- era
284- (const [" treasuryDonation" .= toJSON (unFeatured <$> txTreasuryDonation)])
285- )
286- )
287- where
288- friendlyLedgerProposals
289- :: ConwayEraOnwards era -> [L. ProposalProcedure (ShelleyLedgerEra era )] -> Aeson. Value
290- friendlyLedgerProposals cOnwards proposalProcedures =
291- Array $ fromList $ map (friendlyLedgerProposal cOnwards) proposalProcedures
203+ friendlyTxBodyImpl era tb = do
204+ return $
205+ cardanoEraConstraints
206+ era
207+ ( [ " auxiliary scripts" .= friendlyAuxScripts txAuxScripts
208+ , " certificates" .= forEraInEon era Null (`friendlyCertificates` txCertificates)
209+ , " collateral inputs" .= friendlyCollateralInputs txInsCollateral
210+ , " era" .= era
211+ , " fee" .= friendlyFee txFee
212+ , " inputs" .= friendlyInputs txIns
213+ , " metadata" .= friendlyMetadata txMetadata
214+ , " mint" .= friendlyMintValue txMintValue
215+ , " outputs" .= map (friendlyTxOut era) txOuts
216+ , " reference inputs" .= friendlyReferenceInputs txInsReference
217+ , " total collateral" .= friendlyTotalCollateral txTotalCollateral
218+ , " return collateral" .= friendlyReturnCollateral era txReturnCollateral
219+ , " required signers (payment key hashes needed for scripts)"
220+ .= friendlyExtraKeyWits txExtraKeyWits
221+ , " update proposal" .= friendlyUpdateProposal txUpdateProposal
222+ , " validity range" .= friendlyValidityRange era (txValidityLowerBound, txValidityUpperBound)
223+ , " withdrawals" .= friendlyWithdrawals txWithdrawals
224+ ]
225+ ++ ( monoidForEraInEon @ AlonzoEraOnwards
226+ era
227+ (`getScriptWitnessDetails` tb)
228+ )
229+ ++ ( monoidForEraInEon @ ConwayEraOnwards
230+ era
231+ ( \ cOnwards ->
232+ conwayEraOnwardsConstraints cOnwards $
233+ case txProposalProcedures of
234+ Nothing -> []
235+ Just (Featured _ TxProposalProceduresNone ) -> []
236+ Just (Featured _ pp) -> do
237+ let lProposals = toList $ convProposalProcedures pp
238+ [" governance actions" .= (friendlyLedgerProposals cOnwards lProposals)]
239+ )
240+ )
241+ ++ ( monoidForEraInEon @ ConwayEraOnwards
242+ era
243+ ( \ cOnwards ->
244+ case txVotingProcedures of
245+ Nothing -> []
246+ Just (Featured _ TxVotingProceduresNone ) -> []
247+ Just (Featured _ (TxVotingProcedures votes _witnesses)) ->
248+ [" voters" .= friendlyVotingProcedures cOnwards votes]
249+ )
250+ )
251+ ++ ( monoidForEraInEon @ ConwayEraOnwards
252+ era
253+ (const [" currentTreasuryValue" .= toJSON (unFeatured <$> txCurrentTreasuryValue)])
254+ )
255+ ++ ( monoidForEraInEon @ ConwayEraOnwards
256+ era
257+ (const [" treasuryDonation" .= toJSON (unFeatured <$> txTreasuryDonation)])
258+ )
259+ )
260+ where
261+ -- Enumerating the fields, so that we are warned by GHC when we add a new one
262+ TxBodyContent
263+ txIns
264+ txInsCollateral
265+ txInsReference
266+ txOuts
267+ txTotalCollateral
268+ txReturnCollateral
269+ txFee
270+ txValidityLowerBound
271+ txValidityUpperBound
272+ txMetadata
273+ txAuxScripts
274+ txExtraKeyWits
275+ _txProtocolParams
276+ txWithdrawals
277+ txCertificates
278+ txUpdateProposal
279+ txMintValue
280+ _txScriptValidity
281+ txProposalProcedures
282+ txVotingProcedures
283+ txCurrentTreasuryValue
284+ txTreasuryDonation = getTxBodyContent tb
285+ friendlyLedgerProposals
286+ :: ConwayEraOnwards era -> [L. ProposalProcedure (ShelleyLedgerEra era )] -> Aeson. Value
287+ friendlyLedgerProposals cOnwards proposalProcedures =
288+ Array $ fromList $ map (friendlyLedgerProposal cOnwards) proposalProcedures
292289
293290friendlyLedgerProposal
294291 :: ConwayEraOnwards era -> L. ProposalProcedure (ShelleyLedgerEra era ) -> Aeson. Value
0 commit comments