Skip to content

Commit 56546a8

Browse files
mikekekemikekeke
authored
Merge pull request #146 from mlabs-haskell/revert-err-messages-commit
Revert "Merge pull request #141 from mlabs-haskell/mitch/error-messages"
2 parents 11db995 + 28b107d commit 56546a8

File tree

3 files changed

+98
-116
lines changed

3 files changed

+98
-116
lines changed

‎src/BotPlutusInterface/Balance.hs‎

Lines changed: 27 additions & 29 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, firstEitherT, hoistEither, newEitherT, runEitherT)
39+
import Control.Monad.Trans.Either (EitherT, hoistEither, newEitherT, runEitherT)
4040
import Control.Monad.Trans.Except (throwE)
4141
import Data.Bifunctor (bimap)
4242
import Data.Coerce (coerce)
@@ -52,10 +52,12 @@ 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 (..), PaymentPubKeyHash (PaymentPubKeyHash))
55+
import Ledger.Address (Address (..))
5656
import Ledger.Constraints.OffChain (UnbalancedTx (..))
57+
import Ledger.Crypto (PubKeyHash)
5758
import Ledger.Interval (
5859
Extended (Finite, NegInf, PosInf),
60+
Interval (Interval),
5961
LowerBound (LowerBound),
6062
UpperBound (UpperBound),
6163
)
@@ -69,15 +71,13 @@ import Ledger.Tx (
6971
TxOutRef (..),
7072
)
7173
import Ledger.Tx qualified as Tx
72-
import Ledger.Tx.CardanoAPI (ToCardanoError (InvalidValidityRange))
7374
import Ledger.Value (Value)
7475
import Ledger.Value qualified as Value
7576
import Plutus.V1.Ledger.Api (
7677
CurrencySymbol (..),
7778
TokenName (..),
7879
)
7980
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 WAPI.WalletAPIError Tx)
104+
Eff effs (Either Text 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 WAPI.WalletAPIError Tx)
115+
Eff effs (Either Text Tx)
116116
balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
117117
runEitherT $
118118
do
119119
(utxos, mcollateral) <- newEitherT $ utxosAndCollateralAtAddress @w balanceCfg pabConf changeAddr
120-
privKeys <- firstEitherT WAPI.OtherError $ newEitherT $ Files.readPrivateKeys @w pabConf
120+
privKeys <- 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 $ WAPI.OtherError "Tx uses script but no collateral was provided.")
145+
(throwE "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,13 +189,12 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
189189
Map PubKeyHash DummyPrivKey ->
190190
[(TxOut, Integer)] ->
191191
Tx ->
192-
EitherT WAPI.WalletAPIError (Eff effs) (Tx, [(TxOut, Integer)])
192+
EitherT Text (Eff effs) (Tx, [(TxOut, Integer)])
193193
balanceTxLoop utxoIndex privKeys prevMinUtxos tx = do
194194
void $ lift $ Files.writeAll @w pabConf tx
195195
nextMinUtxos <-
196-
firstEitherT WAPI.OtherError $
197-
newEitherT $
198-
calculateMinUtxos @w pabConf (Tx.txData tx) $ Tx.txOutputs tx \\ map fst prevMinUtxos
196+
newEitherT $
197+
calculateMinUtxos @w pabConf (Tx.txData tx) $ Tx.txOutputs tx \\ map fst prevMinUtxos
199198

200199
let minUtxos = prevMinUtxos ++ nextMinUtxos
201200

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

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

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

212211
let fees = nonBudgettedFees + getBudgetPrice (getExecutionUnitPrices pabConf) exBudget
213212

@@ -228,10 +227,10 @@ utxosAndCollateralAtAddress ::
228227
BalanceConfig ->
229228
PABConfig ->
230229
Address ->
231-
Eff effs (Either WAPI.WalletAPIError (Map TxOutRef Tx.ChainIndexTxOut, Maybe CollateralUtxo))
230+
Eff effs (Either Text (Map TxOutRef Tx.ChainIndexTxOut, Maybe CollateralUtxo))
232231
utxosAndCollateralAtAddress balanceCfg pabConf changeAddr =
233232
runEitherT $ do
234-
utxos <- firstEitherT WAPI.OtherError $ newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr
233+
utxos <- newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr
235234
inMemCollateral <- lift $ getInMemCollateral @w
236235

237236
-- check if `bcHasScripts` is true, if this is the case then we search of
@@ -240,9 +239,8 @@ utxosAndCollateralAtAddress balanceCfg pabConf changeAddr =
240239
then
241240
maybe
242241
( throwE $
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."
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."
246244
)
247245
(const $ pure (removeCollateralFromMap inMemCollateral utxos, inMemCollateral))
248246
inMemCollateral
@@ -290,7 +288,7 @@ balanceTxStep ::
290288
Map TxOutRef TxOut ->
291289
Address ->
292290
Tx ->
293-
Eff effs (Either WAPI.WalletAPIError Tx)
291+
Eff effs (Either Text Tx)
294292
balanceTxStep balanceCfg minUtxos utxos changeAddr tx =
295293
runEitherT $
296294
(newEitherT . balanceTxIns @w utxos) (addLovelaces minUtxos tx)
@@ -338,7 +336,7 @@ balanceTxIns ::
338336
Member (PABEffect w) effs =>
339337
Map TxOutRef TxOut ->
340338
Tx ->
341-
Eff effs (Either WAPI.WalletAPIError Tx)
339+
Eff effs (Either Text Tx)
342340
balanceTxIns utxos tx = do
343341
runEitherT $ do
344342
let txOuts = Tx.txOutputs tx
@@ -348,7 +346,7 @@ balanceTxIns utxos tx = do
348346
[ txFee tx
349347
, nonMintedValue
350348
]
351-
txIns <- firstEitherT WAPI.OtherError $ newEitherT $ selectTxIns @w (txInputs tx) utxos minSpending
349+
txIns <- newEitherT $ selectTxIns @w (txInputs tx) utxos minSpending
352350
pure $ tx {txInputs = txIns <> txInputs tx}
353351

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

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

394392
{- | `addAdaChange` checks if `bcSeparateChange` is true,
395393
if it is then we add the ada change to seperate `TxOut` at changeAddr that contains only ada,
@@ -433,13 +431,13 @@ addOutput changeAddr tx = tx {txOutputs = txOutputs tx ++ [changeTxOut]}
433431
{- | Add the required signatories to the transaction. Be aware the the signature itself is invalid,
434432
and will be ignored. Only the pub key hashes are used, mapped to signing key files on disk.
435433
-}
436-
addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either WAPI.WalletAPIError Tx
434+
addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either Text Tx
437435
addSignatories ownPkh privKeys pkhs tx =
438436
foldM
439437
( \tx' pkh ->
440438
case Map.lookup pkh privKeys of
441439
Just privKey -> Right $ Tx.addSignature' (unDummyPrivateKey privKey) tx'
442-
Nothing -> Left $ WAPI.PaymentPrivateKeyNotFound $ PaymentPubKeyHash pkh
440+
Nothing -> Left "Signing key not found."
443441
)
444442
tx
445443
(ownPkh : pkhs)
@@ -449,13 +447,13 @@ addValidRange ::
449447
Member (PABEffect w) effs =>
450448
POSIXTimeRange ->
451449
Tx ->
452-
Eff effs (Either WAPI.WalletAPIError Tx)
450+
Eff effs (Either Text Tx)
453451
addValidRange timeRange tx =
454452
if validateRange timeRange
455453
then
456-
bimap (WAPI.OtherError . Text.pack . show) (setRange tx)
454+
bimap (Text.pack . show) (setRange tx)
457455
<$> posixTimeRangeToContainedSlotRange @w timeRange
458-
else pure $ Left $ WAPI.ToCardanoError InvalidValidityRange
456+
else pure $ Left "Invalid validity interval."
459457
where
460458
setRange tx' range = tx' {txValidRange = range}
461459

‎src/BotPlutusInterface/CardanoCLI.hs‎

Lines changed: 60 additions & 75 deletions
Original file line numberDiff line numberDiff line change
@@ -142,24 +142,19 @@ calculateMinUtxo ::
142142
Map DatumHash Datum ->
143143
TxOut ->
144144
Eff effs (Either Text Integer)
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-
}
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+
}
163158

164159
-- | Calculating fee for an unbalanced transaction
165160
calculateMinFee ::
@@ -196,46 +191,39 @@ buildTx ::
196191
Tx ->
197192
Eff effs (Either Text ExBudget)
198193
buildTx pabConf privKeys txBudget tx = do
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-
]
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)]
238225
]
226+
]
239227

240228
-- Signs and writes a tx (uses the tx body written to disk as input)
241229
signTx ::
@@ -378,25 +366,22 @@ txOutOpts :: PABConfig -> Map DatumHash Datum -> [TxOut] -> [Text]
378366
txOutOpts pabConf datums =
379367
concatMap
380368
( \TxOut {txOutAddress, txOutValue, txOutDatumHash} ->
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-
]
369+
mconcat
370+
[
371+
[ "--tx-out"
372+
, Text.intercalate
373+
"+"
374+
[ unsafeSerialiseAddress pabConf.pcNetwork txOutAddress
375+
, valueToCliArg txOutValue
392376
]
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-
]
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+
]
400385
)
401386

402387
networkOpt :: PABConfig -> [Text]

0 commit comments

Comments
 (0)