Skip to content

Commit 11db995

Browse files
mikekekemikekeke
authored
Merge pull request #141 from mlabs-haskell/mitch/error-messages
Add More `WalletAPIError` Types
2 parents f93927c + 39eed0b commit 11db995

File tree

3 files changed

+116
-98
lines changed

3 files changed

+116
-98
lines changed

‎src/BotPlutusInterface/Balance.hs

Lines changed: 29 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ import Cardano.Api.Shelley (ProtocolParameters (protocolParamPrices))
3636
import Control.Monad (foldM, void, zipWithM)
3737
import Control.Monad.Freer (Eff, Member)
3838
import Control.Monad.Trans.Class (lift)
39-
import Control.Monad.Trans.Either (EitherT, hoistEither, newEitherT, runEitherT)
39+
import Control.Monad.Trans.Either (EitherT, firstEitherT, hoistEither, newEitherT, runEitherT)
4040
import Control.Monad.Trans.Except (throwE)
4141
import Data.Bifunctor (bimap)
4242
import Data.Coerce (coerce)
@@ -52,12 +52,10 @@ import Data.Text qualified as Text
5252
import GHC.Real (Ratio ((:%)))
5353
import Ledger qualified
5454
import Ledger.Ada qualified as Ada
55-
import Ledger.Address (Address (..))
55+
import Ledger.Address (Address (..), PaymentPubKeyHash (PaymentPubKeyHash))
5656
import Ledger.Constraints.OffChain (UnbalancedTx (..))
57-
import Ledger.Crypto (PubKeyHash)
5857
import Ledger.Interval (
5958
Extended (Finite, NegInf, PosInf),
60-
Interval (Interval),
6159
LowerBound (LowerBound),
6260
UpperBound (UpperBound),
6361
)
@@ -71,13 +69,15 @@ import Ledger.Tx (
7169
TxOutRef (..),
7270
)
7371
import Ledger.Tx qualified as Tx
72+
import Ledger.Tx.CardanoAPI (ToCardanoError (InvalidValidityRange))
7473
import Ledger.Value (Value)
7574
import Ledger.Value qualified as Value
7675
import Plutus.V1.Ledger.Api (
7776
CurrencySymbol (..),
7877
TokenName (..),
7978
)
8079
import Prettyprinter (pretty, viaShow, (<+>))
80+
import Wallet.API as WAPI
8181
import Prelude
8282

8383
-- Config for balancing a `Tx`.
@@ -101,7 +101,7 @@ balanceTxIO ::
101101
PABConfig ->
102102
PubKeyHash ->
103103
UnbalancedTx ->
104-
Eff effs (Either Text Tx)
104+
Eff effs (Either WAPI.WalletAPIError Tx)
105105
balanceTxIO = balanceTxIO' @w defaultBalanceConfig
106106

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

122122
let utxoIndex :: Map TxOutRef TxOut
123123
utxoIndex = fmap Tx.toTxOut utxos <> unBalancedTxUtxoIndex unbalancedTx
@@ -142,7 +142,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
142142
if bcHasScripts balanceCfg
143143
then
144144
maybe
145-
(throwE "Tx uses script but no collateral was provided.")
145+
(throwE $ WAPI.OtherError "Tx uses script but no collateral was provided.")
146146
(hoistEither . addSignatories ownPkh privKeys requiredSigs . flip addTxCollaterals tx)
147147
mcollateral
148148
else hoistEither $ addSignatories ownPkh privKeys requiredSigs tx
@@ -189,12 +189,13 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
189189
Map PubKeyHash DummyPrivKey ->
190190
[(TxOut, Integer)] ->
191191
Tx ->
192-
EitherT Text (Eff effs) (Tx, [(TxOut, Integer)])
192+
EitherT WAPI.WalletAPIError (Eff effs) (Tx, [(TxOut, Integer)])
193193
balanceTxLoop utxoIndex privKeys prevMinUtxos tx = do
194194
void $ lift $ Files.writeAll @w pabConf tx
195195
nextMinUtxos <-
196-
newEitherT $
197-
calculateMinUtxos @w pabConf (Tx.txData tx) $ Tx.txOutputs tx \\ map fst prevMinUtxos
196+
firstEitherT WAPI.OtherError $
197+
newEitherT $
198+
calculateMinUtxos @w pabConf (Tx.txData tx) $ Tx.txOutputs tx \\ map fst prevMinUtxos
198199

