Add FakeTime example for SingularityNet

doc/faq.md

@@ -94,6 +94,8 @@ Time/slot conversion functions depend on `eraSummaries` [Ogmios local state quer
 
 When using Plutip, a solution may be [to increase the `epochSize` parameter](https://github.com/Plutonomicon/cardano-transaction-lib/issues/1057#issuecomment-1450692539).
 
+Another way that is **really not recommended** is faking the EraSummaries data to trick CTL into believing that `EraSummaries` span infinitely into the future. The consequence of this is that in case the protocol parameters are changed, your time arithmetic may become completely wrong. See [`examples/FakeTime.purs`](../examples/FakeTime.purs).
+
 ### Q: I'm getting `Uncomputable slot arithmetic; transaction's validity bounds go beyond the foreseeable end of the current era: PastHorizon`
 
 Ensure your transaction's validity range does not go over `SafeZone` slots of the current era. The reason for this kind of errors is that time-related estimations are slot-based, and future forks may change slot lengths. So there is only a relatively small time window in the future during which it is known that forks cannot occur.

examples/FakeTime.purs

@@ -0,0 +1,92 @@
+-- | This example demonstrates how to fake EraSummary responses to trick CTL
+-- | into believing that EraSummaries span infinite time in the future (which
+-- | is untrue!)
+-- | Do not use this unless you know what you are doing!
+module Ctl.Examples.FakeTime (contract, withInfiniteFakeTime, getSlotInOneYear) where
+
+import Contract.Prelude
+
+import Contract.Log (logInfo')
+import Contract.Monad (Contract, ContractEnv)
+import Contract.Time
+  ( EraSummaries(EraSummaries)
+  , EraSummary(EraSummary)
+  , POSIXTime(POSIXTime)
+  , PosixTimeToSlotError(CannotFindTimeInEraSummaries)
+  , Slot
+  , getEraSummaries
+  , getSystemStart
+  , posixTimeToSlot
+  , slotToPosixTime
+  )
+import Control.Monad.Reader (local)
+import Data.Array as Array
+import Data.BigInt as BigInt
+import Data.DateTime.Instant (unInstant)
+import Data.Maybe (Maybe(Nothing))
+import Data.Time.Duration (Milliseconds, convertDuration)
+import Effect.Now (now)
+import Partial.Unsafe (unsafePartial)
+import Prim.TypeError (class Warn, Text)
+import Test.Spec.Assertions (shouldSatisfy)
+
+-- | This function is dangerous!
+-- | It fakes EraSummary response data (makes the last epoch infinite), which
+-- | may result in wrong time/slot coversions in the future.
+withInfiniteFakeTime
+  :: forall a
+   . Warn
+       ( Text
+           "withInfiniteFakeTime assumes that slot lengths are never changed which is known to be untrue"
+       )
+  => Contract a
+  -> Contract a
+withInfiniteFakeTime = local patchContractEnv
+  where
+  patchContractEnv :: ContractEnv -> ContractEnv
+  patchContractEnv env = env { handle = patchQueryHandle env.handle }
+  patchQueryHandle qh =
+    qh { getEraSummaries = patchGetEraSummaries qh.getEraSummaries }
+  patchGetEraSummaries getEraSummaries = do
+    getEraSummaries <#> map
+      ( over EraSummaries $ \summaries -> Array.slice 0 (-1) summaries <>
+          foldMap makeInfinite
+            (Array.last summaries)
+      )
+
+  makeInfinite :: EraSummary -> Array EraSummary
+  makeInfinite (EraSummary sum) = [ EraSummary sum { end = Nothing } ]
+
+getSlotInOneYear :: Contract (Either PosixTimeToSlotError Slot)
+getSlotInOneYear = do
+  logInfo' "Running Examples.Pkh2Pkh"
+  systemStart <- getSystemStart
+  eraSummaries <- getEraSummaries
+  nowTime :: Milliseconds <- liftEffect $ convertDuration <<< unInstant <$> now
+  logInfo' $ show $ unwrap nowTime
+  pure $ posixTimeToSlot eraSummaries systemStart
+    ( POSIXTime
+        ( unsafePartial $ fromJust $ BigInt.fromNumber $ unwrap nowTime +
+            oneYear
+        )
+    )
+  where
+  oneYear = 1000.0 * 3600.0 * 24.0 * 365.0
+
+contract :: Contract Unit
+contract = do
+  -- check that slot conversion fails WITHOUT the fix
+  -- with the correct error
+  getSlotInOneYear >>= flip shouldSatisfy \x -> case x of
+    Left (CannotFindTimeInEraSummaries _) -> true
+    _ -> false
+  withInfiniteFakeTime do
+    getSlotInOneYear >>= logInfo' <<< show
+    -- check that it works with the hack applied
+    getSlotInOneYear >>= flip shouldSatisfy isRight
+    -- check that we can also convert the slot back to POSIXTime
+    getSlotInOneYear >>= traverse_ \slot -> do
+      systemStart <- getSystemStart
+      eraSummaries <- getEraSummaries
+      logInfo' $ show $ slotToPosixTime eraSummaries systemStart slot
+      slotToPosixTime eraSummaries systemStart slot `shouldSatisfy` isRight

src/Internal/Types/Interval.purs

@@ -118,7 +118,7 @@ import Data.Argonaut.Encode.Encoders (encodeString)
 import Data.Array (find, head, index, length)
 import Data.Bifunctor (bimap, lmap)
 import Data.BigInt (BigInt)
-import Data.BigInt (fromInt, fromNumber, fromString, toNumber) as BigInt
+import Data.BigInt (fromNumber, fromString, toNumber) as BigInt
 import Data.Either (Either(Left, Right), note)
 import Data.Generic.Rep (class Generic)
 import Data.Lattice
@@ -716,12 +716,6 @@ slotToPosixTime eraSummaries sysStart slot = runExcept do
   -- Add the system start time to the absolute time relative to system start
   -- to get overall POSIXTime
   pure $ wrap $ sysStartPosix + unwrap absTime
-  where
-  -- TODO: See https://github.com/input-output-hk/cardano-ledger/blob/master/eras/shelley/impl/src/Cardano/Ledger/Shelley/HardForks.hs#L57
-  -- translateTimeForPlutusScripts and ensure protocol version > 5 which would
-  -- mean converting to milliseconds
-  _transTime :: BigInt -> BigInt
-  _transTime = (*) $ BigInt.fromInt 1000
 
 -- | Finds the `EraSummary` an `Slot` lies inside (if any).
 findSlotEraSummary

test/Plutip/Contract.purs

@@ -110,6 +110,7 @@ import Ctl.Examples.BalanceTxConstraints as BalanceTxConstraintsExample
 import Ctl.Examples.Cip30 as Cip30
 import Ctl.Examples.ContractTestUtils as ContractTestUtils
 import Ctl.Examples.ECDSA as ECDSA
+import Ctl.Examples.FakeTime as FakeTime
 import Ctl.Examples.Helpers
   ( mkCurrencySymbol
   , mkTokenName
@@ -204,6 +205,9 @@ suite = do
         void $ waitUntilSlot $ Slot $ BigNum.fromInt 161
         void $ waitUntilSlot $ Slot $ BigNum.fromInt 241
   group "Regressions" do
+    test "Allow faking time responses (dangerous!)" do
+      withWallets unit \_ -> do
+        FakeTime.contract
     skip $ test
       "#1441 - Mint many assets at once - fails with TooManyAssetsInOutput"
       do