Merge pull request #370 from geniusyield/allow-ref-script-for-higher-…

…plutus-versions

feat #372 & #373

.github/workflows/haskell.yml

@@ -174,12 +174,12 @@ jobs:
       run: git ls-files -z '*.hs' | xargs -P 12 -0 fourmolu --mode check
     - name: Symlink cardano-node binaries
       run: cabal install --package-env=$(pwd) --overwrite-policy=always cardano-cli cardano-node
-    - name: Run privnet tests
-      run: cabal run atlas-privnet-tests -- -j1 --hide-successes
     - name: Run unified tests
       run: cabal run atlas-unified-tests -- -j1 --hide-successes
-    - name: Run all tests (cabal)
-      run: cabal run atlas-tests -- -j1 --hide-successes
+    - name: Run privnet tests
+      run: cabal run atlas-privnet-tests -- -j1 --hide-successes
+    # - name: Run all tests (cabal)
+    #   run: cabal run atlas-tests -- -j1 --hide-successes
     - name: Run doctest (docspec)
       run: |
         # Install docspec and run doctests.

CHANGELOG.md

@@ -1,3 +1,11 @@
+## 0.7.0
+
+* Era histories are now cached through entire run of the program whereas protocol parameters are fetched once per epoch. In case you were utilising era summary given by Atlas, note that era end of last era is now set to being unbounded.
+* Bug fix for our caching mechanism, see PR [#370](https://github.com/geniusyield/atlas/pull/370) for more details.
+* We no longer fetch registered stake pools as it is not required.
+* Added utility functions to do slot to epoch related conversations.
+* `addRefScript` now accepts for scripts that has version greater than or equal to `PlutusV2`.
+
 ## 0.6.3
 
 * Avoid dependency upon `cardano-balance-tx:internal`. See [#368](https://github.com/geniusyield/atlas/issues/368) for more details.

atlas-cardano.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.8
 name:               atlas-cardano
-version:            0.6.3
+version:            0.7.0
 synopsis:           Application backend for Plutus smart contracts on Cardano
 description:
   Atlas is an all-in-one, Haskell-native application backend for writing off-chain code for on-chain Plutus smart contracts.
@@ -133,6 +133,7 @@ library
     GeniusYield.Types.Datum
     GeniusYield.Types.Delegatee
     GeniusYield.Types.DRep
+    GeniusYield.Types.Epoch
     GeniusYield.Types.Era
     GeniusYield.Types.Key
     GeniusYield.Types.Key.Class

src/GeniusYield/GYConfig.hs

@@ -160,7 +160,7 @@ withCfgProviders
   ns
   f =
     do
-      (gyGetParameters, gySlotActions', gyQueryUTxO', gyLookupDatum, gySubmitTx, gyAwaitTxConfirmed, gyGetStakeAddressInfo) <- case cfgCoreProvider of
+      (gyGetParameters, gySlotActions', gyQueryUTxO', gyLookupDatum, gySubmitTx, gyAwaitTxConfirmed, gyGetStakeAddressInfo, gyGetStakePools) <- case cfgCoreProvider of
         GYNodeKupo path kupoUrl -> do
           let info = nodeConnectInfo path cfgNetworkId
           kEnv <- KupoApi.newKupoApiEnv $ Text.unpack kupoUrl
@@ -174,6 +174,7 @@ withCfgProviders
             , Node.nodeSubmitTx info
             , KupoApi.kupoAwaitTxConfirmed kEnv
             , nodeStakeAddressInfo info
+            , Node.nodeStakePools info
             )
         GYMaestro (Confidential apiToken) turboSubmit -> do
           maestroApiEnv <- MaestroApi.networkIdToMaestroEnv apiToken cfgNetworkId
@@ -183,7 +184,7 @@ withCfgProviders
               (MaestroApi.maestroProtocolParams maestroApiEnv)
               (MaestroApi.maestroSystemStart maestroApiEnv)
               (MaestroApi.maestroEraHistory maestroApiEnv)
-              (MaestroApi.maestroStakePools maestroApiEnv)
+              (MaestroApi.maestroGetSlotOfCurrentBlock maestroApiEnv)
           pure
             ( maestroGetParams
             , maestroSlotActions
@@ -192,6 +193,7 @@ withCfgProviders
             , MaestroApi.maestroSubmitTx (Just True == turboSubmit) maestroApiEnv
             , MaestroApi.maestroAwaitTxConfirmed maestroApiEnv
             , MaestroApi.maestroStakeAddressInfo maestroApiEnv
+            , MaestroApi.maestroStakePools maestroApiEnv
             )
         GYBlockfrost (Confidential key) -> do
           let proj = Blockfrost.networkIdToProject cfgNetworkId key
@@ -201,7 +203,7 @@ withCfgProviders
               (Blockfrost.blockfrostProtocolParams proj)
               (Blockfrost.blockfrostSystemStart proj)
               (Blockfrost.blockfrostEraHistory proj)
-              (Blockfrost.blockfrostStakePools proj)
+              (Blockfrost.blockfrostGetSlotOfCurrentBlock proj)
           pure
             ( blockfrostGetParams
             , blockfrostSlotActions
@@ -210,6 +212,7 @@ withCfgProviders
             , Blockfrost.blockfrostSubmitTx proj
             , Blockfrost.blockfrostAwaitTxConfirmed proj
             , Blockfrost.blockfrostStakeAddressInfo proj
+            , Blockfrost.blockfrostStakePools proj
             )
 
       bracket (mkLogEnv ns cfgLogging) closeScribes $ \logEnv -> do
@@ -253,6 +256,7 @@ logTiming providers@GYProviders {..} =
     , gyQueryUTxO = gyQueryUTxO'
     , gyGetStakeAddressInfo = gyGetStakeAddressInfo'
     , gyLog' = gyLog'
+    , gyGetStakePools = gyGetStakePools'
     }
  where
   wrap :: String -> IO a -> IO a
