Add validity interval to release-funds, and provide example VFunction (#183)

* Add validity interval to release-funds, and provide example VFunction

* cleanup

---------

Co-authored-by: Krisztian Pinter <[email protected]>

Author: jankun4

.changes/unreleased/Added-20250109-144213.yaml

@@ -0,0 +1,3 @@
+kind: Added
+body: Example V function
+time: 2025-01-09T14:42:13.317947+01:00

.changes/unreleased/Changed-20250109-144241.yaml

@@ -0,0 +1,3 @@
+kind: Changed
+body: '`reserve-release-funds` now sets up validity interval from the current time to +infinity'
+time: 2025-01-09T14:42:41.875132+01:00

offchain/spago.dhall

@@ -15,6 +15,7 @@
   , "const"
   , "control"
   , "datetime"
+  , "effect"
   , "either"
   , "exceptions"
   , "foldable-traversable"
@@ -33,6 +34,7 @@
   , "node-process"
   , "node-streams"
   , "nonempty"
+  , "now"
   , "optparse"
   , "ordered-collections"
   , "parsing"

offchain/src/Main.purs

@@ -31,9 +31,11 @@ import TrustlessSidechain.EndpointResp
       , UpdatePermissionedCandidatesResp
       , ListVersionedScriptsResp
       , ReserveResp
+      , GetVFunctionCBORResp
       )
   , stringifyEndpointResp
   )
+import TrustlessSidechain.ExampleVFunction as ExampleVFunction
 import TrustlessSidechain.GetSidechainAddresses as GetSidechainAddresses
 import TrustlessSidechain.Governance.Utils (updateGovernance)
 import TrustlessSidechain.InitSidechain.Governance (initGovernance)
@@ -69,6 +71,7 @@ import TrustlessSidechain.Options.Types
       , DepositReserve
       , ReleaseReserveFunds
       , HandoverReserve
+      , GetVFunctionCBOR
       )
   )
 import TrustlessSidechain.PermissionedCandidates as PermissionedCandidates
@@ -274,6 +277,10 @@ runTxEndpoint genesisUtxo endpoint =
       txHash <- handover genesisUtxo utxo
       pure $ ReserveResp { transactionHash: txHashToByteArray txHash }
 
+    GetVFunctionCBOR { unixTimestamp } -> do
+      vFunctionCBOR <- ExampleVFunction.decodeExampleVFunctionPolicy unixTimestamp
+      pure $ GetVFunctionCBORResp { vFunctionCBOR }
+
 printEndpointResp :: EndpointResp -> Effect Unit
 printEndpointResp =
   log <<< stringifyEndpointResp

offchain/src/TrustlessSidechain/Effects/App.purs

@@ -7,13 +7,14 @@ import Run (AFF, EFFECT)
 import Run.Except (EXCEPT)
 import TrustlessSidechain.Effects.Contract (CONTRACT)
 import TrustlessSidechain.Effects.Log (LOG)
+import TrustlessSidechain.Effects.Time (TIME)
 import TrustlessSidechain.Effects.Transaction (TRANSACTION)
 import TrustlessSidechain.Effects.Wallet (WALLET)
 import TrustlessSidechain.Error (OffchainError)
 import Type.Row (type (+))
 
 -- | The top level effects
-type APP r = EXCEPT OffchainError + WALLET + TRANSACTION + LOG + r
+type APP r = EXCEPT OffchainError + WALLET + TRANSACTION + LOG + TIME + r
 
 -- | The base effects
 type BASE r = CONTRACT + EFFECT + AFF + r

offchain/src/TrustlessSidechain/Effects/Run.purs

@@ -16,7 +16,8 @@ import Run.Except (EXCEPT, runExcept)
 import TrustlessSidechain.Effects.App (APP, BASE)
 import TrustlessSidechain.Effects.Contract (liftContract, unliftContract)
 import TrustlessSidechain.Effects.Contract as Effect
-import TrustlessSidechain.Effects.Log (LogF, handleLogLive, handleLogWith)
+import TrustlessSidechain.Effects.Log (LOG, LogF, handleLogLive, handleLogWith)
+import TrustlessSidechain.Effects.Time (TimeF, handleTimeLive, handleTimeWith)
 import TrustlessSidechain.Effects.Transaction
   ( TRANSACTION
   , TransactionF
@@ -46,12 +47,17 @@ runAppWith ::
       ( EXCEPT OffchainError + WALLET + TRANSACTION + r
       )
   ) ->
+  ( TimeF ~> Run
+      ( EXCEPT OffchainError + WALLET + TRANSACTION + LOG + r
+      )
+  ) ->
   Run (APP + r) ~>
     Run (EXCEPT OffchainError + r)