199200
let minUtxos = prevMinUtxos ++ nextMinUtxos
200201

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

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

209-
nonBudgettedFees <- newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees
210+
nonBudgettedFees <- firstEitherT WAPI.OtherError $ newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees
210211

211212
let fees = nonBudgettedFees + getBudgetPrice (getExecutionUnitPrices pabConf) exBudget
212213

@@ -227,10 +228,10 @@ utxosAndCollateralAtAddress ::
227228
BalanceConfig ->
228229
PABConfig ->
229230
Address ->
230-
Eff effs (Either Text (Map TxOutRef Tx.ChainIndexTxOut, Maybe CollateralUtxo))
231+
Eff effs (Either WAPI.WalletAPIError (Map TxOutRef Tx.ChainIndexTxOut, Maybe CollateralUtxo))
231232
utxosAndCollateralAtAddress balanceCfg pabConf changeAddr =
232233
runEitherT $ do
233-
utxos <- newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr
234+
utxos <- firstEitherT WAPI.OtherError $ newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr
234235
inMemCollateral <- lift $ getInMemCollateral @w
235236

236237
-- check if `bcHasScripts` is true, if this is the case then we search of
@@ -239,8 +240,9 @@ utxosAndCollateralAtAddress balanceCfg pabConf changeAddr =
239240
then
240241
maybe
241242
( throwE $
242-
"The given transaction uses script, but there's no collateral provided."
243-
<> "This usually means that, we failed to create Tx and update our ContractEnvironment."
243+
WAPI.OtherError $
244+
"The given transaction uses script, but there's no collateral provided."
245+
<> "This usually means that, we failed to create Tx and update our ContractEnvironment."
244246
)
245247
(const $ pure (removeCollateralFromMap inMemCollateral utxos, inMemCollateral))
246248
inMemCollateral
@@ -288,7 +290,7 @@ balanceTxStep ::
288290
Map TxOutRef TxOut ->
289291
Address ->
290292
Tx ->
291-
Eff effs (Either Text Tx)
293+
Eff effs (Either WAPI.WalletAPIError Tx)
292294
balanceTxStep balanceCfg minUtxos utxos changeAddr tx =
293295
runEitherT $
294296
(newEitherT . balanceTxIns @w utxos) (addLovelaces minUtxos tx)
@@ -336,7 +338,7 @@ balanceTxIns ::
336338
Member (PABEffect w) effs =>
337339
Map TxOutRef TxOut ->
338340
Tx ->
339-
Eff effs (Either Text Tx)
341+
Eff effs (Either WAPI.WalletAPIError Tx)
340342
balanceTxIns utxos tx = do
341343
runEitherT $ do
342344
let txOuts = Tx.txOutputs tx
@@ -346,7 +348,7 @@ balanceTxIns utxos tx = do
346348
[ txFee tx
347349
, nonMintedValue
348350
]
349-
txIns <- newEitherT $ selectTxIns @w (txInputs tx) utxos minSpending
351+
txIns <- firstEitherT WAPI.OtherError $ newEitherT $ selectTxIns @w (txInputs tx) utxos minSpending
350352
pure $ tx {txInputs = txIns <> txInputs tx}
351353

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

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

392394
{- | `addAdaChange` checks if `bcSeparateChange` is true,
393395
if it is then we add the ada change to seperate `TxOut` at changeAddr that contains only ada,
@@ -431,13 +433,13 @@ addOutput changeAddr tx = tx {txOutputs = txOutputs tx ++ [changeTxOut]}
431433
{- | Add the required signatories to the transaction. Be aware the the signature itself is invalid,
432434
and will be ignored. Only the pub key hashes are used, mapped to signing key files on disk.
433435
-}
434-
addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either Text Tx
436+
addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either WAPI.WalletAPIError Tx
435437
addSignatories ownPkh privKeys pkhs tx =
436438
foldM
437439
( \tx' pkh ->
438440
case Map.lookup pkh privKeys of
439441
Just privKey -> Right $ Tx.addSignature' (unDummyPrivateKey privKey) tx'
440-
Nothing -> Left "Signing key not found."
442+
Nothing -> Left $ WAPI.PaymentPrivateKeyNotFound $ PaymentPubKeyHash pkh
441443
)
442444
tx
443445
(ownPkh : pkhs)
@@ -447,13 +449,13 @@ addValidRange ::
447449
Member (PABEffect w) effs =>
448450
POSIXTimeRange ->
449451
Tx ->
450-
Eff effs (Either Text Tx)
452+
Eff effs (Either WAPI.WalletAPIError Tx)
451453
addValidRange timeRange tx =
452454
if validateRange timeRange
453455
then
454-
bimap (Text.pack . show) (setRange tx)
456+
bimap (WAPI.OtherError . Text.pack . show) (setRange tx)
455457
<$> posixTimeRangeToContainedSlotRange @w timeRange
456-
else pure $ Left "Invalid validity interval."
458+
else pure $ Left $ WAPI.ToCardanoError InvalidValidityRange
457459
where
458460
setRange tx' range = tx' {txValidRange = range}
459461

‎src/BotPlutusInterface/CardanoCLI.hs

Lines changed: 75 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -142,19 +142,24 @@ calculateMinUtxo ::
142142
Map DatumHash Datum ->
143143
TxOut ->
144144
Eff effs (Either Text Integer)
145-
calculateMinUtxo pabConf datums txOut =
146-
join
147-
<$> callCommand @w
148-
ShellArgs
149-
{ cmdName = "cardano-cli"
150-
, cmdArgs =
151-
mconcat
152-
[ ["transaction", "calculate-min-required-utxo", "--alonzo-era"]
153-
, txOutOpts pabConf datums [txOut]
154-
, ["--protocol-params-file", pabConf.pcProtocolParamsFile]
155-
]
156-
, cmdOutParser = mapLeft Text.pack . parseOnly UtxoParser.feeParser . Text.pack
157-
}
145+
calculateMinUtxo pabConf datums txOut = do
146+
let outs = txOutOpts pabConf datums [txOut]
147+
148+
case outs of
149+
[] -> pure $ Left "When constructing the transaction, no output values were specified."
150+
_ ->
151+
join
152+
<$> callCommand @w
153+
ShellArgs
154+
{ cmdName = "cardano-cli"
155+
, cmdArgs =
156+
mconcat
157+
[ ["transaction", "calculate-min-required-utxo", "--alonzo-era"]
158+
, outs
159+
, ["--protocol-params-file", pabConf.pcProtocolParamsFile]
160+
]
161+
, cmdOutParser = mapLeft Text.pack . parseOnly UtxoParser.feeParser . Text.pack
162+
}
158163

159164
-- | Calculating fee for an unbalanced transaction
160165
calculateMinFee ::
@@ -191,39 +196,46 @@ buildTx ::
191196
Tx ->
192197
Eff effs (Either Text ExBudget)
193198
buildTx pabConf privKeys txBudget tx = do
194-
let (ins, valBudget) = txInOpts (spendBudgets txBudget) pabConf (txInputs tx)
195-
(mints, mintBudget) = mintOpts (mintBudgets txBudget) pabConf (txMintScripts tx) (txRedeemers tx) (txMint tx)
196-
callCommand @w $ ShellArgs "cardano-cli" (opts ins mints) (const $ valBudget <> mintBudget)
197-
where
198-
requiredSigners =
199-
concatMap
200-
( \pubKey ->
201-
let pkh = Ledger.pubKeyHash pubKey
202-
in case Map.lookup pkh privKeys of
203-
Just (FromSKey _) ->
204-
["--required-signer", signingKeyFilePath pabConf pkh]
205-
Just (FromVKey _) ->
206-
["--required-signer-hash", encodeByteString $ fromBuiltin $ getPubKeyHash pkh]
207-
Nothing ->
208-
[]
209-
)
210-
(Map.keys (Ledger.txSignatures tx))
211-
opts ins mints =
212-
mconcat
213-
[ ["transaction", "build-raw", "--alonzo-era"]
214-
, ins
215-
, txInCollateralOpts (txCollateral tx)
216-
, txOutOpts pabConf (txData tx) (txOutputs tx)
217-
, mints
218-
, validRangeOpts (txValidRange tx)
219-
, metadataOpts pabConf (txMetadata tx)
220-
, requiredSigners
221-
, ["--fee", showText . getLovelace . fromValue $ txFee tx]
222-
, mconcat
223-
[ ["--protocol-params-file", pabConf.pcProtocolParamsFile]
224-
, ["--out-file", txFilePath pabConf "raw" (txId tx)]
199+
let outs = txOutOpts pabConf (txData tx) (txOutputs tx)
200+
201+
case outs of
202+
[] -> pure $ Left "When constructing the transaction, no output values were specified."
203+
_ ->
204+
callCommand @w $ ShellArgs "cardano-cli" opts (const $ valBudget <> mintBudget)
205+
where
206+
(ins, valBudget) = txInOpts (spendBudgets txBudget) pabConf (txInputs tx)
207+
(mints, mintBudget) = mintOpts (mintBudgets txBudget) pabConf (txMintScripts tx) (txRedeemers tx) (txMint tx)
208+
209+
requiredSigners =
210+
concatMap
211+
( \pubKey ->
212+
let pkh = Ledger.pubKeyHash pubKey
213+
in case Map.lookup pkh privKeys of
214+
Just (FromSKey _) ->
215+
["--required-signer", signingKeyFilePath pabConf pkh]
216+
Just (FromVKey _) ->
217+
["--required-signer-hash", encodeByteString $ fromBuiltin $ getPubKeyHash pkh]
218+
Nothing ->
219+
[]
220+
)
221+
(Map.keys (Ledger.txSignatures tx))
222+
223+
opts =
224+
mconcat
225+
[ ["transaction", "build-raw", "--alonzo-era"]
226+
, ins
227+
, txInCollateralOpts (txCollateral tx)
228+
, outs
229+
, mints
230+
, validRangeOpts (txValidRange tx)
231+
, metadataOpts pabConf (txMetadata tx)
232+
, requiredSigners
233+
, ["--fee", showText . getLovelace . fromValue $ txFee tx]
234+
, mconcat
235+
[ ["--protocol-params-file", pabConf.pcProtocolParamsFile]
236+
, ["--out-file", txFilePath pabConf "raw" (txId tx)]
237+
]
225238
]
226-
]
227239

228240
-- Signs and writes a tx (uses the tx body written to disk as input)
229241
signTx ::
@@ -366,22 +378,25 @@ txOutOpts :: PABConfig -> Map DatumHash Datum -> [TxOut] -> [Text]
366378
txOutOpts pabConf datums =
367379
concatMap
368380
( \TxOut {txOutAddress, txOutValue, txOutDatumHash} ->
369-
mconcat
370-
[
371-
[ "--tx-out"
372-
, Text.intercalate
373-
"+"
374-
[ unsafeSerialiseAddress pabConf.pcNetwork txOutAddress
375-
, valueToCliArg txOutValue
381+
if Value.isZero txOutValue
382+
then []
383+
else
384+
mconcat
385+
[
386+
[ "--tx-out"
387+
, Text.intercalate
388+
"+"
389+
[ unsafeSerialiseAddress pabConf.pcNetwork txOutAddress
390+
, valueToCliArg txOutValue
391+
]
376392
]
377-
]
378-
, case txOutDatumHash of
379-
Nothing -> []
380-
Just datumHash@(DatumHash dh) ->
381-
if Map.member datumHash datums
382-
then ["--tx-out-datum-embed-file", datumJsonFilePath pabConf datumHash]
383-
else ["--tx-out-datum-hash", encodeByteString $ fromBuiltin dh]
384-
]
393+
, case txOutDatumHash of
394+
Nothing -> []
395+
Just datumHash@(DatumHash dh) ->
396+
if Map.member datumHash datums
397+
then ["--tx-out-datum-embed-file", datumJsonFilePath pabConf datumHash]
398+
else ["--tx-out-datum-hash", encodeByteString $ fromBuiltin dh]
399+
]
385400
)
386401

387402
networkOpt :: PABConfig -> [Text]

0 commit comments

Comments
 (0)