Refactor

Author: gege251

examples/plutus-transfer/src/Cardano/PlutusExample/Transfer.hs

@@ -12,6 +12,7 @@ import Data.Aeson.TH (defaultOptions, deriveJSON)
 import Data.Bifunctor (first)
 import Data.Monoid (Last (Last))
 import Data.Text (Text)
+import Data.Void (Void)
 import GHC.Generics (Generic)
 import Ledger hiding (singleton)
 import Ledger.Constraints as Constraints
@@ -35,10 +36,12 @@ transfer :: TransferParams -> Contract (Last Text) TransferSchema Text ()
 transfer (TransferParams outputPerTx allPayments) = do
   tell $ Last $ Just "Contract started"
   let txs =
-        map (mconcat . map (uncurry Constraints.mustPayToPubKey . first PaymentPubKeyHash)) $
-          group outputPerTx allPayments
+        map toTx $ group outputPerTx allPayments
   forM_ txs $ \tx -> submitTx tx >> waitNSlots 1
   tell $ Last $ Just "Finished"
+  where
+    toTx :: [(PubKeyHash, Value)] -> TxConstraints Void Void
+    toTx = mconcat . map (uncurry Constraints.mustPayToPubKey . first PaymentPubKeyHash)
 
 group :: Int -> [a] -> [[a]]
 group n list

src/BotPlutusInterface/CardanoCLI.hs

@@ -33,6 +33,7 @@ import Control.Monad.Freer (Eff, Member)
 import Data.Aeson qualified as JSON
 import Data.Aeson.Extras (encodeByteString)
 import Data.Attoparsec.Text (parseOnly)
+import Data.Bool (bool)
 import Data.ByteString.Lazy qualified as LazyByteString
 import Data.ByteString.Lazy.Char8 qualified as Char8
 import Data.ByteString.Short qualified as ShortByteString
@@ -356,17 +357,17 @@ mintOpts pabConf buildMode mintingPolicies redeemers mintValue =
         else []
     ]
 
--- | This function does not check if the range is valid, that
+-- | This function does not check if the range is valid, for that see `PreBalance.validateRange`
 validRangeOpts :: SlotRange -> [Text]
 validRangeOpts (Interval lowerBound upperBound) =
   mconcat
     [ case lowerBound of
-        LowerBound (Finite (Slot x)) True -> ["--invalid-before", showText x]
-        LowerBound (Finite (Slot x)) False -> ["--invalid-before", showText (x + 1)]
+        LowerBound (Finite (Slot x)) closed ->
+          ["--invalid-before", showText (bool (x + 1) x closed)]
         _ -> []
     , case upperBound of
-        UpperBound (Finite (Slot x)) True -> ["--invalid-hereafter", showText (x + 1)]
-        UpperBound (Finite (Slot x)) False -> ["--invalid-hereafter", showText x]
+        UpperBound (Finite (Slot x)) closed ->
+          ["--invalid-hereafter", showText (bool x (x + 1) closed)]
         _ -> []
     ]
 

src/BotPlutusInterface/PreBalance.hs

@@ -283,7 +283,6 @@ 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

test/Spec/BotPlutusInterface/Contract.hs

@@ -756,7 +756,7 @@ waitNextBlock = do
       contract :: Contract () (Endpoint "SendAda" ()) Text Slot
       contract = waitNSlots 1
 
-  let (result, state) = runContractPure contract initState
+      (result, state) = runContractPure contract initState
 
   case result of
     Left errMsg -> assertFailure (show errMsg)

test/Spec/MockContract.hs

@@ -318,9 +318,14 @@ mockQueryTip :: forall (w :: Type). MockContract w String
 mockQueryTip = do
   state <- get @(MockContractState w)
 
-  let slot = Text.pack $ show $ getSlot $ tipSlot (state ^. tip)
-      blockId = decodeUtf8 $ getBlockId $ tipBlockId (state ^. tip)
-      blockNo = Text.pack $ show $ unBlockNumber $ tipBlockNo (state ^. tip)
+  let (slot, blockId, blockNo) =
+        case state ^. tip of
+          TipAtGenesis -> ("0", "00", "0")
+          Tip {tipSlot, tipBlockId, tipBlockNo} ->
+            ( Text.pack $ show $ getSlot tipSlot
+            , decodeUtf8 $ getBlockId tipBlockId
+            , Text.pack $ show $ unBlockNumber tipBlockNo
+            )
   pure $
     Text.unpack
       [text|{