-runAppWith handleTransaction handleWallet handleLog f =
+runAppWith handleTransaction handleWallet handleLog handleTime f =
   handleTransactionWith handleTransaction
     $ handleWalletWith handleWallet
     $ handleLogWith handleLog
+    $ handleTimeWith handleTime
     $ f
 
 -- | Run the effect stack down to an `Aff` using the live handlers
@@ -64,6 +70,7 @@ runAppLive contractParams = runBaseAff'
   <<< runExcept
   <<< Effect.runContract contractParams
   <<< runAppWith handleTransactionLive handleWalletLive handleLogLive
+    handleTimeLive
 
 -- | Strip away the `APP` effect using the live handlers
 runToBase ::
@@ -72,6 +79,7 @@ runToBase f =
   runAppWith handleTransactionLive
     handleWalletLive
     handleLogLive
+    handleTimeLive
     $ f
 
 -- | Unlift an effect stack which contains a `CONTRACT` effect to the `Contract` monad

offchain/src/TrustlessSidechain/Effects/Time.purs

@@ -0,0 +1,69 @@
+module TrustlessSidechain.Effects.Time
+  ( TIME
+  , TimeF
+  , handleTimeLive
+  , handleTimeWith
+  , getCurrentEra
+  , getSystemStart
+  ) where
+
+import Contract.Prelude
+
+import Contract.Log (logDebug', logInfo', logWarn') as Contract
+import Contract.Time as Time
+import Effect.Aff (Error)
+import Run (Run, interpret, on, send)
+import Run as Run
+import Run.Except (EXCEPT)
+import TrustlessSidechain.Effects.Contract (CONTRACT, withTry)
+import TrustlessSidechain.Effects.Errors.Context
+  ( ErrorContext(ErrorContext)
+  , ErrorContextType(Log)
+  )
+import TrustlessSidechain.Effects.Errors.Parser
+  ( parseDefaultError
+  , parseFromError
+  )
+import TrustlessSidechain.Error (OffchainError)
+import Type.Proxy (Proxy(Proxy))
+import Type.Row (type (+))
+
+data TimeF a
+  = GetCurrentEra' (Time.EraSummary -> a)
+  | GetSystemStart' (Time.SystemStart -> a)
+
+derive instance functorTimeF :: Functor TimeF
+
+type TIME r = (time :: TimeF | r)
+
+_time :: Proxy "time"
+_time = Proxy
+
+handleTimeWith ::
+  forall r. (TimeF ~> Run r) -> Run (TIME + r) ~> Run r
+handleTimeWith f = interpret (on _time f send)
+
+getCurrentEra ::
+  forall r. Run (TIME + r) Time.EraSummary
+getCurrentEra = Run.lift _time
+  (GetCurrentEra' identity)
+
+getSystemStart ::
+  forall r. Run (TIME + r) Time.SystemStart
+getSystemStart = Run.lift _time
+  (GetSystemStart' identity)
+
+handleTimeLive ::
+  forall r. TimeF ~> Run (EXCEPT OffchainError + CONTRACT + r)
+handleTimeLive =
+  case _ of
+    GetCurrentEra' f -> f <$> withTry
+      (fromError "getCurrentEra: ")
+      (Time.getCurrentEra)
+    GetSystemStart' f -> f <$> withTry
+      (fromError "getSystemStart: ")
+      (Time.getSystemStart)
+  where
+  fromError :: String -> Error -> OffchainError
+  fromError ctx =
+    parseFromError parseDefaultError (Just (ErrorContext Log ctx))

offchain/src/TrustlessSidechain/EndpointResp.purs

@@ -51,6 +51,7 @@ data EndpointResp
       , versionedValidators :: List (Tuple Types.ScriptId PlutusScript)
       }
   | ReserveResp { transactionHash :: ByteArray }
+  | GetVFunctionCBORResp { vFunctionCBOR :: ByteArray }
 
 -- Note [BigInt values and JSON]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -189,6 +190,11 @@ endpointRespCodec = CA.prismaticCodec "EndpointResp" dec enc CA.json
       J.fromObject $ Object.fromFoldable
         [ "transactionHash" /\ J.fromString (byteArrayToHex transactionHash) ]
 
+    GetVFunctionCBORResp { vFunctionCBOR } ->
+      J.fromObject $ Object.fromFoldable
+        [ "vFunctionCBOR" /\ J.fromString (byteArrayToHex vFunctionCBOR)
+        ]
+
 -- | Encode the endpoint response to a json object
 encodeEndpointResp :: EndpointResp -> J.Json
 encodeEndpointResp = CA.encode endpointRespCodec

offchain/src/TrustlessSidechain/ExampleVFunction.purs

@@ -0,0 +1,44 @@
+module TrustlessSidechain.ExampleVFunction where
+
+import Contract.Prelude hiding (note)
+
+import Cardano.AsCbor (encodeCbor)
+import Cardano.ToData (toData)
+import Cardano.Types.BigInt (BigInt)
+import Cardano.Types.PlutusScript (PlutusScript, getBytes)
+import Data.ByteArray (ByteArray)
+import Run (Run)
+import Run.Except (EXCEPT)
+import TrustlessSidechain.Effects.Wallet (WALLET)
+import TrustlessSidechain.Error (OffchainError)
+import TrustlessSidechain.Utils.Scripts
+  ( mkMintingPolicyWithParams
+  )
+import TrustlessSidechain.Versioning.ScriptId
+  ( ScriptId
+      ( ExampleVFunctionPolicy
+      )
+  )
+import Type.Row (type (+))
+
+decodeExampleVFunctionPolicy ::
+  forall r.
+  BigInt ->
+  Run (EXCEPT OffchainError + WALLET + r) ByteArray
+decodeExampleVFunctionPolicy unixTimestamp = do
+
+  plutusScript <- mkMintingPolicyWithParams ExampleVFunctionPolicy $
+    [ toData unixTimestamp
+    ]
+
+  pure $ unwrap $ encodeCbor plutusScript
+
+exampleVFunctionPolicy ::
+  forall r.
+  BigInt ->
+  Run (EXCEPT OffchainError + WALLET + r) PlutusScript
+exampleVFunctionPolicy unixTimestamp = do
+
+  mkMintingPolicyWithParams ExampleVFunctionPolicy $
+    [ toData unixTimestamp
+    ]

offchain/src/TrustlessSidechain/NativeTokenManagement/Reserve.purs

@@ -32,6 +32,10 @@ import Contract.PlutusData
   , toData
   )
 import Contract.ScriptLookups as Lookups
+import Contract.Time
+  ( POSIXTime
+  )
+import Contract.Time as Time
 import Contract.Transaction
   ( ScriptRef(..)
   , TransactionHash
@@ -45,15 +49,27 @@ import Contract.TxConstraints
 import Contract.TxConstraints as TxConstraints
 import Contract.Utxos (UtxoMap)
 import Contract.Value (add, minus, singleton) as Value
+import Data.Array as Array
+import Data.Bifunctor (lmap)
+import Data.DateTime.Instant (unInstant)
+import Data.Int (floor)
 import Data.Map as Map
+import Data.Time.Duration (Milliseconds(..))
+import Effect.Now as Now
+import Effect.Unsafe (unsafePerformEffect)
 import JS.BigInt as BigInt
+import Partial.Unsafe (unsafePartial)
+import Run (EFFECT, Run, liftEffect)
 import Run (Run)
 import Run.Except (EXCEPT, throw)
-import TrustlessSidechain.Effects.App (APP)
+import TrustlessSidechain.Effects.App (APP, BASE)
+import TrustlessSidechain.Effects.Contract (CONTRACT, liftContract)
+import TrustlessSidechain.Effects.Time (getCurrentEra, getSystemStart)
 import TrustlessSidechain.Effects.Transaction (TRANSACTION, getUtxo, utxosAt)
-import TrustlessSidechain.Effects.Util (fromMaybeThrow)
+import TrustlessSidechain.Effects.Util (fromEitherThrow, fromMaybeThrow)
 import TrustlessSidechain.Effects.Wallet (WALLET)
 import TrustlessSidechain.Error (OffchainError(..))
+import TrustlessSidechain.Error (OffchainError(GenericInternalError))
 import TrustlessSidechain.Governance.Utils as Governance
 import TrustlessSidechain.NativeTokenManagement.Types
   ( ImmutableReserveSettings
@@ -662,6 +678,18 @@ transferToIlliquidCirculationSupply
     (GenericInternalError "Could not calculate new ICS value")
     (pure (toTransferAsValue `Value.minus` incentiveAsValue))
 
+  currentEra <- getCurrentEra
+  systemStart <- getSystemStart
+
+  let summaries = wrap $ Array.singleton currentEra
+
+  nowMoment <- fromEitherThrow $ pure
+    $ lmap (\x -> GenericInternalError (show x))
+    $ Time.slotToPosixTime summaries systemStart
+        (unwrap (unwrap currentEra).start).slot
+
+  let validityInterval = Time.from nowMoment
+
   let
     lookups :: Lookups.ScriptLookups
     lookups =
@@ -703,6 +731,7 @@ transferToIlliquidCirculationSupply
           PlutusData.unit
           DatumInline
           illiquidCirculationNewValue
+        <> TxConstraints.mustValidateIn validityInterval
 
   balanceSignAndSubmit
     "Transfer to illiquid circulation supply"