post-merge fixes

- still one test fails

Author: mikekeke

src/BotPlutusInterface/Balance.hs

@@ -41,7 +41,6 @@ import Control.Monad.Trans.Except (throwE)
 import Data.Bifunctor (bimap)
 import Data.Coerce (coerce)
 import Data.Kind (Type)
-import Data.List ((\\))
 import Data.List qualified as List
 import Data.Map (Map)
 import Data.Map qualified as Map
@@ -152,7 +151,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
 
       -- Get current Ada change
       let adaChange = getAdaChange utxoIndex balancedTx
-          bTx = fst <$> balanceTxLoop utxoIndex privKeys minUtxos (addOutput changeAddr balancedTx)
+          bTx = balanceTxLoop utxoIndex privKeys (addOutput changeAddr balancedTx)
 
       -- Checks if there's ada change left, if there is then we check
       -- if `bcSeparateChange` is true, if this is the case then we create a new UTxO at
@@ -188,16 +187,9 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
       Map TxOutRef TxOut ->
       Map PubKeyHash DummyPrivKey ->
       Tx ->
-      EitherT Text (Eff effs) (Tx, [(TxOut, Integer)])
-    balanceTxLoop utxoIndex privKeys prevMinUtxos tx = do
+      EitherT Text (Eff effs) Tx
+    balanceTxLoop utxoIndex privKeys tx = do
       void $ lift $ Files.writeAll @w pabConf tx
-      nextMinUtxos <-
-        newEitherT $
-          calculateMinUtxos @w pabConf (Tx.txData tx) $ Tx.txOutputs tx \\ map fst prevMinUtxos
-
-      let minUtxos = prevMinUtxos ++ nextMinUtxos
-
-      lift $ printBpiLog @w (Debug [TxBalancingLog]) $ "Min utxos:" <+> pretty minUtxos
 
       -- Calculate fees by pre-balancing the tx, building it, and running the CLI on result
       txWithoutFees <-
@@ -212,11 +204,11 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
       lift $ printBpiLog @w (Debug [TxBalancingLog]) $ "Fees:" <+> pretty fees
 
       -- Rebalance the initial tx with the above fees
-      balancedTx <- newEitherT $ balanceTxStep @w balanceCfg minUtxos utxoIndex changeAddr $ tx `withFee` fees
+      balancedTx <- newEitherT $ balanceTxStep @w balanceCfg utxoIndex changeAddr $ tx `withFee` fees
 
       if balancedTx == tx
-        then pure (balancedTx, minUtxos)
-        else balanceTxLoop utxoIndex privKeys minUtxos balancedTx
+        then pure balancedTx
+        else balanceTxLoop utxoIndex privKeys balancedTx
 
 -- `utxosAndCollateralAtAddress` returns all the utxos that can be used as an input of a `Tx`,
 -- i.e. we filter out `CollateralUtxo` present at the user's address, so it can't be used as input of a `Tx`.
@@ -275,14 +267,13 @@ balanceTxStep ::
   forall (w :: Type) (effs :: [Type -> Type]).
   Member (PABEffect w) effs =>
   BalanceConfig ->
-  [(TxOut, Integer)] ->
   Map TxOutRef TxOut ->
   Address ->
   Tx ->
   Eff effs (Either Text Tx)
-balanceTxStep balanceCfg minUtxos utxos changeAddr tx =
+balanceTxStep balanceCfg utxos changeAddr tx =
   runEitherT $
-    (newEitherT . balanceTxIns @w utxos) (addLovelaces minUtxos tx)
+    (newEitherT . balanceTxIns @w utxos) tx
       >>= hoistEither . handleNonAdaChange balanceCfg changeAddr utxos
 
 -- | Get change value of a transaction, taking inputs, outputs, mint and fees into account
@@ -305,23 +296,6 @@ getAdaChange utxos = lovelaceValue . getChange utxos
 getNonAdaChange :: Map TxOutRef TxOut -> Tx -> Value
 getNonAdaChange utxos = Ledger.noAdaValue . getChange utxos
 
--- | Add min lovelaces to each tx output
-addLovelaces :: [(TxOut, Integer)] -> Tx -> Tx
-addLovelaces minLovelaces tx =
-  let lovelacesAdded =
-        map
-          ( \txOut ->
-              let outValue = txOutValue txOut
-                  lovelaces = Ada.getLovelace $ Ada.fromValue outValue
-                  minUtxo = fromMaybe 0 $ lookup txOut minLovelaces
-               in txOut
-                    { txOutValue =
-                        outValue <> Ada.lovelaceValueOf (max 0 (minUtxo - lovelaces))
-                    }
-          )
-          $ txOutputs tx
-   in tx {txOutputs = lovelacesAdded}
-
 balanceTxIns ::
   forall (w :: Type) (effs :: [Type -> Type]).
   Member (PABEffect w) effs =>

