Skip to content

Add More WalletAPIError Types #141

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.

Sign up for GitHub

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

Merged
mikekeke merged 6 commits into from
Aug 25, 2022
Merged

Add More WalletAPIError Types #141

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
49da0a5
Add `WalletAPIError` Types
MitchyCola Aug 14, 2022
3dc9936
Error message for missing tx-out value
MitchyCola Aug 15, 2022
5a81d08
Apply Formatting
MitchyCola Aug 15, 2022
c070f79
Fix from hlint
MitchyCola Aug 15, 2022
07d2597
Move isZero TxOut Check
MitchyCola Aug 23, 2022
39eed0b
Copy Empty TxOut Check
MitchyCola Aug 24, 2022
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
56 changes: 29 additions & 27 deletions src/BotPlutusInterface/Balance.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ import Cardano.Api.Shelley (ProtocolParameters (protocolParamPrices))
import Control.Monad (foldM, void, zipWithM)
import Control.Monad.Freer (Eff, Member)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Either (EitherT, hoistEither, newEitherT, runEitherT)
import Control.Monad.Trans.Either (EitherT, firstEitherT, hoistEither, newEitherT, runEitherT)
import Control.Monad.Trans.Except (throwE)
import Data.Bifunctor (bimap)
import Data.Coerce (coerce)
Expand All @@ -52,12 +52,10 @@ import Data.Text qualified as Text
import GHC.Real (Ratio ((:%)))
import Ledger qualified
import Ledger.Ada qualified as Ada
import Ledger.Address (Address (..))
import Ledger.Address (Address (..), PaymentPubKeyHash (PaymentPubKeyHash))
import Ledger.Constraints.OffChain (UnbalancedTx (..))
import Ledger.Crypto (PubKeyHash)
import Ledger.Interval (
Extended (Finite, NegInf, PosInf),
Interval (Interval),
LowerBound (LowerBound),
UpperBound (UpperBound),
)
Expand All @@ -71,13 +69,15 @@ import Ledger.Tx (
TxOutRef (..),
)
import Ledger.Tx qualified as Tx
import Ledger.Tx.CardanoAPI (ToCardanoError (InvalidValidityRange))
import Ledger.Value (Value)
import Ledger.Value qualified as Value
import Plutus.V1.Ledger.Api (
CurrencySymbol (..),
TokenName (..),
)
import Prettyprinter (pretty, viaShow, (<+>))
import Wallet.API as WAPI
import Prelude

-- Config for balancing a `Tx`.
Expand All @@ -101,7 +101,7 @@ balanceTxIO ::
PABConfig ->
PubKeyHash ->
UnbalancedTx ->
Eff effs (Either Text Tx)
Eff effs (Either WAPI.WalletAPIError Tx)
balanceTxIO = balanceTxIO' @w defaultBalanceConfig

-- | `balanceTxIO'` is more flexible version of `balanceTxIO`, this let us specify custom `BalanceConfig`.
Expand All @@ -112,12 +112,12 @@ balanceTxIO' ::
PABConfig ->
PubKeyHash ->
UnbalancedTx ->
Eff effs (Either Text Tx)
Eff effs (Either WAPI.WalletAPIError Tx)
balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
runEitherT $
do
(utxos, mcollateral) <- newEitherT $ utxosAndCollateralAtAddress @w balanceCfg pabConf changeAddr
privKeys <- newEitherT $ Files.readPrivateKeys @w pabConf
privKeys <- firstEitherT WAPI.OtherError $ newEitherT $ Files.readPrivateKeys @w pabConf

