From fce6a22e652891f39a41564888782a0692aa8f8b Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Sun, 22 Nov 2020 14:51:38 +0000 Subject: [PATCH] Update cardano-cli to use withCardanoEra --- cardano-api/src/Cardano/Api/Script.hs | 8 +- cardano-api/src/Cardano/Api/TxBody.hs | 217 ++++++++++++------ cardano-api/src/Cardano/Api/Typed.hs | 3 +- .../src/Cardano/CLI/Shelley/Commands.hs | 9 +- .../src/Cardano/CLI/Shelley/Parsers.hs | 34 ++- .../src/Cardano/CLI/Shelley/Run/Address.hs | 49 +++- .../Cardano/CLI/Shelley/Run/Transaction.hs | 99 +++++--- cardano-cli/src/Cardano/CLI/Types.hs | 20 ++ .../test/Test/Cli/Pioneers/Exercise2.hs | 1 + .../Test/Golden/Shelley/TextEnvelope/Tx/Tx.hs | 1 + .../Golden/Shelley/TextEnvelope/Tx/TxBody.hs | 1 + .../Test/Golden/Shelley/Transaction/Build.hs | 1 + .../Shelley/Transaction/CreateWitness.hs | 4 + .../src/Testnet/ByronShelley.hs | 1 + cardano-node-chairman/src/Testnet/Shelley.hs | 1 + 15 files changed, 318 insertions(+), 131 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 1647ebbc2c7..d6260188d3c 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -29,6 +29,7 @@ module Cardano.Api.Script ( , ScriptFeatureInEra(..) , SignatureFeature , TimeLocksFeature + , HasScriptFeatures -- * Deprecated aliases , MultiSigScript @@ -65,12 +66,11 @@ import qualified Cardano.Crypto.Hash.Class as Crypto import Cardano.Slotting.Slot (SlotNo) import qualified Cardano.Ledger.Core as Shelley -import qualified Cardano.Ledger.Era as Ledger +import qualified Cardano.Ledger.Era as Ledger import qualified Cardano.Ledger.ShelleyMA.Timelocks as Timelock -import Ouroboros.Consensus.Shelley.Eras - (StandardAllegra, StandardMary, StandardShelley, - StandardCrypto) +import Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardCrypto, StandardMary, + StandardShelley) import qualified Shelley.Spec.Ledger.Keys as Shelley import qualified Shelley.Spec.Ledger.Scripts as Shelley import qualified Shelley.Spec.Ledger.Tx as Shelley diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 39675cc5eb8..32578f12bdd 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -1,10 +1,11 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE EmptyCase #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -38,34 +39,35 @@ module Cardano.Api.TxBody ( txExtraContentEmpty, -- * Data family instances - AsType(..), + AsType(AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody), ) where import Prelude -import qualified Data.List.NonEmpty as NonEmpty -import Data.String (IsString) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Short as SBS +import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map.Strict as Map import qualified Data.Sequence.Strict as Seq import qualified Data.Set as Set +import Data.String (IsString) import Cardano.Binary (Annotated (..), reAnnotate, recoverBytes) import qualified Cardano.Binary as CBOR -import qualified Shelley.Spec.Ledger.Serialization as CBOR - (decodeNullMaybe, encodeNullMaybe) +import qualified Shelley.Spec.Ledger.Serialization as CBOR (decodeNullMaybe, encodeNullMaybe) -import Cardano.Slotting.Slot (SlotNo (..)) import qualified Cardano.Crypto.Hash.Class as Crypto +import Cardano.Slotting.Slot (SlotNo (..)) -import qualified Cardano.Crypto.Hashing as Byron import qualified Cardano.Chain.Common as Byron import qualified Cardano.Chain.UTxO as Byron +import qualified Cardano.Crypto.Hashing as Byron +import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Era as Ledger import qualified Cardano.Ledger.Shelley as Ledger +import qualified Cardano.Ledger.ShelleyMA.TxBody () import Ouroboros.Consensus.Shelley.Eras (StandardShelley) import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) @@ -132,12 +134,20 @@ getTxId (ByronTxBody tx) = . recoverBytes $ tx -getTxId (ShelleyTxBody tx _) = - TxId - . Crypto.castHash - . (\(Shelley.TxId txhash) -> txhash) - . Shelley.txid - $ tx +getTxId (ShelleyTxBody era tx _) = + case era of + ShelleyBasedEraShelley -> getTxIdShelley tx + ShelleyBasedEraAllegra -> getTxIdShelley tx + ShelleyBasedEraMary -> getTxIdShelley tx + where + getTxIdShelley :: Ledger.Crypto ledgerera ~ StandardCrypto + => Ledger.TxBodyConstraints ledgerera + => Ledger.TxBody ledgerera -> TxId + getTxIdShelley = + TxId + . Crypto.castHash + . (\(Shelley.TxId txhash) -> txhash) + . Shelley.txid -- ---------------------------------------------------------------------------- @@ -201,8 +211,9 @@ toShelleyTxOut (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value)) = toShelleyTxOut (TxOut addr (TxOutValue MultiAssetInMaryEra value)) = Shelley.TxOut (toShelleyAddr addr) (toMaryValue value) - - +-- TODO: Placeholder +toMaryValue :: a +toMaryValue = undefined -- ---------------------------------------------------------------------------- -- Transaction bodies @@ -215,48 +226,107 @@ data TxBody era where -> TxBody ByronEra ShelleyTxBody - :: Shelley.TxBody StandardShelley + :: ShelleyBasedEra era + -> Ledger.TxBody (ShelleyLedgerEra era) -> Maybe Shelley.MetaData - -> TxBody ShelleyEra - -deriving instance Eq (TxBody ByronEra) -deriving instance Show (TxBody ByronEra) - -deriving instance Eq (TxBody ShelleyEra) -deriving instance Show (TxBody ShelleyEra) - -instance HasTypeProxy (TxBody ByronEra) where - data AsType (TxBody ByronEra) = AsByronTxBody - proxyToAsType _ = AsByronTxBody + -> TxBody era + -- The 'ShelleyBasedEra' GADT tells us what era we are in. + -- The 'ShelleyLedgerEra' type family maps that to the era type from the + -- ledger lib. The 'Ledger.TxBody' type family maps that to a specific + -- tx body type, which is different for each Shelley-based era. + + +-- The GADT in the ShelleyTxBody case requires a custom instance +instance Eq (TxBody era) where + (==) (ByronTxBody txbodyA) + (ByronTxBody txbodyB) = txbodyA == txbodyB + + (==) (ShelleyTxBody era txbodyA txmetadataA) + (ShelleyTxBody _ txbodyB txmetadataB) = + txmetadataA == txmetadataB + && case era of + ShelleyBasedEraShelley -> txbodyA == txbodyB + ShelleyBasedEraAllegra -> txbodyA == txbodyB + ShelleyBasedEraMary -> txbodyA == txbodyB + + (==) (ByronTxBody{}) (ShelleyTxBody era _ _) = case era of {} + + +-- The GADT in the ShelleyTxBody case requires a custom instance +instance Show (TxBody era) where + showsPrec p (ByronTxBody txbody) = + showParen (p >= 11) + ( showString "ByronTxBody " + . showsPrec 11 txbody + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraShelley txbody txmetadata) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraShelley " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txmetadata + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraAllegra txbody txmetadata) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraAllegra " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txmetadata + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraMary txbody txmetadata) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraMary " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txmetadata + ) + +instance HasTypeProxy era => HasTypeProxy (TxBody era) where + data AsType (TxBody era) = AsTxBody (AsType era) + proxyToAsType _ = AsTxBody (proxyToAsType (Proxy :: Proxy era)) + +pattern AsByronTxBody :: AsType (TxBody ByronEra) +pattern AsByronTxBody = AsTxBody AsByronEra +{-# COMPLETE AsByronTxBody #-} + +pattern AsShelleyTxBody :: AsType (TxBody ShelleyEra) +pattern AsShelleyTxBody = AsTxBody AsShelleyEra +{-# COMPLETE AsShelleyTxBody #-} + + +instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where -instance HasTypeProxy (TxBody ShelleyEra) where - data AsType (TxBody ShelleyEra) = AsShelleyTxBody - proxyToAsType _ = AsShelleyTxBody - - -instance SerialiseAsCBOR (TxBody ByronEra) where serialiseToCBOR (ByronTxBody txbody) = recoverBytes txbody - deserialiseFromCBOR AsByronTxBody bs = do - ByronTxBody <$> - CBOR.decodeFullAnnotatedBytes - "Byron TxBody" - CBOR.fromCBORAnnotated - (LBS.fromStrict bs) - -instance SerialiseAsCBOR (TxBody ShelleyEra) where - serialiseToCBOR (ShelleyTxBody txbody txmetadata) = + serialiseToCBOR (ShelleyTxBody ShelleyBasedEraShelley txbody txmetadata) = CBOR.serializeEncoding' $ CBOR.encodeListLen 2 <> CBOR.toCBOR txbody <> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata - - deserialiseFromCBOR AsShelleyTxBody bs = - CBOR.decodeAnnotator - "Shelley TxBody" - decodeAnnotatedPair - (LBS.fromStrict bs) + serialiseToCBOR (ShelleyTxBody ShelleyBasedEraAllegra _ _) = + error "TODO: SerialiseAsCBOR (TxBody AllegraEra)" + serialiseToCBOR (ShelleyTxBody ShelleyBasedEraMary _ _) = + error "TODO: SerialiseAsCBOR (TxBody MaryEra)" + + deserialiseFromCBOR _ bs = + case cardanoEra :: CardanoEra era of + ByronEra -> + ByronTxBody <$> + CBOR.decodeFullAnnotatedBytes + "Byron TxBody" + CBOR.fromCBORAnnotated + (LBS.fromStrict bs) + ShelleyEra -> + CBOR.decodeAnnotator + "Shelley TxBody" + decodeAnnotatedPair + (LBS.fromStrict bs) + AllegraEra -> error "TODO: SerialiseAsCBOR (TxBody AllegraEra)" + MaryEra -> error "TODO: SerialiseAsCBOR (TxBody MaryEra)" where decodeAnnotatedPair :: CBOR.Decoder s (CBOR.Annotator (TxBody ShelleyEra)) decodeAnnotatedPair = do @@ -265,15 +335,18 @@ instance SerialiseAsCBOR (TxBody ShelleyEra) where txmetadata <- CBOR.decodeNullMaybe fromCBOR return $ CBOR.Annotator $ \fbs -> ShelleyTxBody + ShelleyBasedEraShelley (CBOR.runAnnotator txbody fbs) (CBOR.runAnnotator <$> txmetadata <*> pure fbs) -instance HasTextEnvelope (TxBody ByronEra) where - textEnvelopeType _ = "TxUnsignedByron" - -instance HasTextEnvelope (TxBody ShelleyEra) where - textEnvelopeType _ = "TxUnsignedShelley" +instance IsCardanoEra era => HasTextEnvelope (TxBody era) where + textEnvelopeType _ = + case cardanoEra :: CardanoEra era of + ByronEra -> "TxUnsignedByron" + ShelleyEra -> "TxUnsignedShelley" + AllegraEra -> "TxBodyAllegra" + MaryEra -> "TxBodyMary" data ByronTxBodyConversionError = @@ -322,12 +395,14 @@ txExtraContentEmpty = type TxFee = Lovelace type TTL = SlotNo -makeShelleyTransaction :: TxExtraContent +makeShelleyTransaction :: forall era. + IsShelleyBasedEra era + => TxExtraContent -> TTL -> TxFee -> [TxIn] - -> [TxOut ShelleyEra] - -> TxBody ShelleyEra + -> [TxOut era] + -> TxBody era makeShelleyTransaction TxExtraContent { txMetadata, txWithdrawals, @@ -335,17 +410,23 @@ makeShelleyTransaction TxExtraContent { txUpdateProposal } ttl fee ins outs = --TODO: validate the txins are not empty, and tx out coin values are in range - ShelleyTxBody - (Shelley.TxBody - (Set.fromList (map toShelleyTxIn ins)) - (Seq.fromList (map toShelleyTxOut outs)) - (Seq.fromList (map toShelleyCertificate txCertificates)) - (toShelleyWithdrawal txWithdrawals) - (toShelleyLovelace fee) - ttl - (toShelleyUpdate <$> maybeToStrictMaybe txUpdateProposal) - (toShelleyMetadataHash <$> maybeToStrictMaybe txMetadata)) - (toShelleyMetadata <$> txMetadata) + case shelleyBasedEra :: ShelleyBasedEra era of + ShelleyBasedEraShelley -> + ShelleyTxBody + ShelleyBasedEraShelley + (Shelley.TxBody + (Set.fromList (map toShelleyTxIn ins)) + (Seq.fromList (map toShelleyTxOut outs)) + (Seq.fromList (map toShelleyCertificate txCertificates)) + (toShelleyWithdrawal txWithdrawals) + (toShelleyLovelace fee) + ttl + (toShelleyUpdate <$> maybeToStrictMaybe txUpdateProposal) + (toShelleyMetadataHash <$> maybeToStrictMaybe txMetadata)) + (toShelleyMetadata <$> txMetadata) + ShelleyBasedEraAllegra -> error "TODO: makeShelleyTransaction AllegraEra" + ShelleyBasedEraMary -> error "TODO: makeShelleyTransaction MaryEra" + toShelleyWithdrawal :: [(StakeAddress, Lovelace)] -> Shelley.Wdrl ledgerera toShelleyWithdrawal withdrawals = diff --git a/cardano-api/src/Cardano/Api/Typed.hs b/cardano-api/src/Cardano/Api/Typed.hs index 1fcdb5ccbcf..713073f6294 100644 --- a/cardano-api/src/Cardano/Api/Typed.hs +++ b/cardano-api/src/Cardano/Api/Typed.hs @@ -241,6 +241,7 @@ module Cardano.Api.Typed ( ScriptFeatureInEra(..), SignatureFeature, TimeLocksFeature, + HasScriptFeatures, -- *** Deprecated aliases MultiSigScript, makeMultiSigScript, @@ -467,7 +468,7 @@ import qualified Cardano.Chain.Slotting as Byron -- -- Shelley imports -- -import Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardShelley, StandardMary) +import Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardMary, StandardShelley) import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) import qualified Shelley.Spec.Ledger.Address as Shelley diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index f383e33977b..56dc0184cd1 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs @@ -48,8 +48,8 @@ module Cardano.CLI.Shelley.Commands import Data.Text (Text) import Prelude -import Cardano.Api.Typed hiding (PoolId) import Cardano.Api.Protocol (Protocol) +import Cardano.Api.Typed hiding (PoolId) import Ouroboros.Consensus.BlockchainTime (SystemStart (..)) @@ -100,7 +100,7 @@ data AddressCmd (Maybe (VerificationKeyOrFile StakeKey)) NetworkId (Maybe OutputFile) - | AddressBuildMultiSig ScriptFile NetworkId (Maybe OutputFile) + | AddressBuildMultiSig UseCardanoEra ScriptFile NetworkId (Maybe OutputFile) | AddressInfo Text (Maybe OutputFile) deriving (Eq, Show) @@ -161,6 +161,7 @@ renderKeyCmd cmd = data TransactionCmd = TxBuildRaw + UseCardanoEra [TxIn] [TxOut ShelleyEra] (Maybe String) -- Placeholder for multi asset Values @@ -172,8 +173,8 @@ data TransactionCmd [MetaDataFile] (Maybe UpdateProposalFile) TxBodyFile - | TxSign TxBodyFile [WitnessSigningData] (Maybe NetworkId) TxFile - | TxCreateWitness TxBodyFile WitnessSigningData (Maybe NetworkId) OutputFile + | TxSign UseCardanoEra TxBodyFile [WitnessSigningData] (Maybe NetworkId) TxFile + | TxCreateWitness UseCardanoEra TxBodyFile WitnessSigningData (Maybe NetworkId) OutputFile | TxAssembleTxBodyWitness TxBodyFile [WitnessFile] OutputFile | TxSubmit Protocol NetworkId FilePath | TxMintedPolicyId ScriptFile diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index 1f92b80be4b..47e997d3fa4 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -16,8 +16,8 @@ module Cardano.CLI.Shelley.Parsers import Cardano.Prelude hiding (All, Any, option) import Prelude (String) -import Cardano.Api.Typed hiding (PoolId) import Cardano.Api.Protocol (Protocol (..)) +import Cardano.Api.Typed hiding (PoolId) import Cardano.Chain.Slotting (EpochSlots (..)) import Cardano.CLI.Shelley.Commands @@ -147,7 +147,8 @@ pAddressCmd = pAddressBuildScript :: Parser AddressCmd pAddressBuildScript = AddressBuildMultiSig - <$> pScript + <$> pUseCardanoEra + <*> pScript <*> pNetworkId <*> pMaybeOutputFile @@ -492,7 +493,8 @@ pTransaction = $ Opt.command "sign-witness" assembleInfo <> Opt.internal pTransactionBuild :: Parser TransactionCmd - pTransactionBuild = TxBuildRaw <$> some pTxIn + pTransactionBuild = TxBuildRaw <$> pUseCardanoEra + <*> some pTxIn <*> some pTxOut <*> optional pMint <*> pTxTTL @@ -505,14 +507,16 @@ pTransaction = <*> pTxBodyFile Output pTransactionSign :: Parser TransactionCmd - pTransactionSign = TxSign <$> pTxBodyFile Input + pTransactionSign = TxSign <$> pUseCardanoEra + <*> pTxBodyFile Input <*> pSomeWitnessSigningData <*> optional pNetworkId <*> pTxFile Output pTransactionCreateWitness :: Parser TransactionCmd pTransactionCreateWitness = TxCreateWitness - <$> pTxBodyFile Input + <$> pUseCardanoEra + <*> pTxBodyFile Input <*> pWitnessSigningData <*> optional pNetworkId <*> pOutputFile @@ -1417,6 +1421,26 @@ pTxSubmitFile = <> Opt.completer (Opt.bashCompleter "file") ) +pUseCardanoEra :: Parser UseCardanoEra +pUseCardanoEra = asum + [ Opt.flag' UseByronEra + ( Opt.long "byron-era" + <> Opt.help "Specify the Byron era" + ) + , Opt.flag' UseShelleyEra + ( Opt.long "shelley-era" + <> Opt.help "Specify the Shelley era" + ) + , Opt.flag' UseAllegraEra + ( Opt.long "allegra-era" + <> Opt.help "Specify the Allegra era" + ) + , Opt.flag' UseMaryEra + ( Opt.long "mary-era" + <> Opt.help "Specify the Mary era" + ) + ] + pTxIn :: Parser TxIn pTxIn = Opt.option (readerFromAttoParser parseTxIn) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs index 79c6c75a24e..025cfd4d793 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Cardano.CLI.Shelley.Run.Address ( ShelleyAddressCmdError @@ -15,7 +16,8 @@ import qualified Data.ByteString.Lazy as LB import qualified Data.Text as Text import qualified Data.Text.IO as Text -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, left, newExceptT) +import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, + newExceptT) import Cardano.Api.Typed @@ -56,7 +58,7 @@ runAddressCmd cmd = AddressKeyGen kt vkf skf -> runAddressKeyGen kt vkf skf AddressKeyHash vkf mOFp -> runAddressKeyHash vkf mOFp AddressBuild payVk stkVk nw mOutFp -> runAddressBuild payVk stkVk nw mOutFp - AddressBuildMultiSig sFp nId mOutFp -> runAddressBuildScript sFp nId mOutFp + AddressBuildMultiSig useEra sFp nId mOutFp -> runAddressBuildScript useEra sFp nId mOutFp AddressInfo txt mOFp -> firstExceptT ShelleyAddressCmdAddressInfoError $ runAddressInfo txt mOFp runAddressKeyGen :: AddressKeyType @@ -201,18 +203,41 @@ readAddressVerificationKeyTextOrFile vkTextOrFile = -- runAddressBuildScript - :: ScriptFile + :: UseCardanoEra + -> ScriptFile -> NetworkId -> Maybe OutputFile -> ExceptT ShelleyAddressCmdError IO () -runAddressBuildScript (ScriptFile fp) nId mOutFp = do +runAddressBuildScript useEra (ScriptFile fp) nId mOutFp = do scriptLB <- handleIOExceptT (ShelleyAddressCmdReadFileException . FileIOError fp) $ LB.readFile fp - script <- case eitherDecode scriptLB :: Either String (MultiSigScript ShelleyEra) of - Right mss -> return $ makeMultiSigScript mss - Left err -> left . ShelleyAddressCmdAesonDecodeError fp $ Text.pack err - let payCred = PaymentCredentialByScript $ scriptHash script - scriptAddr = serialiseAddress $ makeShelleyAddress nId payCred NoStakeAddress - case mOutFp of - Just (OutputFile oFp) -> liftIO $ Text.writeFile oFp scriptAddr - Nothing -> liftIO $ Text.putStr scriptAddr + withCardanoEra useEra $ \_era _eraStyle -> + case useEra of + UseByronEra -> liftIO $ putTextLn "Not implemented yet" + UseShelleyEra -> do + aScript :: SimpleScript ShelleyEra <- + firstExceptT (ShelleyAddressCmdAesonDecodeError fp . Text.pack) . hoistEither $ decodeScript scriptLB + mOutput mOutFp $ serialiseScriptAddress nId aScript + UseAllegraEra -> do + aScript :: SimpleScript AllegraEra <- + firstExceptT (ShelleyAddressCmdAesonDecodeError fp . Text.pack) . hoistEither $ decodeScript scriptLB + mOutput mOutFp $ serialiseScriptAddress nId aScript + UseMaryEra -> do + aScript :: SimpleScript MaryEra <- + firstExceptT (ShelleyAddressCmdAesonDecodeError fp . Text.pack) . hoistEither $ decodeScript scriptLB + mOutput mOutFp $ serialiseScriptAddress nId aScript + +serialiseScriptAddress :: HasScriptFeatures era => NetworkId -> SimpleScript era -> Text +serialiseScriptAddress nId s = + let payCred = makePaymentCredential s + in serialiseAddress $ makeShelleyAddress nId payCred NoStakeAddress + +decodeScript :: HasScriptFeatures era => LB.ByteString -> Either String (SimpleScript era) +decodeScript bs = eitherDecode bs + +makePaymentCredential :: HasScriptFeatures era => SimpleScript era -> PaymentCredential +makePaymentCredential s = PaymentCredentialByScript . scriptHash $ SimpleScript s + +mOutput :: Maybe OutputFile -> Text -> ExceptT a IO () +mOutput (Just (OutputFile oFp)) output = liftIO $ Text.writeFile oFp output +mOutput Nothing output = liftIO $ Text.putStr output diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index 07bce8cb14f..adebc24de5f 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -39,9 +39,9 @@ import Cardano.CLI.Shelley.Key (InputDecodeError, readSigningKeyFileAn import Cardano.CLI.Shelley.Parsers import Cardano.CLI.Types -import Cardano.Api.Typed as Api import Cardano.Api.Protocol import Cardano.Api.TxSubmit as Api +import Cardano.Api.Typed as Api data ShelleyTxCmdError = ShelleyTxCmdAesonDecodeProtocolParamsError !FilePath !Text @@ -104,12 +104,12 @@ renderShelleyTxCmdError err = runTransactionCmd :: TransactionCmd -> ExceptT ShelleyTxCmdError IO () runTransactionCmd cmd = case cmd of - TxBuildRaw txins txouts _Values ttl fee certs wdrls + TxBuildRaw era txins txouts _Values ttl fee certs wdrls metadataSchema metadataFiles mUpProp out -> - runTxBuildRaw txins txouts ttl fee certs wdrls + runTxBuildRaw era txins txouts ttl fee certs wdrls metadataSchema metadataFiles mUpProp out - TxSign txinfile skfiles network txoutfile -> - runTxSign txinfile skfiles network txoutfile + TxSign era txinfile skfiles network txoutfile -> + runTxSign era txinfile skfiles network txoutfile TxSubmit protocol network txFp -> runTxSubmit protocol network txFp TxCalculateMinFee txbody mnw pParamsFile nInputs nOutputs @@ -119,14 +119,16 @@ runTransactionCmd cmd = TxGetTxId txinfile -> runTxGetTxId txinfile TxMintedPolicyId sFile -> runTxCreatePolicyId sFile - TxCreateWitness txBodyfile witSignData mbNw outFile -> - runTxCreateWitness txBodyfile witSignData mbNw outFile + TxCreateWitness era txBodyfile witSignData mbNw outFile -> + runTxCreateWitness era txBodyfile witSignData mbNw outFile TxAssembleTxBodyWitness txBodyFile witnessFile outFile -> runTxSignWitness txBodyFile witnessFile outFile runTxBuildRaw - :: [Api.TxIn] - -> [Api.TxOut Api.ShelleyEra] + :: (IsCardanoEra era, IsShelleyBasedEra era) + => UseCardanoEra + -> [Api.TxIn] + -> [Api.TxOut era] -> SlotNo -> Api.Lovelace -> [CertificateFile] @@ -136,12 +138,11 @@ runTxBuildRaw -> Maybe UpdateProposalFile -> TxBodyFile -> ExceptT ShelleyTxCmdError IO () -runTxBuildRaw txins txouts ttl fee +runTxBuildRaw useEra txins txouts ttl fee certFiles withdrawals metadataSchema metadataFiles mUpdatePropFile (TxBodyFile fpath) = do - certs <- sequence [ firstExceptT ShelleyTxCmdReadTextViewFileError . newExceptT $ Api.readFileTextEnvelope Api.AsCertificate certFile @@ -161,29 +162,37 @@ runTxBuildRaw txins txouts ttl fee fmap Just <$> firstExceptT ShelleyTxCmdReadTextViewFileError $ newExceptT $ Api.readFileTextEnvelope Api.AsUpdateProposal file - let txBody = Api.makeShelleyTransaction - Api.txExtraContentEmpty { - Api.txCertificates = certs, - Api.txWithdrawals = withdrawals, - Api.txMetadata = mMetaData, - Api.txUpdateProposal = mUpdateProp - } - ttl - fee - txins - txouts - - firstExceptT ShelleyTxCmdWriteFileError - . newExceptT - $ Api.writeFileTextEnvelope fpath Nothing txBody - - -runTxSign :: TxBodyFile + let shelleyBasedTxBody = Api.makeShelleyTransaction + Api.txExtraContentEmpty + { Api.txCertificates = certs + , Api.txWithdrawals = withdrawals + , Api.txMetadata = mMetaData + , Api.txUpdateProposal = mUpdateProp + } + ttl + fee + txins + txouts + + writeTxBody = firstExceptT ShelleyTxCmdWriteFileError + . newExceptT + $ Api.writeFileTextEnvelope fpath Nothing shelleyBasedTxBody + + withCardanoEra useEra $ \ _era _eraStyle -> + case useEra of + UseByronEra -> liftIO $ putTextLn "Not implemented yet" + UseShelleyEra -> writeTxBody + UseAllegraEra -> writeTxBody + UseMaryEra -> writeTxBody + + +runTxSign :: UseCardanoEra + -> TxBodyFile -> [WitnessSigningData] -> Maybe Api.NetworkId -> TxFile -> ExceptT ShelleyTxCmdError IO () -runTxSign (TxBodyFile txbodyFile) witSigningData mnw (TxFile txFile) = do +runTxSign useEra (TxBodyFile txbodyFile) witSigningData mnw (TxFile txFile) = do txbody <- firstExceptT ShelleyTxCmdReadTextViewFileError . newExceptT $ Api.readFileTextEnvelope Api.AsShelleyTxBody txbodyFile sks <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError $ @@ -202,8 +211,16 @@ runTxSign (TxBodyFile txbodyFile) witSigningData mnw (TxFile txFile) = do shelleyWitnesses = shelleyKeyWitnesses ++ shelleyScriptWitnesses tx = Api.makeSignedTransaction (byronWitnesses ++ shelleyWitnesses) txbody - firstExceptT ShelleyTxCmdWriteFileError . newExceptT $ - Api.writeFileTextEnvelope txFile Nothing tx + writeTx = firstExceptT ShelleyTxCmdWriteFileError . newExceptT $ + Api.writeFileTextEnvelope txFile Nothing tx + + withCardanoEra useEra $ \_era _eraStyle -> + case useEra of + UseByronEra -> liftIO $ putTextLn "Not implemented yet" + UseShelleyEra -> writeTx + UseAllegraEra -> writeTx + UseMaryEra -> writeTx + runTxSubmit :: Protocol -> NetworkId -> FilePath -> ExceptT ShelleyTxCmdError IO () @@ -512,12 +529,13 @@ runTxGetTxId (TxBodyFile txbodyFile) = do liftIO $ BS.putStrLn $ Api.serialiseToRawBytesHex (Api.getTxId txbody) runTxCreateWitness - :: TxBodyFile + :: UseCardanoEra + -> TxBodyFile -> WitnessSigningData -> Maybe NetworkId -> OutputFile -> ExceptT ShelleyTxCmdError IO () -runTxCreateWitness (TxBodyFile txbodyFile) witSignData mbNw (OutputFile oFile) = do +runTxCreateWitness useEra (TxBodyFile txbodyFile) witSignData mbNw (OutputFile oFile) = do txbody <- firstExceptT ShelleyTxCmdReadTextViewFileError . newExceptT $ Api.readFileTextEnvelope Api.AsShelleyTxBody txbodyFile @@ -537,9 +555,16 @@ runTxCreateWitness (TxBodyFile txbodyFile) witSignData mbNw (OutputFile oFile) = AShelleyScriptWitness scShelley -> pure $ makeScriptWitness (makeMultiSigScript scShelley) - firstExceptT ShelleyTxCmdWriteFileError - . newExceptT - $ Api.writeFileTextEnvelope oFile Nothing witness + let writeWitness = firstExceptT ShelleyTxCmdWriteFileError + . newExceptT + $ Api.writeFileTextEnvelope oFile Nothing witness + + withCardanoEra useEra $ \_era _eraStyle -> + case useEra of + UseByronEra -> liftIO $ putTextLn "Not implemented yet" + UseShelleyEra -> writeWitness + UseAllegraEra -> writeWitness + UseMaryEra -> writeWitness runTxSignWitness :: TxBodyFile diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs index 4ae8467272b..4579e60ba5a 100644 --- a/cardano-cli/src/Cardano/CLI/Types.hs +++ b/cardano-cli/src/Cardano/CLI/Types.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE RankNTypes #-} + module Cardano.CLI.Types ( CBORObject (..) @@ -12,7 +14,9 @@ module Cardano.CLI.Types , SocketPath (..) , ScriptFile (..) , UpdateProposalFile (..) + , UseCardanoEra (..) , VerificationKeyFile (..) + , withCardanoEra ) where import Cardano.Prelude @@ -80,3 +84,19 @@ newtype ScriptFile = ScriptFile { unScriptFile :: FilePath } data SigningKeyOrScriptFile = ScriptFileForWitness FilePath | SigningKeyFileForWitness FilePath deriving (Eq, Show) + +data UseCardanoEra = UseByronEra + | UseShelleyEra + | UseAllegraEra + | UseMaryEra + deriving (Eq, Show) + +withCardanoEra + :: UseCardanoEra + -> (forall era. CardanoEra era -> CardanoEraStyle era -> a) + -> a +withCardanoEra UseByronEra f = f ByronEra cardanoEraStyle +withCardanoEra UseShelleyEra f = f ShelleyEra cardanoEraStyle +withCardanoEra UseAllegraEra f = f AllegraEra cardanoEraStyle +withCardanoEra UseMaryEra f = f MaryEra cardanoEraStyle + diff --git a/cardano-cli/test/Test/Cli/Pioneers/Exercise2.hs b/cardano-cli/test/Test/Cli/Pioneers/Exercise2.hs index 8c039294367..cbac5606c0c 100644 --- a/cardano-cli/test/Test/Cli/Pioneers/Exercise2.hs +++ b/cardano-cli/test/Test/Cli/Pioneers/Exercise2.hs @@ -35,6 +35,7 @@ prop_createTransaction = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- Create transaction body void $ execCardanoCLI [ "shelley","transaction", "build-raw" + , "--shelley-era" , "--tx-in", "91999ea21177b33ebe6b8690724a0c026d410a11ad7521caa350abdafa5394c3#0" , "--tx-out", "addr1v9wmu83pzajplrtpsq6tsqdgwr98x888trpmah2u0ezznsge7del3+100000000" , "--fee", "1000000" diff --git a/cardano-cli/test/Test/Golden/Shelley/TextEnvelope/Tx/Tx.hs b/cardano-cli/test/Test/Golden/Shelley/TextEnvelope/Tx/Tx.hs index d689d070a40..65d8c67d664 100644 --- a/cardano-cli/test/Test/Golden/Shelley/TextEnvelope/Tx/Tx.hs +++ b/cardano-cli/test/Test/Golden/Shelley/TextEnvelope/Tx/Tx.hs @@ -38,6 +38,7 @@ golden_shelleyTx = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- Create transaction body void $ execCardanoCLI [ "shelley","transaction", "build-raw" + , "--shelley-era" , "--tx-in", "91999ea21177b33ebe6b8690724a0c026d410a11ad7521caa350abdafa5394c3#0" , "--tx-out", "addr1v9wmu83pzajplrtpsq6tsqdgwr98x888trpmah2u0ezznsge7del3+100000000" , "--fee", "1000000" diff --git a/cardano-cli/test/Test/Golden/Shelley/TextEnvelope/Tx/TxBody.hs b/cardano-cli/test/Test/Golden/Shelley/TextEnvelope/Tx/TxBody.hs index f021d07396a..59f30997315 100644 --- a/cardano-cli/test/Test/Golden/Shelley/TextEnvelope/Tx/TxBody.hs +++ b/cardano-cli/test/Test/Golden/Shelley/TextEnvelope/Tx/TxBody.hs @@ -26,6 +26,7 @@ golden_shelleyTxBody = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- Create transaction body void $ execCardanoCLI [ "shelley","transaction", "build-raw" + , "--shelley-era" , "--tx-in", "91999ea21177b33ebe6b8690724a0c026d410a11ad7521caa350abdafa5394c3#0" , "--tx-out", "addr1v9wmu83pzajplrtpsq6tsqdgwr98x888trpmah2u0ezznsge7del3+100000000" , "--fee", "1000000" diff --git a/cardano-cli/test/Test/Golden/Shelley/Transaction/Build.hs b/cardano-cli/test/Test/Golden/Shelley/Transaction/Build.hs index a4b806e730e..090de8cf7b6 100644 --- a/cardano-cli/test/Test/Golden/Shelley/Transaction/Build.hs +++ b/cardano-cli/test/Test/Golden/Shelley/Transaction/Build.hs @@ -25,6 +25,7 @@ golden_shelleyTransactionBuild = propertyOnce $ H.moduleWorkspace "tmp" $ \tempD void $ execCardanoCLI [ "shelley","transaction","build-raw" + , "--shelley-era" , "--tx-in", txIn , "--tx-out", txOut , "--ttl", "60" diff --git a/cardano-cli/test/Test/Golden/Shelley/Transaction/CreateWitness.hs b/cardano-cli/test/Test/Golden/Shelley/Transaction/CreateWitness.hs index 806b215a217..c996b782c3a 100644 --- a/cardano-cli/test/Test/Golden/Shelley/Transaction/CreateWitness.hs +++ b/cardano-cli/test/Test/Golden/Shelley/Transaction/CreateWitness.hs @@ -31,6 +31,7 @@ golden_shelleyTransactionAllMultiSigWitness = propertyOnce $ H.moduleWorkspace " -- Create tx body file void $ execCardanoCLI [ "shelley","transaction","build-raw" + , "--shelley-era" , "--tx-in", txIn , "--tx-out", txOut , "--ttl", "60" @@ -64,6 +65,7 @@ golden_shelleyTransactionAnyMultiSigWitness = propertyOnce $ H.moduleWorkspace " -- Create tx body file void $ execCardanoCLI [ "shelley","transaction","build-raw" + , "--shelley-era" , "--tx-in", txIn , "--tx-out", txOut , "--ttl", "60" @@ -92,6 +94,7 @@ golden_shelleyTransactionAtLeastMultiSigWitness = propertyOnce $ H.moduleWorkspa -- Create tx body file void $ execCardanoCLI [ "shelley","transaction","build-raw" + , "--shelley-era" , "--tx-in", txIn , "--tx-out", txOut , "--ttl", "60" @@ -120,6 +123,7 @@ golden_shelleyTransactionSigningKeyWitness = propertyOnce $ H.moduleWorkspace "t -- Create tx body file void $ execCardanoCLI [ "shelley","transaction","build-raw" + , "--shelley-era" , "--tx-in", txIn , "--tx-out", txOut , "--ttl", "60" diff --git a/cardano-node-chairman/src/Testnet/ByronShelley.hs b/cardano-node-chairman/src/Testnet/ByronShelley.hs index 57455471067..2c083f796c3 100644 --- a/cardano-node-chairman/src/Testnet/ByronShelley.hs +++ b/cardano-node-chairman/src/Testnet/ByronShelley.hs @@ -516,6 +516,7 @@ testnet H.Conf {..} = do void $ H.execCli [ "shelley", "transaction", "build-raw" + , "--shelley-era" , "--ttl", "1000" , "--fee", "0" , "--tx-in", txIn diff --git a/cardano-node-chairman/src/Testnet/Shelley.hs b/cardano-node-chairman/src/Testnet/Shelley.hs index 3d1cecb2f53..1f40336d0ed 100644 --- a/cardano-node-chairman/src/Testnet/Shelley.hs +++ b/cardano-node-chairman/src/Testnet/Shelley.hs @@ -307,6 +307,7 @@ testnet H.Conf {..} = do void $ H.execCli [ "shelley", "transaction", "build-raw" + , "--shelley-era" , "--ttl", "1000" , "--fee", "0" , "--tx-in", genesisTxinResult