moving custom toCardanoTxOut to another module

mlabs-haskell · Oct 10, 2022 · 8524fef · 8524fef
1 parent 5db75f0
commit 8524fef
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 14 deletions.
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/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@