let utxoIndex :: Map TxOutRef TxOut
utxoIndex = fmap Tx.toTxOut utxos <> unBalancedTxUtxoIndex unbalancedTx
Expand All @@ -142,7 +142,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
if bcHasScripts balanceCfg
then
maybe
(throwE "Tx uses script but no collateral was provided.")
(throwE $ WAPI.OtherError "Tx uses script but no collateral was provided.")
(hoistEither . addSignatories ownPkh privKeys requiredSigs . flip addTxCollaterals tx)
mcollateral
else hoistEither $ addSignatories ownPkh privKeys requiredSigs tx
Expand Down Expand Up @@ -189,12 +189,13 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
Map PubKeyHash DummyPrivKey ->
[(TxOut, Integer)] ->
Tx ->
EitherT Text (Eff effs) (Tx, [(TxOut, Integer)])
EitherT WAPI.WalletAPIError (Eff effs) (Tx, [(TxOut, Integer)])
balanceTxLoop utxoIndex privKeys prevMinUtxos tx = do
void $ lift $ Files.writeAll @w pabConf tx
nextMinUtxos <-
newEitherT $
calculateMinUtxos @w pabConf (Tx.txData tx) $ Tx.txOutputs tx \\ map fst prevMinUtxos
firstEitherT WAPI.OtherError $
newEitherT $
calculateMinUtxos @w pabConf (Tx.txData tx) $ Tx.txOutputs tx \\ map fst prevMinUtxos

let minUtxos = prevMinUtxos ++ nextMinUtxos

Expand All @@ -204,9 +205,9 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
txWithoutFees <-
newEitherT $ balanceTxStep @w balanceCfg minUtxos utxoIndex changeAddr $ tx `withFee` 0

exBudget <- newEitherT $ BodyBuilder.buildAndEstimateBudget @w pabConf privKeys txWithoutFees
exBudget <- firstEitherT WAPI.OtherError $ newEitherT $ BodyBuilder.buildAndEstimateBudget @w pabConf privKeys txWithoutFees

nonBudgettedFees <- newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees
nonBudgettedFees <- firstEitherT WAPI.OtherError $ newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees

let fees = nonBudgettedFees + getBudgetPrice (getExecutionUnitPrices pabConf) exBudget

Expand All @@ -227,10 +228,10 @@ utxosAndCollateralAtAddress ::
BalanceConfig ->
PABConfig ->
Address ->
Eff effs (Either Text (Map TxOutRef Tx.ChainIndexTxOut, Maybe CollateralUtxo))
Eff effs (Either WAPI.WalletAPIError (Map TxOutRef Tx.ChainIndexTxOut, Maybe CollateralUtxo))
utxosAndCollateralAtAddress balanceCfg pabConf changeAddr =
runEitherT $ do
utxos <- newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr
utxos <- firstEitherT WAPI.OtherError $ newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr
inMemCollateral <- lift $ getInMemCollateral @w

-- check if `bcHasScripts` is true, if this is the case then we search of
Expand All @@ -239,8 +240,9 @@ utxosAndCollateralAtAddress balanceCfg pabConf changeAddr =
then
maybe
( throwE $
"The given transaction uses script, but there's no collateral provided."
<> "This usually means that, we failed to create Tx and update our ContractEnvironment."
WAPI.OtherError $
"The given transaction uses script, but there's no collateral provided."
<> "This usually means that, we failed to create Tx and update our ContractEnvironment."
)
(const $ pure (removeCollateralFromMap inMemCollateral utxos, inMemCollateral))
inMemCollateral
Expand Down Expand Up @@ -288,7 +290,7 @@ balanceTxStep ::
Map TxOutRef TxOut ->
Address ->
Tx ->
Eff effs (Either Text Tx)
Eff effs (Either WAPI.WalletAPIError Tx)
balanceTxStep balanceCfg minUtxos utxos changeAddr tx =
runEitherT $
(newEitherT . balanceTxIns @w utxos) (addLovelaces minUtxos tx)
Expand Down Expand Up @@ -336,7 +338,7 @@ balanceTxIns ::
Member (PABEffect w) effs =>
Map TxOutRef TxOut ->
Tx ->
Eff effs (Either Text Tx)
Eff effs (Either WAPI.WalletAPIError Tx)
balanceTxIns utxos tx = do
runEitherT $ do
let txOuts = Tx.txOutputs tx
Expand All @@ -346,7 +348,7 @@ balanceTxIns utxos tx = do
[ txFee tx
, nonMintedValue
]
txIns <- newEitherT $ selectTxIns @w (txInputs tx) utxos minSpending
txIns <- firstEitherT WAPI.OtherError $ newEitherT $ selectTxIns @w (txInputs tx) utxos minSpending
pure $ tx {txInputs = txIns <> txInputs tx}

