diff --git a/CHANGELOG.md b/CHANGELOG.md index 9743d7070b..87748134ea 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -56,6 +56,9 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) ### Added +- `Contract.Time.currentEra` and `Contract.Time.mkTimeRangeWithinSummary`, + providing an improved interface for eras and time ranges + ([#1542](https://github.com/Plutonomicon/cardano-transaction-lib/pull/1542)). - Added `extraSources` and `data` features to CTL's Nix build function ([#1516](https://github.com/Plutonomicon/cardano-transaction-lib/pull/1516)) - Added several `Ring`-like numeric instances for `Coin` ([#1485](https://github.com/Plutonomicon/cardano-transaction-lib/issues/1485)) - Added `ToData` and `FromData` instances for `PoolPubKeyHash` ([#1483](https://github.com/Plutonomicon/cardano-transaction-lib/issues/1483)) diff --git a/src/Contract/Time.purs b/src/Contract/Time.purs index deae988fa1..4350b4fdc9 100644 --- a/src/Contract/Time.purs +++ b/src/Contract/Time.purs @@ -3,7 +3,10 @@ module Contract.Time ( getCurrentEpoch , getEraSummaries , getSystemStart + , currentEra + , mkTimeRangeWithinSummary , module Chain + , module TipChain , module ExportEraSummaries , module ExportOgmios , module ExportSystemStart @@ -13,15 +16,12 @@ module Contract.Time import Prelude -import Contract.Chain - ( BlockHeaderHash(BlockHeaderHash) - , ChainTip(ChainTip) - , Tip(Tip, TipAtGenesis) - , getTip - ) as Chain -import Contract.Monad (Contract, liftedE) +import Contract.Chain (getTip) as TipChain +import Contract.Log (logInfo') +import Contract.Monad (Contract, liftContractM, liftedE) import Control.Monad.Reader.Class (asks) import Ctl.Internal.Cardano.Types.Transaction (Epoch(Epoch)) +import Ctl.Internal.Contract (getChainTip) import Ctl.Internal.Contract.Monad (getQueryHandle) import Ctl.Internal.Helpers (liftM) import Ctl.Internal.QueryM.Ogmios (CurrentEpoch(CurrentEpoch)) @@ -30,6 +30,12 @@ import Ctl.Internal.QueryM.Ogmios , OgmiosEraSummaries(OgmiosEraSummaries) ) as ExportOgmios import Ctl.Internal.Serialization.Address (BlockId(BlockId), Slot(Slot)) as SerializationAddress +import Ctl.Internal.Serialization.Address (Slot) +import Ctl.Internal.Types.Chain + ( BlockHeaderHash(BlockHeaderHash) + , ChainTip(ChainTip) + , Tip(TipAtGenesis, Tip) + ) as Chain import Ctl.Internal.Types.EraSummaries ( EpochLength(EpochLength) , EraSummaries(EraSummaries) @@ -44,7 +50,7 @@ import Ctl.Internal.Types.Interval ( AbsTime(AbsTime) , Closure , Extended(NegInf, Finite, PosInf) - , Interval + , Interval(FiniteInterval) , LowerBound(LowerBound) , ModTime(ModTime) , OnchainPOSIXTimeRange(OnchainPOSIXTimeRange) @@ -98,10 +104,70 @@ import Ctl.Internal.Types.Interval import Ctl.Internal.Types.SystemStart (SystemStart) import Ctl.Internal.Types.SystemStart (SystemStart(SystemStart)) as ExportSystemStart import Data.BigInt as BigInt +import Data.Foldable (find) +import Data.Maybe (Maybe(Just, Nothing)) +import Data.Newtype (unwrap) import Data.UInt as UInt +import Effect.Aff (delay) import Effect.Aff.Class (liftAff) import Effect.Exception (error) +-- | Get a summary of the current era. +currentEra :: Contract ExportEraSummaries.EraSummary +currentEra = do + eraSummaries <- getEraSummaries + currentSlot <- getCurrentSlot + logInfo' $ show eraSummaries + logInfo' $ show currentSlot + -- Assumes that eras are sorted: this may not be stable in the future. + liftContractM "Could not find era summary" + $ find (go currentSlot) + $ unwrap eraSummaries + where + go :: Slot -> ExportEraSummaries.EraSummary -> Boolean + go currentSlot era = + let + eraStartSlot = era # unwrap # _.start # unwrap # _.slot + startNotAfterUs = eraStartSlot <= currentSlot + in + case era # unwrap # _.end of + Nothing -> startNotAfterUs + Just eraEnd -> startNotAfterUs && + ( (eraEnd # unwrap # _.slot) > + currentSlot + ) + + getCurrentSlot :: Contract Slot + getCurrentSlot = do + { delay: delayMs } <- asks $ _.timeParams >>> _.awaitTxConfirmed + getChainTip >>= case _ of + Chain.TipAtGenesis -> do + liftAff $ delay delayMs + getCurrentSlot + Chain.Tip (Chain.ChainTip { slot }) -> pure slot + +-- | Given a desired range, tighten it to fit onchain. +mkTimeRangeWithinSummary + :: Interval.Interval Interval.POSIXTime + -> Contract (Interval.Interval Interval.POSIXTime) +mkTimeRangeWithinSummary = case _ of + desired@(Interval.FiniteInterval start end) -> do + era <- currentEra + let params = unwrap (unwrap era).parameters + slotLength <- liftContractM "Could not get slot length" $ BigInt.fromNumber + $ unwrap params.slotLength + let offset = unwrap params.safeZone + slotLength + let endTime = start + Interval.POSIXTime offset + let oneSecond = Interval.POSIXTime $ BigInt.fromInt 1_000 + let + range = Interval.FiniteInterval (start + oneSecond) + (min end (endTime - oneSecond)) + logInfo' $ "Desired range: " <> show desired + logInfo' $ "Computed range: " <> show range + pure range + i -> liftContractM ("Could not convert to start-end range: " <> show i) + Nothing + -- | Get the current Epoch. getCurrentEpoch :: Contract Epoch getCurrentEpoch = do