diff --git a/src/BotPlutusInterface/Balance.hs b/src/BotPlutusInterface/Balance.hs index 0366afc..e462a84 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 ( @@ -66,6 +66,7 @@ import Ledger.Interval ( ) import Ledger.Time (POSIXTimeRange) import Ledger.Tx ( + ToCardanoError (InvalidValidityRange), Tx (..), TxIn (..), TxInType (..), @@ -83,6 +84,7 @@ import Plutus.V1.Ledger.Api ( import Ledger.Constraints.OffChain qualified as Constraints import Prettyprinter (pretty, viaShow, (<+>)) +import Wallet.API qualified as WAPI import Prelude -- Config for balancing a `Tx`. @@ -106,7 +108,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 +119,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 +138,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 +165,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 +215,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 +223,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 +246,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,7 +256,7 @@ 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. @@ -262,8 +264,9 @@ utxosAndCollateralAtAddress balanceCfg _pabConf changeAddr = then maybe ( throwE $ - "The given transaction uses script, but there's no collateral provided." - <> "This usually means that, we failed to create Tx and update our ContractEnvironment." + 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 @@ -302,7 +305,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 +342,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 +380,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 +406,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 +418,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, @@ -467,22 +470,21 @@ addOutput changeAddr tx = } changeTxOutWithMinAmt <- - firstEitherT (Text.pack . show) $ - newEitherT $ - minUtxo @w changeTxOut + 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 +494,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/CardanoAPI.hs b/src/BotPlutusInterface/CardanoAPI.hs index e600632..6cc81d8 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/CoinSelection.hs b/src/BotPlutusInterface/CoinSelection.hs index 4971d16..a599c06 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 (firstEitherT, hoistEither, newEitherT, runEitherT) import Data.Either.Combinators (isRight, maybeToRight) import Data.Kind (Type) import Data.List qualified as List @@ -51,6 +51,7 @@ import Plutus.V1.Ledger.Api ( Credential (PubKeyCredential, ScriptCredential), ) import Prettyprinter (pretty, (<+>)) +import Wallet.API qualified as WAPI import Prelude {- @@ -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 c6f3073..9855920 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,6 +94,7 @@ 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 @@ -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/src/BotPlutusInterface/Effects.hs b/src/BotPlutusInterface/Effects.hs index 049465d..18fe1dc 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) @@ -294,7 +295,7 @@ calcMinUtxo pabconf txout = do ctxout <- mapLeft (Text.pack . show) $ - TxApi.toCardanoTxOut netId TxApi.toCardanoTxOutDatumHash txout + BPI.CApi.toCardanoTxOut' netId TxApi.toCardanoTxOutDatumHash txout let (Coin minTxOut) = evaluateMinLovelaceOutput pparamsInEra $ diff --git a/test/Spec/BotPlutusInterface/Balance.hs b/test/Spec/BotPlutusInterface/Balance.hs index 86aa8ab..8ba6f33 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 fe12b74..044c355 100644 --- a/test/Spec/BotPlutusInterface/CoinSelection.hs +++ b/test/Spec/BotPlutusInterface/CoinSelection.hs @@ -32,6 +32,7 @@ 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 tests :: TestTree @@ -175,7 +176,7 @@ 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 $