src/BotPlutusInterface/ChainIndex.hs

@@ -57,11 +57,11 @@ handleChainIndexReq contractEnv@ContractEnvironment {cePABConfig} =
     TxOutFromRef txOutRef ->
       TxOutRefResponse <$> chainIndexQueryOne cePABConfig (ChainIndexClient.getTxOut txOutRef)
     UnspentTxOutFromRef txOutRef ->
-      UnspentTxOutResponse <$> chainIndexQueryOne pabConf (ChainIndexClient.getUnspentTxOut txOutRef)
+      UnspentTxOutResponse <$> chainIndexQueryOne cePABConfig (ChainIndexClient.getUnspentTxOut txOutRef)
     UnspentTxOutSetAtAddress page credential ->
       UnspentTxOutsAtResponse
         <$> chainIndexQueryMany
-          pabConf
+          cePABConfig
           (ChainIndexClient.getUnspentTxOutsAtAddress (QueryAtAddressRequest (Just page) credential))
     TxFromTxId txId ->
       TxIdResponse <$> chainIndexQueryOne cePABConfig (ChainIndexClient.getTx txId)

src/BotPlutusInterface/Contract.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module BotPlutusInterface.Contract (runContract, handleContract) where
 
@@ -348,7 +349,8 @@ balanceTx ::
   ContractEnvironment w ->
   UnbalancedTx ->
   Eff effs BalanceTxResponse
-balanceTx contractEnv unbalancedTx = do
+balanceTx _ (UnbalancedTx (Left _) _ _ _) = pure $ BalanceTxFailed $ OtherError "CardanoBuildTx is not supported"
+balanceTx contractEnv unbalancedTx@(UnbalancedTx (Right tx') _ _ _) = do
   let pabConf = contractEnv.cePABConfig
 
   result <- handleCollateral @w contractEnv
@@ -360,13 +362,13 @@ balanceTx contractEnv unbalancedTx = do
       eitherBalancedTx <-
         Balance.balanceTxIO' @w
           Balance.defaultBalanceConfig
-            { Balance.bcHasScripts = Balance.txUsesScripts (unBalancedTxTx unbalancedTx)
+            { Balance.bcHasScripts = Balance.txUsesScripts tx'
             }
           pabConf
           pabConf.pcOwnPubKeyHash
           unbalancedTx
 
-      pure $ either (BalanceTxFailed . InsufficientFunds) (BalanceTxSuccess . EmulatorTx) eitherBalancedTx
+      pure $ either (BalanceTxFailed . OtherError) (BalanceTxSuccess . EmulatorTx) eitherBalancedTx
 
 fromCardanoTx :: CardanoTx -> Tx.Tx
 fromCardanoTx (CardanoApiTx _) = error "Cannot handle cardano api tx"
@@ -575,7 +577,7 @@ makeCollateral cEnv = runEitherT $ do
         pabConf
         pabConf.pcOwnPubKeyHash unbalancedTx
 
-  wbr <- lift $ writeBalancedTx cEnv (Right balancedTx)
+  wbr <- lift $ writeBalancedTx cEnv (EmulatorTx balancedTx)
   case wbr of
     WriteBalancedTxFailed e -> throwE . T.pack $ "Failed to create collateral output: " <> show e
     WriteBalancedTxSuccess cTx -> do

src/BotPlutusInterface/Types.hs

@@ -66,12 +66,12 @@ import Plutus.PAB.Effects.Contract.Builtin (
   SomeBuiltin (SomeBuiltin),
   endpointsToSchemas,
  )
-import Plutus.V1.Ledger.Ada qualified as Ada
 import Prettyprinter (Pretty (pretty), (<+>))
 import Prettyprinter qualified as PP
 import Servant.Client (BaseUrl (BaseUrl), Scheme (Http))
 import Wallet.Types (ContractInstanceId (..))
 import Prelude
+import Ledger.Ada qualified as Ada
 
 data PABConfig = PABConfig
   { -- | Calling the cli through ssh when set to Remote

src/PlutusConfig/Cardano/Api/Shelley.hs

@@ -23,6 +23,7 @@ import Cardano.Api.Shelley (ProtocolParameters (..))
 --  )
 import Data.Aeson qualified as JSON
 import Data.ByteString.Lazy qualified as LazyByteString
+import Control.Exception (IOException, catch)
 
 -- import Data.Default (def)
 -- import Data.Text qualified as Text
@@ -279,7 +280,9 @@ import Prelude
 --     pure ProtocolParameters {..}
 
 readProtocolParametersJSON :: FilePath -> IO (Either String ProtocolParameters)
-readProtocolParametersJSON fn = (JSON.eitherDecode <$> LazyByteString.readFile fn) `catch` (\(e :: IOException) -> pure $ Left (show e))
+readProtocolParametersJSON fn = 
+  (JSON.eitherDecode <$> LazyByteString.readFile fn) 
+  `catch` (\(e :: IOException) -> pure $ Left (show e))
 
 writeProtocolParametersJSON :: FilePath -> ProtocolParameters -> IO ()
 writeProtocolParametersJSON fn params =

test/Spec/BotPlutusInterface/Collateral.hs

@@ -12,9 +12,9 @@ import Ledger qualified
 import Ledger.Ada qualified as Ada
 import Ledger.Constraints qualified as Constraints
 import Ledger.Scripts qualified as Scripts
-import Ledger.Tx (CardanoTx, TxOut (TxOut), TxOutRef (TxOutRef))
+import Ledger.Tx (CardanoTx, TxOut (TxOut), TxOutRef (TxOutRef), ChainIndexTxOut (PublicKeyChainIndexTxOut))
 import Ledger.Tx qualified as Tx
-import Ledger.TxId qualified as TxId
+import Ledger.Tx qualified as TxId
 import Ledger.Value qualified as Value
 import NeatInterpolation (text)
 import Plutus.Contract (
@@ -50,6 +50,7 @@ import System.IO.Unsafe (unsafePerformIO)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
 import Prelude
+import Plutus.ChainIndex (OutputDatum(NoOutputDatum))
 
 tests :: TestTree
 tests =
@@ -65,9 +66,9 @@ tests =
 testTxUsesCollateralCorrectly :: Assertion
 testTxUsesCollateralCorrectly = do
   let txOutRef1 = TxOutRef "e406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e5" 0
-      txOut1 = TxOut pkhAddr1 (Ada.lovelaceValueOf 10_000_000) Nothing
+      txOut1 = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 10_000_000) NoOutputDatum Nothing
       txOutRef2 = TxOutRef "d406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e4" 0
-      txOut2 = TxOut pkhAddr1 (Ada.lovelaceValueOf 90_000_000) Nothing
+      txOut2 = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 90_000_000) NoOutputDatum Nothing
       cenv' = def {ceCollateral = CollateralVar $ unsafePerformIO $ newTVarIO Nothing}
       initState = def & utxos .~ [(txOutRef1, txOut1), (txOutRef2, txOut2)] & contractEnv .~ cenv' & collateralUtxo .~ Nothing
 
@@ -106,7 +107,7 @@ testTxUsesCollateralCorrectly = do
 testTxCreatesCollateralCorrectly :: Assertion
 testTxCreatesCollateralCorrectly = do
   let txOutRef1 = TxOutRef "d406b0cf676fc2b1a9edb0617f259ad025c20ea6f0333820aa7cef1bfe7302e4" 0
-      txOut1 = TxOut pkhAddr1 (Ada.lovelaceValueOf 90_000_000) Nothing
+      txOut1 = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 90_000_000) NoOutputDatum Nothing
       cenv' = def {ceCollateral = CollateralVar $ unsafePerformIO $ newTVarIO Nothing}
       initState = def & utxos .~ [(txOutRef1, txOut1)] & contractEnv .~ cenv' & collateralUtxo .~ Nothing
 

test/Spec/BotPlutusInterface/Contract.hs

@@ -447,7 +447,7 @@ mintTokens = do
       txOut = PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf 1_000_000) NoOutputDatum Nothing
       initState = def & utxos <>~ [(txOutRef, txOut)]
       inTxId = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef
-      collateralTxId = encodeByteString $ fromBuiltin $ TxId.getTxId theCollateralTxId
+      collateralTxId = encodeByteString $ fromBuiltin $ Tx.getTxId theCollateralTxId
 
       mintingPolicy :: Scripts.MintingPolicy
       mintingPolicy =
@@ -621,7 +621,7 @@ redeemFromValidator = do
           (Right validator)
       initState = def & utxos <>~ [(txOutRef, txOut), (txOutRef', txOut')]
       inTxId = encodeByteString $ fromBuiltin $ Tx.getTxId $ Tx.txOutRefId txOutRef
-      collateralTxId = encodeByteString $ fromBuiltin $ TxId.getTxId theCollateralTxId
+      collateralTxId = encodeByteString $ fromBuiltin $ Tx.getTxId theCollateralTxId
 
       validator :: Scripts.Validator
       validator =

test/Spec/MockContract.hs

@@ -287,7 +287,7 @@ instance Monoid w => Default (MockContractState w) where
         _utxos =
           [
             ( collateralTxOutRef theCollateralUtxo
-            , TxOut pkhAddr1 (Ada.lovelaceValueOf $ toInteger $ pcCollateralSize def) Nothing
+            , PublicKeyChainIndexTxOut pkhAddr1 (Ada.lovelaceValueOf $ toInteger $ pcCollateralSize def) NoOutputDatum Nothing
             )
           ]
       , _tip = Tip 1000 (BlockId "ab12") 4