wip: slot <-> time convcersion

- cleanup TimeSlot module
- refactoring
- removing `SlotConfig` from `PABConfig`

Author: mikekeke

README.md

@@ -84,8 +84,6 @@ main = do
           , pcPort = 9080
           , pcProtocolParams = protocolParams
           , pcTipPollingInterval = 10_000_000
-          , -- | Slot configuration of the network, the default value can be used for the mainnet
-            pcSlotConfig = def
           , pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
           , pcOwnStakePubKeyHash = Nothing
           , -- Directory name of the script and data files

examples/ex-units/src/PlutipRun.hs

@@ -74,7 +74,7 @@ mkPabConf pparams pparamsFile clusterDir ownPkh =
     , pcPort = 9080
     , pcProtocolParams = pparams
     , pcTipPollingInterval = 1_000_000
-    , pcSlotConfig = def {scSlotZeroTime = POSIXTime $ 1652956123 * 1000}
+    -- , pcSlotConfig = def {scSlotZeroTime = POSIXTime $ 1652956123 * 1000}
     , pcOwnPubKeyHash = ownPkh
     , pcOwnStakePubKeyHash = Nothing
     , pcScriptFileDir = Text.pack $ clusterDir </> "bot-plutus-interface/scripts"

examples/ex-units/src/TestnetRun.hs

@@ -7,15 +7,12 @@ import Cardano.Api.Shelley (ProtocolParameters)
 import Control.Concurrent.STM (newTVarIO, readTVarIO)
 import Data.Aeson (decodeFileStrict, (.=))
 import Data.Aeson qualified as JSON
-import Data.Default (def)
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.UUID.V4 qualified as UUID
 import Ledger (PubKeyHash)
 import TimeDebugContract qualified
 
--- import LockSpendSingle (lockThenSpendSingle)
-
 import GHC.IO.Encoding
 import Plutus.PAB.Core.ContractInstance.STM (Activity (Active))
 import Servant.Client (BaseUrl (BaseUrl), Scheme (Http))
@@ -75,7 +72,6 @@ mkPabConf pparams pparamsFile bpiDir ownPkh =
     , pcPort = 9080
     , pcProtocolParams = pparams
     , pcTipPollingInterval = 1_000_000
-    , pcSlotConfig = def
     , pcOwnPubKeyHash = ownPkh
     , pcOwnStakePubKeyHash = Nothing
     , pcScriptFileDir = Text.pack $ bpiDir </> "scripts"

examples/plutus-game/app/Main.hs

