From e195ddc08c3c31eba02e8842c3ef0eebb3bbbde0 Mon Sep 17 00:00:00 2001 From: zmrocze Date: Wed, 28 Sep 2022 20:35:01 +0200 Subject: [PATCH 1/5] Change error type to WalletApiError. --- src/BotPlutusInterface/Balance.hs | 57 +++++++++---------- src/BotPlutusInterface/CoinSelection.hs | 30 +++++----- src/BotPlutusInterface/Contract.hs | 24 ++++---- test/Spec/BotPlutusInterface/Balance.hs | 8 +-- test/Spec/BotPlutusInterface/CoinSelection.hs | 4 +- 5 files changed, 64 insertions(+), 59 deletions(-) diff --git a/src/BotPlutusInterface/Balance.hs b/src/BotPlutusInterface/Balance.hs index 0366afc4..190f6ed0 100644 --- a/src/BotPlutusInterface/Balance.hs +++ b/src/BotPlutusInterface/Balance.hs @@ -55,7 +55,7 @@ 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 ( @@ -70,7 +70,7 @@ import Ledger.Tx ( TxIn (..), TxInType (..), TxOut (..), - TxOutRef (..), + TxOutRef (..), ToCardanoError (InvalidValidityRange) ) import Ledger.Tx qualified as Tx import Ledger.Tx.CardanoAPI (CardanoBuildTx) @@ -84,6 +84,7 @@ import Plutus.V1.Ledger.Api ( import Ledger.Constraints.OffChain qualified as Constraints import Prettyprinter (pretty, viaShow, (<+>)) import Prelude +import qualified Wallet.API as WAPI -- Config for balancing a `Tx`. data BalanceConfig = BalanceConfig @@ -106,7 +107,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 lets us specify custom `BalanceConfig`. @@ -117,12 +118,12 @@ balanceTxIO' :: PABConfig -> PubKeyHash -> UnbalancedTx -> - Eff effs (Either Text Tx) + Eff effs (Either WAPI.WalletAPIError Tx) balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx' = runEitherT $ do updatedOuts <- - firstEitherT (Text.pack . show) $ + firstEitherT WAPI.OtherError $ newEitherT $ sequence <$> traverse (minUtxo @w) (unbalancedTx' ^. Constraints.tx . Tx.outputs) @@ -136,7 +137,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx' = 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 @@ -163,14 +164,14 @@ 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 -- Balance the tx balancedTx <- balanceTxLoop utxoIndex privKeys preBalancedTx - changeTxOutWithMinAmt <- newEitherT $ addOutput @w changeAddr balancedTx + changeTxOutWithMinAmt <- firstEitherT WAPI.OtherError $ newEitherT $ addOutput @w changeAddr balancedTx -- Get current Ada change let adaChange = getAdaChange utxoIndex balancedTx @@ -213,7 +214,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx' = Map TxOutRef TxOut -> Map PubKeyHash DummyPrivKey -> Tx -> - EitherT Text (Eff effs) Tx + EitherT WAPI.WalletAPIError (Eff effs) Tx balanceTxLoop utxoIndex privKeys tx = do void $ lift $ Files.writeAll @w pabConf tx @@ -221,9 +222,9 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx' = txWithoutFees <- newEitherT $ balanceTxStep @w balanceCfg 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 @@ -244,7 +245,7 @@ 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 inMemCollateral <- lift $ getInMemCollateral @w @@ -254,14 +255,14 @@ utxosAndCollateralAtAddress balanceCfg _pabConf changeAddr = (UtxosAtExcluding changeAddr . Set.singleton . collateralTxOutRef) inMemCollateral - utxos <- firstEitherT (Text.pack . show) $ newEitherT $ queryNode @w nodeQuery + utxos <- firstEitherT (WAPI.OtherError . Text.pack . show) $ newEitherT $ queryNode @w nodeQuery -- check if `bcHasScripts` is true, if this is the case then we search of -- collateral UTxO in the environment, if such collateral is not present we throw Error. if bcHasScripts balanceCfg then maybe - ( throwE $ + ( 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." ) @@ -302,7 +303,7 @@ balanceTxStep :: Map TxOutRef TxOut -> Address -> Tx -> - Eff effs (Either Text Tx) + Eff effs (Either WAPI.WalletAPIError Tx) balanceTxStep balanceCfg utxos changeAddr tx = runEitherT $ (newEitherT . balanceTxIns @w utxos) tx @@ -339,7 +340,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 @@ -377,7 +378,7 @@ handleNonAdaChange :: Address -> Map TxOutRef TxOut -> Tx -> - Eff effs (Either Text Tx) + Eff effs (Either WAPI.WalletAPIError Tx) handleNonAdaChange balanceCfg changeAddr utxos tx = runEitherT $ do let nonAdaChange :: Value nonAdaChange = getNonAdaChange utxos tx @@ -403,7 +404,7 @@ handleNonAdaChange balanceCfg changeAddr utxos tx = runEitherT $ do } newOutputWithMinAmt <- - firstEitherT (Text.pack . show) $ + firstEitherT WAPI.OtherError $ newEitherT $ minUtxo @w newOutput let outputs :: [TxOut] @@ -415,7 +416,7 @@ handleNonAdaChange balanceCfg changeAddr utxos tx = runEitherT $ do if isValueNat nonAdaChange then return $ if Value.isZero nonAdaChange then tx else tx {txOutputs = outputs} - else throwE "Not enough inputs to balance tokens." + else throwE $ 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, @@ -466,23 +467,21 @@ addOutput changeAddr tx = , txOutDatumHash = Nothing } - changeTxOutWithMinAmt <- - firstEitherT (Text.pack . show) $ - newEitherT $ - minUtxo @w changeTxOut + changeTxOutWithMinAmt <- newEitherT $ + minUtxo @w changeTxOut return $ tx {txOutputs = txOutputs tx ++ [changeTxOutWithMinAmt]} {- | 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) @@ -492,14 +491,14 @@ addValidRange :: Member (PABEffect w) effs => POSIXTimeRange -> Either CardanoBuildTx Tx -> - Eff effs (Either Text Tx) -addValidRange _ (Left _) = pure $ Left "BPI is not using CardanoBuildTx" + Eff effs (Either WAPI.WalletAPIError Tx) +addValidRange _ (Left _) = pure $ Left $ WAPI.OtherError "BPI is not using CardanoBuildTx" addValidRange timeRange (Right 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} diff --git a/src/BotPlutusInterface/CoinSelection.hs b/src/BotPlutusInterface/CoinSelection.hs index 4971d160..f4f476c9 100644 --- a/src/BotPlutusInterface/CoinSelection.hs +++ b/src/BotPlutusInterface/CoinSelection.hs @@ -28,7 +28,7 @@ import Control.Lens ( import Control.Monad.Except (foldM, throwError, unless) import Control.Monad.Freer (Eff, Member) import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Either (hoistEither, newEitherT, runEitherT) +import Control.Monad.Trans.Either (hoistEither, newEitherT, runEitherT, firstEitherT) import Data.Either.Combinators (isRight, maybeToRight) import Data.Kind (Type) import Data.List qualified as List @@ -52,6 +52,7 @@ import Plutus.V1.Ledger.Api ( ) import Prettyprinter (pretty, (<+>)) import Prelude +import qualified Wallet.API as WAPI {- @@ -184,7 +185,7 @@ selectTxIns :: Set TxIn -> -- Inputs `TxIn` of the transaction. Map TxOutRef TxOut -> -- Map of utxos that can be spent Value -> -- total output value of the Tx. - Eff effs (Either Text (Set TxIn)) + Eff effs (Either WAPI.WalletAPIError (Set TxIn)) selectTxIns originalTxIns utxosIndex outValue = runEitherT $ do let -- This represents the input value. @@ -227,13 +228,14 @@ selectTxIns originalTxIns utxosIndex outValue = -- we use the default search strategy to get indexes of optimal utxos, these indexes are for the -- remainingUtxos, as we are sampling utxos from that set. selectedUtxosIdxs <- - newEitherT $ - searchTxIns @w - defaultSearchStrategy - (isSufficient outVec) - outVec - txInsVec - remainingUtxosVec + firstEitherT WAPI.OtherError $ + newEitherT $ + searchTxIns @w + defaultSearchStrategy + (isSufficient outVec) + outVec + txInsVec + remainingUtxosVec lift $ printBpiLog @w (Debug [CoinSelectionLog]) $ "" <+> "Selected UTxOs Index: " <+> pretty selectedUtxosIdxs @@ -244,10 +246,10 @@ selectTxIns originalTxIns utxosIndex outValue = selectedVectors :: [ValueVector] selectedVectors = selectedUtxosIdxs ^.. folded . to (\idx -> remainingUtxosVec ^? ix idx) . folded - finalTxInputVector <- hoistEither $ foldM addVec txInsVec selectedVectors - unless (isSufficient outVec finalTxInputVector) $ throwError "Insufficient Funds" + finalTxInputVector <- firstEitherT WAPI.OtherError $ hoistEither $ foldM addVec txInsVec selectedVectors + unless (isSufficient outVec finalTxInputVector) $ throwError (WAPI.InsufficientFunds "Insufficient funds in the final vector.") - selectedTxIns <- hoistEither $ mapM txOutToTxIn selectedUtxos + selectedTxIns <- firstEitherT WAPI.OtherError $ hoistEither $ mapM txOutToTxIn selectedUtxos lift $ printBpiLog @w (Debug [CoinSelectionLog]) $ "Selected TxIns: " <+> pretty selectedTxIns @@ -447,9 +449,9 @@ zeroVec :: Int -> Vector Integer zeroVec n = Vec.replicate n 0 -- | Convert a value to a vector. -valueToVec :: Set AssetClass -> Value -> Either Text ValueVector +valueToVec :: Set AssetClass -> Value -> Either WAPI.WalletAPIError ValueVector valueToVec allAssetClasses v = - maybeToRight "Error: Not able to uncons from empty vector." $ + maybeToRight (WAPI.OtherError "Error: Not able to uncons from empty vector.") $ (over _Just fst . uncons) $ valuesToVecs allAssetClasses [v] -- | Convert values to a list of vectors. diff --git a/src/BotPlutusInterface/Contract.hs b/src/BotPlutusInterface/Contract.hs index c6f3073a..c357c9aa 100644 --- a/src/BotPlutusInterface/Contract.hs +++ b/src/BotPlutusInterface/Contract.hs @@ -95,6 +95,8 @@ import Prettyprinter (Pretty (pretty), (<+>)) import Prettyprinter qualified as PP import Wallet.Emulator.Error (WalletAPIError (..)) import Prelude +import qualified Wallet.API as WAPI +import qualified Data.Text as T runContract :: forall (w :: Type) (s :: Row Type) (e :: Type) (a :: Type). @@ -325,7 +327,7 @@ balanceTx contractEnv unbalancedTx@(UnbalancedTx (Right tx') _ _ _) = do result <- handleCollateral @w contractEnv case result of - Left e -> pure $ BalanceTxFailed (OtherError e) + Left e -> pure $ BalanceTxFailed e _ -> do uploadDir @w pabConf.pcSigningKeyFileDir eitherBalancedTx <- @@ -337,7 +339,7 @@ balanceTx contractEnv unbalancedTx@(UnbalancedTx (Right tx') _ _ _) = do pabConf.pcOwnPubKeyHash unbalancedTx - pure $ either (BalanceTxFailed . OtherError) (BalanceTxSuccess . EmulatorTx) eitherBalancedTx + pure $ either BalanceTxFailed (BalanceTxSuccess . EmulatorTx) eitherBalancedTx fromCardanoTx :: CardanoTx -> Tx.Tx fromCardanoTx (CardanoApiTx _) = error "Cannot handle cardano api tx" @@ -499,7 +501,7 @@ handleCollateral :: forall (w :: Type) (effs :: [Type -> Type]). Member (PABEffect w) effs => ContractEnvironment w -> - Eff effs (Either Text ()) + Eff effs (Either WAPI.WalletAPIError ()) handleCollateral cEnv = do result <- (fmap swapEither . runEitherT) $ do @@ -525,13 +527,13 @@ handleCollateral cEnv = do helperLog ("Failed to create collateral UTxO: " <> pretty notCreatedCollateral) - pure ("Failed to create collateral UTxO: " <> notCreatedCollateral) + pure ("Failed to create collateral UTxO: " <> show 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 $ "Failed to make collateral: " <> err + Left err -> pure $ Left $ WAPI.OtherError $ T.pack $ "Failed to make collateral: " <> show err {- | Create collateral UTxO by submitting Tx. Then try to find created UTxO at own PKH address. @@ -540,13 +542,13 @@ makeCollateral :: forall (w :: Type) (effs :: [Type -> Type]). Member (PABEffect w) effs => ContractEnvironment w -> - Eff effs (Either Text CollateralUtxo) + Eff effs (Either WAPI.WalletAPIError CollateralUtxo) makeCollateral cEnv = runEitherT $ do lift $ printBpiLog @w (Notice [CollateralLog]) "Making collateral" let pabConf = cEnv.cePABConfig unbalancedTx <- - firstEitherT (Text.pack . show) $ + firstEitherT (WAPI.OtherError . Text.pack . show) $ hoistEither $ Collateral.mkCollateralTx pabConf balancedTx <- @@ -558,7 +560,7 @@ makeCollateral cEnv = runEitherT $ do wbr <- lift $ writeBalancedTx cEnv (EmulatorTx balancedTx) case wbr of - WriteBalancedTxFailed e -> throwE . Text.pack $ "Failed to create collateral output: " <> show e + WriteBalancedTxFailed e -> throwE . WAPI.OtherError . Text.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 @@ -569,7 +571,7 @@ findCollateralAtOwnPKH :: forall (w :: Type) (effs :: [Type -> Type]). Member (PABEffect w) effs => ContractEnvironment w -> - Eff effs (Either Text CollateralUtxo) + Eff effs (Either WAPI.WalletAPIError CollateralUtxo) findCollateralAtOwnPKH cEnv = runEitherT $ CollateralUtxo <$> do @@ -580,11 +582,11 @@ findCollateralAtOwnPKH cEnv = pabConf.pcOwnStakePubKeyHash r <- - firstEitherT (Text.pack . show) $ + firstEitherT (WAPI.OtherError . Text.pack . show) $ newEitherT $ queryNode @w (UtxosAt changeAddr) let refsAndOuts = Map.toList $ Tx.toTxOut <$> r hoistEither $ case filter check refsAndOuts of - [] -> Left "Couldn't find collateral UTxO" + [] -> Left $ WAPI.OtherError "Couldn't find collateral UTxO" ((oref, _) : _) -> Right oref where check (_, txOut) = Tx.txOutValue txOut == collateralValue (cePABConfig cEnv) diff --git a/test/Spec/BotPlutusInterface/Balance.hs b/test/Spec/BotPlutusInterface/Balance.hs index 86aa8abe..8ba6f33a 100644 --- a/test/Spec/BotPlutusInterface/Balance.hs +++ b/test/Spec/BotPlutusInterface/Balance.hs @@ -237,8 +237,8 @@ dontAddChangeToDatum = do unbalancedTx <- liftAssertFailure eunbalancedTx (\err -> "MkTx Error: " <> show err) let (eRslt, _finalState) = runPABEffectPure initState (balanceTxIO @() @'[PABEffect ()] pabConf pkh3 unbalancedTx) - eRslt' <- liftAssertFailure eRslt (\txt -> "PAB effect error: " <> Text.unpack txt) - trx <- liftAssertFailure eRslt' (\txt -> "Balancing error: " <> Text.unpack txt) + eRslt' <- liftAssertFailure eRslt (\txt -> "PAB effect error: " <> show txt) + trx <- liftAssertFailure eRslt' (\txt -> "Balancing error: " <> show txt) let scrTxOut'' = scrTxOut & Ledger.ciTxOutValue .~ payToScriptValue scrTxOutExpected = Ledger.toTxOut scrTxOut'' isScrUtxo :: TxOut -> Bool @@ -307,8 +307,8 @@ dontAddChangeToDatum2 = do unbalancedTx <- liftAssertFailure eunbalancedTx (\err -> "MkTx Error: " <> show err) let (eRslt, _finalState) = runPABEffectPure initState (balanceTxIO @() @'[PABEffect ()] pabConf pkh3 unbalancedTx) - eRslt' <- liftAssertFailure eRslt (\txt -> "PAB effect error: " <> Text.unpack txt) - trx <- liftAssertFailure eRslt' (\txt -> "Balancing error: " <> Text.unpack txt) + eRslt' <- liftAssertFailure eRslt (\txt -> "PAB effect error: " <> show txt) + trx <- liftAssertFailure eRslt' (\txt -> "Balancing error: " <> show txt) let scrTxOut'' = scrTxOut & Ledger.ciTxOutValue .~ payToScrValue scrTxOutExpected = Ledger.toTxOut scrTxOut'' isScrUtxo :: TxOut -> Bool diff --git a/test/Spec/BotPlutusInterface/CoinSelection.hs b/test/Spec/BotPlutusInterface/CoinSelection.hs index fe12b74c..34875044 100644 --- a/test/Spec/BotPlutusInterface/CoinSelection.hs +++ b/test/Spec/BotPlutusInterface/CoinSelection.hs @@ -33,6 +33,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertFailure, testCase, (@?=)) import Test.Tasty.QuickCheck (testProperty) import Prelude +import qualified Wallet.API as WAPI tests :: TestTree tests = @@ -175,7 +176,8 @@ validateBalancing = withMaxSuccess 10000 (forAll balanceGen validate) where validate :: (TxOut, Map TxOutRef TxOut) -> Bool validate (txOutput, utxos) = - let result :: (Either Text (Either Text (Set TxIn))) + let + result :: Either Text (Either WAPI.WalletAPIError (Set TxIn)) result = fst $ runPABEffectPure def $ From 4a9a3956d24d17505a0d452e671a082bc48bb635 Mon Sep 17 00:00:00 2001 From: zmrocze Date: Thu, 29 Sep 2022 19:52:41 +0200 Subject: [PATCH 2/5] Format. --- src/BotPlutusInterface/Balance.hs | 15 +++++++++------ src/BotPlutusInterface/CoinSelection.hs | 4 ++-- src/BotPlutusInterface/Contract.hs | 4 ++-- test/Spec/BotPlutusInterface/CoinSelection.hs | 5 ++--- 4 files changed, 15 insertions(+), 13 deletions(-) diff --git a/src/BotPlutusInterface/Balance.hs b/src/BotPlutusInterface/Balance.hs index 190f6ed0..e462a844 100644 --- a/src/BotPlutusInterface/Balance.hs +++ b/src/BotPlutusInterface/Balance.hs @@ -66,11 +66,12 @@ import Ledger.Interval ( ) import Ledger.Time (POSIXTimeRange) import Ledger.Tx ( + ToCardanoError (InvalidValidityRange), Tx (..), TxIn (..), TxInType (..), TxOut (..), - TxOutRef (..), ToCardanoError (InvalidValidityRange) + TxOutRef (..), ) import Ledger.Tx qualified as Tx import Ledger.Tx.CardanoAPI (CardanoBuildTx) @@ -83,8 +84,8 @@ import Plutus.V1.Ledger.Api ( import Ledger.Constraints.OffChain qualified as Constraints import Prettyprinter (pretty, viaShow, (<+>)) +import Wallet.API qualified as WAPI import Prelude -import qualified Wallet.API as WAPI -- Config for balancing a `Tx`. data BalanceConfig = BalanceConfig @@ -262,9 +263,10 @@ utxosAndCollateralAtAddress balanceCfg _pabConf changeAddr = if bcHasScripts balanceCfg 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." + ( 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." ) (const $ pure (utxos, inMemCollateral)) inMemCollateral @@ -467,7 +469,8 @@ addOutput changeAddr tx = , txOutDatumHash = Nothing } - changeTxOutWithMinAmt <- newEitherT $ + changeTxOutWithMinAmt <- + newEitherT $ minUtxo @w changeTxOut return $ tx {txOutputs = txOutputs tx ++ [changeTxOutWithMinAmt]} diff --git a/src/BotPlutusInterface/CoinSelection.hs b/src/BotPlutusInterface/CoinSelection.hs index f4f476c9..a599c062 100644 --- a/src/BotPlutusInterface/CoinSelection.hs +++ b/src/BotPlutusInterface/CoinSelection.hs @@ -28,7 +28,7 @@ import Control.Lens ( import Control.Monad.Except (foldM, throwError, unless) import Control.Monad.Freer (Eff, Member) import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Either (hoistEither, newEitherT, runEitherT, firstEitherT) +import Control.Monad.Trans.Either (firstEitherT, hoistEither, newEitherT, runEitherT) import Data.Either.Combinators (isRight, maybeToRight) import Data.Kind (Type) import Data.List qualified as List @@ -51,8 +51,8 @@ import Plutus.V1.Ledger.Api ( Credential (PubKeyCredential, ScriptCredential), ) import Prettyprinter (pretty, (<+>)) +import Wallet.API qualified as WAPI import Prelude -import qualified Wallet.API as WAPI {- diff --git a/src/BotPlutusInterface/Contract.hs b/src/BotPlutusInterface/Contract.hs index c357c9aa..98559208 100644 --- a/src/BotPlutusInterface/Contract.hs +++ b/src/BotPlutusInterface/Contract.hs @@ -68,6 +68,7 @@ import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Map qualified as Map import Data.Row (Row) import Data.Text (Text) +import Data.Text qualified as T import Data.Text qualified as Text import Data.Vector qualified as V import Ledger (POSIXTime, getCardanoTxId) @@ -93,10 +94,9 @@ 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 -import qualified Wallet.API as WAPI -import qualified Data.Text as T runContract :: forall (w :: Type) (s :: Row Type) (e :: Type) (a :: Type). diff --git a/test/Spec/BotPlutusInterface/CoinSelection.hs b/test/Spec/BotPlutusInterface/CoinSelection.hs index 34875044..044c355d 100644 --- a/test/Spec/BotPlutusInterface/CoinSelection.hs +++ b/test/Spec/BotPlutusInterface/CoinSelection.hs @@ -32,8 +32,8 @@ import Test.QuickCheck (Gen, Property, forAll, withMaxSuccess) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertFailure, testCase, (@?=)) import Test.Tasty.QuickCheck (testProperty) +import Wallet.API qualified as WAPI import Prelude -import qualified Wallet.API as WAPI tests :: TestTree tests = @@ -176,8 +176,7 @@ validateBalancing = withMaxSuccess 10000 (forAll balanceGen validate) where validate :: (TxOut, Map TxOutRef TxOut) -> Bool validate (txOutput, utxos) = - let - result :: Either Text (Either WAPI.WalletAPIError (Set TxIn)) + let result :: Either Text (Either WAPI.WalletAPIError (Set TxIn)) result = fst $ runPABEffectPure def $ From 015bb9e6335d6caba6650b8b5b5b018838cb98b8 Mon Sep 17 00:00:00 2001 From: zmrocze Date: Thu, 29 Sep 2022 19:53:35 +0200 Subject: [PATCH 3/5] Don't throw OutputZeroAda in toCardano translation. --- src/BotPlutusInterface/Effects.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/src/BotPlutusInterface/Effects.hs b/src/BotPlutusInterface/Effects.hs index 049465d4..4cd8a227 100644 --- a/src/BotPlutusInterface/Effects.hs +++ b/src/BotPlutusInterface/Effects.hs @@ -86,6 +86,8 @@ import Data.Text (Text) import Data.Text qualified as Text import Ledger qualified import Ledger.Ada qualified as Ada +import Ledger.Tx (TxOut (TxOut)) +import Ledger.Tx.CardanoAPI (toCardanoAddressInEra, toCardanoValue) import Ledger.Tx.CardanoAPI qualified as TxApi import Ledger.Validation (Coin (Coin)) import Plutus.Contract.Effects (ChainIndexQuery, ChainIndexResponse) @@ -294,7 +296,7 @@ calcMinUtxo pabconf txout = do ctxout <- mapLeft (Text.pack . show) $ - TxApi.toCardanoTxOut netId TxApi.toCardanoTxOutDatumHash txout + toCardanoTxOutForked netId TxApi.toCardanoTxOutDatumHash txout let (Coin minTxOut) = evaluateMinLovelaceOutput pparamsInEra $ @@ -305,6 +307,17 @@ calcMinUtxo pabconf txout = do if missingLovelace > 0 then calcMinUtxo pabconf (txout {Ledger.txOutValue = Ledger.txOutValue txout <> Ada.toValue missingLovelace}) else return txout + where + -- We need to redefine this to remove error reporting with 0 ada outputs. + toCardanoTxOutValue value = do + -- when (Ada.fromValue value == mempty) (Left OutputHasZeroAda) + CApi.TxOutValue CApi.MultiAssetInBabbageEra <$> toCardanoValue value + + toCardanoTxOutForked networkId fromHash (TxOut addr value datumHash) = + CApi.TxOut <$> toCardanoAddressInEra networkId addr + <*> toCardanoTxOutValue value + <*> fromHash datumHash + <*> pure CApi.S.ReferenceScriptNone -- Couldn't use the template haskell makeEffect here, because it caused an OverlappingInstances problem. -- For some reason, we need to manually propagate the @w@ type variable to @send@ From 5db75f0335b6c42937607006e6fe873fabbeaed8 Mon Sep 17 00:00:00 2001 From: zmrocze Date: Thu, 29 Sep 2022 20:42:20 +0200 Subject: [PATCH 4/5] Verbose name. --- src/BotPlutusInterface/Effects.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/BotPlutusInterface/Effects.hs b/src/BotPlutusInterface/Effects.hs index 4cd8a227..92f5e321 100644 --- a/src/BotPlutusInterface/Effects.hs +++ b/src/BotPlutusInterface/Effects.hs @@ -296,7 +296,7 @@ calcMinUtxo pabconf txout = do ctxout <- mapLeft (Text.pack . show) $ - toCardanoTxOutForked netId TxApi.toCardanoTxOutDatumHash txout + toCardanoTxOutPossibleZeroAda netId TxApi.toCardanoTxOutDatumHash txout let (Coin minTxOut) = evaluateMinLovelaceOutput pparamsInEra $ @@ -309,13 +309,13 @@ calcMinUtxo pabconf txout = do else return txout where -- We need to redefine this to remove error reporting with 0 ada outputs. - toCardanoTxOutValue value = do + toCardanoTxOutValuePossibleZeroAda value = do -- when (Ada.fromValue value == mempty) (Left OutputHasZeroAda) CApi.TxOutValue CApi.MultiAssetInBabbageEra <$> toCardanoValue value - toCardanoTxOutForked networkId fromHash (TxOut addr value datumHash) = + toCardanoTxOutPossibleZeroAda networkId fromHash (TxOut addr value datumHash) = CApi.TxOut <$> toCardanoAddressInEra networkId addr - <*> toCardanoTxOutValue value + <*> toCardanoTxOutValuePossibleZeroAda value <*> fromHash datumHash <*> pure CApi.S.ReferenceScriptNone From 8524fef2a22a1185b02f36d9d4c2d1b193ebbdc2 Mon Sep 17 00:00:00 2001 From: Mikhail Lazarev Date: Mon, 10 Oct 2022 15:02:59 +0400 Subject: [PATCH 5/5] moving custom `toCardanoTxOut` to another module --- src/BotPlutusInterface/CardanoAPI.hs | 21 +++++++++++++++++++++ src/BotPlutusInterface/Effects.hs | 16 ++-------------- 2 files changed, 23 insertions(+), 14 deletions(-) diff --git a/src/BotPlutusInterface/CardanoAPI.hs b/src/BotPlutusInterface/CardanoAPI.hs index e600632c..6cc81d88 100644 --- a/src/BotPlutusInterface/CardanoAPI.hs +++ b/src/BotPlutusInterface/CardanoAPI.hs @@ -6,9 +6,11 @@ module BotPlutusInterface.CardanoAPI ( fromCardanoSlotNo, fromCardanoEpochInfo, posixTimeToSlot, + toCardanoTxOut', ) where import Cardano.Api qualified as CApi +import Cardano.Api.Shelley qualified as CApi.S import Cardano.Ledger.Slot (EpochInfo) import Cardano.Prelude (maybeToEither) import Cardano.Slotting.EpochInfo (hoistEpochInfo) @@ -99,3 +101,22 @@ convertOutputDatum = \case V2.NoOutputDatum -> Nothing V2.OutputDatumHash dh -> Just (dh, Nothing) V2.OutputDatum d -> Just (ScriptUtils.datumHash d, Just d) + +{- | Custom version of `toCardanoTxOut` from `plutus-ledger` + which doesn't throw an error in case `Value` has 0 Ada +-} +toCardanoTxOut' :: + CApi.S.NetworkId -> + ( Maybe ScriptUtils.DatumHash -> + Either TxApi.ToCardanoError (CApi.S.TxOutDatum ctx CApi.S.BabbageEra) + ) -> + Ledger.TxOut -> + Either TxApi.ToCardanoError (CApi.S.TxOut ctx CApi.S.BabbageEra) +toCardanoTxOut' networkId fromHash (Ledger.TxOut addr value datumHash) = + CApi.TxOut <$> TxApi.toCardanoAddressInEra networkId addr + <*> toCardanoTxOutValue' value + <*> fromHash datumHash + <*> pure CApi.S.ReferenceScriptNone + where + toCardanoTxOutValue' v = do + CApi.TxOutValue CApi.MultiAssetInBabbageEra <$> TxApi.toCardanoValue v diff --git a/src/BotPlutusInterface/Effects.hs b/src/BotPlutusInterface/Effects.hs index 92f5e321..18fe1dc0 100644 --- a/src/BotPlutusInterface/Effects.hs +++ b/src/BotPlutusInterface/Effects.hs @@ -35,6 +35,7 @@ module BotPlutusInterface.Effects ( calcMinUtxo, ) where +import BotPlutusInterface.CardanoAPI qualified as BPI.CApi import BotPlutusInterface.CardanoNode.Effects (NodeQuery, runNodeQuery) import BotPlutusInterface.ChainIndex (handleChainIndexReq) import BotPlutusInterface.Collateral (withCollateralHandling) @@ -86,8 +87,6 @@ import Data.Text (Text) import Data.Text qualified as Text import Ledger qualified import Ledger.Ada qualified as Ada -import Ledger.Tx (TxOut (TxOut)) -import Ledger.Tx.CardanoAPI (toCardanoAddressInEra, toCardanoValue) import Ledger.Tx.CardanoAPI qualified as TxApi import Ledger.Validation (Coin (Coin)) import Plutus.Contract.Effects (ChainIndexQuery, ChainIndexResponse) @@ -296,7 +295,7 @@ calcMinUtxo pabconf txout = do ctxout <- mapLeft (Text.pack . show) $ - toCardanoTxOutPossibleZeroAda netId TxApi.toCardanoTxOutDatumHash txout + BPI.CApi.toCardanoTxOut' netId TxApi.toCardanoTxOutDatumHash txout let (Coin minTxOut) = evaluateMinLovelaceOutput pparamsInEra $ @@ -307,17 +306,6 @@ calcMinUtxo pabconf txout = do if missingLovelace > 0 then calcMinUtxo pabconf (txout {Ledger.txOutValue = Ledger.txOutValue txout <> Ada.toValue missingLovelace}) else return txout - where - -- We need to redefine this to remove error reporting with 0 ada outputs. - toCardanoTxOutValuePossibleZeroAda value = do - -- when (Ada.fromValue value == mempty) (Left OutputHasZeroAda) - CApi.TxOutValue CApi.MultiAssetInBabbageEra <$> toCardanoValue value - - toCardanoTxOutPossibleZeroAda networkId fromHash (TxOut addr value datumHash) = - CApi.TxOut <$> toCardanoAddressInEra networkId addr - <*> toCardanoTxOutValuePossibleZeroAda value - <*> fromHash datumHash - <*> pure CApi.S.ReferenceScriptNone -- Couldn't use the template haskell makeEffect here, because it caused an OverlappingInstances problem. -- For some reason, we need to manually propagate the @w@ type variable to @send@