Validate range before prebalancing tx

Author: gege251

src/BotPlutusInterface/CardanoCLI.hs

@@ -12,7 +12,6 @@ module BotPlutusInterface.CardanoCLI (
   validatorScriptFilePath,
   unsafeSerialiseAddress,
   policyScriptFilePath,
-  validateRange,
   utxosAt,
   queryTip,
 ) where
@@ -56,7 +55,7 @@ import Ledger.Ada qualified as Ada
 import Ledger.Address (Address (..))
 import Ledger.Crypto (PubKey, PubKeyHash)
 import Ledger.Interval (
-  Extended (Finite, NegInf, PosInf),
+  Extended (Finite),
   Interval (Interval),
   LowerBound (LowerBound),
   UpperBound (UpperBound),
@@ -438,14 +437,6 @@ exBudgetToCliArg (ExBudget (ExCPU steps) (ExMemory memory)) =
 showText :: forall (a :: Type). Show a => a -> Text
 showText = Text.pack . show
 
-validateRange :: SlotRange -> Bool
-validateRange (Interval (LowerBound PosInf _) _) = False
-validateRange (Interval _ (UpperBound NegInf _)) = False
-validateRange (Interval (LowerBound (Finite lowerBound) _) (UpperBound (Finite upperBound) _))
-  | lowerBound >= upperBound = False
-  | otherwise = True
-validateRange _ = True
-
 -- -- TODO: There is some issue with this function, the generated wallet key is incorrect
 -- toWalletKey :: Wallet -> Text
 -- toWalletKey =

src/BotPlutusInterface/PreBalance.hs

@@ -30,6 +30,12 @@ import Ledger.Ada qualified as Ada
 import Ledger.Address (Address (..))
 import Ledger.Constraints.OffChain (UnbalancedTx (..), fromScriptOutput)
 import Ledger.Crypto (PrivateKey, PubKeyHash)
+import Ledger.Interval (
+  Extended (Finite, NegInf, PosInf),
+  Interval (Interval),
+  LowerBound (LowerBound),
+  UpperBound (UpperBound),
+ )
 import Ledger.Scripts (Datum, DatumHash)
 import Ledger.Time (POSIXTimeRange)
 import Ledger.TimeSlot (posixTimeRangeToContainedSlotRange)
@@ -67,8 +73,12 @@ preBalanceTxIO pabConf ownPkh unbalancedTx =
       utxos <- lift $ CardanoCLI.utxosAt @w pabConf $ Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing
       privKeys <- newEitherT $ Files.readPrivateKeys @w pabConf
       let utxoIndex = fmap Tx.toTxOut utxos <> fmap (Ledger.toTxOut . fromScriptOutput) (unBalancedTxUtxoIndex unbalancedTx)
-          tx = addValidRange (unBalancedTxValidityTimeRange unbalancedTx) (unBalancedTxTx unbalancedTx)
           requiredSigs = map Ledger.unPaymentPubKeyHash $ Map.keys (unBalancedTxRequiredSignatories unbalancedTx)
+      tx <-
+        hoistEither $
+          addValidRange
+            (unBalancedTxValidityTimeRange unbalancedTx)
+            (unBalancedTxTx unbalancedTx)
 
       lift $ printLog @w Debug $ show utxoIndex
 
@@ -262,9 +272,19 @@ addSignatories ownPkh privKeys pkhs tx =
     tx
     (ownPkh : pkhs)
 
-addValidRange :: POSIXTimeRange -> Tx -> Tx
+addValidRange :: POSIXTimeRange -> Tx -> Either Text Tx
 addValidRange timeRange tx =
-  tx {txValidRange = posixTimeRangeToContainedSlotRange def timeRange}
+  if validateRange timeRange
+    then Right $ tx {txValidRange = posixTimeRangeToContainedSlotRange def timeRange}
+    else Left "Invalid validity interval."
+
+validateRange :: forall (a :: Type). Ord a => Interval a -> Bool
+validateRange (Interval (LowerBound PosInf _) _) = False
+validateRange (Interval _ (UpperBound NegInf _)) = False
+validateRange (Interval (LowerBound (Finite lowerBound) _) (UpperBound (Finite upperBound) _))
+  | lowerBound >= upperBound = False
+  | otherwise = True
+validateRange _ = True
 
 showText :: forall (a :: Type). Show a => a -> Text
 showText = Text.pack . show