From 3346e76f23429c96c26e74634b2ac0ff2cb66ffe Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 21 Apr 2023 11:17:12 +1000 Subject: [PATCH 01/13] Access fields via qualified import --- cardano-api/src/Cardano/Api/TxBody.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 4818d30741c..e3d402b9b32 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -281,6 +281,8 @@ import Cardano.Api.Utils import Cardano.Api.Value import Cardano.Api.ValueParser +-- import Cardano.Chain.UTxO (Tx (..)) + -- | Indicates whether a script is expected to fail or pass validation. data ScriptValidity = ScriptInvalid -- ^ Script is expected to fail validation. @@ -3007,7 +3009,7 @@ fromLedgerTxValidityRange era body = SJust s -> TxValidityUpperBound ValidityUpperBoundInAllegraEra s ) where - L.ValidityInterval{invalidBefore, invalidHereafter} = body ^. L.vldtTxBodyL + L.ValidityInterval{L.invalidBefore, L.invalidHereafter} = body ^. L.vldtTxBodyL ShelleyBasedEraMary -> ( case invalidBefore of @@ -3018,7 +3020,7 @@ fromLedgerTxValidityRange era body = SJust s -> TxValidityUpperBound ValidityUpperBoundInMaryEra s ) where - L.ValidityInterval{invalidBefore, invalidHereafter} = body ^. L.vldtTxBodyL + L.ValidityInterval{L.invalidBefore, L.invalidHereafter} = body ^. L.vldtTxBodyL ShelleyBasedEraAlonzo -> ( case invalidBefore of @@ -3029,7 +3031,7 @@ fromLedgerTxValidityRange era body = SJust s -> TxValidityUpperBound ValidityUpperBoundInAlonzoEra s ) where - L.ValidityInterval{invalidBefore, invalidHereafter} = body ^. L.vldtTxBodyL + L.ValidityInterval{L.invalidBefore, L.invalidHereafter} = body ^. L.vldtTxBodyL ShelleyBasedEraBabbage -> ( case invalidBefore of @@ -3040,7 +3042,7 @@ fromLedgerTxValidityRange era body = SJust s -> TxValidityUpperBound ValidityUpperBoundInBabbageEra s ) where - L.ValidityInterval{invalidBefore, invalidHereafter} = body ^. L.vldtTxBodyL + L.ValidityInterval{L.invalidBefore, L.invalidHereafter} = body ^. L.vldtTxBodyL ShelleyBasedEraConway -> ( case invalidBefore of @@ -3051,7 +3053,7 @@ fromLedgerTxValidityRange era body = SJust s -> TxValidityUpperBound ValidityUpperBoundInConwayEra s ) where - L.ValidityInterval{invalidBefore, invalidHereafter} = body ^. L.vldtTxBodyL + L.ValidityInterval{L.invalidBefore, L.invalidHereafter} = body ^. L.vldtTxBodyL fromLedgerAuxiliaryData :: ShelleyBasedEra era @@ -3392,7 +3394,7 @@ makeByronTransactionBody TxBodyContent { txIns, txOuts } = do getByronTxBodyContent :: Annotated Byron.Tx ByteString -> TxBodyContent ViewTx ByronEra -getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) = +getByronTxBodyContent (Annotated Byron.UnsafeTx{Byron.txInputs, Byron.txOutputs} _) = TxBodyContent { txIns = [(fromByronTxIn input, ViewTx) | input <- toList txInputs] , txInsCollateral = TxInsCollateralNone @@ -3481,10 +3483,10 @@ convValidityInterval -> L.ValidityInterval convValidityInterval (lowerBound, upperBound) = L.ValidityInterval - { invalidBefore = case lowerBound of + { L.invalidBefore = case lowerBound of TxValidityNoLowerBound -> SNothing TxValidityLowerBound _ s -> SJust s - , invalidHereafter = case upperBound of + , L.invalidHereafter = case upperBound of TxValidityNoUpperBound _ -> SNothing TxValidityUpperBound _ s -> SJust s } From 222e16aa7fe5fc208a945bde85b83bd9f95bc465 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sun, 9 Apr 2023 19:48:47 +1000 Subject: [PATCH 02/13] Aeson combinators for optional fields --- cardano-api/src/Cardano/Api/Utils.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/cardano-api/src/Cardano/Api/Utils.hs b/cardano-api/src/Cardano/Api/Utils.hs index 2c2146d8e43..bddc903ad20 100644 --- a/cardano-api/src/Cardano/Api/Utils.hs +++ b/cardano-api/src/Cardano/Api/Utils.hs @@ -14,6 +14,8 @@ module Cardano.Api.Utils ( (?!) , (?!.) + , (..=) + , (..=?) , formatParsecError , failEither , failEitherWith @@ -54,6 +56,7 @@ import System.Directory (emptyPermissions, readable, setPermissions) #endif import Cardano.Api.Eras +import Data.Aeson (KeyValue, ToJSON, (.=)) import Options.Applicative (ReadM) import Options.Applicative.Builder (eitherReader) import qualified Text.Read as Read @@ -148,3 +151,13 @@ bounded t = eitherReader $ \s -> do when (i < fromIntegral (minBound @a)) $ Left $ t <> " must not be less than " <> show (minBound @a) when (i > fromIntegral (maxBound @a)) $ Left $ t <> " must not greater than " <> show (maxBound @a) pure (fromIntegral i) + +-- | A key-value pair difference list for encoding a JSON object. +(..=) :: (KeyValue kv, ToJSON v) => Aeson.Key -> v -> [kv] -> [kv] +(..=) n v = (n .= v:) + +-- | A key-value pair difference list for encoding a JSON object where Nothing encodes absence of the key-value pair. +(..=?) :: (KeyValue kv, ToJSON v) => Aeson.Key -> Maybe v -> [kv] -> [kv] +(..=?) n mv = case mv of + Just v -> (n .= v:) + Nothing -> id From 259c612c8b47202f9ba3148e38af1ad0db4c0d94 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 8 Apr 2023 16:49:06 +1000 Subject: [PATCH 03/13] ToJSON instance for MirPot --- cardano-api/src/Cardano/Api/Orphans.hs | 14 ++++++++++++++ cardano-cli/src/Cardano/CLI/Run/Friendly.hs | 8 ++------ 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Orphans.hs b/cardano-api/src/Cardano/Api/Orphans.hs index 356e01fbe74..60e743c0e60 100644 --- a/cardano-api/src/Cardano/Api/Orphans.hs +++ b/cardano-api/src/Cardano/Api/Orphans.hs @@ -1,12 +1,20 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} + module Cardano.Api.Orphans () where import Data.Aeson (ToJSON (..), object, pairs, (.=)) import qualified Data.Aeson as Aeson +import Data.Text (Text) import qualified Cardano.Ledger.Crypto as Crypto +import Cardano.Ledger.Shelley.API (MIRPot (..)) + import qualified Ouroboros.Consensus.Shelley.Ledger.Query as Consensus -- Orphan instances involved in the JSON output of the API queries. @@ -47,3 +55,9 @@ stakeSnapshotToPair Consensus.StakeSnapshot , "stakeSet" .= ssSetPool , "stakeGo" .= ssGoPool ] + +instance ToJSON MIRPot where + toJSON pot = toJSON @Text $ + case pot of + ReservesMIR -> "reserves" + TreasuryMIR -> "treasury" diff --git a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs index 70c02f8353a..466fdf7657a 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs @@ -31,6 +31,7 @@ import GHC.Unicode (isAlphaNum) import Cardano.Api as Api import Cardano.Api.Byron (KeyWitness (ByronKeyWitness)) +import Cardano.Api.Orphans () import Cardano.Api.Shelley (Address (ShelleyAddress), KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), StakeAddress (..), StakeCredential (..), StakePoolParameters (..), fromShelleyPaymentCredential, @@ -339,7 +340,7 @@ friendlyCertificate = "VRF key hash" .= serialiseToRawBytesHexText vrfKeyHash ] MIRCertificate pot target -> - "MIR" .= object ["pot" .= friendlyMirPot pot, friendlyMirTarget target] + "MIR" .= object [ "pot" .= pot, friendlyMirTarget target] friendlyMirTarget :: MIRTarget -> Aeson.Pair friendlyMirTarget = \case @@ -368,11 +369,6 @@ friendlyPaymentCredential = \case PaymentCredentialByScript scriptHash -> "payment credential script hash" .= serialiseToRawBytesHexText scriptHash -friendlyMirPot :: Shelley.MIRPot -> Aeson.Value -friendlyMirPot = \case - Shelley.ReservesMIR -> "reserves" - Shelley.TreasuryMIR -> "treasury" - friendlyStakePoolParameters :: StakePoolParameters -> Aeson.Value friendlyStakePoolParameters StakePoolParameters From 5d100c0c49dcce94adfdd6e293a41f80c544a4eb Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Fri, 28 Jan 2022 17:47:04 +0300 Subject: [PATCH 04/13] Simplify writeFilteredUTxOs with getIsCardanoEraConstraint. --- .../src/Cardano/CLI/Shelley/Run/Query.hs | 22 +++++++------------ 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index 705b4146cc4..0add351e438 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -916,20 +916,14 @@ writeFilteredUTxOs :: Api.ShelleyBasedEra era -> UTxO era -> ExceptT ShelleyQueryCmdError IO () writeFilteredUTxOs shelleyBasedEra' mOutFile utxo = - case mOutFile of - Nothing -> liftIO $ printFilteredUTxOs shelleyBasedEra' utxo - Just (File fpath) -> - case shelleyBasedEra' of - ShelleyBasedEraShelley -> writeUTxo fpath utxo - ShelleyBasedEraAllegra -> writeUTxo fpath utxo - ShelleyBasedEraMary -> writeUTxo fpath utxo - ShelleyBasedEraAlonzo -> writeUTxo fpath utxo - ShelleyBasedEraBabbage -> writeUTxo fpath utxo - ShelleyBasedEraConway -> writeUTxo fpath utxo - where - writeUTxo fpath utxo' = - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) - $ LBS.writeFile fpath (encodePretty utxo') + case mOutFile of + Nothing -> liftIO $ printFilteredUTxOs shelleyBasedEra' utxo + + Just (File fpath) -> + handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) + $ LBS.writeFile fpath + $ getIsCardanoEraConstraint (shelleyBasedToCardanoEra shelleyBasedEra') + $ encodePretty utxo printFilteredUTxOs :: Api.ShelleyBasedEra era -> UTxO era -> IO () printFilteredUTxOs shelleyBasedEra' (UTxO utxo) = do From 569445cd3acb21504547415a98ef974ee82cdfca Mon Sep 17 00:00:00 2001 From: John Ky Date: Tue, 11 Apr 2023 10:31:19 +1000 Subject: [PATCH 05/13] Certificate related ToJSON instances: * Certificate * MIRTarget * StakePoolParameters * StakePoolRelay * StakePoolMetadataReference --- cardano-api/src/Cardano/Api/Certificate.hs | 114 ++++++++++++++++++++- 1 file changed, 113 insertions(+), 1 deletion(-) diff --git a/cardano-api/src/Cardano/Api/Certificate.hs b/cardano-api/src/Cardano/Api/Certificate.hs index 88a46aaf55e..490987c6515 100644 --- a/cardano-api/src/Cardano/Api/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Certificate.hs @@ -37,6 +37,8 @@ module Cardano.Api.Certificate ( AsType(..) ) where +import Data.Aeson (ToJSON, Value (..), object, toJSON, (.=)) +import qualified Data.Aeson as Aeson import Data.ByteString (ByteString) import qualified Data.Foldable as Foldable import qualified Data.Map.Strict as Map @@ -68,7 +70,9 @@ import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Byron import Cardano.Api.Keys.Praos import Cardano.Api.Keys.Shelley +import Cardano.Api.Orphans () import Cardano.Api.SerialiseCBOR +import Cardano.Api.SerialiseRaw (serialiseToRawBytesHexText) import Cardano.Api.SerialiseTextEnvelope import Cardano.Api.StakePoolMetadata import Cardano.Api.Value @@ -108,6 +112,52 @@ instance ToCBOR Certificate where instance FromCBOR Certificate where fromCBOR = fromShelleyCertificate <$> Shelley.fromEraCBOR @Shelley.Shelley +instance ToJSON Certificate where + toJSON a = case a of + StakeAddressRegistrationCertificate credential -> + object + [ "type" .= String "StakeAddressRegistration" + , "credential" .= credential + ] + StakeAddressDeregistrationCertificate credential -> + object + [ "type" .= String "StakeAddressDeregistration" + , "credential" .= credential + ] + StakeAddressDelegationCertificate credential pool -> + object + [ "type" .= String "StakeAddressDelegation" + , "credential" .= credential + , "pool" .= pool + ] + StakePoolRegistrationCertificate parameters -> + object + [ "type" .= String "StakePoolRegistration" + , "parameters" .= parameters + ] + StakePoolRetirementCertificate pool epoch -> + object + [ "type" .= String "StakePoolRetirement" + , "pool" .= pool + , "epoch" .= epoch + ] + GenesisKeyDelegationCertificate + genesisKeyHash + genesisDelegateKeyHash + vrfKeyHash -> + object + [ "type" .= String "GenesisKeyDelegation" + , "genesisKeyHash" .= serialiseToRawBytesHexText genesisKeyHash + , "genesisDelegateKeyHash" .= serialiseToRawBytesHexText genesisDelegateKeyHash + , "vrfKeyHash" .= serialiseToRawBytesHexText vrfKeyHash + ] + MIRCertificate pot target -> + object + [ "type" .= String "MIR" + , "pot" .= pot + , "target" .= target + ] + instance HasTextEnvelope Certificate where textEnvelopeType _ = "CertificateShelley" textEnvelopeDefaultDescr cert = case cert of @@ -137,6 +187,24 @@ data MIRTarget = | SendToTreasuryMIR Lovelace deriving stock (Eq, Show) +instance ToJSON MIRTarget where + toJSON a = case a of + StakeAddressesMIR addresses -> + object + [ "type" .= String "StakeAddresses" + , "addresses" .= addresses + ] + SendToReservesMIR lovelace -> + object + [ "type" .= String "SendToReserves" + , "lovelace" .= lovelace + ] + SendToTreasuryMIR lovelace -> + object + [ "type" .= String "SendToTreasury" + , "lovelace" .= lovelace + ] + -- ---------------------------------------------------------------------------- -- Stake pool parameters -- @@ -157,13 +225,27 @@ data StakePoolParameters = } deriving (Eq, Show) +instance ToJSON StakePoolParameters where + toJSON ref = + object + [ "id" .= stakePoolId ref + , "vrf" .= serialiseToRawBytesHexText (stakePoolVRF ref) + , "cost" .= stakePoolCost ref + , "margin" .= stakePoolMargin ref + , "rewardAccount" .= stakePoolRewardAccount ref + , "pledge" .= stakePoolPledge ref + , "owners" .= map serialiseToRawBytesHexText (stakePoolOwners ref) + , "relays" .= stakePoolRelays ref + , "metadata" .= stakePoolMetadata ref + ] + data StakePoolRelay = -- | One or both of IPv4 & IPv6 StakePoolRelayIp (Maybe IPv4) (Maybe IPv6) (Maybe PortNumber) - -- | An DNS name pointing to a @A@ or @AAAA@ record. + -- | A DNS name pointing to a @A@ or @AAAA@ record. | StakePoolRelayDnsARecord ByteString (Maybe PortNumber) @@ -173,6 +255,29 @@ data StakePoolRelay = deriving (Eq, Show) +instance ToJSON StakePoolRelay where + toJSON a = case a of + StakePoolRelayIp ipv4 ipv6 port -> + object + [ "type" .= String "IP" + , "ipv4" .= ipv4 + , "ipv6" .= ipv6 + , "port" .= (portToJson <$> port) + ] + StakePoolRelayDnsARecord name port -> + object + [ "type" .= String "DnsA" + , "name" .= Text.decodeUtf8 name + , "port" .= (portToJson <$> port) + ] + StakePoolRelayDnsSrvRecord name -> + object + [ "type" .= String "DnsSrv" + , "name" .= Text.decodeUtf8 name + ] + where + portToJson = Aeson.Number . fromIntegral + data StakePoolMetadataReference = StakePoolMetadataReference { stakePoolMetadataURL :: Text, @@ -180,6 +285,13 @@ data StakePoolMetadataReference = } deriving (Eq, Show) +instance ToJSON StakePoolMetadataReference where + toJSON ref = + object + [ "url" .= stakePoolMetadataURL ref + , "hash" .= serialiseToRawBytesHexText (stakePoolMetadataHash ref) + ] + -- ---------------------------------------------------------------------------- -- Constructor functions From f9161c9dfba371f90c313c7aa9e57089b240a033 Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Thu, 26 May 2022 18:00:58 +0200 Subject: [PATCH 06/13] ToJSON instances for protocol update types: * ProtocolParametersUpdate * UpdateProposal --- .../src/Cardano/Api/ProtocolParameters.hs | 44 +++++++++++++++++-- 1 file changed, 40 insertions(+), 4 deletions(-) diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 786085aab83..2441479941c 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -3,7 +3,6 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -538,7 +537,7 @@ data ProtocolParametersUpdate = -- /Introduced in Babbage. Supercedes 'protocolUpdateUTxOCostPerWord'/ protocolUpdateUTxOCostPerByte :: Maybe Lovelace } - deriving (Eq, Show) + deriving (Eq, Generic, Show) instance Semigroup ProtocolParametersUpdate where ppu1 <> ppu2 = @@ -673,6 +672,36 @@ instance FromCBOR ProtocolParametersUpdate where <*> fromCBOR <*> fromCBOR +instance ToJSON ProtocolParametersUpdate where + toJSON ref = + object $ + ( ("protocolVersion" ..=? protocolUpdateProtocolVersion ref) + . ("decentralization" ..=? protocolUpdateDecentralization ref) + . ("extraPraosEntropy" ..=? protocolUpdateExtraPraosEntropy ref) + . ("maxBlockHeaderSize" ..=? protocolUpdateMaxBlockHeaderSize ref) + . ("maxBlockBodySize" ..=? protocolUpdateMaxBlockBodySize ref) + . ("maxTxSize" ..=? protocolUpdateMaxTxSize ref) + . ("txFeeFixed" ..=? protocolUpdateTxFeeFixed ref) + . ("txFeePerByte" ..=? protocolUpdateTxFeePerByte ref) + . ("minUTxOValue" ..=? protocolUpdateMinUTxOValue ref) + . ("stakeAddressDeposit" ..=? protocolUpdateStakeAddressDeposit ref) + . ("stakePoolDeposit" ..=? protocolUpdateStakePoolDeposit ref) + . ("minPoolCost" ..=? protocolUpdateMinPoolCost ref) + . ("poolRetireMaxEpoch" ..=? protocolUpdatePoolRetireMaxEpoch ref) + . ("stakePoolTargetNum" ..=? protocolUpdateStakePoolTargetNum ref) + . ("poolPledgeInfluence" ..=? protocolUpdatePoolPledgeInfluence ref) + . ("monetaryExpansion" ..=? protocolUpdateMonetaryExpansion ref) + . ("treasuryCut" ..=? protocolUpdateTreasuryCut ref) + . ("utxoCostPerWord" ..=? protocolUpdateUTxOCostPerWord ref) + . ("costModels" ..= protocolUpdateCostModels ref) + . ("prices" ..=? protocolUpdatePrices ref) + . ("maxTxExUnits" ..=? protocolUpdateMaxTxExUnits ref) + . ("maxBlockExUnits" ..=? protocolUpdateMaxBlockExUnits ref) + . ("maxValueSize" ..=? protocolUpdateMaxValueSize ref) + . ("collateralPercent" ..=? protocolUpdateCollateralPercent ref) + . ("maxCollateralInputs" ..=? protocolUpdateMaxCollateralInputs ref) + . ("utxoCostPerByte" ..=? protocolUpdateUTxOCostPerByte ref) + ) [] -- ---------------------------------------------------------------------------- -- Praos nonce @@ -845,7 +874,7 @@ data UpdateProposal = UpdateProposal !(Map (Hash GenesisKey) ProtocolParametersUpdate) !EpochNo - deriving stock (Eq, Show) + deriving stock (Eq, Generic, Show) deriving anyclass SerialiseAsCBOR instance HasTypeProxy UpdateProposal where @@ -868,6 +897,13 @@ instance FromCBOR UpdateProposal where <$> fromCBOR <*> fromCBOR +instance ToJSON UpdateProposal where + toJSON (UpdateProposal updates epoch) = + object + [ "updates" .= Map.mapKeys serialiseToRawBytesHexText updates + , "epoch" .= epoch + ] + makeShelleyUpdateProposal :: ProtocolParametersUpdate -> [Hash GenesisKey] -> EpochNo @@ -1247,7 +1283,7 @@ unbundleLedgerShelleyBasedProtocolParams :: ShelleyBasedEra era -> BundledProtocolParameters era -> Ledger.PParams (ShelleyLedgerEra era) -unbundleLedgerShelleyBasedProtocolParams = \case +unbundleLedgerShelleyBasedProtocolParams era = case era of ShelleyBasedEraShelley -> \(BundleAsShelleyBasedProtocolParameters _ _ lpp) -> lpp ShelleyBasedEraAllegra -> \(BundleAsShelleyBasedProtocolParameters _ _ lpp) -> lpp ShelleyBasedEraMary -> \(BundleAsShelleyBasedProtocolParameters _ _ lpp) -> lpp From 6501a12a4c4ef105db11c0b1a5a2fd8af0c3b951 Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Thu, 26 May 2022 18:03:38 +0200 Subject: [PATCH 07/13] Add ToJSON instance for KeyWitness: * WitVKey 'Witness crypto * KeyWitness era --- cardano-api/src/Cardano/Api/Orphans.hs | 14 +++++++++++ .../src/Cardano/Api/ProtocolParameters.hs | 3 ++- cardano-api/src/Cardano/Api/Tx.hs | 25 +++++++++++++++++++ 3 files changed, 41 insertions(+), 1 deletion(-) diff --git a/cardano-api/src/Cardano/Api/Orphans.hs b/cardano-api/src/Cardano/Api/Orphans.hs index 60e743c0e60..1bbcdf04166 100644 --- a/cardano-api/src/Cardano/Api/Orphans.hs +++ b/cardano-api/src/Cardano/Api/Orphans.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -10,11 +12,18 @@ module Cardano.Api.Orphans () where import Data.Aeson (ToJSON (..), object, pairs, (.=)) import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Base16 as Base16 import Data.Text (Text) +import qualified Data.Text.Encoding as Text import qualified Cardano.Ledger.Crypto as Crypto + import Cardano.Ledger.Shelley.API (MIRPot (..)) +import qualified Cardano.Ledger.Shelley.API as Ledger (KeyRole (..), WitVKey) +import Cardano.Api.SerialiseCBOR (ToCBOR (..)) +import Cardano.Binary (encodeListLen, serialize') +import Codec.CBOR.Encoding (encodeWord) import qualified Ouroboros.Consensus.Shelley.Ledger.Query as Consensus -- Orphan instances involved in the JSON output of the API queries. @@ -61,3 +70,8 @@ instance ToJSON MIRPot where case pot of ReservesMIR -> "reserves" TreasuryMIR -> "treasury" + +instance Crypto.Crypto crypto => ToJSON (Ledger.WitVKey 'Ledger.Witness crypto) where + toJSON = toJSON . Text.decodeLatin1 . Base16.encode . serialize' . prefixWithTag + where + prefixWithTag wit = encodeListLen 2 <> encodeWord 0 <> toCBOR wit diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 2441479941c..258c34216fa 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -703,6 +703,7 @@ instance ToJSON ProtocolParametersUpdate where . ("utxoCostPerByte" ..=? protocolUpdateUTxOCostPerByte ref) ) [] + -- ---------------------------------------------------------------------------- -- Praos nonce -- @@ -807,7 +808,7 @@ fromAlonzoPrices Alonzo.Prices{Alonzo.prSteps, Alonzo.prMem} = newtype CostModel = CostModel [Integer] deriving (Eq, Show) - deriving newtype (ToCBOR, FromCBOR) + deriving newtype (ToCBOR, FromCBOR, ToJSON) newtype CostModels = CostModels { unCostModels :: Map AnyPlutusScriptVersion CostModel } deriving (Eq, Show) diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs index f9c038f3aeb..7d5084ba0a8 100644 --- a/cardano-api/src/Cardano/Api/Tx.hs +++ b/cardano-api/src/Cardano/Api/Tx.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -49,12 +50,14 @@ module Cardano.Api.Tx ( import Data.Maybe +import Data.Aeson (ToJSON, object, toJSON, (.=)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Map.Strict as Map import qualified Data.Set as Set +import Data.Text (Text) import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) import qualified Data.Vector as Vector import Lens.Micro @@ -428,7 +431,29 @@ instance IsCardanoEra era => SerialiseAsCBOR (KeyWitness era) where ConwayEra -> decodeShelleyBasedWitness ShelleyBasedEraConway bs +<<<<<<< HEAD encodeShelleyBasedKeyWitness :: CBOR.EncCBOR w => w -> CBOR.Encoding +======= +instance ToJSON (KeyWitness era) where + toJSON a = case a of + ByronKeyWitness w -> + object + [ "type" .= ("key" :: Text) + , "in_witness" .= show w + ] + ShelleyBootstrapWitness _era w -> + object + ["type" .= ("bootstrap" :: Text) + , "bootstrap_witness" .= show w + ] + ShelleyKeyWitness _era witness -> + object + [ "type" .= ("keyWitness" :: Text) + , "witness" .= witness + ] + +encodeShelleyBasedKeyWitness :: ToCBOR w => w -> CBOR.Encoding +>>>>>>> d02481507 (Add ToJSON instance for KeyWitness:) encodeShelleyBasedKeyWitness wit = CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> CBOR.encCBOR wit From 37e5f7db3f7aae886eaa8d4a116c08a1b8638a4d Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Thu, 26 May 2022 18:01:40 +0200 Subject: [PATCH 08/13] Add ToJSON instances for script types: * PlutusScriptVersion lang * Script lang * ScriptInEra era * PlutusScript lang --- cardano-api/src/Cardano/Api/Script.hs | 33 +++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 9b1f21f42de..8ebbb5097c3 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -106,6 +105,7 @@ module Cardano.Api.Script ( Hash(..), ) where +import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as LBS import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as SBS @@ -247,6 +247,9 @@ instance TestEquality PlutusScriptVersion where testEquality PlutusScriptV2 PlutusScriptV2 = Just Refl testEquality _ _ = Nothing +instance ToJSON (PlutusScriptVersion lang) where + toJSON = toJSON . fromEnum . AnyScriptLanguage . PlutusScriptLanguage + data AnyScriptLanguage where AnyScriptLanguage :: ScriptLanguage lang -> AnyScriptLanguage @@ -428,6 +431,19 @@ instance IsScriptLanguage lang => HasTextEnvelope (Script lang) where PlutusScriptLanguage PlutusScriptV1 -> "PlutusScriptV1" PlutusScriptLanguage PlutusScriptV2 -> "PlutusScriptV2" +instance ToJSON (Script lang) where + toJSON a = case a of + SimpleScript script -> + object + [ "type" .= String "simple" + , "script" .= script + ] + PlutusScript version script -> + object + [ "type" .= String "plutus" + , "version" .= version + , "script" .= script + ] -- ---------------------------------------------------------------------------- -- Scripts in any language @@ -513,6 +529,13 @@ instance Eq (ScriptInEra era) where Nothing -> False Just Refl -> script == script' +instance ToJSON (ScriptInEra era) where + toJSON (ScriptInEra language script) = + object + [ "language" .= language + , "script" .= script + ] + data ScriptLanguageInEra lang era where @@ -983,6 +1006,12 @@ instance IsPlutusScriptLanguage lang => HasTextEnvelope (PlutusScript lang) wher PlutusScriptV1 -> "PlutusScriptV1" PlutusScriptV2 -> "PlutusScriptV2" +instance ToJSON (PlutusScript lang) where + toJSON (PlutusScriptSerialised bytes) = + object + [ "base16" .= Text.decodeUtf8 (Base16.encode $ SBS.fromShort bytes) + ] + -- | An example Plutus script that always succeeds, irrespective of inputs. -- @@ -1324,7 +1353,7 @@ instance IsCardanoEra era => FromJSON (ReferenceScript era) where ReferenceScript refSupInEra <$> o .: "referenceScript" instance EraCast ReferenceScript where - eraCast toEra = \case + eraCast toEra a = case a of ReferenceScriptNone -> pure ReferenceScriptNone v@(ReferenceScript (_ :: ReferenceTxInsScriptsInlineDatumsSupportedInEra fromEra) scriptInAnyLang) -> case refInsScriptsAndInlineDatsSupportedInEra toEra of From ac26b331dd0188653ec1162e58cd875e51178d59 Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Thu, 26 May 2022 18:04:56 +0200 Subject: [PATCH 09/13] Add ToJSON instances for TxBodyContent ViewTx and its parts: * TxAuxScripts era * TxBodyContent ViewTx era * TxCertificates ViewTx era * TxExtraKeyWitnesses era * TxFee era * TxInsCollateral era * TxInsReference build era * TxMetadataInEra era * TxMintValue ViewTx era * TxReturnCollateral CtxTx era * TxScriptValidity era * TxTotalCollateral era * TxUpdateProposal era * TxValidityLowerBound era * TxValidityUpperBound era * TxWithdrawals ViewTx era --- cardano-api/src/Cardano/Api/Tx.hs | 9 +- cardano-api/src/Cardano/Api/TxBody.hs | 160 +++++++++++++++++++++++++- 2 files changed, 162 insertions(+), 7 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs index 7d5084ba0a8..0a24bf4cc30 100644 --- a/cardano-api/src/Cardano/Api/Tx.hs +++ b/cardano-api/src/Cardano/Api/Tx.hs @@ -50,14 +50,13 @@ module Cardano.Api.Tx ( import Data.Maybe -import Data.Aeson (ToJSON, object, toJSON, (.=)) +import Data.Aeson (ToJSON, Value (..), object, toJSON, (.=)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Map.Strict as Map import qualified Data.Set as Set -import Data.Text (Text) import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) import qualified Data.Vector as Vector import Lens.Micro @@ -438,17 +437,17 @@ instance ToJSON (KeyWitness era) where toJSON a = case a of ByronKeyWitness w -> object - [ "type" .= ("key" :: Text) + [ "type" .= String "key" , "in_witness" .= show w ] ShelleyBootstrapWitness _era w -> object - ["type" .= ("bootstrap" :: Text) + ["type" .= String "bootstrap" , "bootstrap_witness" .= show w ] ShelleyKeyWitness _era witness -> object - [ "type" .= ("keyWitness" :: Text) + [ "type" .= String "keyWitness" , "witness" .= witness ] diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index e3d402b9b32..350c456234d 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} -{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -325,6 +324,15 @@ data TxScriptValidity era where deriving instance Eq (TxScriptValiditySupportedInEra era) deriving instance Show (TxScriptValiditySupportedInEra era) +-- | Public JSON API over CLI +instance ToJSON (TxScriptValidity era) where + toJSON = \case + TxScriptValidityNone -> Aeson.Null + TxScriptValidity _support validity -> + case validity of + ScriptInvalid -> "Invalid" + ScriptValid -> "Valid" + data TxScriptValiditySupportedInEra era where TxScriptValiditySupportedInAlonzoEra :: TxScriptValiditySupportedInEra AlonzoEra TxScriptValiditySupportedInBabbageEra :: TxScriptValiditySupportedInEra BabbageEra @@ -1337,6 +1345,9 @@ deriving instance Show a => Show (BuildTxWith build a) type TxIns build era = [(TxIn, BuildTxWith build (Witness WitCtxTxIn era))] +txInsToJson :: TxIns ViewTx era -> Aeson.Value +txInsToJson = toJSON . map fst + data TxInsCollateral era where TxInsCollateralNone :: TxInsCollateral era @@ -1348,8 +1359,13 @@ data TxInsCollateral era where deriving instance Eq (TxInsCollateral era) deriving instance Show (TxInsCollateral era) -data TxInsReference build era where +-- | Public JSON API over CLI +instance ToJSON (TxInsCollateral era) where + toJSON = \case + TxInsCollateralNone -> Aeson.Null + TxInsCollateral _support ins -> toJSON ins +data TxInsReference build era where TxInsReferenceNone :: TxInsReference build era TxInsReference :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era @@ -1359,6 +1375,13 @@ data TxInsReference build era where deriving instance Eq (TxInsReference build era) deriving instance Show (TxInsReference build era) +-- | Public JSON API over CLI +instance ToJSON (TxInsReference build era) where + toJSON = \case + TxInsReferenceNone -> Aeson.Null + TxInsReference _support ins -> toJSON ins + + -- ---------------------------------------------------------------------------- -- Transaction output values (era-dependent) -- @@ -1464,6 +1487,13 @@ data TxReturnCollateral ctx era where deriving instance Eq (TxReturnCollateral ctx era) deriving instance Show (TxReturnCollateral ctx era) +-- | Public JSON API over CLI +instance IsCardanoEra era => ToJSON (TxReturnCollateral CtxTx era) where + toJSON = \case + TxReturnCollateralNone -> Aeson.Null + TxReturnCollateral _support out -> toJSON out + + data TxTotalCollateral era where TxTotalCollateralNone :: TxTotalCollateral era @@ -1475,6 +1505,13 @@ data TxTotalCollateral era where deriving instance Eq (TxTotalCollateral era) deriving instance Show (TxTotalCollateral era) +-- | Public JSON API over CLI +instance ToJSON (TxTotalCollateral era) where + toJSON = \case + TxTotalCollateralNone -> Aeson.Null + TxTotalCollateral _support lovelace -> toJSON lovelace + + data TxTotalAndReturnCollateralSupportedInEra era where TxTotalAndReturnCollateralInBabbageEra :: TxTotalAndReturnCollateralSupportedInEra BabbageEra @@ -1587,6 +1624,12 @@ defaultTxFee = case cardanoEra @era of BabbageEra -> TxFeeExplicit TxFeesExplicitInBabbageEra mempty ConwayEra -> TxFeeExplicit TxFeesExplicitInConwayEra mempty +-- | Public JSON API over CLI +instance ToJSON (TxFee era) where + toJSON = \case + TxFeeImplicit _support -> Aeson.Null + TxFeeExplicit _support lovelace -> toJSON lovelace + -- ---------------------------------------------------------------------------- -- Transaction validity range @@ -1616,6 +1659,12 @@ defaultTxValidityUpperBound = case cardanoEra @era of BabbageEra -> TxValidityNoUpperBound ValidityNoUpperBoundInBabbageEra ConwayEra -> TxValidityNoUpperBound ValidityNoUpperBoundInConwayEra +-- | Public JSON API over CLI +instance ToJSON (TxValidityUpperBound era) where + toJSON = \case + TxValidityNoUpperBound _support -> Aeson.Null + TxValidityUpperBound _support slot -> object ["slot" .= slot] + data TxValidityLowerBound era where TxValidityNoLowerBound :: TxValidityLowerBound era @@ -1627,6 +1676,13 @@ data TxValidityLowerBound era where deriving instance Eq (TxValidityLowerBound era) deriving instance Show (TxValidityLowerBound era) +-- | Public JSON API over CLI +instance ToJSON (TxValidityLowerBound era) where + toJSON = \case + TxValidityNoLowerBound -> Aeson.Null + TxValidityLowerBound _support slot -> object ["slot" .= slot] + + -- ---------------------------------------------------------------------------- -- Transaction metadata (era-dependent) -- @@ -1642,6 +1698,14 @@ data TxMetadataInEra era where deriving instance Eq (TxMetadataInEra era) deriving instance Show (TxMetadataInEra era) +-- | Public JSON API over CLI +instance ToJSON (TxMetadataInEra era) where + toJSON = \case + TxMetadataNone -> Aeson.Null + TxMetadataInEra _support metadata -> + metadataToJson TxMetadataJsonDetailedSchema metadata + + -- ---------------------------------------------------------------------------- -- Auxiliary scripts (era-dependent) -- @@ -1657,6 +1721,13 @@ data TxAuxScripts era where deriving instance Eq (TxAuxScripts era) deriving instance Show (TxAuxScripts era) +-- | Public JSON API over CLI +instance ToJSON (TxAuxScripts era) where + toJSON = \case + TxAuxScriptsNone -> Aeson.Null + TxAuxScripts _support scripts -> toJSON scripts + + -- ---------------------------------------------------------------------------- -- Optionally required signatures (era-dependent) -- @@ -1672,6 +1743,14 @@ data TxExtraKeyWitnesses era where deriving instance Eq (TxExtraKeyWitnesses era) deriving instance Show (TxExtraKeyWitnesses era) +-- | Public JSON API over CLI +instance ToJSON (TxExtraKeyWitnesses era) where + toJSON = \case + TxExtraKeyWitnessesNone -> Aeson.Null + TxExtraKeyWitnesses _support hashes -> + toJSON $ map serialiseToRawBytesHexText hashes + + -- ---------------------------------------------------------------------------- -- Withdrawals within transactions (era-dependent) -- @@ -1688,6 +1767,17 @@ data TxWithdrawals build era where deriving instance Eq (TxWithdrawals build era) deriving instance Show (TxWithdrawals build era) +-- | Public JSON API over CLI +instance ToJSON (TxWithdrawals ViewTx era) where + toJSON = \case + TxWithdrawalsNone -> Aeson.Null + TxWithdrawals _support ws -> + toJSON + [ object ["stakeAddress" .= stakeAddress, "lovelace" .= lovelace] + | (stakeAddress, lovelace, ViewTx) <- ws + ] + + -- ---------------------------------------------------------------------------- -- Certificates within transactions (era-dependent) -- @@ -1705,6 +1795,13 @@ data TxCertificates build era where deriving instance Eq (TxCertificates build era) deriving instance Show (TxCertificates build era) +-- | Public JSON API over CLI +instance ToJSON (TxCertificates ViewTx era) where + toJSON = \case + TxCertificatesNone -> Aeson.Null + TxCertificates _support certificates ViewTx -> toJSON certificates + + -- ---------------------------------------------------------------------------- -- Transaction update proposal (era-dependent) -- @@ -1720,6 +1817,13 @@ data TxUpdateProposal era where deriving instance Eq (TxUpdateProposal era) deriving instance Show (TxUpdateProposal era) +-- | Public JSON API over CLI +instance ToJSON (TxUpdateProposal era) where + toJSON = \case + TxUpdateProposalNone -> Aeson.Null + TxUpdateProposal _support updateProposal -> toJSON updateProposal + + -- ---------------------------------------------------------------------------- -- Value minting within transactions (era-dependent) -- @@ -1737,6 +1841,13 @@ data TxMintValue build era where deriving instance Eq (TxMintValue build era) deriving instance Show (TxMintValue build era) +-- | Public JSON API over CLI +instance ToJSON (TxMintValue ViewTx era) where + toJSON = \case + TxMintNone -> Aeson.Null + TxMintValue _support value ViewTx -> toJSON value + + -- ---------------------------------------------------------------------------- -- Transaction body content -- @@ -1848,6 +1959,51 @@ setTxMintValue v txBodyContent = txBodyContent { txMintValue = v } setTxScriptValidity :: TxScriptValidity era -> TxBodyContent build era -> TxBodyContent build era setTxScriptValidity v txBodyContent = txBodyContent { txScriptValidity = v } +-- | Public JSON API over CLI +instance IsCardanoEra era => ToJSON (TxBodyContent ViewTx era) where + toJSON TxBodyContent + { txIns + , txInsCollateral + , txInsReference + , txOuts + , txTotalCollateral + , txReturnCollateral + , txFee + , txMetadata + , txAuxScripts + , txExtraKeyWits + , txWithdrawals + , txCertificates + , txUpdateProposal + , txMintValue + , txScriptValidity + , txValidityRange + } = + object + [ "ins" .= txInsToJson txIns + , "insCollateral" .= txInsCollateral + , "insReference" .= txInsReference + , "outs" .= txOuts + , "totalCollateral" .= txTotalCollateral + , "returnCollateral" .= txReturnCollateral + , "fee" .= txFee + , "validityRange" .= object + [ "lowerBound" .= lowerBound + , "upperBound" .= upperBound + ] + , "metadata" .= txMetadata + , "auxScripts" .= txAuxScripts + , "extraKeyWits" .= txExtraKeyWits + -- txProtocolParams -- not exposed, since is used for building only + , "withdrawals" .= txWithdrawals + , "certificates" .= txCertificates + , "updateProposal" .= txUpdateProposal + , "mintValue" .= txMintValue + , "scriptValidity" .= txScriptValidity + ] + where + (lowerBound, upperBound) = txValidityRange + -- ---------------------------------------------------------------------------- -- Transaction bodies -- From 3973486bc86419546ffaf417c362961152d7a983 Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Thu, 26 May 2022 18:06:56 +0200 Subject: [PATCH 10/13] Add `--output-file` option to `transaction view` command --- cardano-api/src/Cardano/Api/Script.hs | 1 + cardano-cli/src/Cardano/CLI/Run/Friendly.hs | 2 +- .../src/Cardano/CLI/Shelley/Commands.hs | 4 +- .../src/Cardano/CLI/Shelley/Parsers.hs | 5 +- .../Cardano/CLI/Shelley/Run/Transaction.hs | 49 ++++++++++++++++++- 5 files changed, 56 insertions(+), 5 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 8ebbb5097c3..f8eedef3431 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} diff --git a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs index 466fdf7657a..090ca0f71ba 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs @@ -96,7 +96,7 @@ friendlyTxBody , "outputs" .= map friendlyTxOut txOuts , "reference inputs" .= friendlyReferenceInputs txInsReference , "total collateral" .= friendlyTotalCollateral txTotalCollateral - , "return collateral" .= friendlyReturnCollateral txReturnCollateral + , "return collateral" .= getIsCardanoEraConstraint era (friendlyReturnCollateral txReturnCollateral) , "required signers (payment key hashes needed for scripts)" .= friendlyExtraKeyWits txExtraKeyWits , "update proposal" .= friendlyUpdateProposal txUpdateProposal diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index aefd75f95a4..48bec8d878a 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs @@ -252,7 +252,9 @@ data TransactionCmd | TxHashScriptData ScriptDataOrFile | TxGetTxId InputTxBodyOrTxFile - | TxView InputTxBodyOrTxFile + | TxView + InputTxBodyOrTxFile + (Maybe OutputFile) data InputTxBodyOrTxFile = InputTxBodyFile (TxBodyFile In) | InputTxFile (TxFile In) deriving Show diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index f45c6ea9b56..1df6b2bf521 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -834,7 +834,10 @@ pTransaction envCli = pTransactionId = TxGetTxId <$> pInputTxOrTxBodyFile pTransactionView :: Parser TransactionCmd - pTransactionView = TxView <$> pInputTxOrTxBodyFile + pTransactionView = + TxView + <$> pInputTxOrTxBodyFile + <*> pMaybeOutputFile pNodeCmd :: Parser NodeCmd pNodeCmd = diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index e16bd7ac9a8..b2a7c5b4e9d 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -23,6 +22,8 @@ import Control.Monad.Trans (MonadTrans (..)) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, hoistMaybe, left, newExceptT, onLeft, onNothing) +import Data.Aeson ((.=)) +import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (encodePretty) import Data.Bifunctor (Bifunctor (..)) import qualified Data.ByteString.Char8 as BS @@ -288,7 +289,7 @@ runTransactionCmd cmd = TxCalculateMinRequiredUTxO era pParamsFile txOuts -> runTxCalculateMinRequiredUTxO era pParamsFile txOuts TxHashScriptData scriptDataOrFile -> runTxHashScriptData scriptDataOrFile TxGetTxId txinfile -> runTxGetTxId txinfile - TxView txinfile -> runTxView txinfile + TxView txinfile mOutputFile -> runTxView txinfile mOutputFile TxMintedPolicyId sFile -> runTxCreatePolicyId sFile TxCreateWitness txBodyfile witSignData mbNw outFile -> runTxCreateWitness txBodyfile witSignData mbNw outFile @@ -1308,6 +1309,7 @@ runTxGetTxId txfile = do liftIO $ BS.putStrLn $ serialiseToRawBytesHex (getTxId txbody) +<<<<<<< HEAD runTxView :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () runTxView = \case InputTxBodyFile (File txbodyFilePath) -> do @@ -1327,6 +1329,49 @@ runTxView = \case txFile <- liftIO $ fileOrPipe txFilePath InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) liftIO $ BS.putStr $ friendlyTxBS era tx +======= +runTxView :: InputTxBodyOrTxFile -> Maybe OutputFile -> ExceptT ShelleyTxCmdError IO () +runTxView input mOutputFile = + case input of + InputTxBodyFile (TxBodyFile txbodyFilePath) -> do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath + unwitnessed <- lift (readFileTxBody txbodyFile) & onLeft (left . ShelleyTxCmdCddlError) + InAnyCardanoEra era txbody <- + case unwitnessed of + UnwitnessedCliFormattedTxBody anyTxBody -> pure anyTxBody + IncompleteCddlFormattedTx (InAnyCardanoEra era tx) -> + pure $ InAnyCardanoEra era (getTxBody tx) + --TODO: Why are we maintaining friendlyTxBodyBS and friendlyTxBS? + -- In the case of a transaction body, we can simply call makeSignedTransaction [] + -- to get a transaction which allows us to reuse friendlyTxBS! + + case mOutputFile of + Just (OutputFile fpath) -> liftIO $ LBS.writeFile fpath $ prettyTxBodyLBS era txbody + Nothing -> liftIO $ BS.putStr $ friendlyTxBodyBS era txbody + + InputTxFile (TxFile txFilePath) -> do + txFile <- liftIO $ fileOrPipe txFilePath + InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) + + case mOutputFile of + Just (OutputFile fpath) -> liftIO $ LBS.writeFile fpath $ prettyTxLBS era tx + Nothing -> liftIO $ BS.putStr $ friendlyTxBS era tx + +prettyTxLBS :: CardanoEra era -> Tx era -> LBS.ByteString +prettyTxLBS era (Tx (TxBody body) witnesses) = + encodePretty + $ Aeson.object + $ getIsCardanoEraConstraint era + [ "era" .= era + , "body" .= body + , "witnesses" .= witnesses + ] + +prettyTxBodyLBS :: CardanoEra era -> TxBody era -> LBS.ByteString +prettyTxBodyLBS era (TxBody body) = + encodePretty + $ Aeson.object $ getIsCardanoEraConstraint era ["era" .= era, "body" .= body] +>>>>>>> 952e00151 (Add `--output-file` option to `transaction view` command) -- ---------------------------------------------------------------------------- From ecb9be0253a96b0b66bc26a95d4ebe0621df7461 Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Tue, 11 Apr 2023 10:17:55 +1000 Subject: [PATCH 11/13] Add tests for --out-file option of the 'transaction view' command --- cardano-api/src/Cardano/Api/Certificate.hs | 2 +- cardano-api/src/Cardano/Api/Tx.hs | 6 +- .../src/Cardano/CLI/Shelley/Commands.hs | 2 +- .../Cardano/CLI/Shelley/Run/Transaction.hs | 33 +- cardano-cli/test/Test/Golden/TxView.hs | 404 ++++++++++-------- .../alonzo/signed-transaction-view.json | 37 ++ .../data/golden/alonzo/transaction-view.out | 99 +++-- .../data/golden/mary/transaction-view.json | 56 +++ .../data/golden/shelley/transaction-view.json | 135 ++++++ 9 files changed, 520 insertions(+), 254 deletions(-) create mode 100644 cardano-cli/test/data/golden/alonzo/signed-transaction-view.json create mode 100644 cardano-cli/test/data/golden/mary/transaction-view.json create mode 100644 cardano-cli/test/data/golden/shelley/transaction-view.json diff --git a/cardano-api/src/Cardano/Api/Certificate.hs b/cardano-api/src/Cardano/Api/Certificate.hs index 490987c6515..90b7e4ba9e8 100644 --- a/cardano-api/src/Cardano/Api/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Certificate.hs @@ -124,7 +124,7 @@ instance ToJSON Certificate where [ "type" .= String "StakeAddressDeregistration" , "credential" .= credential ] - StakeAddressDelegationCertificate credential pool -> + StakeAddressPoolDelegationCertificate credential pool -> object [ "type" .= String "StakeAddressDelegation" , "credential" .= credential diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs index 0a24bf4cc30..ded24d000bc 100644 --- a/cardano-api/src/Cardano/Api/Tx.hs +++ b/cardano-api/src/Cardano/Api/Tx.hs @@ -430,9 +430,6 @@ instance IsCardanoEra era => SerialiseAsCBOR (KeyWitness era) where ConwayEra -> decodeShelleyBasedWitness ShelleyBasedEraConway bs -<<<<<<< HEAD -encodeShelleyBasedKeyWitness :: CBOR.EncCBOR w => w -> CBOR.Encoding -======= instance ToJSON (KeyWitness era) where toJSON a = case a of ByronKeyWitness w -> @@ -451,8 +448,7 @@ instance ToJSON (KeyWitness era) where , "witness" .= witness ] -encodeShelleyBasedKeyWitness :: ToCBOR w => w -> CBOR.Encoding ->>>>>>> d02481507 (Add ToJSON instance for KeyWitness:) +encodeShelleyBasedKeyWitness :: CBOR.EncCBOR w =>w -> CBOR.Encoding encodeShelleyBasedKeyWitness wit = CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> CBOR.encCBOR wit diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index 48bec8d878a..c759aec813c 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs @@ -254,7 +254,7 @@ data TransactionCmd | TxGetTxId InputTxBodyOrTxFile | TxView InputTxBodyOrTxFile - (Maybe OutputFile) + (Maybe (File () Out)) data InputTxBodyOrTxFile = InputTxBodyFile (TxBodyFile In) | InputTxFile (TxFile In) deriving Show diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index b2a7c5b4e9d..c7e515fd950 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -1309,31 +1309,10 @@ runTxGetTxId txfile = do liftIO $ BS.putStrLn $ serialiseToRawBytesHex (getTxId txbody) -<<<<<<< HEAD -runTxView :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () -runTxView = \case - InputTxBodyFile (File txbodyFilePath) -> do - txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT - $ readFileTxBody txbodyFile - InAnyCardanoEra era txbody <- - case unwitnessed of - UnwitnessedCliFormattedTxBody anyTxBody -> pure anyTxBody - IncompleteCddlFormattedTx (InAnyCardanoEra era tx) -> - pure $ InAnyCardanoEra era (getTxBody tx) - --TODO: Why are we maintaining friendlyTxBodyBS and friendlyTxBS? - -- In the case of a transaction body, we can simply call makeSignedTransaction [] - -- to get a transaction which allows us to reuse friendlyTxBS! - liftIO $ BS.putStr $ friendlyTxBodyBS era txbody - InputTxFile (File txFilePath) -> do - txFile <- liftIO $ fileOrPipe txFilePath - InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) - liftIO $ BS.putStr $ friendlyTxBS era tx -======= -runTxView :: InputTxBodyOrTxFile -> Maybe OutputFile -> ExceptT ShelleyTxCmdError IO () +runTxView :: InputTxBodyOrTxFile -> Maybe (File () Out) -> ExceptT ShelleyTxCmdError IO () runTxView input mOutputFile = case input of - InputTxBodyFile (TxBodyFile txbodyFilePath) -> do + InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- lift (readFileTxBody txbodyFile) & onLeft (left . ShelleyTxCmdCddlError) InAnyCardanoEra era txbody <- @@ -1341,20 +1320,21 @@ runTxView input mOutputFile = UnwitnessedCliFormattedTxBody anyTxBody -> pure anyTxBody IncompleteCddlFormattedTx (InAnyCardanoEra era tx) -> pure $ InAnyCardanoEra era (getTxBody tx) + --TODO: Why are we maintaining friendlyTxBodyBS and friendlyTxBS? -- In the case of a transaction body, we can simply call makeSignedTransaction [] -- to get a transaction which allows us to reuse friendlyTxBS! case mOutputFile of - Just (OutputFile fpath) -> liftIO $ LBS.writeFile fpath $ prettyTxBodyLBS era txbody + Just (File fpath) -> liftIO $ LBS.writeFile fpath $ prettyTxBodyLBS era txbody Nothing -> liftIO $ BS.putStr $ friendlyTxBodyBS era txbody - InputTxFile (TxFile txFilePath) -> do + InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) case mOutputFile of - Just (OutputFile fpath) -> liftIO $ LBS.writeFile fpath $ prettyTxLBS era tx + Just (File fpath) -> liftIO $ LBS.writeFile fpath $ prettyTxLBS era tx Nothing -> liftIO $ BS.putStr $ friendlyTxBS era tx prettyTxLBS :: CardanoEra era -> Tx era -> LBS.ByteString @@ -1371,7 +1351,6 @@ prettyTxBodyLBS :: CardanoEra era -> TxBody era -> LBS.ByteString prettyTxBodyLBS era (TxBody body) = encodePretty $ Aeson.object $ getIsCardanoEraConstraint era ["era" .= era, "body" .= body] ->>>>>>> 952e00151 (Add `--output-file` option to `transaction view` command) -- ---------------------------------------------------------------------------- diff --git a/cardano-cli/test/Test/Golden/TxView.hs b/cardano-cli/test/Test/Golden/TxView.hs index b4e18d4fbba..b767b3ee4e3 100644 --- a/cardano-cli/test/Test/Golden/TxView.hs +++ b/cardano-cli/test/Test/Golden/TxView.hs @@ -6,7 +6,8 @@ import Control.Monad (void) import Hedgehog (Group (..), Property, checkSequential) import Hedgehog.Extras (Integration, moduleWorkspace, note_, propertyOnce) -import Hedgehog.Extras.Test.Golden (diffVsGoldenFile) +import qualified Hedgehog.Extras.Test.File as H +import qualified Hedgehog.Extras.Test.Golden as H import System.FilePath (()) import Test.OptParse (execCardanoCLI, noteTempFile) @@ -32,22 +33,23 @@ golden_view_byron = transactionBodyFile <- noteTempFile tempDir "transaction-body-file" -- Create transaction body - void $ - execCardanoCLI - [ "transaction", "build-raw" - , "--byron-era" - , "--tx-in" - , "F8EC302D19E3C8251C30B1434349BF2E949A1DBF14A4EBC3D512918D2D4D5C56#88" - , "--tx-out" - , "5oP9ib6ym3XfwXuy3ksXZzgtBzXSArXAACQVXKqcPhiLnHVYjXJNu2T6Zomh8LAWLV+68" - , "--out-file", transactionBodyFile - ] + void $ execCardanoCLI + [ "transaction", "build-raw" + , "--byron-era" + , "--tx-in" + , "F8EC302D19E3C8251C30B1434349BF2E949A1DBF14A4EBC3D512918D2D4D5C56#88" + , "--tx-out" + , "5oP9ib6ym3XfwXuy3ksXZzgtBzXSArXAACQVXKqcPhiLnHVYjXJNu2T6Zomh8LAWLV+68" + , "--out-file", transactionBodyFile + ] -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - diffVsGoldenFile result "test/data/golden/byron/transaction-view.out" + result <- execCardanoCLI + [ "transaction", "view" + , "--tx-body-file", transactionBodyFile + ] + + H.diffVsGoldenFile result "test/data/golden/byron/transaction-view.out" golden_view_shelley :: Property golden_view_shelley = let @@ -66,6 +68,7 @@ golden_view_shelley = let moduleWorkspace "tmp" $ \tempDir -> do updateProposalFile <- noteTempFile tempDir "update-proposal" transactionBodyFile <- noteTempFile tempDir "transaction-body" + outFile <- noteTempFile tempDir "out-file" let extraEntropySeed = "c0ffee" note_ $ "extra entropy seed: " ++ extraEntropySeed @@ -80,37 +83,35 @@ golden_view_shelley = let ] -- Create update proposal - void $ - execCardanoCLI - [ "governance", "create-update-proposal" - , "--decentralization-parameter", "63/64" - , "--epoch", "64" - , "--extra-entropy", extraEntropySeed - , "--genesis-verification-key-file" - , "test/data/golden/shelley/keys/genesis_keys/verification_key" - , "--key-reg-deposit-amt", "71" - , "--max-block-body-size", "72" - , "--max-block-header-size", "73" - , "--max-tx-size", "74" - , "--min-fee-constant", "75" - , "--min-fee-linear", "76" - , "--min-pool-cost", "77" - , "--min-utxo-value", "78" - , "--monetary-expansion", "79/80" - , "--number-of-pools", "80" - , "--out-file", updateProposalFile - , "--pool-influence", "82/83" - , "--pool-reg-deposit", "83" - , "--pool-retirement-epoch-boundary", "84" - , "--protocol-major-version", "8" - , "--protocol-minor-version", "86" - , "--treasury-expansion", "87/88" - ] + void $ execCardanoCLI + [ "governance", "create-update-proposal" + , "--decentralization-parameter", "63/64" + , "--epoch", "64" + , "--extra-entropy", extraEntropySeed + , "--genesis-verification-key-file" + , "test/data/golden/shelley/keys/genesis_keys/verification_key" + , "--key-reg-deposit-amt", "71" + , "--max-block-body-size", "72" + , "--max-block-header-size", "73" + , "--max-tx-size", "74" + , "--min-fee-constant", "75" + , "--min-fee-linear", "76" + , "--min-pool-cost", "77" + , "--min-utxo-value", "78" + , "--monetary-expansion", "79/80" + , "--number-of-pools", "80" + , "--out-file", updateProposalFile + , "--pool-influence", "82/83" + , "--pool-reg-deposit", "83" + , "--pool-retirement-epoch-boundary", "84" + , "--protocol-major-version", "8" + , "--protocol-minor-version", "86" + , "--treasury-expansion", "87/88" + ] -- Create transaction body - void $ - execCardanoCLI $ - [ "transaction", "build-raw" + void $ execCardanoCLI $ mconcat + [ [ "transaction", "build-raw" , "--shelley-era" , "--tx-in" , "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#29" @@ -123,14 +124,27 @@ golden_view_shelley = let , "--update-proposal-file", updateProposalFile , "--out-file", transactionBodyFile ] - ++ - ["--certificate-file=" <> cert | cert <- certs] + , [ "--certificate-file=" <> cert | cert <- certs + ] + ] -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - diffVsGoldenFile result "test/data/golden/shelley/transaction-view.out" + result <- execCardanoCLI + [ "transaction", "view" + , "--tx-body-file", transactionBodyFile + ] + H.diffVsGoldenFile result "test/data/golden/shelley/transaction-view.out" + + -- JSON version + void $ execCardanoCLI + ["transaction", "view" + , "--tx-body-file", transactionBodyFile + , "--out-file", outFile + ] + + resultJson <- H.readFile outFile + + H.diffVsGoldenFile resultJson "test/data/golden/shelley/transaction-view.json" golden_view_allegra :: Property golden_view_allegra = @@ -139,119 +153,131 @@ golden_view_allegra = transactionBodyFile <- noteTempFile tempDir "transaction-body-file" -- Create transaction body - void $ - execCardanoCLI - [ "transaction", "build-raw" - , "--allegra-era" - , "--tx-in" - , "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#94" - , "--tx-out" - , mconcat - [ "addr_test1" - , "qrefnr4k09pvge6dq83v6s67ruter8sftmky8qrmkqqsxy7q5psgn8tgqmupq4r7" - , "9jmxlyk4eqt6z6hj5g8jd8393msqaw47f4" - , "+99" - ] - , "--fee", "100" - , "--invalid-hereafter", "101" - , "--out-file", transactionBodyFile + void $ execCardanoCLI + [ "transaction", "build-raw" + , "--allegra-era" + , "--tx-in" + , "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#94" + , "--tx-out" + , mconcat + [ "addr_test1" + , "qrefnr4k09pvge6dq83v6s67ruter8sftmky8qrmkqqsxy7q5psgn8tgqmupq4r7" + , "9jmxlyk4eqt6z6hj5g8jd8393msqaw47f4" + , "+99" ] + , "--fee", "100" + , "--invalid-hereafter", "101" + , "--out-file", transactionBodyFile + ] -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - diffVsGoldenFile result "test/data/golden/allegra/transaction-view.out" + result <- execCardanoCLI + [ "transaction", "view" + , "--tx-body-file", transactionBodyFile + ] + + H.diffVsGoldenFile result "test/data/golden/allegra/transaction-view.out" golden_view_mary :: Property golden_view_mary = propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do transactionBodyFile <- noteTempFile tempDir "transaction-body-file" + outFile <- noteTempFile tempDir "out-file" -- Create transaction body - void $ - execCardanoCLI - [ "transaction", "build-raw" - , "--mary-era" - , "--tx-in" - , "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#135" - , "--tx-out" - , mconcat - [ "addr_test1" - , "qrefnr4k09pvge6dq83v6s67ruter8sftmky8qrmkqqsxy7q5psgn8tgqmupq4r7" - , "9jmxlyk4eqt6z6hj5g8jd8393msqaw47f4" - , " + " - , "138" - , " + " - , "130 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" - , " + " - , "132 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.cafe" - , " + " - , "134 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf.f00d" - , " + " - , "136 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.dead" - , " + " - , "138" - , " d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" - , ".736e6f77" - , " + " - , "142" - , " a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067" - , ".736b79" - ] - , "--fee", "139" - , "--invalid-before", "140" - , "--mint" - , mconcat - [ "130 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" - , " + " - , "132 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.cafe" - , " + " - , "134 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf.f00d" - , " + " - , "136 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.dead" - , " + " - , "138" - , " d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" - , ".736e6f77" - , " + " - , "142" - , " a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067" - , ".736b79" - ] - , "--mint-script-file", "test/data/golden/mary/scripts/mint.all" - , "--mint-script-file", "test/data/golden/mary/scripts/mint.sig" - , "--out-file", transactionBodyFile + void $ execCardanoCLI + [ "transaction", "build-raw" + , "--mary-era" + , "--tx-in" + , "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#135" + , "--tx-out" + , mconcat + [ "addr_test1" + , "qrefnr4k09pvge6dq83v6s67ruter8sftmky8qrmkqqsxy7q5psgn8tgqmupq4r7" + , "9jmxlyk4eqt6z6hj5g8jd8393msqaw47f4" + , " + " + , "138" + , " + " + , "130 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" + , " + " + , "132 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.cafe" + , " + " + , "134 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf.f00d" + , " + " + , "136 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.dead" + , " + " + , "138" + , " d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" + , ".736e6f77" + , " + " + , "142" + , " a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067" + , ".736b79" ] + , "--fee", "139" + , "--invalid-before", "140" + , "--mint" + , mconcat + [ "130 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" + , " + " + , "132 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.cafe" + , " + " + , "134 d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf.f00d" + , " + " + , "136 a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067.dead" + , " + " + , "138" + , " d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf" + , ".736e6f77" + , " + " + , "142" + , " a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067" + , ".736b79" + ] + , "--mint-script-file", "test/data/golden/mary/scripts/mint.all" + , "--mint-script-file", "test/data/golden/mary/scripts/mint.sig" + , "--out-file", transactionBodyFile + ] -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - diffVsGoldenFile result "test/data/golden/mary/transaction-view.out" + result <- execCardanoCLI + [ "transaction", "view" + , "--tx-body-file", transactionBodyFile + ] + H.diffVsGoldenFile result "test/data/golden/mary/transaction-view.out" + + -- JSON version + void $ execCardanoCLI + [ "transaction", "view" + , "--out-file", outFile + , "--tx-body-file", transactionBodyFile + ] + + resultJson <- H.readFile outFile + + H.diffVsGoldenFile resultJson "test/data/golden/mary/transaction-view.json" createAlonzoTxBody :: Maybe FilePath -> FilePath -> Integration () createAlonzoTxBody mUpdateProposalFile transactionBodyFile = do - void $ - execCardanoCLI - ( [ "transaction", "build-raw" - , "--alonzo-era" - , "--tx-in" - , "ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#212" - , "--tx-in-collateral" - , "c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256" - , "--fee", "213" - , "--required-signer-hash" - , "98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27" - , "--required-signer-hash" - , "fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4" - , "--out-file", transactionBodyFile - ] - ++ [ "--update-proposal-file=" <> updateProposalFile - | Just updateProposalFile <- [mUpdateProposalFile] - ] - ) + void $ execCardanoCLI $ mconcat + [ [ "transaction", "build-raw" + , "--alonzo-era" + , "--tx-in" + , "ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#212" + , "--tx-in-collateral" + , "c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256" + , "--fee", "213" + , "--required-signer-hash" + , "98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27" + , "--required-signer-hash" + , "fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4" + , "--out-file", transactionBodyFile + ] + , [ "--update-proposal-file=" <> updateProposalFile + | Just updateProposalFile <- [mUpdateProposalFile] + ] + ] golden_view_alonzo :: Property golden_view_alonzo = @@ -259,6 +285,7 @@ golden_view_alonzo = moduleWorkspace "tmp" $ \tempDir -> do updateProposalFile <- noteTempFile tempDir "update-proposal" transactionBodyFile <- noteTempFile tempDir "transaction-body" + outFile <- noteTempFile tempDir "out-file" note_ $ mconcat [ "genesis-verification-key-file hash:" @@ -266,53 +293,68 @@ golden_view_alonzo = ] -- Create update proposal - void $ - execCardanoCLI - [ "governance", "create-update-proposal" - , "--epoch", "190" - , "--genesis-verification-key-file" - , "test/data/golden/shelley/keys/genesis_keys/verification_key" - , "--utxo-cost-per-word", "194" - , "--price-execution-steps", "195/196" - , "--price-execution-memory", "196/197" - , "--max-tx-execution-units", "(197, 198)" - , "--max-block-execution-units", "(198, 199)" - , "--max-value-size", "199" - , "--collateral-percent", "200" - , "--max-collateral-inputs", "201" - , "--out-file", updateProposalFile - ] + void $ execCardanoCLI + [ "governance", "create-update-proposal" + , "--epoch", "190" + , "--genesis-verification-key-file" + , "test/data/golden/shelley/keys/genesis_keys/verification_key" + , "--utxo-cost-per-word", "194" + , "--price-execution-steps", "195/196" + , "--price-execution-memory", "196/197" + , "--max-tx-execution-units", "(197, 198)" + , "--max-block-execution-units", "(198, 199)" + , "--max-value-size", "199" + , "--collateral-percent", "200" + , "--max-collateral-inputs", "201" + , "--out-file", updateProposalFile + ] createAlonzoTxBody (Just updateProposalFile) transactionBodyFile -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - diffVsGoldenFile result "test/data/golden/alonzo/transaction-view.out" + void $ execCardanoCLI + [ "transaction", "view" + , "--out-file", outFile + , "--tx-body-file", transactionBodyFile + ] + + result <- H.readFile outFile + + H.diffVsGoldenFile result "test/data/golden/alonzo/transaction-view.out" golden_view_alonzo_signed :: Property golden_view_alonzo_signed = - let testData = "test/data/golden/alonzo" - in - propertyOnce $ - moduleWorkspace "tmp" $ \tempDir -> do + propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do + let testData = "test/data/golden/alonzo" + transactionBodyFile <- noteTempFile tempDir "transaction-body" transactionFile <- noteTempFile tempDir "transaction" + outFile <- noteTempFile tempDir "out-file" createAlonzoTxBody Nothing transactionBodyFile -- Sign - void $ - execCardanoCLI - [ "transaction", "sign" - , "--tx-body-file", transactionBodyFile - , "--signing-key-file", testData "signing.key" - , "--out-file", transactionFile - ] + void $ execCardanoCLI + [ "transaction", "sign" + , "--tx-body-file", transactionBodyFile + , "--signing-key-file", testData "signing.key" + , "--out-file", transactionFile + ] -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-file", transactionFile] - diffVsGoldenFile result (testData "signed-transaction-view.out") + result <- execCardanoCLI + [ "transaction", "view" + , "--tx-file", transactionFile + ] + H.diffVsGoldenFile result $ testData "signed-transaction-view.out" + + -- JSON version + void $ execCardanoCLI + [ "transaction", "view" + , "--out-file", outFile + , "--tx-file", transactionFile + ] + + resultJson <- H.readFile outFile + + H.diffVsGoldenFile resultJson $ testData "signed-transaction-view.json" diff --git a/cardano-cli/test/data/golden/alonzo/signed-transaction-view.json b/cardano-cli/test/data/golden/alonzo/signed-transaction-view.json new file mode 100644 index 00000000000..02887a3cf06 --- /dev/null +++ b/cardano-cli/test/data/golden/alonzo/signed-transaction-view.json @@ -0,0 +1,37 @@ +{ + "body": { + "auxScripts": null, + "certificates": null, + "extraKeyWits": [ + "98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27", + "fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4" + ], + "fee": 213, + "ins": [ + "ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#212" + ], + "insCollateral": [ + "c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256" + ], + "insReference": null, + "metadata": null, + "mintValue": null, + "outs": [], + "returnCollateral": null, + "scriptValidity": "Valid", + "totalCollateral": null, + "updateProposal": null, + "validityRange": { + "lowerBound": null, + "upperBound": null + }, + "withdrawals": null + }, + "era": "Alonzo", + "witnesses": [ + { + "type": "keyWitness", + "witness": "820082582084ce03e08b05533685d593c14cd6ca5c7485824156ca11fb303ddac9dd3ef41c5840f6aae8023de4858244c6aac4b1ca7428f669a142731fe7354021059887b5366f24abba49355e14d435dbc7726df66dfeafe269e2752a7a6f752529600d1e9a00" + } + ] +} \ No newline at end of file diff --git a/cardano-cli/test/data/golden/alonzo/transaction-view.out b/cardano-cli/test/data/golden/alonzo/transaction-view.out index fe8af64a163..ffe0b514ab0 100644 --- a/cardano-cli/test/data/golden/alonzo/transaction-view.out +++ b/cardano-cli/test/data/golden/alonzo/transaction-view.out @@ -1,39 +1,60 @@ -auxiliary scripts: null -certificates: null -collateral inputs: -- c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256 -era: Alonzo -fee: 213 Lovelace -inputs: -- ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#212 -metadata: null -mint: null -outputs: [] -reference inputs: null -required signers (payment key hashes needed for scripts): -- 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27 -- fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4 -return collateral: null -total collateral: null -update proposal: - epoch: 190 - updates: - - genesis key hash: 1bafa294233a5a7ffbf539ae798da0943aa83d2a19398c2d0e5af114 - update: - UTxO storage cost per word: 194 Lovelace - collateral inputs share: 200% - execution prices: - memory: 196/197 - steps: 195/196 - max block execution units: - memory: 199 - steps: 198 - max collateral inputs: 201 - max transaction execution units: - memory: 198 - steps: 197 - max value size: 199 -validity range: - lower bound: null - upper bound: null -withdrawals: null +{ + "body": { + "auxScripts": null, + "certificates": null, + "extraKeyWits": [ + "98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27", + "fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4" + ], + "fee": 213, + "ins": [ + "ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#212" + ], + "insCollateral": [ + "c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256" + ], + "insReference": null, + "metadata": null, + "mintValue": null, + "outs": [], + "returnCollateral": null, + "scriptValidity": "Valid", + "totalCollateral": null, + "updateProposal": { + "epoch": 190, + "updates": { + "1bafa294233a5a7ffbf539ae798da0943aa83d2a19398c2d0e5af114": { + "collateralPercent": 200, + "costModels": {}, + "maxBlockExUnits": { + "memory": 199, + "steps": 198 + }, + "maxCollateralInputs": 201, + "maxTxExUnits": { + "memory": 198, + "steps": 197 + }, + "maxValueSize": 199, + "prices": { + "priceMemory": { + "denominator": 197, + "numerator": 196 + }, + "priceSteps": { + "denominator": 196, + "numerator": 195 + } + }, + "utxoCostPerWord": 194 + } + } + }, + "validityRange": { + "lowerBound": null, + "upperBound": null + }, + "withdrawals": null + }, + "era": "Alonzo" +} \ No newline at end of file diff --git a/cardano-cli/test/data/golden/mary/transaction-view.json b/cardano-cli/test/data/golden/mary/transaction-view.json new file mode 100644 index 00000000000..8b968c7661d --- /dev/null +++ b/cardano-cli/test/data/golden/mary/transaction-view.json @@ -0,0 +1,56 @@ +{ + "body": { + "auxScripts": null, + "certificates": null, + "extraKeyWits": null, + "fee": 139, + "ins": [ + "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#135" + ], + "insCollateral": null, + "insReference": null, + "metadata": null, + "mintValue": { + "a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067": { + "736b79": 142, + "cafe": 132, + "dead": 136 + }, + "d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf": { + "": 130, + "736e6f77": 138, + "f00d": 134 + } + }, + "outs": [ + { + "address": "addr_test1qrefnr4k09pvge6dq83v6s67ruter8sftmky8qrmkqqsxy7q5psgn8tgqmupq4r79jmxlyk4eqt6z6hj5g8jd8393msqaw47f4", + "value": { + "a06ee5ffdd7f9b5bd992eb9543f44418323f81229526b77b0e4be067": { + "736b79": 142, + "cafe": 132, + "dead": 136 + }, + "d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf": { + "": 130, + "736e6f77": 138, + "f00d": 134 + }, + "lovelace": 138 + } + } + ], + "returnCollateral": null, + "scriptValidity": null, + "totalCollateral": null, + "updateProposal": null, + "validityRange": { + "lowerBound": { + "slot": 140 + }, + "upperBound": null + }, + "withdrawals": null + }, + "era": "Mary" +} \ No newline at end of file diff --git a/cardano-cli/test/data/golden/shelley/transaction-view.json b/cardano-cli/test/data/golden/shelley/transaction-view.json new file mode 100644 index 00000000000..2b5316f3402 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/transaction-view.json @@ -0,0 +1,135 @@ +{ + "body": { + "auxScripts": null, + "certificates": [ + { + "genesisDelegateKeyHash": "d52ac434259f2af7fd2a538ece5ef8d80386527aa93e207473acb31c", + "genesisKeyHash": "c3db461200fa59c81a4ecc8495446d9e42de27483ff6ee4339c9ab94", + "type": "GenesisKeyDelegation", + "vrfKeyHash": "1b9de69baec0dff8dde6e81d71f40f8b65fb3df55bb6ece5783aade88b17354d" + }, + { + "pot": "reserves", + "target": { + "addresses": [ + [ + { + "stakingKeyHash": "ee475cade27e95faf1093541b0783498016cdcfba0d6441055b2dfcb" + }, + 1000 + ] + ], + "type": "StakeAddresses" + }, + "type": "MIR" + }, + { + "credential": { + "stakingKeyHash": "d0efd9836e62225a47baf9bedfeaccbb86ba3f49d9edc4ac0aa26df5" + }, + "type": "StakeAddressDeregistration" + }, + { + "credential": { + "stakingKeyHash": "c6ea7e348d300b32798888497290db24a99a36f2238ed9668f602d7a" + }, + "type": "StakeAddressRegistration" + }, + { + "epoch": 42, + "pool": "pool13lllruv6rd63l70vkpgye2ea856f22k8xhujmf2vvlul5ytw7mx", + "type": "StakePoolRetirement" + }, + { + "parameters": { + "cost": 1000, + "id": "pool1cxxj569g3x9akwv49vv6u5z8d3l7xrwzh7p2tf2g2ajkce894m3", + "margin": { + "denominator": 10, + "numerator": 1 + }, + "metadata": null, + "owners": [ + "f25fc5c9f341ec3bd785ddea746f76b6a9ac7f38fdd7aef1779bbe81" + ], + "pledge": 5000, + "relays": [], + "rewardAccount": "stake1u8e9l3wf7dq7cw7hshw75ar0w6m2ntrl8r7a0th3w7dmaqgne5h5d", + "vrf": "8d445260282cef45e4c6a862b8a924aeed1b316ccba779dd39f9517220e96407" + }, + "type": "StakePoolRegistration" + } + ], + "extraKeyWits": null, + "fee": 32, + "ins": [ + "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#29" + ], + "insCollateral": null, + "insReference": null, + "metadata": null, + "mintValue": null, + "outs": [ + { + "address": "addr_test1vz7w0r9epak6nmnh3mc8e2ypkjyu8zsc3xf7dpct6k577acxmcfyv", + "value": 31 + } + ], + "returnCollateral": null, + "scriptValidity": null, + "totalCollateral": null, + "updateProposal": { + "epoch": 64, + "updates": { + "1bafa294233a5a7ffbf539ae798da0943aa83d2a19398c2d0e5af114": { + "costModels": {}, + "decentralization": { + "denominator": 64, + "numerator": 63 + }, + "extraPraosEntropy": "88f04f011dcded879039ae4b9b20219d9448e5c7b42c2d1f638fb8740e0ab8be", + "maxBlockBodySize": 72, + "maxBlockHeaderSize": 73, + "maxTxSize": 74, + "minPoolCost": 77, + "minUTxOValue": 78, + "monetaryExpansion": { + "denominator": 80, + "numerator": 79 + }, + "poolPledgeInfluence": { + "denominator": 83, + "numerator": 82 + }, + "poolRetireMaxEpoch": 84, + "protocolVersion": [ + 85, + 86 + ], + "stakeAddressDeposit": 71, + "stakePoolDeposit": 83, + "stakePoolTargetNum": 80, + "treasuryCut": { + "denominator": 88, + "numerator": 87 + }, + "txFeeFixed": 75, + "txFeePerByte": 76 + } + } + }, + "validityRange": { + "lowerBound": null, + "upperBound": { + "slot": 33 + } + }, + "withdrawals": [ + { + "lovelace": 42, + "stakeAddress": "stake_test1up00fz9lyqs5sjks82k22eqz7a9srym9vysjgp3h2ua2v2cm522kg" + } + ] + }, + "era": "Shelley" +} \ No newline at end of file From ba37c5d7aebe2fd0f3fee8e77b99a8a89b2608fc Mon Sep 17 00:00:00 2001 From: John Ky Date: Tue, 11 Apr 2023 11:23:42 +1000 Subject: [PATCH 12/13] Add --out-file option to calculate-min-fee command --- .../src/Cardano/CLI/Shelley/Commands.hs | 1 + .../src/Cardano/CLI/Shelley/Parsers.hs | 1 + .../Cardano/CLI/Shelley/Run/Transaction.hs | 19 ++++++++++++------- 3 files changed, 14 insertions(+), 7 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index c759aec813c..3d29642ede7 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs @@ -245,6 +245,7 @@ data TransactionCmd TxOutCount TxShelleyWitnessCount TxByronWitnessCount + (Maybe (File () Out)) | TxCalculateMinRequiredUTxO AnyCardanoEra ProtocolParamsFile diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index 1df6b2bf521..adb8a4db90b 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -816,6 +816,7 @@ pTransaction envCli = <*> pTxOutCount <*> pTxShelleyWitnessCount <*> pTxByronWitnessCount + <*> optional pOutputFile pTransactionCalculateMinReqUTxO :: Parser TransactionCmd pTransactionCalculateMinReqUTxO = TxCalculateMinRequiredUTxO diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index c7e515fd950..efb3dbe8431 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -22,7 +22,7 @@ import Control.Monad.Trans (MonadTrans (..)) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, hoistMaybe, left, newExceptT, onLeft, onNothing) -import Data.Aeson ((.=)) +import Data.Aeson (ToJSON (..), (.=)) import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (encodePretty) import Data.Bifunctor (Bifunctor (..)) @@ -284,8 +284,8 @@ runTransactionCmd cmd = runTxSign txinfile skfiles network txoutfile TxSubmit mNodeSocketPath anyConsensusModeParams network txFp -> runTxSubmit mNodeSocketPath anyConsensusModeParams network txFp - TxCalculateMinFee txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses -> - runTxCalculateMinFee txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses + TxCalculateMinFee txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses mOutputFile -> + runTxCalculateMinFee txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses mOutputFile TxCalculateMinRequiredUTxO era pParamsFile txOuts -> runTxCalculateMinRequiredUTxO era pParamsFile txOuts TxHashScriptData scriptDataOrFile -> runTxHashScriptData scriptDataOrFile TxGetTxId txinfile -> runTxGetTxId txinfile @@ -1147,12 +1147,13 @@ runTxCalculateMinFee -> TxOutCount -> TxShelleyWitnessCount -> TxByronWitnessCount + -> Maybe (File () Out) -> ExceptT ShelleyTxCmdError IO () runTxCalculateMinFee (File txbodyFilePath) nw pParamsFile (TxInCount nInputs) (TxOutCount nOutputs) (TxShelleyWitnessCount nShelleyKeyWitnesses) - (TxByronWitnessCount nByronKeyWitnesses) = do - + (TxByronWitnessCount nByronKeyWitnesses) + mOutputFile = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile @@ -1171,7 +1172,9 @@ runTxCalculateMinFee (File txbodyFilePath) nw pParamsFile nInputs nOutputs nByronKeyWitnesses nShelleyKeyWitnesses - liftIO $ putStrLn $ (show fee :: String) <> " Lovelace" + case mOutputFile of + Just fp -> liftIO $ LBS.writeFile (unFile fp) (Aeson.encode (toJSON fee)) + Nothing -> liftIO $ putStrLn $ (show fee :: String) <> " Lovelace" UnwitnessedCliFormattedTxBody anyTxBody -> do InAnyShelleyBasedEra _era txbody <- @@ -1187,7 +1190,9 @@ runTxCalculateMinFee (File txbodyFilePath) nw pParamsFile nInputs nOutputs nByronKeyWitnesses nShelleyKeyWitnesses - liftIO $ putStrLn $ (show fee :: String) <> " Lovelace" + case mOutputFile of + Just fp -> liftIO $ LBS.writeFile (unFile fp) (Aeson.encode (toJSON fee)) + Nothing -> liftIO $ putStrLn $ (show fee :: String) <> " Lovelace" -- ---------------------------------------------------------------------------- -- Transaction fee calculation From 759a646f1c68ed46668ddf629d1cb9484f1b183f Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 11 May 2023 01:11:44 +1000 Subject: [PATCH 13/13] Add tests for --out-file option of the 'calculate-min-fee' command --- cardano-cli/test/Test/Golden/Shelley.hs | 4 +- .../Shelley/Transaction/CalculateMinFee.hs | 31 ++++++- cardano-cli/test/Test/Utilities.hs | 91 ------------------- .../tx/calculate-min-fee/out-file.json | 1 + 4 files changed, 32 insertions(+), 95 deletions(-) delete mode 100644 cardano-cli/test/Test/Utilities.hs create mode 100644 cardano-cli/test/data/golden/shelley/tx/calculate-min-fee/out-file.json diff --git a/cardano-cli/test/Test/Golden/Shelley.hs b/cardano-cli/test/Test/Golden/Shelley.hs index d639746d8e1..ccb597f2628 100644 --- a/cardano-cli/test/Test/Golden/Shelley.hs +++ b/cardano-cli/test/Test/Golden/Shelley.hs @@ -83,7 +83,8 @@ import Test.Golden.Shelley.Transaction.Build (golden_shelleyTransactio golden_shelleyTransactionBuild_TxInScriptWitnessed, golden_shelleyTransactionBuild_WithdrawalScriptWitnessed) import Test.Golden.Shelley.Transaction.CalculateMinFee - (golden_shelleyTransactionCalculateMinFee) + (golden_shelleyTransactionCalculateMinFee, + golden_shelleyTransactionCalculateMinFee_outFile) import Test.Golden.Shelley.Transaction.CreateWitness (golden_shelleyTransactionSigningKeyWitness) import Test.Golden.Shelley.Transaction.Sign (golden_shelleyTransactionSign) @@ -131,6 +132,7 @@ keyTests = , ("golden_shelleyTransactionBuild_CertificateScriptWitnessed", golden_shelleyTransactionBuild_CertificateScriptWitnessed) , ("golden_shelleyTransactionBuild_WithdrawalScriptWitnessed", golden_shelleyTransactionBuild_WithdrawalScriptWitnessed) , ("golden_shelleyTransactionCalculateMinFee", golden_shelleyTransactionCalculateMinFee) + , ("golden_shelleyTransactionCalculateMinFee_outFile", golden_shelleyTransactionCalculateMinFee_outFile) , ("golden_shelleyTransactionSign", golden_shelleyTransactionSign) , ("golden_shelleyVRFKeys", golden_shelleyVRFKeys) , ("golden_version", golden_version) diff --git a/cardano-cli/test/Test/Golden/Shelley/Transaction/CalculateMinFee.hs b/cardano-cli/test/Test/Golden/Shelley/Transaction/CalculateMinFee.hs index 053bb41e3be..9d45efd24cf 100644 --- a/cardano-cli/test/Test/Golden/Shelley/Transaction/CalculateMinFee.hs +++ b/cardano-cli/test/Test/Golden/Shelley/Transaction/CalculateMinFee.hs @@ -2,13 +2,14 @@ module Test.Golden.Shelley.Transaction.CalculateMinFee ( golden_shelleyTransactionCalculateMinFee + , golden_shelleyTransactionCalculateMinFee_outFile ) where -import Hedgehog (Property) -import Test.OptParse - +import Hedgehog (Property, (===)) import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H +import qualified Hedgehog.Extras.Test.Golden as H +import Test.OptParse {- HLINT ignore "Use camelCase" -} @@ -34,3 +35,27 @@ golden_shelleyTransactionCalculateMinFee = propertyOnce $ H.moduleWorkspace "tmp H.assertFileOccurences 1 "5083100" minFeeTxtFile H.assertFileLines (== 1) minFeeTxtFile H.assertEndsWithSingleNewline minFeeTxtFile + +golden_shelleyTransactionCalculateMinFee_outFile :: Property +golden_shelleyTransactionCalculateMinFee_outFile = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + protocolParamsJsonFile <- noteInputFile "test/data/golden/shelley/transaction-calculate-min-fee/protocol-params.json" + txBodyFile <- noteInputFile "test/data/golden/shelley/tx/txbody" + outFile <- noteTempFile tempDir "out-file" + + minFeeTxt <- execCardanoCLI + [ "transaction","calculate-min-fee" + , "--out-file", outFile + , "--tx-in-count", "32" + , "--tx-out-count", "27" + , "--byron-witness-count", "5" + , "--witness-count", "10" + , "--testnet-magic", "4036000900" + , "--protocol-params-file", protocolParamsJsonFile + , "--tx-body-file", txBodyFile + ] + + minFeeTxt === "" + + resultJson <- H.readFile outFile + + H.diffVsGoldenFile resultJson "test/data/golden/shelley/tx/calculate-min-fee/out-file.json" diff --git a/cardano-cli/test/Test/Utilities.hs b/cardano-cli/test/Test/Utilities.hs deleted file mode 100644 index 715da93e39b..00000000000 --- a/cardano-cli/test/Test/Utilities.hs +++ /dev/null @@ -1,91 +0,0 @@ -module Test.Utilities - ( diffVsGoldenFile, - diffFileVsGoldenFile, - ) where - -import Cardano.Prelude (ConvertText (..), HasCallStack) - -import Control.Monad.IO.Class (MonadIO) -import Data.Algorithm.Diff (PolyDiff (Both), getGroupedDiff) -import Data.Algorithm.DiffOutput (ppDiff) -import GHC.Stack (callStack) -import qualified GHC.Stack as GHC -import Hedgehog (MonadTest) -import qualified Hedgehog.Extras.Test as H -import Hedgehog.Extras.Test.Base (failMessage) -import qualified Hedgehog.Internal.Property as H -import qualified System.Directory as IO -import qualified System.Environment as IO -import System.FilePath (takeDirectory) -import qualified System.IO.Unsafe as IO - --- | Whether the test should create the golden files if the file does ont exist. -createFiles :: Bool -createFiles = IO.unsafePerformIO $ do - value <- IO.lookupEnv "CREATE_GOLDEN_FILES" - return $ value == Just "1" - --- | Diff contents against the golden file. If CREATE_GOLDEN_FILES environment is --- set to "1", then should the gold file not exist it would be created. --- --- Set the environment variable when you intend to generate or re-generate the golden --- file for example when running the test for the first time or if the golden file --- genuinely needs to change. --- --- To re-generate a golden file you must also delete the golden file because golden --- files are never overwritten. --- --- TODO: Improve the help output by saying the difference of --- each input. -diffVsGoldenFile - :: HasCallStack - => MonadTest m - => MonadIO m - => String -- ^ Actual content - -> FilePath -- ^ Reference file - -> m () -diffVsGoldenFile actualContent referenceFile = GHC.withFrozenCallStack $ do - fileExists <- H.evalIO $ IO.doesFileExist referenceFile - - if fileExists - then do - referenceLines <- map toS . lines <$> H.readFile referenceFile - let difference = getGroupedDiff actualLines referenceLines - case difference of - [Both{}] -> pure () - _ -> failMessage callStack $ ppDiff difference - else if createFiles - then do - -- CREATE_GOLDEN_FILES is set, so we create any golden files that don't - -- already exist. - H.note_ $ "Creating golden file " <> referenceFile - H.createDirectoryIfMissing_ (takeDirectory referenceFile) - H.writeFile referenceFile actualContent - else do - H.note_ $ mconcat - [ "Golden file " <> referenceFile - , " does not exist. To create, run with CREATE_GOLDEN_FILES=1" - ] - H.failure - where - actualLines = Prelude.lines actualContent - --- | Diff file against the golden file. If CREATE_GOLDEN_FILES environment is --- set to "1", then should the gold file not exist it would be created. --- --- Set the environment variable when you intend to generate or re-generate the golden --- file for example when running the test for the first time or if the golden file --- genuinely needs to change. --- --- To re-generate a golden file you must also delete the golden file because golden --- files are never overwritten. -diffFileVsGoldenFile - :: HasCallStack - => MonadIO m - => MonadTest m - => FilePath -- ^ Actual file - -> FilePath -- ^ Reference file - -> m () -diffFileVsGoldenFile actualFile referenceFile = GHC.withFrozenCallStack $ do - contents <- H.readFile actualFile - diffVsGoldenFile contents referenceFile diff --git a/cardano-cli/test/data/golden/shelley/tx/calculate-min-fee/out-file.json b/cardano-cli/test/data/golden/shelley/tx/calculate-min-fee/out-file.json new file mode 100644 index 00000000000..089959d9e1c --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/tx/calculate-min-fee/out-file.json @@ -0,0 +1 @@ +5083100 \ No newline at end of file