From 8524fef2a22a1185b02f36d9d4c2d1b193ebbdc2 Mon Sep 17 00:00:00 2001 From: Mikhail Lazarev Date: Mon, 10 Oct 2022 15:02:59 +0400 Subject: [PATCH] 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@