Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update error message for incorrectly witnessed collateral inputs #4484

Merged
merged 2 commits into from
Sep 29, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -694,7 +694,7 @@ module Cardano.Api (
getIsCardanoEraConstraint,

-- ** Misc
NotScriptLockedTxInsError(..),
ScriptLockedTxInsError(..),
TxInsExistError(..),
renderNotScriptLockedTxInsError,
renderTxInsExistError,
Expand Down
15 changes: 8 additions & 7 deletions cardano-api/src/Cardano/Api/Convenience/Construction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ module Cardano.Api.Convenience.Construction (

-- * Misc
TxInsExistError(..),
NotScriptLockedTxInsError(..),
ScriptLockedTxInsError(..),
notScriptLockedTxIns,
renderNotScriptLockedTxInsError,
renderTxInsExistError,
Expand Down Expand Up @@ -84,19 +84,20 @@ txInsExistInUTxO ins (UTxO utxo)
then return ()
else Left . TxInsDoNotExist $ ins List.\\ occursInUtxo

newtype NotScriptLockedTxInsError = NotScriptLockedTxIns [TxIn]
newtype ScriptLockedTxInsError = ScriptLockedTxIns [TxIn]

renderNotScriptLockedTxInsError :: NotScriptLockedTxInsError -> Text
renderNotScriptLockedTxInsError (NotScriptLockedTxIns txins) =
"The followings tx inputs are not script locked: " <> textShow (map renderTxIn txins)
renderNotScriptLockedTxInsError :: ScriptLockedTxInsError -> Text
renderNotScriptLockedTxInsError (ScriptLockedTxIns txins) =
"The followings tx inputs were expected to be key witnessed but are actually script witnessed: " <>
textShow (map renderTxIn txins)

notScriptLockedTxIns :: [TxIn] -> UTxO era -> Either NotScriptLockedTxInsError ()
notScriptLockedTxIns :: [TxIn] -> UTxO era -> Either ScriptLockedTxInsError ()
notScriptLockedTxIns collTxIns (UTxO utxo) = do
let onlyCollateralUTxOs = Map.restrictKeys utxo $ Set.fromList collTxIns
scriptLockedTxIns =
filter (\(_, TxOut aInEra _ _ _) -> not $ isKeyAddress aInEra ) $ Map.assocs onlyCollateralUTxOs
if null scriptLockedTxIns
then return ()
else Left . NotScriptLockedTxIns $ map fst scriptLockedTxIns
else Left . ScriptLockedTxIns $ map fst scriptLockedTxIns


38 changes: 29 additions & 9 deletions cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -110,7 +110,7 @@ data ShelleyTxCmdError
| ShelleyTxCmdPParamExecutionUnitsNotAvailable
| ShelleyTxCmdTxEraCastErr EraCastError
| ShelleyTxCmdQueryConvenienceError !QueryConvenienceError
| ShelleyTxCmdQueryNotScriptLocked !NotScriptLockedTxInsError
| ShelleyTxCmdQueryNotScriptLocked !ScriptLockedTxInsError

renderShelleyTxCmdError :: ShelleyTxCmdError -> Text
renderShelleyTxCmdError err =
Expand Down Expand Up @@ -501,33 +501,53 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS
validatedTxUpProp
validatedMintValue
validatedTxScriptValidity

eInMode <- case toEraInMode era CardanoMode of
Just result -> return result
Nothing ->
left (ShelleyTxCmdEraConsensusModeMismatchTxBalance outputOptions
(AnyConsensusMode CardanoMode) (AnyCardanoEra era))

let allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc
SocketPath sockPath <- firstExceptT ShelleyTxCmdSocketEnvError
$ newExceptT readEnvSocketPath

(utxo, pparams, eraHistory, systemStart, stakePools) <-
let allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc
localNodeConnInfo = LocalNodeConnectInfo
{ localConsensusModeParams = CardanoModeParams $ EpochSlots 21600
, localNodeNetworkId = networkId
, localNodeSocketPath = sockPath
}
AnyCardanoEra nodeEra
<- firstExceptT (ShelleyTxCmdQueryConvenienceError . AcqFailure)
. newExceptT $ determineEra cModeParams localNodeConnInfo

(nodeEraUTxO, pparams, eraHistory, systemStart, stakePools) <-
firstExceptT ShelleyTxCmdQueryConvenienceError . newExceptT
$ queryStateForBalancedTx era networkId allTxInputs
$ queryStateForBalancedTx nodeEra networkId allTxInputs

firstExceptT ShelleyTxCmdTxInsDoNotExist
. hoistEither $ txInsExistInUTxO allTxInputs utxo
. hoistEither $ txInsExistInUTxO allTxInputs nodeEraUTxO
firstExceptT ShelleyTxCmdQueryNotScriptLocked
. hoistEither $ notScriptLockedTxIns txinsc utxo
. hoistEither $ notScriptLockedTxIns txinsc nodeEraUTxO

let cAddr = case anyAddressInEra era changeAddr of
Just addr -> addr
Nothing -> error $ "runTxBuild: Byron address used: " <> show changeAddr

-- Why do we cast the era? The user can specify an era prior to the era that the node is currently in.
-- We cannot use the user specified era to construct a query against a node because it may differ
-- from the node's era and this will result in the 'QueryEraMismatch' failure.
txEraUtxo <- case first ShelleyTxCmdTxEraCastErr (eraCast era nodeEraUTxO) of
Right txEraUtxo -> return txEraUtxo
Left e -> left e

(BalancedTxBody balancedTxBody _ fee) <-
firstExceptT ShelleyTxCmdBalanceTxBody
. hoistEither
$ makeTransactionBodyAutoBalance eInMode systemStart eraHistory
pparams stakePools utxo txBodyContent
pparams stakePools txEraUtxo txBodyContent
cAddr mOverrideWits

putStrLn $ "Estimated transaction fee: " <> (show fee :: String)

case outputOptions of
Expand All @@ -537,10 +557,10 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS
scriptExecUnitsMap <- firstExceptT ShelleyTxCmdTxExecUnitsErr $ hoistEither
$ evaluateTransactionExecutionUnits
eInMode systemStart eraHistory
pparams utxo balancedTxBody
pparams txEraUtxo balancedTxBody
scriptCostOutput <- firstExceptT ShelleyTxCmdPlutusScriptCostErr $ hoistEither
$ renderScriptCosts
utxo
txEraUtxo
executionUnitPrices
(collectTxBodyScriptWitnesses txBodyContent)
scriptExecUnitsMap
Expand Down