diff --git a/doc/plutus/tutorials/EscrowImpl.hs b/doc/plutus/tutorials/EscrowImpl.hs index 1bf5afdac2..cf7822f5e0 100644 --- a/doc/plutus/tutorials/EscrowImpl.hs +++ b/doc/plutus/tutorials/EscrowImpl.hs @@ -70,9 +70,9 @@ import Plutus.V1.Ledger.Api (Datum (Datum), DatumHash, ValidatorHash) import Plutus.V1.Ledger.Contexts (ScriptContext (ScriptContext, scriptContextTxInfo), TxInfo (txInfoValidRange)) import Plutus.Contract (AsContractError (_ContractError), Contract, ContractError, Endpoint, HasEndpoint, Promise, - adjustUnbalancedTx, awaitTime, currentTime, endpoint, mapError, mkTxConstraints, - ownFirstPaymentPubKeyHash, promiseMap, selectList, submitUnbalancedTx, type (.\/), utxosAt, - waitNSlots) + adjustUnbalancedTx, awaitTime, currentNodeClientTimeRange, currentTime, endpoint, mapError, + mkTxConstraints, ownFirstPaymentPubKeyHash, promiseMap, selectList, submitUnbalancedTx, + type (.\/), utxosAt, waitNSlots) import PlutusTx qualified {- START imports -} import PlutusTx.Code qualified as PlutusTx @@ -299,7 +299,7 @@ redeem :: -> Contract w s e RedeemSuccess redeem inst escrow = mapError (review _EscrowError) $ do let addr = Scripts.validatorAddress inst - current <- currentTime + current <- Haskell.snd <$> currentNodeClientTimeRange unspentOutputs <- utxosAt addr let valRange = Interval.to (Haskell.pred $ escrowDeadline escrow) @@ -365,7 +365,7 @@ payRedeemRefund params vl = do if presentVal `geq` targetTotal params then Right <$> redeem inst params else do - time <- currentTime + time <- Haskell.snd <$> currentNodeClientTimeRange if time >= escrowDeadline params then Left <$> refund inst params else waitNSlots 1 >> go diff --git a/plutus-contract/src/Plutus/Contract.hs b/plutus-contract/src/Plutus/Contract.hs index 17f418b3fc..d57c74c3c3 100644 --- a/plutus-contract/src/Plutus/Contract.hs +++ b/plutus-contract/src/Plutus/Contract.hs @@ -27,11 +27,13 @@ module Plutus.Contract( , Request.isSlot , Request.currentSlot , Request.currentPABSlot + , Request.currentNodeClientSlot , Request.currentChainIndexSlot , Request.waitNSlots , Request.awaitTime , Request.isTime , Request.currentTime + , Request.currentNodeClientTimeRange , Request.waitNMilliSeconds -- * Endpoints , Request.HasEndpoint diff --git a/plutus-contract/src/Plutus/Contract/Effects.hs b/plutus-contract/src/Plutus/Contract/Effects.hs index 5aeea00b37..31a82e933d 100644 --- a/plutus-contract/src/Plutus/Contract/Effects.hs +++ b/plutus-contract/src/Plutus/Contract/Effects.hs @@ -13,9 +13,10 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal _AwaitTimeReq, _AwaitUtxoSpentReq, _AwaitUtxoProducedReq, - _CurrentPABSlotReq, + _CurrentNodeClientSlotReq, _CurrentChainIndexSlotReq, _CurrentTimeReq, + _CurrentNodeClientTimeRangeReq, _AwaitTxStatusChangeReq, _AwaitTxOutStatusChangeReq, _OwnContractInstanceIdReq, @@ -47,9 +48,10 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal _AwaitTimeResp, _AwaitUtxoSpentResp, _AwaitUtxoProducedResp, - _CurrentPABSlotResp, + _CurrentNodeClientSlotResp, _CurrentChainIndexSlotResp, _CurrentTimeResp, + _CurrentNodeClientTimeRangeResp, _AwaitTxStatusChangeResp, _AwaitTxStatusChangeResp', _AwaitTxOutStatusChangeResp, @@ -122,9 +124,10 @@ data PABReq = | AwaitUtxoProducedReq Address | AwaitTxStatusChangeReq TxId | AwaitTxOutStatusChangeReq TxOutRef - | CurrentPABSlotReq + | CurrentNodeClientSlotReq | CurrentChainIndexSlotReq | CurrentTimeReq + | CurrentNodeClientTimeRangeReq | OwnContractInstanceIdReq | OwnAddressesReq | ChainIndexQueryReq ChainIndexQuery @@ -143,9 +146,10 @@ instance Pretty PABReq where AwaitTimeReq s -> "Await time:" <+> pretty s AwaitUtxoSpentReq utxo -> "Await utxo spent:" <+> pretty utxo AwaitUtxoProducedReq a -> "Await utxo produced:" <+> pretty a - CurrentPABSlotReq -> "Current PAB slot" + CurrentNodeClientSlotReq -> "Current node client slot" CurrentChainIndexSlotReq -> "Current chain index slot" CurrentTimeReq -> "Current time" + CurrentNodeClientTimeRangeReq -> "Current node client time range" AwaitTxStatusChangeReq txid -> "Await tx status change:" <+> pretty txid AwaitTxOutStatusChangeReq ref -> "Await txout status change:" <+> pretty ref OwnContractInstanceIdReq -> "Own contract instance ID" @@ -166,9 +170,10 @@ data PABResp = | AwaitUtxoProducedResp (NonEmpty ChainIndexTx) | AwaitTxStatusChangeResp TxId TxStatus | AwaitTxOutStatusChangeResp TxOutRef TxOutStatus - | CurrentPABSlotResp Slot + | CurrentNodeClientSlotResp Slot | CurrentChainIndexSlotResp Slot | CurrentTimeResp POSIXTime + | CurrentNodeClientTimeRangeResp (POSIXTime, POSIXTime) | OwnContractInstanceIdResp ContractInstanceId | OwnAddressesResp (NonEmpty Address) | ChainIndexQueryResp ChainIndexResponse @@ -187,9 +192,10 @@ instance Pretty PABResp where AwaitTimeResp s -> "Time:" <+> pretty s AwaitUtxoSpentResp utxo -> "Utxo spent:" <+> pretty utxo AwaitUtxoProducedResp addr -> "Utxo produced:" <+> pretty addr - CurrentPABSlotResp s -> "Current PAB slot:" <+> pretty s + CurrentNodeClientSlotResp s -> "Current node client slot:" <+> pretty s CurrentChainIndexSlotResp s -> "Current chain index slot:" <+> pretty s CurrentTimeResp s -> "Current time:" <+> pretty s + CurrentNodeClientTimeRangeResp s -> "Current node client time range:" <+> pretty s AwaitTxStatusChangeResp txid status -> "Status of" <+> pretty txid <+> "changed to" <+> pretty status AwaitTxOutStatusChangeResp ref status -> "Status of" <+> pretty ref <+> "changed to" <+> pretty status OwnContractInstanceIdResp i -> "Own contract instance ID:" <+> pretty i @@ -208,9 +214,10 @@ matches a b = case (a, b) of (AwaitTimeReq{}, AwaitTimeResp{}) -> True (AwaitUtxoSpentReq{}, AwaitUtxoSpentResp{}) -> True (AwaitUtxoProducedReq{}, AwaitUtxoProducedResp{}) -> True - (CurrentPABSlotReq, CurrentPABSlotResp{}) -> True - (CurrentChainIndexSlotReq, CurrentChainIndexSlotResp{}) -> True + (CurrentNodeClientSlotReq, CurrentNodeClientSlotResp{}) -> True + (CurrentChainIndexSlotReq, CurrentChainIndexSlotResp{}) -> True (CurrentTimeReq, CurrentTimeResp{}) -> True + (CurrentNodeClientTimeRangeReq, CurrentNodeClientTimeRangeResp{}) -> True (AwaitTxStatusChangeReq i, AwaitTxStatusChangeResp i' _) -> i == i' (AwaitTxOutStatusChangeReq i, AwaitTxOutStatusChangeResp i' _) -> i == i' (OwnContractInstanceIdReq, OwnContractInstanceIdResp{}) -> True diff --git a/plutus-contract/src/Plutus/Contract/Request.hs b/plutus-contract/src/Plutus/Contract/Request.hs index 24b2d00e1b..39e30f98f6 100644 --- a/plutus-contract/src/Plutus/Contract/Request.hs +++ b/plutus-contract/src/Plutus/Contract/Request.hs @@ -22,11 +22,13 @@ module Plutus.Contract.Request( , isSlot , currentSlot , currentPABSlot + , currentNodeClientSlot , currentChainIndexSlot , waitNSlots , awaitTime , isTime , currentTime + , currentNodeClientTimeRange , waitNMilliSeconds -- ** Chain index queries , datumFromHash @@ -138,7 +140,7 @@ import Plutus.V1.Ledger.Api (Address, Datum, DatumHash, MintingPolicy, MintingPo import PlutusTx qualified import Plutus.Contract.Effects (ActiveEndpoint (ActiveEndpoint, aeDescription, aeMetadata), - PABReq (AdjustUnbalancedTxReq, AwaitSlotReq, AwaitTimeReq, AwaitTxOutStatusChangeReq, AwaitTxStatusChangeReq, AwaitUtxoProducedReq, AwaitUtxoSpentReq, BalanceTxReq, ChainIndexQueryReq, CurrentChainIndexSlotReq, CurrentPABSlotReq, CurrentTimeReq, ExposeEndpointReq, OwnAddressesReq, OwnContractInstanceIdReq, WriteBalancedTxReq, YieldUnbalancedTxReq), + PABReq (AdjustUnbalancedTxReq, AwaitSlotReq, AwaitTimeReq, AwaitTxOutStatusChangeReq, AwaitTxStatusChangeReq, AwaitUtxoProducedReq, AwaitUtxoSpentReq, BalanceTxReq, ChainIndexQueryReq, CurrentChainIndexSlotReq, CurrentNodeClientSlotReq, CurrentNodeClientTimeRangeReq, CurrentTimeReq, ExposeEndpointReq, OwnAddressesReq, OwnContractInstanceIdReq, WriteBalancedTxReq, YieldUnbalancedTxReq), PABResp (ExposeEndpointResp)) import Plutus.Contract.Effects qualified as E import Plutus.Contract.Logging (logDebug) @@ -214,7 +216,7 @@ isSlot :: isSlot = Promise . awaitSlot -- | Get the current slot number -{-# DEPRECATED currentSlot "It was renamed to 'currentPABSlot', this function will be removed" #-} +{-# DEPRECATED currentSlot "Use currentNodeClientSlot instead" #-} currentSlot :: forall w s e. ( AsContractError e @@ -222,13 +224,23 @@ currentSlot :: => Contract w s e Slot currentSlot = currentPABSlot +{-# DEPRECATED currentPABSlot "Use currentNodeClientSlot instead" #-} -- | Get the current slot number of PAB currentPABSlot :: forall w s e. ( AsContractError e ) => Contract w s e Slot -currentPABSlot = pabReq CurrentPABSlotReq E._CurrentPABSlotResp +currentPABSlot = pabReq CurrentNodeClientSlotReq E._CurrentNodeClientSlotResp + +-- | Get the current slot number of the node client (the local or remote node) that the application +-- is connected to. +currentNodeClientSlot :: + forall w s e. + ( AsContractError e + ) + => Contract w s e Slot +currentNodeClientSlot = pabReq CurrentNodeClientSlotReq E._CurrentNodeClientSlotResp -- | Get the current node slot number querying slot number from plutus chain index to be aligned with slot at local running node currentChainIndexSlot :: @@ -272,6 +284,7 @@ isTime :: -> Promise w s e POSIXTime isTime = Promise . awaitTime +{-# DEPRECATED currentTime "Use currentNodeClientTimeRange instead" #-} -- | Get the latest time of the current slot. -- -- Example: if slot length is 3s and current slot is 2, then `currentTime` @@ -283,6 +296,17 @@ currentTime :: => Contract w s e POSIXTime currentTime = pabReq CurrentTimeReq E._CurrentTimeResp +-- | Get the 'POSIXTime' range of the current slot. +-- +-- Example: if slot length is 3s and current slot is 2, then `currentTimeRange` +-- returns the time interval @[3, 5[@. +currentNodeClientTimeRange :: + forall w s e. + ( AsContractError e + ) + => Contract w s e (POSIXTime, POSIXTime) +currentNodeClientTimeRange = pabReq CurrentNodeClientTimeRangeReq E._CurrentNodeClientTimeRangeResp + -- | Wait for a number of milliseconds starting at the ending time of the current -- slot, and return the latest time we know has passed. -- diff --git a/plutus-contract/src/Plutus/Contract/Trace.hs b/plutus-contract/src/Plutus/Contract/Trace.hs index a3cf1bed66..1882298fd8 100644 --- a/plutus-contract/src/Plutus/Contract/Trace.hs +++ b/plutus-contract/src/Plutus/Contract/Trace.hs @@ -28,9 +28,10 @@ module Plutus.Contract.Trace , handleSlotNotifications , handleTimeNotifications , handleOwnAddressesQueries - , handleCurrentPABSlotQueries + , handleCurrentNodeClientSlotQueries , handleCurrentChainIndexSlotQueries , handleCurrentTimeQueries + , handleCurrentNodeClientTimeRangeQueries , handleTimeToSlotConversions , handleUnbalancedTransactions , handlePendingTransactions @@ -117,13 +118,13 @@ handleTimeNotifications :: handleTimeNotifications = generalise (preview E._AwaitTimeReq) E.AwaitTimeResp RequestHandler.handleTimeNotifications -handleCurrentPABSlotQueries :: +handleCurrentNodeClientSlotQueries :: ( Member (LogObserve (LogMessage Text)) effs , Member NodeClientEffect effs ) => RequestHandler effs PABReq PABResp -handleCurrentPABSlotQueries = - generalise (preview E._CurrentPABSlotReq) E.CurrentPABSlotResp RequestHandler.handleCurrentPABSlot +handleCurrentNodeClientSlotQueries = + generalise (preview E._CurrentNodeClientSlotReq) E.CurrentNodeClientSlotResp RequestHandler.handleCurrentNodeClientSlot handleCurrentChainIndexSlotQueries :: ( Member (LogObserve (LogMessage Text)) effs @@ -141,6 +142,17 @@ handleCurrentTimeQueries :: handleCurrentTimeQueries = generalise (preview E._CurrentTimeReq) E.CurrentTimeResp RequestHandler.handleCurrentTime +handleCurrentNodeClientTimeRangeQueries :: + ( Member (LogObserve (LogMessage Text)) effs + , Member NodeClientEffect effs + ) + => RequestHandler effs PABReq PABResp +handleCurrentNodeClientTimeRangeQueries = + generalise + (preview E._CurrentNodeClientTimeRangeReq) + E.CurrentNodeClientTimeRangeResp + RequestHandler.handleCurrentNodeClientTimeRange + handleTimeToSlotConversions :: ( Member (LogObserve (LogMessage Text)) effs , Member NodeClientEffect effs diff --git a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs index f570332c9e..d7165ba723 100644 --- a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs +++ b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs @@ -20,10 +20,11 @@ module Plutus.Contract.Trace.RequestHandler( , handleAdjustUnbalancedTx , handleOwnAddresses , handleSlotNotifications - , handleCurrentPABSlot + , handleCurrentNodeClientSlot , handleCurrentChainIndexSlot , handleTimeNotifications , handleCurrentTime + , handleCurrentNodeClientTimeRange , handleTimeToSlotConversions , handleUnbalancedTransactions , handlePendingTransactions @@ -89,8 +90,8 @@ tryHandler' :: => RequestHandler effs req (f resp) -> [req] -> Eff effs (f resp) -tryHandler' (RequestHandler h) requests = - foldM (\e i -> fmap (e <|>) $ fmap join $ NonDet.makeChoiceA @f $ h i) empty requests +tryHandler' (RequestHandler h) = + foldM (\e i -> fmap ((e <|>) . join) $ NonDet.makeChoiceA @f $ h i) empty extract :: Alternative f => Prism' a b -> a -> f b extract p = maybe empty pure . preview p @@ -159,15 +160,15 @@ handleTimeNotifications = guard (currentSlot >= targetSlot_) pure $ TimeSlot.slotToEndPOSIXTime pSlotConfig currentSlot -handleCurrentPABSlot :: +handleCurrentNodeClientSlot :: forall effs a. ( Member NodeClientEffect effs , Member (LogObserve (LogMessage Text)) effs ) => RequestHandler effs a Slot -handleCurrentPABSlot = +handleCurrentNodeClientSlot = RequestHandler $ \_ -> - surroundDebug @Text "handleCurrentPABSlot" $ do + surroundDebug @Text "handleCurrentNodeClientSlot" $ do Wallet.Effects.getClientSlot handleCurrentChainIndexSlot :: @@ -196,6 +197,21 @@ handleCurrentTime = Params { pSlotConfig } <- Wallet.Effects.getClientParams TimeSlot.slotToEndPOSIXTime pSlotConfig <$> Wallet.Effects.getClientSlot +handleCurrentNodeClientTimeRange :: + forall effs a. + ( Member NodeClientEffect effs + , Member (LogObserve (LogMessage Text)) effs + ) + => RequestHandler effs a (POSIXTime, POSIXTime) +handleCurrentNodeClientTimeRange = + RequestHandler $ \_ -> + surroundDebug @Text "handleCurrentNodeClientTimeRange" $ do + Params { pSlotConfig } <- Wallet.Effects.getClientParams + nodeClientSlot <- Wallet.Effects.getClientSlot + pure ( TimeSlot.slotToBeginPOSIXTime pSlotConfig nodeClientSlot + , TimeSlot.slotToEndPOSIXTime pSlotConfig nodeClientSlot + ) + handleTimeToSlotConversions :: forall effs. ( Member NodeClientEffect effs diff --git a/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs b/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs index c3e2772a37..ab051faa70 100644 --- a/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs +++ b/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs @@ -254,10 +254,11 @@ handleBlockchainQueries = <> RequestHandler.handleOwnAddressesQueries <> RequestHandler.handleOwnInstanceIdQueries <> RequestHandler.handleSlotNotifications - <> RequestHandler.handleCurrentPABSlotQueries + <> RequestHandler.handleCurrentNodeClientSlotQueries <> RequestHandler.handleCurrentChainIndexSlotQueries <> RequestHandler.handleTimeNotifications <> RequestHandler.handleCurrentTimeQueries + <> RequestHandler.handleCurrentNodeClientTimeRangeQueries <> RequestHandler.handleTimeToSlotConversions <> RequestHandler.handleYieldedUnbalancedTx <> RequestHandler.handleAdjustUnbalancedTx diff --git a/plutus-contract/test/Spec/TxConstraints/MustSatisfyAnyOf.hs b/plutus-contract/test/Spec/TxConstraints/MustSatisfyAnyOf.hs index a59d3c8f08..df3f7e40f8 100644 --- a/plutus-contract/test/Spec/TxConstraints/MustSatisfyAnyOf.hs +++ b/plutus-contract/test/Spec/TxConstraints/MustSatisfyAnyOf.hs @@ -126,7 +126,7 @@ mustSatisfyAnyOfContract :: SubmitTx -> LanguageContext -> ConstraintParams -> ConstraintParams -> Contract () Empty ContractError () mustSatisfyAnyOfContract submitTxFromConstraints lc offChainConstraints onChainConstraints = do - now <- Con.currentTime + now <- snd <$> Con.currentNodeClientTimeRange let offChainConstraintsWithNow = buildConstraints (applyNowToTimeValidity offChainConstraints now) onChainConstraintsWithNow = applyNowToTimeValidity onChainConstraints now diff --git a/plutus-contract/test/Spec/TxConstraints/TimeValidity.hs b/plutus-contract/test/Spec/TxConstraints/TimeValidity.hs index 922079db7f..00b6cfa504 100644 --- a/plutus-contract/test/Spec/TxConstraints/TimeValidity.hs +++ b/plutus-contract/test/Spec/TxConstraints/TimeValidity.hs @@ -56,7 +56,7 @@ tests = testGroup "time validitity constraint" contract :: Contract () Empty ContractError () contract = do - now <- Con.currentTime + now <- snd <$> Con.currentNodeClientTimeRange logInfo @String $ "now: " ++ show now let lookups1 = Constraints.typedValidatorLookups $ typedValidator deadline tx1 = Constraints.mustPayToTheScriptWithDatumInTx @@ -76,7 +76,7 @@ contract = do void $ waitNSlots 2 ledgerTx2 <- submitTxConstraintsWith @Void lookups2 tx2 awaitTxConfirmed $ Tx.getCardanoTxId ledgerTx2 - cSlot <- Con.currentPABSlot + cSlot <- Con.currentNodeClientSlot logInfo @String $ "Current slot: " ++ show cSlot trace :: Trace.EmulatorTrace () @@ -115,7 +115,7 @@ contractCardano f p = do let mkTx lookups constraints = either (error . show) id $ Tx.Constraints.mkTx @UnitTest p lookups constraints pkh <- Con.ownFirstPaymentPubKeyHash utxos <- Con.ownUtxos - now <- Con.currentTime + now <- snd <$> Con.currentNodeClientTimeRange logInfo @String $ "now: " ++ show now let utxoRef = fst $ head' $ Map.toList utxos lookups = Tx.Constraints.unspentOutputs utxos @@ -126,7 +126,7 @@ contractCardano f p = do ledgerTx <- submitUnbalancedTx $ mkTx lookups tx awaitTxConfirmed $ Tx.getCardanoTxId ledgerTx - cSlot <- Con.currentPABSlot + cSlot <- Con.currentNodeClientSlot logInfo @String $ "Current slot: " ++ show cSlot let txRange = Tx.getCardanoTxValidityRange ledgerTx logInfo @String $ show txRange diff --git a/plutus-pab/src/Plutus/PAB/Arbitrary.hs b/plutus-pab/src/Plutus/PAB/Arbitrary.hs index 64687cee7e..5656a48c30 100644 --- a/plutus-pab/src/Plutus/PAB/Arbitrary.hs +++ b/plutus-pab/src/Plutus/PAB/Arbitrary.hs @@ -316,7 +316,7 @@ instance Arbitrary PABReq where arbitrary = oneof [ AwaitSlotReq <$> arbitrary - , pure CurrentPABSlotReq + , pure CurrentNodeClientSlotReq , pure CurrentChainIndexSlotReq , pure OwnContractInstanceIdReq , ExposeEndpointReq <$> arbitrary diff --git a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs index 25bfc84df3..831df49582 100644 --- a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs +++ b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs @@ -334,9 +334,9 @@ stmRequestHandler = fmap sequence (wrapHandler (fmap pure nonBlockingRequests) < <> RequestHandler.handleUnbalancedTransactions @effs <> RequestHandler.handlePendingTransactions @effs <> RequestHandler.handleOwnInstanceIdQueries @effs - <> RequestHandler.handleCurrentPABSlotQueries @effs + <> RequestHandler.handleCurrentNodeClientSlotQueries @effs <> RequestHandler.handleCurrentChainIndexSlotQueries @effs - <> RequestHandler.handleCurrentTimeQueries @effs + <> RequestHandler.handleCurrentNodeClientTimeRangeQueries @effs <> RequestHandler.handleYieldedUnbalancedTx @effs <> RequestHandler.handleAdjustUnbalancedTx @effs diff --git a/plutus-playground-server/usecases/Vesting.hs b/plutus-playground-server/usecases/Vesting.hs index 693b504939..d6e5de0413 100644 --- a/plutus-playground-server/usecases/Vesting.hs +++ b/plutus-playground-server/usecases/Vesting.hs @@ -176,7 +176,7 @@ retrieveFundsC retrieveFundsC vesting payment = do let inst = typedValidator vesting addr = Scripts.validatorAddress inst - now <- currentTime + now <- fst <$> currentNodeClientTimeRange unspentOutputs <- utxosAt addr let currentlyLocked = foldMap (view Tx.ciTxOutValue) (Map.elems unspentOutputs) @@ -207,7 +207,6 @@ retrieveFundsC vesting payment = do -- we don't need to add a pubkey output for 'vestingOwner' here -- because this will be done by the wallet when it balances the -- transaction. - void $ waitNSlots 1 -- wait until we reach a slot in the validity range mkTxConstraints (Constraints.typedValidatorLookups inst <> Constraints.unspentOutputs unspentOutputs) txn >>= adjustUnbalancedTx >>= void . submitUnbalancedTx diff --git a/plutus-use-cases/src/Plutus/Contracts/Escrow.hs b/plutus-use-cases/src/Plutus/Contracts/Escrow.hs index 75972afb1a..d50bb29d86 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Escrow.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Escrow.hs @@ -293,7 +293,7 @@ redeem :: redeem inst escrow = mapError (review _EscrowError) $ do let addr = Scripts.validatorAddress inst unspentOutputs <- utxosAt addr - current <- currentTime + current <- snd <$> currentNodeClientTimeRange if current >= escrowDeadline escrow then throwing _RedeemFailed DeadlinePassed else if foldMap (view Tx.ciTxOutValue) unspentOutputs `lt` targetTotal escrow @@ -302,7 +302,7 @@ redeem inst escrow = mapError (review _EscrowError) $ do let -- Correct validity interval should be: -- @ - -- Interval (LowerBound NegInf True) (Interval.scriptUpperBound $ escrowDeadline escrow) + -- Interval (LowerBound NegInf True) (Interval.strictUpperBound $ escrowDeadline escrow) -- @ -- See Note [Validity Interval's upper bound] validityTimeRange = Interval.to (Haskell.pred $ Haskell.pred $ escrowDeadline escrow) @@ -366,7 +366,7 @@ payRedeemRefund params vl = do if presentVal `geq` targetTotal params then Right <$> redeem inst params else do - time <- currentTime + time <- snd <$> currentNodeClientTimeRange if time >= escrowDeadline params then Left <$> refund inst params else waitNSlots 1 >> go diff --git a/plutus-use-cases/src/Plutus/Contracts/Governance.hs b/plutus-use-cases/src/Plutus/Contracts/Governance.hs index d58bfa22dc..8ed9fe73d9 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Governance.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Governance.hs @@ -183,7 +183,7 @@ transition Params{..} State{ stateData = s, stateValue} i = case (s, i) of let newMap = AssocMap.insert tokenName vote oldMap -- Correct validity interval should be: -- @ - -- Interval (LowerBound NegInf True) (Interval.scriptUpperBound $ votingDeadline p) + -- Interval (LowerBound NegInf True) (Interval.strictUpperBound $ votingDeadline p) -- @ -- See Note [Validity Interval's upper bound] validityTimeRange = Interval.to (votingDeadline p - 2) diff --git a/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs b/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs index 903f1cb3cb..52905d8416 100644 --- a/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs +++ b/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs @@ -223,7 +223,7 @@ transition params State{ stateData =s, stateValue=currentValue} i = case (s, i) let Payment{paymentAmount, paymentRecipient, paymentDeadline} = payment -- Correct validity interval should be: -- @ - -- Interval (LowerBound NegInf True) (Interval.scriptUpperBound $ paymentDeadline p) + -- Interval (LowerBound NegInf True) (Interval.strictUpperBound $ paymentDeadline p) -- @ -- See Note [Validity Interval's upper bound] validityTimeRange = Interval.to $ paymentDeadline - 2 diff --git a/plutus-use-cases/src/Plutus/Contracts/PubKey.hs b/plutus-use-cases/src/Plutus/Contracts/PubKey.hs index 1fe4df0dc4..0e17920ac7 100644 --- a/plutus-use-cases/src/Plutus/Contracts/PubKey.hs +++ b/plutus-use-cases/src/Plutus/Contracts/PubKey.hs @@ -105,7 +105,7 @@ pubKeyContract pk vl = mapError (review _PubKeyError ) $ do -- The 'awaitChainIndexSlot' blocks the contract until the chain-index -- is synced until the current slot. This is not a good solution, -- as the chain-index is always some time behind the current slot. - slot <- currentPABSlot + slot <- currentNodeClientSlot awaitChainIndexSlot slot ciTxOut <- unspentTxOutFromRef outRef diff --git a/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs b/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs index e83623afea..39308e0d52 100644 --- a/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs +++ b/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs @@ -178,7 +178,7 @@ auctionTransition AuctionParams{apOwner, apAsset, apEndTime, apPayoutTime} State | sealedBidBidder bid `notElem` map sealedBidBidder bids -> -- Correct validity interval should be: -- @ - -- Interval (LowerBound NegInf True) (Interval.scriptUpperBound apEndTime) + -- Interval (LowerBound NegInf True) (Interval.strictUpperBound apEndTime) -- @ -- See Note [Validity Interval's upper bound] let validityTimeRange = Interval.to $ apEndTime - 2 @@ -223,10 +223,10 @@ auctionTransition AuctionParams{apOwner, apAsset, apEndTime, apPayoutTime} State && sealBid bid `elem` sealedBids -> -- Correct validity interval should be: -- @ - -- Interval (LowerBound NegInf True) (Interval.scriptUpperBound apPayoutTime) + -- Interval (LowerBound NegInf True) (Interval.strictUpperBound apPayoutTime) -- @ -- See Note [Validity Interval's upper bound] - let validityTimeRange = Interval.to $ apPayoutTime - 2 + let validityTimeRange = Interval.to apPayoutTime constraints = Constraints.mustValidateIn validityTimeRange <> Constraints.mustPayToPubKey (revealedBidBidder highestBid) (valueOfBid highestBid) newState = diff --git a/plutus-use-cases/src/Plutus/Contracts/SimpleEscrow.hs b/plutus-use-cases/src/Plutus/Contracts/SimpleEscrow.hs index 59814b8d12..0fb2c281ca 100644 --- a/plutus-use-cases/src/Plutus/Contracts/SimpleEscrow.hs +++ b/plutus-use-cases/src/Plutus/Contracts/SimpleEscrow.hs @@ -127,7 +127,7 @@ lockEp :: Promise () EscrowSchema EscrowError () lockEp = endpoint @"lock" $ \params -> do -- Correct validity interval should be: -- @ - -- Interval (LowerBound NegInf True) (Interval.scriptUpperBound $ deadline params) + -- Interval (LowerBound NegInf True) (Interval.strictUpperBound $ deadline params) -- @ -- See Note [Validity Interval's upper bound] let valRange = Interval.to (Haskell.pred $ Haskell.pred $ deadline params) @@ -142,14 +142,14 @@ redeemEp :: Promise () EscrowSchema EscrowError RedeemSuccess redeemEp = endpoint @"redeem" redeem where redeem params = do - time <- currentTime + time <- snd <$> currentNodeClientTimeRange pk <- ownFirstPaymentPubKeyHash unspentOutputs <- utxosAt escrowAddress let value = foldMap (view Tx.ciTxOutValue) unspentOutputs -- Correct validity interval should be: -- @ - -- Interval (LowerBound NegInf True) (Interval.scriptUpperBound $ deadline params) + -- Interval (LowerBound NegInf True) (Interval.strictUpperBound $ deadline params) -- @ -- See Note [Validity Interval's upper bound] validityTimeRange = Interval.to (Haskell.pred $ Haskell.pred $ deadline params) diff --git a/plutus-use-cases/src/Plutus/Contracts/Vesting.hs b/plutus-use-cases/src/Plutus/Contracts/Vesting.hs index bc6fc80ef4..278fa7e298 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Vesting.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Vesting.hs @@ -192,15 +192,6 @@ vestFundsC vesting = mapError (review _VestingError) $ do data Liveness = Alive | Dead -{- Note [slots and POSIX time] - - A slot has a given duration. As a consequence, 'currentTime' does not return exactly the current time but, - - by convention, the last POSIX time of the current slot. - - A consequence to this design choice is that when we use this time to build the 'mustValidateIn constraints', - - we get a range that start at the slot after the current one. - - To be sure that the validity range is valid when the transaction will be validated by the pool, we must therefore - - wait the next slot before sumitting it (which is done using 'waitNSlots 1'). - - - -} retrieveFundsC :: ( AsVestingError e ) @@ -210,7 +201,7 @@ retrieveFundsC retrieveFundsC vesting payment = mapError (review _VestingError) $ do let inst = typedValidator vesting addr = Scripts.validatorAddress inst - now <- currentTime + now <- fst <$> currentNodeClientTimeRange unspentOutputs <- utxosAt addr let currentlyLocked = foldMap (view Tx.ciTxOutValue) (Map.elems unspentOutputs) @@ -233,7 +224,6 @@ retrieveFundsC vesting payment = mapError (review _VestingError) $ do -- we don't need to add a pubkey output for 'vestingOwner' here -- because this will be done by the wallet when it balances the -- transaction. - void $ waitNSlots 1 -- see [slots and POSIX time] mkTxConstraints (Constraints.typedValidatorLookups inst <> Constraints.unspentOutputs unspentOutputs) tx >>= adjustUnbalancedTx >>= void . submitUnbalancedTx diff --git a/plutus-use-cases/test/Spec/Escrow/Endpoints.hs b/plutus-use-cases/test/Spec/Escrow/Endpoints.hs index 28f6389a99..b80dc9d511 100644 --- a/plutus-use-cases/test/Spec/Escrow/Endpoints.hs +++ b/plutus-use-cases/test/Spec/Escrow/Endpoints.hs @@ -47,7 +47,7 @@ badRefund :: -> Contract w s EscrowError () badRefund inst pk = do unspentOutputs <- utxosAt (Scripts.validatorAddress inst) - current <- currentTime + current <- snd <$> currentNodeClientTimeRange let flt _ ciTxOut = fst (Tx._ciTxOutScriptDatum ciTxOut) == Ledger.datumHash (Datum (PlutusTx.toBuiltinData pk)) tx' = Constraints.collectFromTheScriptFilter flt unspentOutputs Refund <> Constraints.mustValidateIn (from (current - 1)) diff --git a/plutus-use-cases/test/Spec/renderVesting.txt b/plutus-use-cases/test/Spec/renderVesting.txt index 41342cd3b2..619578a2c5 100644 --- a/plutus-use-cases/test/Spec/renderVesting.txt +++ b/plutus-use-cases/test/Spec/renderVesting.txt @@ -669,7 +669,7 @@ Balances Carried Forward: Ada: Lovelace: 60000000 ==== Slot #2, Tx #0 ==== -TxId: 0911f72cd7b8e36ccf5c9755c0b2776d7ee435a68c83d540513b6f0fbf448e5d +TxId: a52e05dce68b29cf53e650be5390cface0d434956e539f5fbcf38b6e2cb5b002 Fee: Ada: Lovelace: 443713 Mint: - Inputs: