Skip to content

Commit d6cf1e3

Browse files
mikekekemikekeke
authored
Merge pull request #155 from mlabs-haskell/karol/error-messages
Fix "OutputZeroAda" bug and WalletApiError errors.
2 parents 857ec74 + 8524fef commit d6cf1e3

File tree

7 files changed

+88
-59
lines changed

7 files changed

+88
-59
lines changed

‎src/BotPlutusInterface/Balance.hs

+30-28
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ import Data.Text qualified as Text
5555
import GHC.Real (Ratio ((:%)))
5656
import Ledger qualified
5757
import Ledger.Ada qualified as Ada
58-
import Ledger.Address (Address (..))
58+
import Ledger.Address (Address (..), PaymentPubKeyHash (PaymentPubKeyHash))
5959
import Ledger.Constraints.OffChain (UnbalancedTx (..))
6060
import Ledger.Crypto (PubKeyHash)
6161
import Ledger.Interval (
@@ -66,6 +66,7 @@ import Ledger.Interval (
6666
)
6767
import Ledger.Time (POSIXTimeRange)
6868
import Ledger.Tx (
69+
ToCardanoError (InvalidValidityRange),
6970
Tx (..),
7071
TxIn (..),
7172
TxInType (..),
@@ -83,6 +84,7 @@ import Plutus.V1.Ledger.Api (
8384

8485
import Ledger.Constraints.OffChain qualified as Constraints
8586
import Prettyprinter (pretty, viaShow, (<+>))
87+
import Wallet.API qualified as WAPI
8688
import Prelude
8789

8890
-- Config for balancing a `Tx`.
@@ -106,7 +108,7 @@ balanceTxIO ::
106108
PABConfig ->
107109
PubKeyHash ->
108110
UnbalancedTx ->
109-
Eff effs (Either Text Tx)
111+
Eff effs (Either WAPI.WalletAPIError Tx)
110112
balanceTxIO = balanceTxIO' @w defaultBalanceConfig
111113

112114
-- | `balanceTxIO'` is more flexible version of `balanceTxIO`, this lets us specify custom `BalanceConfig`.
@@ -117,12 +119,12 @@ balanceTxIO' ::
117119
PABConfig ->
118120
PubKeyHash ->
119121
UnbalancedTx ->
120-
Eff effs (Either Text Tx)
122+
Eff effs (Either WAPI.WalletAPIError Tx)
121123
balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx' =
122124
runEitherT $
123125
do
124126
updatedOuts <-
125-
firstEitherT (Text.pack . show) $
127+
firstEitherT WAPI.OtherError $
126128
newEitherT $
127129
sequence <$> traverse (minUtxo @w) (unbalancedTx' ^. Constraints.tx . Tx.outputs)
128130

@@ -136,7 +138,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx' =
136138
pabConf
137139
changeAddr
138140

139-
privKeys <- newEitherT $ Files.readPrivateKeys @w pabConf
141+
privKeys <- firstEitherT WAPI.OtherError $ newEitherT $ Files.readPrivateKeys @w pabConf
140142

141143
let utxoIndex :: Map TxOutRef TxOut
142144
utxoIndex = fmap Tx.toTxOut utxos <> unBalancedTxUtxoIndex unbalancedTx
@@ -163,14 +165,14 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx' =
163165
if bcHasScripts balanceCfg
164166
then
165167
maybe
166-
(throwE "Tx uses script but no collateral was provided.")
168+
(throwE $ WAPI.OtherError "Tx uses script but no collateral was provided.")
167169
(hoistEither . addSignatories ownPkh privKeys requiredSigs . flip addTxCollaterals tx)
168170
mcollateral
169171
else hoistEither $ addSignatories ownPkh privKeys requiredSigs tx
170172

171173
-- Balance the tx
172174
balancedTx <- balanceTxLoop utxoIndex privKeys preBalancedTx
173-
changeTxOutWithMinAmt <- newEitherT $ addOutput @w changeAddr balancedTx
175+
changeTxOutWithMinAmt <- firstEitherT WAPI.OtherError $ newEitherT $ addOutput @w changeAddr balancedTx
174176

175177
-- Get current Ada change
176178
let adaChange = getAdaChange utxoIndex balancedTx
@@ -213,17 +215,17 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx' =
213215
Map TxOutRef TxOut ->
214216
Map PubKeyHash DummyPrivKey ->
215217
Tx ->
216-
EitherT Text (Eff effs) Tx
218+
EitherT WAPI.WalletAPIError (Eff effs) Tx
217219
balanceTxLoop utxoIndex privKeys tx = do
218220
void $ lift $ Files.writeAll @w pabConf tx
219221

220222
-- Calculate fees by pre-balancing the tx, building it, and running the CLI on result
221223
txWithoutFees <-
222224
newEitherT $ balanceTxStep @w balanceCfg utxoIndex changeAddr $ tx `withFee` 0
223225

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

226-
nonBudgettedFees <- newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees
228+
nonBudgettedFees <- firstEitherT WAPI.OtherError $ newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees
227229

228230
let fees = nonBudgettedFees + getBudgetPrice (getExecutionUnitPrices pabConf) exBudget
229231

@@ -244,7 +246,7 @@ utxosAndCollateralAtAddress ::
244246
BalanceConfig ->
245247
PABConfig ->
246248
Address ->
247-
Eff effs (Either Text (Map TxOutRef Tx.ChainIndexTxOut, Maybe CollateralUtxo))
249+
Eff effs (Either WAPI.WalletAPIError (Map TxOutRef Tx.ChainIndexTxOut, Maybe CollateralUtxo))
248250
utxosAndCollateralAtAddress balanceCfg _pabConf changeAddr =
249251
runEitherT $ do
250252
inMemCollateral <- lift $ getInMemCollateral @w
@@ -254,16 +256,17 @@ utxosAndCollateralAtAddress balanceCfg _pabConf changeAddr =
254256
(UtxosAtExcluding changeAddr . Set.singleton . collateralTxOutRef)
255257
inMemCollateral
256258

257-
utxos <- firstEitherT (Text.pack . show) $ newEitherT $ queryNode @w nodeQuery
259+
utxos <- firstEitherT (WAPI.OtherError . Text.pack . show) $ newEitherT $ queryNode @w nodeQuery
258260

259261
-- check if `bcHasScripts` is true, if this is the case then we search of
260262
-- collateral UTxO in the environment, if such collateral is not present we throw Error.
261263
if bcHasScripts balanceCfg
262264
then
263265
maybe
264266
( throwE $
265-
"The given transaction uses script, but there's no collateral provided."
266-
<> "This usually means that, we failed to create Tx and update our ContractEnvironment."
267+
WAPI.OtherError $
268+
"The given transaction uses script, but there's no collateral provided."
269+
<> "This usually means that, we failed to create Tx and update our ContractEnvironment."
267270
)
268271
(const $ pure (utxos, inMemCollateral))
269272
inMemCollateral
@@ -302,7 +305,7 @@ balanceTxStep ::
302305
Map TxOutRef TxOut ->
303306
Address ->
304307
Tx ->
305-
Eff effs (Either Text Tx)
308+
Eff effs (Either WAPI.WalletAPIError Tx)
306309
balanceTxStep balanceCfg utxos changeAddr tx =
307310
runEitherT $
308311
(newEitherT . balanceTxIns @w utxos) tx
@@ -339,7 +342,7 @@ balanceTxIns ::
339342
Member (PABEffect w) effs =>
340343
Map TxOutRef TxOut ->
341344
Tx ->
342-
Eff effs (Either Text Tx)
345+
Eff effs (Either WAPI.WalletAPIError Tx)
343346
balanceTxIns utxos tx = do
344347
runEitherT $ do
345348
let txOuts = Tx.txOutputs tx
@@ -377,7 +380,7 @@ handleNonAdaChange ::
377380
Address ->
378381
Map TxOutRef TxOut ->
379382
Tx ->
380-
Eff effs (Either Text Tx)
383+
Eff effs (Either WAPI.WalletAPIError Tx)
381384
handleNonAdaChange balanceCfg changeAddr utxos tx = runEitherT $ do
382385
let nonAdaChange :: Value
383386
nonAdaChange = getNonAdaChange utxos tx
@@ -403,7 +406,7 @@ handleNonAdaChange balanceCfg changeAddr utxos tx = runEitherT $ do
403406
}
404407

405408
newOutputWithMinAmt <-
406-
firstEitherT (Text.pack . show) $
409+
firstEitherT WAPI.OtherError $
407410
newEitherT $ minUtxo @w newOutput
408411

409412
let outputs :: [TxOut]
@@ -415,7 +418,7 @@ handleNonAdaChange balanceCfg changeAddr utxos tx = runEitherT $ do
415418

416419
if isValueNat nonAdaChange
417420
then return $ if Value.isZero nonAdaChange then tx else tx {txOutputs = outputs}
418-
else throwE "Not enough inputs to balance tokens."
421+
else throwE $ WAPI.InsufficientFunds "Not enough inputs to balance tokens."
419422

420423
{- | `addAdaChange` checks if `bcSeparateChange` is true,
421424
if it is then we add the ada change to seperate `TxOut` at changeAddr that contains only ada,
@@ -467,22 +470,21 @@ addOutput changeAddr tx =
467470
}
468471

469472
changeTxOutWithMinAmt <-
470-
firstEitherT (Text.pack . show) $
471-
newEitherT $
472-
minUtxo @w changeTxOut
473+
newEitherT $
474+
minUtxo @w changeTxOut
473475

474476
return $ tx {txOutputs = txOutputs tx ++ [changeTxOutWithMinAmt]}
475477

476478
{- | Add the required signatories to the transaction. Be aware the the signature itself is invalid,
477479
and will be ignored. Only the pub key hashes are used, mapped to signing key files on disk.
478480
-}
479-
addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either Text Tx
481+
addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either WAPI.WalletAPIError Tx
480482
addSignatories ownPkh privKeys pkhs tx =
481483
foldM
482484
( \tx' pkh ->
483485
case Map.lookup pkh privKeys of
484486
Just privKey -> Right $ Tx.addSignature' (unDummyPrivateKey privKey) tx'
485-
Nothing -> Left "Signing key not found."
487+
Nothing -> Left $ WAPI.PaymentPrivateKeyNotFound $ PaymentPubKeyHash pkh
486488
)
487489
tx
488490
(ownPkh : pkhs)
@@ -492,14 +494,14 @@ addValidRange ::
492494
Member (PABEffect w) effs =>
493495
POSIXTimeRange ->
494496
Either CardanoBuildTx Tx ->
495-
Eff effs (Either Text Tx)
496-
addValidRange _ (Left _) = pure $ Left "BPI is not using CardanoBuildTx"
497+
Eff effs (Either WAPI.WalletAPIError Tx)
498+
addValidRange _ (Left _) = pure $ Left $ WAPI.OtherError "BPI is not using CardanoBuildTx"
497499
addValidRange timeRange (Right tx) =
498500
if validateRange timeRange
499501
then
500-
bimap (Text.pack . show) (setRange tx)
502+
bimap (WAPI.OtherError . Text.pack . show) (setRange tx)
501503
<$> posixTimeRangeToContainedSlotRange @w timeRange
502-
else pure $ Left "Invalid validity interval."
504+
else pure $ Left $ WAPI.ToCardanoError InvalidValidityRange
503505
where
504506
setRange tx' range = tx' {txValidRange = range}
505507

‎src/BotPlutusInterface/CardanoAPI.hs

+21
Original file line numberDiff line numberDiff line change
@@ -6,9 +6,11 @@ module BotPlutusInterface.CardanoAPI (
66
fromCardanoSlotNo,
77
fromCardanoEpochInfo,
88
posixTimeToSlot,
9+
toCardanoTxOut',
910
) where
1011

1112
import Cardano.Api qualified as CApi
13+
import Cardano.Api.Shelley qualified as CApi.S
1214
import Cardano.Ledger.Slot (EpochInfo)
1315
import Cardano.Prelude (maybeToEither)
1416
import Cardano.Slotting.EpochInfo (hoistEpochInfo)
@@ -99,3 +101,22 @@ convertOutputDatum = \case
99101
V2.NoOutputDatum -> Nothing
100102
V2.OutputDatumHash dh -> Just (dh, Nothing)
101103
V2.OutputDatum d -> Just (ScriptUtils.datumHash d, Just d)
104+
105+
{- | Custom version of `toCardanoTxOut` from `plutus-ledger`
106+
which doesn't throw an error in case `Value` has 0 Ada
107+
-}
108+
toCardanoTxOut' ::
109+
CApi.S.NetworkId ->
110+
( Maybe ScriptUtils.DatumHash ->
111+
Either TxApi.ToCardanoError (CApi.S.TxOutDatum ctx CApi.S.BabbageEra)
112+
) ->
113+
Ledger.TxOut ->
114+
Either TxApi.ToCardanoError (CApi.S.TxOut ctx CApi.S.BabbageEra)
115+
toCardanoTxOut' networkId fromHash (Ledger.TxOut addr value datumHash) =
116+
CApi.TxOut <$> TxApi.toCardanoAddressInEra networkId addr
117+
<*> toCardanoTxOutValue' value
118+
<*> fromHash datumHash
119+
<*> pure CApi.S.ReferenceScriptNone
120+
where
121+
toCardanoTxOutValue' v = do
122+
CApi.TxOutValue CApi.MultiAssetInBabbageEra <$> TxApi.toCardanoValue v

‎src/BotPlutusInterface/CoinSelection.hs

+16-14
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@ import Control.Lens (
2828
import Control.Monad.Except (foldM, throwError, unless)
2929
import Control.Monad.Freer (Eff, Member)
3030
import Control.Monad.Trans.Class (lift)
31-
import Control.Monad.Trans.Either (hoistEither, newEitherT, runEitherT)
31+
import Control.Monad.Trans.Either (firstEitherT, hoistEither, newEitherT, runEitherT)
3232
import Data.Either.Combinators (isRight, maybeToRight)
3333
import Data.Kind (Type)
3434
import Data.List qualified as List
@@ -51,6 +51,7 @@ import Plutus.V1.Ledger.Api (
5151
Credential (PubKeyCredential, ScriptCredential),
5252
)
5353
import Prettyprinter (pretty, (<+>))
54+
import Wallet.API qualified as WAPI
5455
import Prelude
5556

5657
{-
@@ -184,7 +185,7 @@ selectTxIns ::
184185
Set TxIn -> -- Inputs `TxIn` of the transaction.
185186
Map TxOutRef TxOut -> -- Map of utxos that can be spent
186187
Value -> -- total output value of the Tx.
187-
Eff effs (Either Text (Set TxIn))
188+
Eff effs (Either WAPI.WalletAPIError (Set TxIn))
188189
selectTxIns originalTxIns utxosIndex outValue =
189190
runEitherT $ do
190191
let -- This represents the input value.
@@ -227,13 +228,14 @@ selectTxIns originalTxIns utxosIndex outValue =
227228
-- we use the default search strategy to get indexes of optimal utxos, these indexes are for the
228229
-- remainingUtxos, as we are sampling utxos from that set.
229230
selectedUtxosIdxs <-
230-
newEitherT $
231-
searchTxIns @w
232-
defaultSearchStrategy
233-
(isSufficient outVec)
234-
outVec
235-
txInsVec
236-
remainingUtxosVec
231+
firstEitherT WAPI.OtherError $
232+
newEitherT $
233+
searchTxIns @w
234+
defaultSearchStrategy
235+
(isSufficient outVec)
236+
outVec
237+
txInsVec
238+
remainingUtxosVec
237239

238240
lift $ printBpiLog @w (Debug [CoinSelectionLog]) $ "" <+> "Selected UTxOs Index: " <+> pretty selectedUtxosIdxs
239241

@@ -244,10 +246,10 @@ selectTxIns originalTxIns utxosIndex outValue =
244246
selectedVectors :: [ValueVector]
245247
selectedVectors = selectedUtxosIdxs ^.. folded . to (\idx -> remainingUtxosVec ^? ix idx) . folded
246248

247-
finalTxInputVector <- hoistEither $ foldM addVec txInsVec selectedVectors
248-
unless (isSufficient outVec finalTxInputVector) $ throwError "Insufficient Funds"
249+
finalTxInputVector <- firstEitherT WAPI.OtherError $ hoistEither $ foldM addVec txInsVec selectedVectors
250+
unless (isSufficient outVec finalTxInputVector) $ throwError (WAPI.InsufficientFunds "Insufficient funds in the final vector.")
249251

250-
selectedTxIns <- hoistEither $ mapM txOutToTxIn selectedUtxos
252+
selectedTxIns <- firstEitherT WAPI.OtherError $ hoistEither $ mapM txOutToTxIn selectedUtxos
251253

252254
lift $ printBpiLog @w (Debug [CoinSelectionLog]) $ "Selected TxIns: " <+> pretty selectedTxIns
253255

@@ -447,9 +449,9 @@ zeroVec :: Int -> Vector Integer
447449
zeroVec n = Vec.replicate n 0
448450

449451
-- | Convert a value to a vector.
450-
valueToVec :: Set AssetClass -> Value -> Either Text ValueVector
452+
valueToVec :: Set AssetClass -> Value -> Either WAPI.WalletAPIError ValueVector
451453
valueToVec allAssetClasses v =
452-
maybeToRight "Error: Not able to uncons from empty vector." $
454+
maybeToRight (WAPI.OtherError "Error: Not able to uncons from empty vector.") $
453455
(over _Just fst . uncons) $ valuesToVecs allAssetClasses [v]
454456

455457
-- | Convert values to a list of vectors.

0 commit comments

Comments
 (0)