@@ -22,7 +22,6 @@ import Cardano.PlutusExample.Game (
 import Data.Aeson qualified as JSON
 import Data.Aeson.TH (defaultOptions, deriveJSON)
 import Data.ByteString.Lazy qualified as LazyByteString
-import Data.Default (def)
 import Data.Maybe (fromMaybe)
 import Playground.Types (FunctionSchema)
 import Schema (FormSchema)
@@ -59,7 +58,6 @@ main = do
           , pcPort = 9080
           , pcProtocolParams = protocolParams
           , pcTipPollingInterval = 10_000_000
-          , pcSlotConfig = def
           , pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
           , pcOwnStakePubKeyHash = Nothing
           , pcScriptFileDir = "./scripts"

examples/plutus-nft/app/Main.hs

@@ -17,7 +17,6 @@ import Cardano.PlutusExample.NFT
 import Data.Aeson qualified as JSON
 import Data.Aeson.TH (defaultOptions, deriveJSON)
 import Data.ByteString.Lazy qualified as LazyByteString
-import Data.Default (def)
 import Data.Maybe (fromMaybe)
 import Playground.Types (FunctionSchema)
 import Schema (FormSchema)
@@ -55,7 +54,6 @@ main = do
           , pcPort = 9080
           , pcProtocolParams = protocolParams
           , pcTipPollingInterval = 10_000_000
-          , pcSlotConfig = def
           , pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
           , pcOwnStakePubKeyHash = Nothing
           , pcScriptFileDir = "./scripts"

examples/plutus-transfer/app/Main.hs

@@ -21,7 +21,6 @@ import Cardano.PlutusExample.Transfer (
 import Data.Aeson qualified as JSON
 import Data.Aeson.TH (defaultOptions, deriveJSON)
 import Data.ByteString.Lazy qualified as LazyByteString
-import Data.Default (def)
 import Data.Maybe (fromMaybe)
 import Playground.Types (FunctionSchema)
 import Schema (FormSchema)
@@ -58,7 +57,6 @@ main = do
           , pcPort = 9080
           , pcProtocolParams = protocolParams
           , pcTipPollingInterval = 10_000_000
-          , pcSlotConfig = def
           , pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
           , pcOwnStakePubKeyHash = Nothing
           , pcScriptFileDir = "./scripts"

src/BotPlutusInterface/Balance.hs

@@ -42,7 +42,6 @@ import Ledger.Interval (
  )
 import Ledger.Scripts (Datum, DatumHash)
 import Ledger.Time (POSIXTimeRange)
-import Ledger.TimeSlot (posixTimeRangeToContainedSlotRange)
 import Ledger.Tx (
   Tx (..),
   TxIn (..),
@@ -60,8 +59,8 @@ import Plutus.V1.Ledger.Api (
  )
 
 import BotPlutusInterface.BodyBuilder qualified as BodyBuilder
-import Debug.Trace (traceM, traceShowId)
 import Prelude
+import Data.Bifunctor (bimap)
 
 {- | Collect necessary tx inputs and collaterals, add minimum lovelace values and balance non ada
  assets
@@ -89,15 +88,14 @@ balanceTxIO pabConf ownPkh unbalancedTx =
 
       tx <-
         newEitherT $
-          addValidRange2 @w
-            pabConf
+          addValidRange @w
             (unBalancedTxValidityTimeRange unbalancedTx)
             (unBalancedTxTx unbalancedTx)
 
       lift $ printLog @w Debug $ show utxoIndex
 
       -- We need this folder on the CLI machine, which may not be the local machine
-      lift $ createDirectoryIfMissingCLI @w False (Text.unpack pabConf.pcTxFileDir)
+      lift $ createDirectoryIfMissingCLI @w False (Text.unpack         "pcTxFileDir"            )
 
       -- Adds required collaterals, only needs to happen once
       -- Also adds signatures for fee calculation
@@ -359,34 +357,22 @@ addSignatories ownPkh privKeys pkhs tx =
     tx
     (ownPkh : pkhs)
 
-addValidRange :: PABConfig -> POSIXTimeRange -> Tx -> Either Text Tx
-addValidRange pabConf timeRange tx =
-  if validateRange timeRange
-    then
-      let r = traceShowId (posixTimeRangeToContainedSlotRange pabConf.pcSlotConfig timeRange)
-       in Right $ tx {txValidRange = r}
-    else Left "Invalid validity interval."
-
-addValidRange2 ::
+addValidRange ::
   forall (w :: Type) (effs :: [Type -> Type]).
   Member (PABEffect w) effs =>
-  PABConfig ->
   POSIXTimeRange ->
   Tx ->
   Eff effs (Either Text Tx)
-addValidRange2 pabConf timeRange tx =
+addValidRange timeRange tx =
   if validateRange timeRange
-    then do
-      let oldWaySlotRange = posixTimeRangeToContainedSlotRange pabConf.pcSlotConfig timeRange
-      traceM $ "Ledger SlotRange: " ++ show oldWaySlotRange
-      newWaySlotRange <- convertTimeRangeToSlotRange @w timeRange
-      case newWaySlotRange of
-        Right range -> do
-          traceM $ "Query  SlotRange: " ++ show range
-          pure $ Right $ tx {txValidRange = range}
-        Left err -> pure $ Left (Text.pack $ show err)
+    then bimap (Text.pack . show) (setRange tx) <$>
+          convertTimeRangeToSlotRange @w timeRange
     else pure $ Left "Invalid validity interval."
 
+  where
+    setRange tx' range = tx' {txValidRange = range}
+
+
 validateRange :: forall (a :: Type). Ord a => Interval a -> Bool
 validateRange (Interval (LowerBound PosInf _) _) = False
 validateRange (Interval _ (UpperBound NegInf _)) = False

src/BotPlutusInterface/Contract.hs

@@ -26,7 +26,6 @@ import BotPlutusInterface.Effects (
  )
 import BotPlutusInterface.Files (DummyPrivKey (FromSKey, FromVKey))
 import BotPlutusInterface.Files qualified as Files
-import BotPlutusInterface.TimeSlot (ToWhichSlotTime (ToEndTime), stackExchangeConvert)
 import BotPlutusInterface.Types (
   ContractEnvironment (..),
   LogLevel (Debug, Warn),
@@ -51,13 +50,11 @@ import Data.Map qualified as Map
 import Data.Row (Row)
 import Data.Text (Text)
 import Data.Text qualified as Text
-import Debug.Trace (traceM)
 import Ledger (POSIXTime)
 import Ledger qualified
 import Ledger.Address (PaymentPubKeyHash (PaymentPubKeyHash))
 import Ledger.Constraints.OffChain (UnbalancedTx (..))
 import Ledger.Slot (Slot (Slot))
-import Ledger.TimeSlot (SlotConversionError, posixTimeToEnclosingSlot, slotToEndPOSIXTime)
 import Ledger.Tx (CardanoTx)
 import Ledger.Tx qualified as Tx
 import Plutus.ChainIndex.TxIdState (fromTx, transactionStatus)
@@ -165,13 +162,8 @@ handlePABReq contractEnv req = do
     CurrentSlotReq -> CurrentSlotResp <$> currentSlot @w contractEnv
     CurrentTimeReq -> CurrentTimeResp <$> currentTime @w contractEnv
     PosixTimeRangeToContainedSlotRangeReq posixTimeRange ->
-      PosixTimeRangeToContainedSlotRangeResp
-        <$> posixTimeRangeToContainedSlotRange_ @w posixTimeRange
-    -- PosixTimeRangeToContainedSlotRangeReq posixTimeRange ->
-    --   pure $
-    --     PosixTimeRangeToContainedSlotRangeResp $
-    --       Right $
-    --         posixTimeRangeToContainedSlotRange contractEnv.cePABConfig.pcSlotConfig posixTimeRange
+      either (error . show) (PosixTimeRangeToContainedSlotRangeResp . Right)
+        <$> convertTimeRangeToSlotRange @w posixTimeRange
     AwaitTxStatusChangeReq txId -> AwaitTxStatusChangeResp txId <$> awaitTxStatusChange @w contractEnv txId
     ------------------------
     -- Unhandled requests --
@@ -362,27 +354,11 @@ awaitTime ::
   POSIXTime ->
   Eff effs POSIXTime
 awaitTime ce pTime = do
-  startingTip <- CardanoCLI.queryTip @w ce.cePABConfig
-  traceM $ "Starting tip: " ++ show startingTip
-
-  slotFromTime <- posixTimeToSlot @w pTime >>= either (error . show) return
-  traceM $ "Converting " ++ show pTime ++ " to slot:"
-  traceM $ "- with node queries: " ++ show slotFromTime
-  traceM $ "- with stack exchng: " ++ show (stackExchangeConvert pTime)
-  traceM $ "- with ledger stuff: " ++ show oldSlotFromTime
+  slotFromTime <- rightOrErr <$> posixTimeToSlot @w pTime
   slot' <- awaitSlot ce slotFromTime
-  traceM $ "Converting " ++ show slot' ++ " to time:"
-  ethTime <- slotToPOSIXTime @w ToEndTime slot'
-  time' <- either (error . show) return ethTime
-  traceM $ "- with node queries: " ++ show time'
-  traceM $ "- with ledger stuff: " ++ show (oldTimeFromSlot slot')
-
-  endTip <- CardanoCLI.queryTip @w ce.cePABConfig
-  traceM $ "Current tip: " ++ show endTip
-  return time'
+  rightOrErr <$> slotToPOSIXTime @w slot'
   where
-    oldSlotFromTime = posixTimeToEnclosingSlot ce.cePABConfig.pcSlotConfig pTime
-    oldTimeFromSlot = slotToEndPOSIXTime ce.cePABConfig.pcSlotConfig
+    rightOrErr = either (error . show) id
 
 currentSlot ::
   forall (w :: Type) (effs :: [Type -> Type]).
@@ -407,14 +383,5 @@ currentTime ::
   Eff effs POSIXTime
 currentTime contractEnv =
   currentSlot @w contractEnv
-    >>= slotToPOSIXTime @w ToEndTime
+    >>= slotToPOSIXTime @w
     >>= either (error . show) return
-
-posixTimeRangeToContainedSlotRange_ ::
-  forall (w :: Type) (effs :: [Type -> Type]).
-  Member (PABEffect w) effs =>
-  Ledger.POSIXTimeRange ->
-  Eff effs (Either SlotConversionError Ledger.SlotRange)
-posixTimeRangeToContainedSlotRange_ posixTimeRange =
-  convertTimeRangeToSlotRange @w posixTimeRange
-    >>= either (error . show) (return . Right)

src/BotPlutusInterface/Effects.hs

@@ -59,7 +59,7 @@ import Data.Text qualified as Text
 import Ledger qualified
 import Plutus.Contract.Effects (ChainIndexQuery, ChainIndexResponse)
 import Plutus.PAB.Core.ContractInstance.STM (Activity)
-import PlutusTx.Builtins.Internal (BuiltinByteString (BuiltinByteString), error)
+import PlutusTx.Builtins.Internal (BuiltinByteString (BuiltinByteString))
 import System.Directory qualified as Directory
 import System.Exit (ExitCode (ExitFailure, ExitSuccess))
 import System.Process (readProcess, readProcessWithExitCode)
@@ -102,7 +102,6 @@ data PABEffect (w :: Type) (r :: Type) where
   EstimateBudget :: TxFile -> PABEffect w (Either BudgetEstimationError TxBudget)
   SaveBudget :: Ledger.TxId -> TxBudget -> PABEffect w ()
   SlotToPOSIXTime ::
-    TimeSlot.ToWhichSlotTime ->
     Ledger.Slot ->
     PABEffect w (Either TimeSlot.TimeSlotConversionError Ledger.POSIXTime)
   POSIXTimeToSlot :: Ledger.POSIXTime -> PABEffect w (Either TimeSlot.TimeSlotConversionError Ledger.Slot)
@@ -158,8 +157,8 @@ handlePABEffect contractEnv =
         EstimateBudget txPath ->
           ExBudget.estimateBudget contractEnv.cePABConfig txPath
         SaveBudget txId exBudget -> saveBudgetImpl contractEnv txId exBudget
-        SlotToPOSIXTime toWhichTime slot ->
-          TimeSlot.slotToPOSIXTimeImpl contractEnv.cePABConfig toWhichTime slot
+        SlotToPOSIXTime slot ->
+          TimeSlot.slotToPOSIXTimeImpl contractEnv.cePABConfig slot
         POSIXTimeToSlot pTime ->
           TimeSlot.posixTimeToSlotImpl contractEnv.cePABConfig pTime
         POSIXTimeRangeToSlotRange pTimeRange ->
@@ -324,10 +323,9 @@ saveBudget txId budget = send @(PABEffect w) $ SaveBudget txId budget
 slotToPOSIXTime ::
   forall (w :: Type) (effs :: [Type -> Type]).
   Member (PABEffect w) effs =>
-  TimeSlot.ToWhichSlotTime ->
   Ledger.Slot ->
   Eff effs (Either TimeSlot.TimeSlotConversionError Ledger.POSIXTime)
-slotToPOSIXTime tw s = send @(PABEffect w) (SlotToPOSIXTime tw s)
+slotToPOSIXTime = send @(PABEffect w) . SlotToPOSIXTime
 
 posixTimeToSlot ::
   forall (w :: Type) (effs :: [Type -> Type]).