From 28b107d9c57aa952fe8f0bca49e43294fa930426 Mon Sep 17 00:00:00 2001 From: Mikhail Lazarev Date: Thu, 25 Aug 2022 11:13:48 +0300 Subject: [PATCH] Revert "Merge pull request #141 from mlabs-haskell/mitch/error-messages" This reverts commit 11db995b733f0c0524534ff05f6b3d148d59455d, reversing changes made to f93927cbcd0fc35251dc530a812677b2ddae18d5. --- src/BotPlutusInterface/Balance.hs | 56 ++++++----- src/BotPlutusInterface/CardanoCLI.hs | 135 ++++++++++++--------------- src/BotPlutusInterface/Contract.hs | 23 +++-- 3 files changed, 98 insertions(+), 116 deletions(-) diff --git a/src/BotPlutusInterface/Balance.hs b/src/BotPlutusInterface/Balance.hs index 5d5d67ee..79f43215 100644 --- a/src/BotPlutusInterface/Balance.hs +++ b/src/BotPlutusInterface/Balance.hs @@ -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, firstEitherT, hoistEither, newEitherT, runEitherT) +import Control.Monad.Trans.Either (EitherT, hoistEither, newEitherT, runEitherT) import Control.Monad.Trans.Except (throwE) import Data.Bifunctor (bimap) import Data.Coerce (coerce) @@ -52,10 +52,12 @@ import Data.Text qualified as Text import GHC.Real (Ratio ((:%))) import Ledger qualified import Ledger.Ada qualified as Ada -import Ledger.Address (Address (..), PaymentPubKeyHash (PaymentPubKeyHash)) +import Ledger.Address (Address (..)) import Ledger.Constraints.OffChain (UnbalancedTx (..)) +import Ledger.Crypto (PubKeyHash) import Ledger.Interval ( Extended (Finite, NegInf, PosInf), + Interval (Interval), LowerBound (LowerBound), UpperBound (UpperBound), ) @@ -69,7 +71,6 @@ 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 ( @@ -77,7 +78,6 @@ import Plutus.V1.Ledger.Api ( TokenName (..), ) import Prettyprinter (pretty, viaShow, (<+>)) -import Wallet.API as WAPI import Prelude -- Config for balancing a `Tx`. @@ -101,7 +101,7 @@ balanceTxIO :: PABConfig -> PubKeyHash -> UnbalancedTx -> - Eff effs (Either WAPI.WalletAPIError Tx) + Eff effs (Either Text Tx) balanceTxIO = balanceTxIO' @w defaultBalanceConfig -- | `balanceTxIO'` is more flexible version of `balanceTxIO`, this let us specify custom `BalanceConfig`. @@ -112,12 +112,12 @@ balanceTxIO' :: PABConfig -> PubKeyHash -> UnbalancedTx -> - Eff effs (Either WAPI.WalletAPIError Tx) + Eff effs (Either Text Tx) balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx = runEitherT $ do (utxos, mcollateral) <- newEitherT $ utxosAndCollateralAtAddress @w balanceCfg pabConf changeAddr - privKeys <- firstEitherT WAPI.OtherError $ newEitherT $ Files.readPrivateKeys @w pabConf + privKeys <- newEitherT $ Files.readPrivateKeys @w pabConf let utxoIndex :: Map TxOutRef TxOut utxoIndex = fmap Tx.toTxOut utxos <> unBalancedTxUtxoIndex unbalancedTx @@ -142,7 +142,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx = if bcHasScripts balanceCfg then maybe - (throwE $ WAPI.OtherError "Tx uses script but no collateral was provided.") + (throwE "Tx uses script but no collateral was provided.") (hoistEither . addSignatories ownPkh privKeys requiredSigs . flip addTxCollaterals tx) mcollateral else hoistEither $ addSignatories ownPkh privKeys requiredSigs tx @@ -189,13 +189,12 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx = Map PubKeyHash DummyPrivKey -> [(TxOut, Integer)] -> Tx -> - EitherT WAPI.WalletAPIError (Eff effs) (Tx, [(TxOut, Integer)]) + EitherT Text (Eff effs) (Tx, [(TxOut, Integer)]) balanceTxLoop utxoIndex privKeys prevMinUtxos tx = do void $ lift $ Files.writeAll @w pabConf tx nextMinUtxos <- - firstEitherT WAPI.OtherError $ - newEitherT $ - calculateMinUtxos @w pabConf (Tx.txData tx) $ Tx.txOutputs tx \\ map fst prevMinUtxos + newEitherT $ + calculateMinUtxos @w pabConf (Tx.txData tx) $ Tx.txOutputs tx \\ map fst prevMinUtxos let minUtxos = prevMinUtxos ++ nextMinUtxos @@ -205,9 +204,9 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx = txWithoutFees <- newEitherT $ balanceTxStep @w balanceCfg minUtxos utxoIndex changeAddr $ tx `withFee` 0 - exBudget <- firstEitherT WAPI.OtherError $ newEitherT $ BodyBuilder.buildAndEstimateBudget @w pabConf privKeys txWithoutFees + exBudget <- newEitherT $ BodyBuilder.buildAndEstimateBudget @w pabConf privKeys txWithoutFees - nonBudgettedFees <- firstEitherT WAPI.OtherError $ newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees + nonBudgettedFees <- newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees let fees = nonBudgettedFees + getBudgetPrice (getExecutionUnitPrices pabConf) exBudget @@ -228,10 +227,10 @@ utxosAndCollateralAtAddress :: BalanceConfig -> PABConfig -> Address -> - Eff effs (Either WAPI.WalletAPIError (Map TxOutRef Tx.ChainIndexTxOut, Maybe CollateralUtxo)) + Eff effs (Either Text (Map TxOutRef Tx.ChainIndexTxOut, Maybe CollateralUtxo)) utxosAndCollateralAtAddress balanceCfg pabConf changeAddr = runEitherT $ do - utxos <- firstEitherT WAPI.OtherError $ newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr + utxos <- newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr inMemCollateral <- lift $ getInMemCollateral @w -- check if `bcHasScripts` is true, if this is the case then we search of @@ -240,9 +239,8 @@ utxosAndCollateralAtAddress balanceCfg pabConf changeAddr = then maybe ( throwE $ - 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." + "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 @@ -290,7 +288,7 @@ balanceTxStep :: Map TxOutRef TxOut -> Address -> Tx -> - Eff effs (Either WAPI.WalletAPIError Tx) + Eff effs (Either Text Tx) balanceTxStep balanceCfg minUtxos utxos changeAddr tx = runEitherT $ (newEitherT . balanceTxIns @w utxos) (addLovelaces minUtxos tx) @@ -338,7 +336,7 @@ balanceTxIns :: Member (PABEffect w) effs => Map TxOutRef TxOut -> Tx -> - Eff effs (Either WAPI.WalletAPIError Tx) + Eff effs (Either Text Tx) balanceTxIns utxos tx = do runEitherT $ do let txOuts = Tx.txOutputs tx @@ -348,7 +346,7 @@ balanceTxIns utxos tx = do [ txFee tx , nonMintedValue ] - txIns <- firstEitherT WAPI.OtherError $ newEitherT $ selectTxIns @w (txInputs tx) utxos minSpending + txIns <- 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 @@ -365,7 +363,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 WAPI.WalletAPIError Tx +handleNonAdaChange :: BalanceConfig -> Address -> Map TxOutRef TxOut -> Tx -> Either Text Tx handleNonAdaChange balanceCfg changeAddr utxos tx = let nonAdaChange = getNonAdaChange utxos tx predicate = @@ -389,7 +387,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 $ WAPI.InsufficientFunds "Not enough inputs to balance tokens." + else Left "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, @@ -433,13 +431,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 WAPI.WalletAPIError Tx +addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either Text 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 $ WAPI.PaymentPrivateKeyNotFound $ PaymentPubKeyHash pkh + Nothing -> Left "Signing key not found." ) tx (ownPkh : pkhs) @@ -449,13 +447,13 @@ addValidRange :: Member (PABEffect w) effs => POSIXTimeRange -> Tx -> - Eff effs (Either WAPI.WalletAPIError Tx) + Eff effs (Either Text Tx) addValidRange timeRange tx = if validateRange timeRange then - bimap (WAPI.OtherError . Text.pack . show) (setRange tx) + bimap (Text.pack . show) (setRange tx) <$> posixTimeRangeToContainedSlotRange @w timeRange - else pure $ Left $ WAPI.ToCardanoError InvalidValidityRange + else pure $ Left "Invalid validity interval." where setRange tx' range = tx' {txValidRange = range} diff --git a/src/BotPlutusInterface/CardanoCLI.hs b/src/BotPlutusInterface/CardanoCLI.hs index df04a111..4e66b65a 100644 --- a/src/BotPlutusInterface/CardanoCLI.hs +++ b/src/BotPlutusInterface/CardanoCLI.hs @@ -142,24 +142,19 @@ calculateMinUtxo :: Map DatumHash Datum -> TxOut -> Eff effs (Either Text Integer) -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." - _ -> - 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 - } +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 + } -- | Calculating fee for an unbalanced transaction calculateMinFee :: @@ -196,46 +191,39 @@ buildTx :: Tx -> Eff effs (Either Text ExBudget) buildTx pabConf privKeys txBudget tx = do - 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)] - ] + 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)] ] + ] -- Signs and writes a tx (uses the tx body written to disk as input) signTx :: @@ -378,25 +366,22 @@ txOutOpts :: PABConfig -> Map DatumHash Datum -> [TxOut] -> [Text] txOutOpts pabConf datums = concatMap ( \TxOut {txOutAddress, txOutValue, txOutDatumHash} -> - if Value.isZero txOutValue - then [] - else - mconcat - [ - [ "--tx-out" - , Text.intercalate - "+" - [ unsafeSerialiseAddress pabConf.pcNetwork txOutAddress - , valueToCliArg txOutValue - ] + 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] diff --git a/src/BotPlutusInterface/Contract.hs b/src/BotPlutusInterface/Contract.hs index e1183bc8..37567103 100644 --- a/src/BotPlutusInterface/Contract.hs +++ b/src/BotPlutusInterface/Contract.hs @@ -85,7 +85,6 @@ import Plutus.Contract.Types (Contract (..), ContractEffs) import PlutusTx.Builtins (fromBuiltin) import Prettyprinter (Pretty (pretty), (<+>)) import Prettyprinter qualified as PP -import Wallet.API qualified as WAPI import Wallet.Emulator.Error (WalletAPIError (..)) import Prelude @@ -293,7 +292,7 @@ balanceTx contractEnv unbalancedTx = do result <- handleCollateral @w contractEnv case result of - Left e -> pure $ BalanceTxFailed e + Left e -> pure $ BalanceTxFailed (OtherError e) _ -> do uploadDir @w pabConf.pcSigningKeyFileDir eitherBalancedTx <- @@ -305,7 +304,7 @@ balanceTx contractEnv unbalancedTx = do pabConf.pcOwnPubKeyHash unbalancedTx - pure $ either BalanceTxFailed (BalanceTxSuccess . Right) eitherBalancedTx + pure $ either (BalanceTxFailed . InsufficientFunds) (BalanceTxSuccess . Right) eitherBalancedTx -- | This step would build tx files, write them to disk and submit them to the chain writeBalancedTx :: @@ -451,7 +450,7 @@ handleCollateral :: forall (w :: Type) (effs :: [Type -> Type]). Member (PABEffect w) effs => ContractEnvironment w -> - Eff effs (Either WAPI.WalletAPIError ()) + Eff effs (Either Text ()) handleCollateral cEnv = do result <- (fmap swapEither . runEitherT) $ do @@ -474,13 +473,13 @@ handleCollateral cEnv = do helperLog ("Failed to create collateral UTxO: " <> pretty notCreatedCollateral) - pure notCreatedCollateral + pure ("Failed to create collateral UTxO: " <> notCreatedCollateral) case result of Right collteralUtxo -> setInMemCollateral @w collteralUtxo >> Right <$> printBpiLog @w (Debug [CollateralLog]) "successfully set the collateral utxo in env." - Left err -> pure $ Left err + Left err -> pure $ Left $ "Failed to make collateral: " <> err where -- helperLog :: PP.Doc () -> ExceptT CollateralUtxo (Eff effs) () @@ -493,13 +492,13 @@ makeCollateral :: forall (w :: Type) (effs :: [Type -> Type]). Member (PABEffect w) effs => ContractEnvironment w -> - Eff effs (Either WAPI.WalletAPIError CollateralUtxo) + Eff effs (Either Text CollateralUtxo) makeCollateral cEnv = runEitherT $ do lift $ printBpiLog @w (Notice [CollateralLog]) "Making collateral" let pabConf = cEnv.cePABConfig unbalancedTx <- - firstEitherT (WAPI.OtherError . T.pack . show) $ + firstEitherT (T.pack . show) $ hoistEither $ Collateral.mkCollateralTx pabConf balancedTx <- @@ -511,7 +510,7 @@ makeCollateral cEnv = runEitherT $ do wbr <- lift $ writeBalancedTx cEnv (Right balancedTx) case wbr of - WriteBalancedTxFailed e -> throwE . WAPI.OtherError $ T.pack $ "Failed to create collateral output: " <> show e + WriteBalancedTxFailed e -> throwE . T.pack $ "Failed to create collateral output: " <> show e WriteBalancedTxSuccess cTx -> do status <- lift $ awaitTxStatusChange cEnv (getCardanoTxId cTx) lift $ printBpiLog @w (Notice [CollateralLog]) $ "Collateral Tx Status: " <> pretty status @@ -522,7 +521,7 @@ findCollateralAtOwnPKH :: forall (w :: Type) (effs :: [Type -> Type]). Member (PABEffect w) effs => ContractEnvironment w -> - Eff effs (Either WAPI.WalletAPIError CollateralUtxo) + Eff effs (Either Text CollateralUtxo) findCollateralAtOwnPKH cEnv = runEitherT $ CollateralUtxo <$> do @@ -532,10 +531,10 @@ findCollateralAtOwnPKH cEnv = (PaymentPubKeyHash pabConf.pcOwnPubKeyHash) pabConf.pcOwnStakePubKeyHash - r <- firstEitherT WAPI.OtherError $ newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr + r <- newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr let refsAndOuts = Map.toList $ Tx.toTxOut <$> r hoistEither $ case filter check refsAndOuts of - [] -> Left $ WAPI.OtherError "Couldn't find collateral UTxO" + [] -> Left "Couldn't find collateral UTxO" ((oref, _) : _) -> Right oref where check (_, txOut) = Tx.txOutValue txOut == collateralValue (cePABConfig cEnv)