Merge pull request #155 from mlabs-haskell/karol/error-messages

Fix "OutputZeroAda" bug and WalletApiError errors.
mlabs-haskell · Oct 10, 2022 · d6cf1e3 · d6cf1e3
2 parents 857ec74 + 8524fef
commit d6cf1e3
Show file tree

Hide file tree

Showing 7 changed files with 88 additions and 59 deletions.
diff --git 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,17 +215,17 @@ 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
 
       -- Calculate fees by pre-balancing the tx, building it, and running the CLI on result
       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,16 +256,17 @@ 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 $
-              "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
@@ -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
@@ -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.