-- | Set collateral or fail in case it's required but not available
Expand All @@ -363,7 +365,7 @@ txUsesScripts Tx {txInputs, txMintScripts} =
(Set.toList txInputs)

-- | Ensures all non ada change goes back to user
handleNonAdaChange :: BalanceConfig -> Address -> Map TxOutRef TxOut -> Tx -> Either Text Tx
handleNonAdaChange :: BalanceConfig -> Address -> Map TxOutRef TxOut -> Tx -> Either WAPI.WalletAPIError Tx
handleNonAdaChange balanceCfg changeAddr utxos tx =
let nonAdaChange = getNonAdaChange utxos tx
predicate =
Expand All @@ -387,7 +389,7 @@ handleNonAdaChange balanceCfg changeAddr utxos tx =
(txOutputs tx)
in if isValueNat nonAdaChange
then Right $ if Value.isZero nonAdaChange then tx else tx {txOutputs = outputs}
else Left "Not enough inputs to balance tokens."
else Left $ WAPI.InsufficientFunds "Not enough inputs to balance tokens."

{- | `addAdaChange` checks if `bcSeparateChange` is true,
if it is then we add the ada change to seperate `TxOut` at changeAddr that contains only ada,
Expand Down Expand Up @@ -431,13 +433,13 @@ addOutput changeAddr tx = tx {txOutputs = txOutputs tx ++ [changeTxOut]}
{- | Add the required signatories to the transaction. Be aware the the signature itself is invalid,
and will be ignored. Only the pub key hashes are used, mapped to signing key files on disk.
-}
addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either Text Tx
addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either WAPI.WalletAPIError Tx
addSignatories ownPkh privKeys pkhs tx =
foldM
( \tx' pkh ->
case Map.lookup pkh privKeys of
Just privKey -> Right $ Tx.addSignature' (unDummyPrivateKey privKey) tx'
Nothing -> Left "Signing key not found."
Nothing -> Left $ WAPI.PaymentPrivateKeyNotFound $ PaymentPubKeyHash pkh
)
tx
(ownPkh : pkhs)
Expand All @@ -447,13 +449,13 @@ addValidRange ::
Member (PABEffect w) effs =>
POSIXTimeRange ->
Tx ->
Eff effs (Either Text Tx)
Eff effs (Either WAPI.WalletAPIError Tx)
addValidRange timeRange tx =
if validateRange timeRange
then
bimap (Text.pack . show) (setRange tx)
bimap (WAPI.OtherError . Text.pack . show) (setRange tx)
<$> posixTimeRangeToContainedSlotRange @w timeRange
else pure $ Left "Invalid validity interval."
else pure $ Left $ WAPI.ToCardanoError InvalidValidityRange
where
setRange tx' range = tx' {txValidRange = range}

Expand Down
135 changes: 75 additions & 60 deletions src/BotPlutusInterface/CardanoCLI.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -142,19 +142,24 @@ calculateMinUtxo ::
Map DatumHash Datum ->
TxOut ->
Eff effs (Either Text Integer)
calculateMinUtxo pabConf datums txOut =
join
<$> callCommand @w
ShellArgs
{ cmdName = "cardano-cli"
, cmdArgs =
mconcat
[ ["transaction", "calculate-min-required-utxo", "--alonzo-era"]
, txOutOpts pabConf datums [txOut]
, ["--protocol-params-file", pabConf.pcProtocolParamsFile]
]
, cmdOutParser = mapLeft Text.pack . parseOnly UtxoParser.feeParser . Text.pack
}
calculateMinUtxo pabConf datums txOut = do
let outs = txOutOpts pabConf datums [txOut]

case outs of
[] -> pure $ Left "When constructing the transaction, no output values were specified."
Copy link
Contributor

@mikekeke mikekeke Aug 17, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think this check should also be in buildTx.
Additional thing to consider, is that there will be no calculateMinUtxo in Vasil compliant version, so check here will be no more and build-raw in buildTx will start to fail.

Copy link
Contributor

@IAmPara0x IAmPara0x Aug 17, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Currently, the check for empty list is redundant because, when we call calculateMinUtxo from calculateMinUtxos (present in Balance.hs) there's always some value present in the txOut. But it nevertheless make sense to handle this case, in case anyone tries to call calculateMinUtxo where the txOutValue is not always non-zero. But after vasil compliance of BPI this function would be redundant, and so would be the need to check for if txOutValue is non-zero.

Copy link
Contributor

@mikekeke mikekeke Aug 18, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@IAmPara0x

Currently, the check for empty list is redundant because, when we call calculateMinUtxo from calculateMinUtxos (present in Balance.hs) there's always some value present in the txOut.

Why does it always have some value there? Because of minimum Ada adjustment?

Copy link
Contributor

@IAmPara0x IAmPara0x Aug 18, 2022 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We need to call calculateMinUtxo when we want to get minimum amount of lovelace that should be present in a TxOut of a Tx, this is required during balancing. But, if there's a TxOut with zero value then we don't need to consider it as an actual output to a Tx, hence don't need to call calculateMinUtxo.

Copy link
Contributor Author

@MitchyCola MitchyCola Aug 18, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I do agree that this check should be moved to buildTx.

@IAmPara0x This check was added for the specific case in which a transaction would only contain a zero Value as the output. Which would result in an empty list from the changes that I made here:

txOutOpts :: PABConfig -> Map DatumHash Datum -> [TxOut] -> [Text]
 txOutOpts pabConf datums =
   concatMap
     ( \TxOut {txOutAddress, txOutValue, txOutDatumHash} ->
         if Value.isZero txOutValue
           then []
           else

Copy link
Contributor

@IAmPara0x IAmPara0x Aug 18, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@MitchyCola oh, I get it now. Thanks for pointing it out!.

Copy link
Contributor Author

@MitchyCola MitchyCola Aug 23, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Since the error is originating from the use of calculateMinUtxos inside of balanceTxLoop (in Balance.hs), the error gets thrown before the use of buildTx. Therefore, I decided to move the check into preBalancedTx.

Copy link
Contributor

@mikekeke mikekeke Aug 24, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What if just put check in both calculateMinUtxos and buildTx? It will keep this commit in working state, and vasil update will just remove calculateMinUtxos.

It feels like omitting check that result of txOutOpts can return [] will shoot one day.

Copy link
Contributor Author

@MitchyCola MitchyCola Aug 24, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Fixed

_ ->
join
<$> callCommand @w
ShellArgs
{ cmdName = "cardano-cli"
, cmdArgs =
mconcat
[ ["transaction", "calculate-min-required-utxo", "--alonzo-era"]
, outs
, ["--protocol-params-file", pabConf.pcProtocolParamsFile]
]
, cmdOutParser = mapLeft Text.pack . parseOnly UtxoParser.feeParser . Text.pack
}

-- | Calculating fee for an unbalanced transaction
calculateMinFee ::
Expand Down Expand Up @@ -191,39 +196,46 @@ buildTx ::
Tx ->
Eff effs (Either Text ExBudget)
buildTx pabConf privKeys txBudget tx = do
let (ins, valBudget) = txInOpts (spendBudgets txBudget) pabConf (txInputs tx)
(mints, mintBudget) = mintOpts (mintBudgets txBudget) pabConf (txMintScripts tx) (txRedeemers tx) (txMint tx)
callCommand @w $ ShellArgs "cardano-cli" (opts ins mints) (const $ valBudget <> mintBudget)
where
requiredSigners =
concatMap
( \pubKey ->
let pkh = Ledger.pubKeyHash pubKey
in case Map.lookup pkh privKeys of
Just (FromSKey _) ->
["--required-signer", signingKeyFilePath pabConf pkh]
Just (FromVKey _) ->
["--required-signer-hash", encodeByteString $ fromBuiltin $ getPubKeyHash pkh]
Nothing ->
[]
)
(Map.keys (Ledger.txSignatures tx))
opts ins mints =
mconcat
[ ["transaction", "build-raw", "--alonzo-era"]
, ins
, txInCollateralOpts (txCollateral tx)
, txOutOpts pabConf (txData tx) (txOutputs tx)
, mints
, validRangeOpts (txValidRange tx)
, metadataOpts pabConf (txMetadata tx)
, requiredSigners
, ["--fee", showText . getLovelace . fromValue $ txFee tx]
, mconcat
[ ["--protocol-params-file", pabConf.pcProtocolParamsFile]
, ["--out-file", txFilePath pabConf "raw" (txId tx)]
let outs = txOutOpts pabConf (txData tx) (txOutputs tx)

case outs of
[] -> pure $ Left "When constructing the transaction, no output values were specified."
_ ->
callCommand @w $ ShellArgs "cardano-cli" opts (const $ valBudget <> mintBudget)
where
(ins, valBudget) = txInOpts (spendBudgets txBudget) pabConf (txInputs tx)
(mints, mintBudget) = mintOpts (mintBudgets txBudget) pabConf (txMintScripts tx) (txRedeemers tx) (txMint tx)

requiredSigners =
concatMap
( \pubKey ->
let pkh = Ledger.pubKeyHash pubKey
in case Map.lookup pkh privKeys of
Just (FromSKey _) ->
["--required-signer", signingKeyFilePath pabConf pkh]
Just (FromVKey _) ->
["--required-signer-hash", encodeByteString $ fromBuiltin $ getPubKeyHash pkh]
Nothing ->
[]
)
(Map.keys (Ledger.txSignatures tx))

opts =
mconcat
[ ["transaction", "build-raw", "--alonzo-era"]
, ins
, txInCollateralOpts (txCollateral tx)
, outs
, mints
, validRangeOpts (txValidRange tx)
, metadataOpts pabConf (txMetadata tx)
, requiredSigners
, ["--fee", showText . getLovelace . fromValue $ txFee tx]
, mconcat
[ ["--protocol-params-file", pabConf.pcProtocolParamsFile]
, ["--out-file", txFilePath pabConf "raw" (txId tx)]
]
]
]

-- Signs and writes a tx (uses the tx body written to disk as input)
signTx ::
Expand Down Expand Up @@ -366,22 +378,25 @@ txOutOpts :: PABConfig -> Map DatumHash Datum -> [TxOut] -> [Text]
txOutOpts pabConf datums =
concatMap
( \TxOut {txOutAddress, txOutValue, txOutDatumHash} ->
mconcat
[
[ "--tx-out"
, Text.intercalate
"+"
[ unsafeSerialiseAddress pabConf.pcNetwork txOutAddress
, valueToCliArg txOutValue
if Value.isZero txOutValue
then []
else
mconcat
[
[ "--tx-out"
, Text.intercalate
"+"
[ unsafeSerialiseAddress pabConf.pcNetwork txOutAddress
, valueToCliArg txOutValue
]
]
]
, case txOutDatumHash of
Nothing -> []
Just datumHash@(DatumHash dh) ->
if Map.member datumHash datums
then ["--tx-out-datum-embed-file", datumJsonFilePath pabConf datumHash]
else ["--tx-out-datum-hash", encodeByteString $ fromBuiltin dh]
]
, case txOutDatumHash of
Nothing -> []
Just datumHash@(DatumHash dh) ->
if Map.member datumHash datums
then ["--tx-out-datum-embed-file", datumJsonFilePath pabConf datumHash]
else ["--tx-out-datum-hash", encodeByteString $ fromBuiltin dh]
]
)

networkOpt :: PABConfig -> [Text]
Expand Down
Loading