diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index a511698f793..972a9eb9686 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -84,6 +84,7 @@ module Cardano.Api ( -- ** Addresses in specific eras AddressInEra(..), + isKeyAddress, AddressTypeInEra(..), byronAddressInEra, shelleyAddressInEra, diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index 9bc7dba719e..84520e75cdc 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -60,7 +60,10 @@ module Cardano.Api.Address ( -- * Data family instances AsType(AsByronAddr, AsShelleyAddr, AsByronAddress, AsShelleyAddress, - AsAddress, AsAddressAny, AsAddressInEra, AsStakeAddress) + AsAddress, AsAddressAny, AsAddressInEra, AsStakeAddress), + + -- * Helpers + isKeyAddress ) where import Prelude @@ -74,8 +77,8 @@ import qualified Data.Text.Encoding as Text import Control.Applicative import Cardano.Api.Eras -import Cardano.Api.Hash import Cardano.Api.HasTypeProxy +import Cardano.Api.Hash import Cardano.Api.Key import Cardano.Api.KeysByron import Cardano.Api.KeysShelley @@ -483,6 +486,18 @@ makeStakeAddress nw sc = (toShelleyNetwork nw) (toShelleyStakeCredential sc) +-- ---------------------------------------------------------------------------- +-- Helpers +-- + +-- | Is the UTxO at the address only spendable via a key witness. +isKeyAddress :: AddressInEra era -> Bool +isKeyAddress (AddressInEra ByronAddressInAnyEra _) = True +isKeyAddress (AddressInEra (ShelleyAddressInEra _) (ShelleyAddress _ pCred _)) = + case fromShelleyPaymentCredential pCred of + PaymentCredentialByKey _ -> True + PaymentCredentialByScript _ -> False + -- ---------------------------------------------------------------------------- -- Internal conversion functions diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs index c12a4336844..13b3cd4709f 100644 --- a/cardano-api/src/Cardano/Api/Query.hs +++ b/cardano-api/src/Cardano/Api/Query.hs @@ -75,14 +75,14 @@ import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry import Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime, SlotLength) import qualified Ouroboros.Consensus.Byron.Ledger as Consensus -import Ouroboros.Consensus.Cardano.Block (StandardCrypto, LedgerState(..)) +import Ouroboros.Consensus.Cardano.Block (LedgerState (..), StandardCrypto) import qualified Ouroboros.Consensus.Cardano.Block as Consensus import qualified Ouroboros.Consensus.Ledger.Query as Consensus import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus import Ouroboros.Network.Block (Serialised) import Cardano.Binary -import Cardano.Slotting.Time (SystemStart(..)) +import Cardano.Slotting.Time (SystemStart (..)) import qualified Cardano.Chain.Update.Validation.Interface as Byron.Update import qualified Cardano.Ledger.Core as Core @@ -684,3 +684,4 @@ fromConsensusQueryResultMismatch = fromConsensusEraMismatch :: SListI xs => Consensus.MismatchEraInfo xs -> EraMismatch fromConsensusEraMismatch = Consensus.mkEraMismatch + diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index 9d01bea2cbf..c07ee644619 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -19,6 +19,7 @@ import Prelude (String, error) import qualified Data.Aeson as Aeson import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS +import Data.List (intersect, (\\)) import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as Text @@ -112,6 +113,8 @@ data ShelleyTxCmdError | ShelleyTxCmdEraConsensusModeMismatchQuery !AnyConsensusMode !AnyCardanoEra | ShelleyTxCmdByronEraQuery | ShelleyTxCmdLocalStateQueryError !ShelleyQueryCmdLocalStateQueryError + | ShelleyTxCmdExpectedKeyLockedTxIn ![TxIn] + | ShelleyTxCmdTxInsDoNotExist ![TxIn] deriving Show @@ -233,6 +236,14 @@ renderShelleyTxCmdError err = ShelleyTxCmdByronEraQuery -> "Query not available in Byron era" ShelleyTxCmdLocalStateQueryError err' -> renderLocalStateQueryError err' ShelleyTxCmdBalanceTxBody err' -> Text.pack $ displayError err' + ShelleyTxCmdExpectedKeyLockedTxIn txins -> + "Expected key witnessed collateral tx inputs but got script witnessed tx inputs: " <> + Text.singleton '\n' <> + Text.intercalate (Text.singleton '\n') (map renderTxIn txins) + ShelleyTxCmdTxInsDoNotExist txins -> + "The following tx input(s) were not present in the UTxO: " <> + Text.singleton '\n' <> + Text.intercalate (Text.singleton '\n') (map renderTxIn txins) renderEra :: AnyCardanoEra -> Text renderEra (AnyCardanoEra ByronEra) = "Byron" @@ -407,6 +418,7 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS consensusMode = consensusModeOnly cModeParams dummyFee = Just $ Lovelace 0 onlyInputs = [input | (input,_) <- txins] + case (consensusMode, cardanoEraStyle era) of (CardanoMode, ShelleyBasedEra sbe) -> do txBodyContent <- @@ -441,10 +453,22 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS left (ShelleyTxCmdEraConsensusModeMismatchTxBalance outBody (AnyConsensusMode CardanoMode) (AnyCardanoEra era)) - let utxoQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe + let collateralUTxOQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe + (QueryUTxO . QueryUTxOByTxIn $ Set.fromList txinsc) + utxoQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe (QueryUTxO . QueryUTxOByTxIn $ Set.fromList onlyInputs) - let pParamsQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryProtocolParameters + pParamsQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryProtocolParameters + + if null txinsc + then return () + else do + collateralUtxo <- executeQuery era cModeParams localConnInfo collateralUTxOQuery + txinsExist txinsc collateralUtxo + notScriptLockedTxIns collateralUtxo + utxo <- executeQuery era cModeParams localConnInfo utxoQuery + txinsExist onlyInputs utxo + pparams <- executeQuery era cModeParams localConnInfo pParamsQuery (eraHistory, systemStart) <- firstExceptT ShelleyTxCmdAcquireFailure $ newExceptT $ queryEraHistoryAndSystemStart localNodeConnInfo Nothing @@ -468,6 +492,24 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS (CardanoMode, LegacyByronEra) -> left ShelleyTxCmdByronEra (wrongMode, _) -> left (ShelleyTxCmdUnsupportedMode (AnyConsensusMode wrongMode)) + where + txinsExist :: [TxIn] -> UTxO era -> ExceptT ShelleyTxCmdError IO () + txinsExist ins (UTxO utxo) + | null utxo = left $ ShelleyTxCmdTxInsDoNotExist ins + | otherwise = do + let utxoIns = Map.keys utxo + occursInUtxo = [ txin | txin <- ins, txin `elem` utxoIns ] + if length occursInUtxo == length ins + then return () + else left . ShelleyTxCmdTxInsDoNotExist $ ins \\ ins `intersect` occursInUtxo + + notScriptLockedTxIns :: UTxO era -> ExceptT ShelleyTxCmdError IO () + notScriptLockedTxIns (UTxO utxo) = do + let scriptLockedTxIns = + filter (\(_, TxOut aInEra _ _) -> not $ isKeyAddress aInEra ) $ Map.assocs utxo + if null scriptLockedTxIns + then return () + else left . ShelleyTxCmdExpectedKeyLockedTxIn $ map fst scriptLockedTxIns queryEraHistoryAndSystemStart :: LocalNodeConnectInfo CardanoMode