@@ -284,10 +288,11 @@ logTiming providers@GYProviders {..} =
       { gyGetProtocolParameters' = wrap "gyGetProtocolParameters" $ gyGetProtocolParameters providers
       , gyGetSystemStart' = wrap "gyGetSystemStart" $ gyGetSystemStart providers
       , gyGetEraHistory' = wrap "gyGetEraHistory" $ gyGetEraHistory providers
-      , gyGetStakePools' = wrap "gyGetStakePools" $ gyGetStakePools providers
       , gyGetSlotConfig' = wrap "gyGetSlotConfig" $ gyGetSlotConfig providers
       }
 
+  gyGetStakePools' = wrap "gyGetStakePools" gyGetStakePools
+
   gyQueryUTxO' :: GYQueryUTxO
   gyQueryUTxO' =
     GYQueryUTxO

src/GeniusYield/Providers/Common.hs

@@ -13,6 +13,7 @@ module GeniusYield.Providers.Common (
   datumFromCBOR,
   newServantClientEnv,
   fromJson,
+  makeLastEraEndUnbounded,
   parseEraHist,
   preprodEraHist,
   previewEraHist,
@@ -50,7 +51,8 @@ import Cardano.Slotting.Time (
  )
 import Control.Exception (Exception)
 import Data.Bifunctor (first)
-import Data.SOP.NonEmpty (NonEmpty (NonEmptyCons, NonEmptyOne))
+import Data.SOP.NonEmpty (NonEmpty (NonEmptyCons, NonEmptyOne), nonEmptyFromList, nonEmptyToList)
+import GeniusYield.CardanoApi.EraHistory (extractEraSummaries)
 import GeniusYield.Types.Datum (
   GYDatum,
   datumFromApi',
@@ -119,6 +121,20 @@ fromJson b = do
   x <- first DeserializeErrorScriptDataJson $ Api.scriptDataFromJson Api.ScriptDataJsonDetailedSchema v
   pure . fromJust . fromData $ Api.toPlutusData $ Api.getScriptData x
 
+makeLastEraEndUnbounded :: Api.EraHistory -> Api.EraHistory
+makeLastEraEndUnbounded eh =
+  let Ouroboros.Summary eraList = extractEraSummaries eh
+   in Api.EraHistory $ Ouroboros.mkInterpreter $ Ouroboros.Summary $ g eraList
+ where
+  g eraList =
+    let eraList' = nonEmptyToList eraList
+        f [] = []
+        f [x] =
+          let oldEraParams = Ouroboros.eraParams x
+           in [x {Ouroboros.eraEnd = Ouroboros.EraUnbounded, Ouroboros.eraParams = oldEraParams {Ouroboros.eraSafeZone = Ouroboros.UnsafeIndefiniteSafeZone}}]
+        f (x : xs) = x : f xs
+     in fromJust $ nonEmptyFromList $ f eraList'
+
 {- | Convert a regular list of era summaries (a la Ogmios) into a typed EraHistory (a la Ouroboros).
 
 == NOTE ==
@@ -133,6 +149,7 @@ Well, unless one uses vectors, from dependent type land.
 parseEraHist :: (t -> Ouroboros.EraSummary) -> [t] -> Maybe Api.EraHistory
 parseEraHist mkEra [byronEra, shelleyEra, allegraEra, maryEra, alonzoEra, babbageEra, conwayEra] =
   Just
+    . makeLastEraEndUnbounded
     . Api.EraHistory
     . Ouroboros.mkInterpreter
     . Ouroboros.Summary

src/GeniusYield/Providers/Node.hs

@@ -14,6 +14,7 @@ module GeniusYield.Providers.Node (
   -- * Low-level
   nodeGetSlotOfCurrentBlock,
   nodeStakeAddressInfo,
+  nodeStakePools,
 
   -- * Auxiliary
   networkIdToLocalNodeConnectInfo,
@@ -28,7 +29,7 @@ import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Text qualified as Txt
 import GeniusYield.CardanoApi.Query
-import GeniusYield.Providers.Common (SubmitTxException (SubmitTxException))
+import GeniusYield.Providers.Common (SubmitTxException (SubmitTxException), makeLastEraEndUnbounded)
 import GeniusYield.Types
 import GeniusYield.Types.ProtocolParameters (ApiProtocolParameters)
 import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult (..))
@@ -69,13 +70,13 @@ nodeSlotActions info =
 -------------------------------------------------------------------------------
 
 nodeGetParameters :: Api.LocalNodeConnectInfo -> IO GYGetParameters
-nodeGetParameters info = makeGetParameters (nodeGetProtocolParameters info) (systemStart info) (eraHistory info) (stakePools info)
+nodeGetParameters info = makeGetParameters (nodeGetProtocolParameters info) (systemStart info) (eraHistory info) (nodeGetSlotOfCurrentBlock info)
 
 nodeGetProtocolParameters :: Api.LocalNodeConnectInfo -> IO ApiProtocolParameters
 nodeGetProtocolParameters info = queryConwayEra info Api.QueryProtocolParameters
 
-stakePools :: Api.LocalNodeConnectInfo -> IO (Set.Set Api.S.PoolId)
-stakePools info = queryConwayEra info Api.QueryStakePools
+nodeStakePools :: Api.LocalNodeConnectInfo -> IO (Set.Set Api.S.PoolId)
+nodeStakePools info = queryConwayEra info Api.QueryStakePools
 
 nodeStakeAddressInfo :: Api.LocalNodeConnectInfo -> GYStakeAddress -> IO (Maybe GYStakeAddressInfo)
 nodeStakeAddressInfo info saddr = resolveStakeAddressInfoFromApi saddr <$> queryConwayEra info (Api.QueryStakeAddresses (Set.singleton $ stakeCredentialToApi $ stakeAddressToCredential saddr) (Api.localNodeNetworkId info))
@@ -95,7 +96,7 @@ systemStart :: Api.LocalNodeConnectInfo -> IO SystemStart
 systemStart info = queryCardanoMode info Api.QuerySystemStart
 
 eraHistory :: Api.LocalNodeConnectInfo -> IO Api.EraHistory
-eraHistory info = queryCardanoMode info Api.QueryEraHistory
+eraHistory info = makeLastEraEndUnbounded <$> queryCardanoMode info Api.QueryEraHistory
 
 -------------------------------------------------------------------------------
 -- Auxiliary functions

src/GeniusYield/Providers/Node/AwaitTx.hs

@@ -75,7 +75,7 @@ nodeUtxosFromTx info txId = do
  where
   go acc startIx uptoIx = do
     utxos <- nodeUtxosAtTxOutRefs info $ curry txOutRefFromTuple txId <$> [startIx .. uptoIx]
-    let acc' = acc <> utxos
+    let !acc' = acc <> utxos
     if utxosSize utxos == 0
       then pure acc'
       else go acc' (uptoIx + 1) (uptoIx * 2)

src/GeniusYield/Test/Privnet/Ctx.hs

@@ -210,6 +210,7 @@ ctxProviders ctx =
     , gyQueryUTxO = ctxQueryUtxos ctx
     , gyLog' = ctxLog ctx
     , gyGetStakeAddressInfo = nodeStakeAddressInfo (ctxInfo ctx)
+    , gyGetStakePools = nodeStakePools (ctxInfo ctx)
     }
 
 -- | Function to find for the first locked output in the given `GYTxBody` at the given `GYAddress`.

src/GeniusYield/Test/Privnet/Setup.hs

@@ -76,7 +76,7 @@ The first argument is the log severity filter. Only logs of this severity or hig
 newtype Setup = Setup (GYLogSeverity -> (String -> IO ()) -> (Ctx -> IO ()) -> IO ())
 
 cardanoDefaultTestnetOptionsConway :: CardanoTestnetOptions
-cardanoDefaultTestnetOptionsConway = cardanoDefaultTestnetOptions {cardanoNodeEra = Api.AnyCardanoEra Api.ConwayEra}
+cardanoDefaultTestnetOptionsConway = cardanoDefaultTestnetOptions {cardanoNodeEra = Api.AnyCardanoEra Api.ConwayEra, cardanoEpochLength = 2000}
 data PrivnetRuntime = PrivnetRuntime
   { runtimeNodeSocket :: !FilePath
   , runtimeNetworkInfo :: !GYNetworkInfo

src/GeniusYield/Test/Utils.hs

@@ -289,7 +289,7 @@ findRefScriptsInBody body = do
 {- | Adds the given script to the given address and returns the reference for it.
 Note: The new utxo is given an inline unit datum.
 -}
-addRefScript :: forall m. GYTxMonad m => GYAddress -> GYScript 'PlutusV2 -> m GYTxOutRef
+addRefScript :: forall m v. (GYTxMonad m, v `VersionIsGreaterOrEqual` 'PlutusV2) => GYAddress -> GYScript v -> m GYTxOutRef
 addRefScript addr sc =
   throwAppError absurdError `runEagerT` do
     existingUtxos <- lift $ utxosAtAddress addr Nothing

src/GeniusYield/TxBuilder/Class.hs

@@ -46,6 +46,8 @@ module GeniusYield.TxBuilder.Class (
   slotToEndTime,
   enclosingSlotFromTime,
   enclosingSlotFromTime',
+  slotToEpoch,
+  epochToBeginSlot,
   scriptAddress,
   scriptAddress',
   addressFromText',
@@ -528,6 +530,14 @@ enclosingSlotFromTime' x = do
   sysStart <- gyscSystemStart <$> slotConfig
   enclosingSlotFromTime x >>= maybe (throwError $ GYTimeUnderflowException sysStart x) pure
 
+-- | Get epoch number in which the given slot belongs to.
+slotToEpoch :: GYTxQueryMonad m => GYSlot -> m GYEpochNo
+slotToEpoch s = flip slotToEpochPure s <$> slotConfig
+
+-- | Get the first slot in the given epoch.
+epochToBeginSlot :: GYTxQueryMonad m => GYEpochNo -> m GYSlot
+epochToBeginSlot e = flip epochToBeginSlotPure e <$> slotConfig
+
 -------------------------------------------------------------------------------
 -- Utilities
 -------------------------------------------------------------------------------
@@ -950,8 +960,7 @@ buildTxBodyCore ownUtxoUpdateF cstrat skeletons = do
   ss <- systemStart
   eh <- eraHistory
   pp <- protocolParams
-  ps <- stakePools
-
+  let ps = mempty -- This denotes the set of registered stake pools that are being unregistered in current transaction. We don't support this yet.
   collateral <- ownCollateral
   addrs <- ownAddresses
   change <- ownChangeAddress

src/GeniusYield/Types.hs

@@ -16,6 +16,7 @@ import GeniusYield.Types.Blueprint as X
 import GeniusYield.Types.Certificate as X
 import GeniusYield.Types.Credential as X
 import GeniusYield.Types.Datum as X
+import GeniusYield.Types.Epoch as X
 import GeniusYield.Types.Era as X
 import GeniusYield.Types.Key as X
 import GeniusYield.Types.Ledger as X

src/GeniusYield/Types/Epoch.hs

@@ -0,0 +1,29 @@
+{- |
+Module      : GeniusYield.Types.Epoch
+Copyright   : (c) 2024 GYELD GMBH
+License     : Apache 2.0
+Maintainer  : support@geniusyield.co
+Stability   : develop
+-}
+module GeniusYield.Types.Epoch (
+  GYEpochNo (..),
+  epochNoFromApi,
+  epochNoToApi,
+  GYEpochSize (..),
+) where
+
+import Cardano.Api qualified as Api
+import Data.Word (Word64)
+import GeniusYield.Imports (coerce)
+
+newtype GYEpochNo = GYEpochNo Word64
+  deriving (Show, Read, Eq, Ord)
+
+epochNoFromApi :: Api.EpochNo -> GYEpochNo
+epochNoFromApi = coerce
+
+epochNoToApi :: GYEpochNo -> Api.EpochNo
+epochNoToApi = coerce
+
+newtype GYEpochSize = GYEpochSize Word64
+  deriving (Show, Read, Eq, Ord)