Merge pull request #414 from geniusyield/408-2-query-gov-prop

feat(#408): update to latest IOG & other deps, support of gov queries by providers

cabal.project

@@ -14,12 +14,12 @@ packages: .
 tests: true
 
 -- repeating the index-state for hackage to work around hackage.nix parsing limitation
-index-state: 2024-10-10T00:52:24Z
+index-state: 2025-01-01T23:24:19Z
 
 -- NOTE: Do not bump chap index beyond that used by target cardano-node version.
 index-state:
-  , hackage.haskell.org 2024-10-10T00:52:24Z
-  , cardano-haskell-packages 2024-11-26T16:00:26Z
+  , hackage.haskell.org 2025-01-01T23:24:19Z
+  , cardano-haskell-packages 2025-02-11T21:18:23Z
 
 -- TODO: Default value should be @direct@ in upcoming 3.10 version of cabal, omit this line then.
 test-show-details: direct
@@ -30,39 +30,40 @@ package cardano-crypto-praos
 source-repository-package
   type: git
   location: https://github.com/maestro-org/haskell-sdk
-  tag: v1.7.3
-  --sha256: sha256-FYZMbh9Uz+RIjjXIf3PBK94mhd1XMX/wxHDA9LukvQg=
+  tag: 3e39a6d485d7c6f98222b1ca58aed2fb45e5ff27
+  --sha256: sha256-plfrSgirKf7WGESYvEBqBkR1s673Qd0ZhGs0KzGfOig=
 
--- TODO: Temporary, until proposed changes are in upstream (track https://github.com/mlabs-haskell/clb/pull/62)
+-- TODO: Temporary, until proposed changes are in upstream (track https://github.com/mlabs-haskell/clb/pull/72)
 source-repository-package
   type: git
   location: https://github.com/sourabhxyz/clb
-  tag: 257475d987994db8dc5b1b27c9cdf6d6ea547a2c
-  --sha256: sha256-Tf9Pxh0W1cyvqPKKA07VVZCOLJBMk8W7BVLV+jwZeOM=
+  tag: 1b084647dc9118520c1cc615cf2fa7c3dd8a394e
+  --sha256: sha256-QliJng5PmJIRJd/l644T0zxBBOKhuMkIgeu1B5ymfVU=
   subdir:
     clb
     emulator
 
--- Obtaining cardano-node stuff for 10.1.3 as cardano-testnet version available on CHaP is not correctly updated.
+-- TODO: Temporary, remove once we are on 10.9 or above. Fix relates to issue: https://github.com/IntersectMBO/cardano-api/issues/714.
 source-repository-package
   type: git
-  location: https://github.com/IntersectMBO/cardano-node
-  tag: 10.1.3
-  --sha256: sha256-v0q8qHdI6LKc8mP43QZt3UGdTNDQXE0aF6QapvZsTvU=
+  location: https://github.com/sourabhxyz/cardano-api
+  tag: 14674d6b099e8fc36e5044e206bfc32164f75cee
+  --sha256: sha256-Qr4rv9bLz+wJdICYjxDVnnzgsVwx+wsU+tSFwDYr/kE=
   subdir:
-    cardano-node
-    cardano-testnet
-    trace-dispatcher
+    cardano-api
+    cardano-api-gen
 
--- TODO: Temporary, track https://github.com/IntersectMBO/cardano-api/issues/714.
+-- Using latest version which is not on CHaP.
 source-repository-package
   type: git
-  location: https://github.com/sourabhxyz/cardano-api
-  tag: 7081a82a4c6dd57cc0ab01027a18233d3bca2b3e
-  --sha256: sha256-JGyNbkEkBl69mfMc42Sq4sBwR2IY84aO2WcQihSKdLM=
+  location: https://github.com/IntersectMBO/cardano-node
+  tag: 757f3386fc39dfeadb184d87e06bbf310d58344f
+  --sha256: sha256-M+LdSrGgh3wM/CN3XruPFoFnNqTcDRMHhnr0SgtLBAc=
   subdir:
-    cardano-api
-    cardano-api-gen
+    cardano-node
+    cardano-testnet
+    trace-dispatcher
+    trace-forward
 
 package postgresql-libpq
   flags: +use-pkg-config

fixtures/script-env-v1.json

@@ -1,5 +1,5 @@
 {
     "type": "PlutusScriptV1",
     "description": "",
-    "cborHex": "484701000022200101"
+    "cborHex": "4701000022200101"
 }

fixtures/script-env-v2.json

@@ -1,5 +1,5 @@
 {
     "type": "PlutusScriptV2",
     "description": "",
-    "cborHex": "484701000022200101"
+    "cborHex": "4701000022200101"
 }

src/GeniusYield/GYConfig.hs

@@ -40,6 +40,8 @@ import GeniusYield.Imports
 import GeniusYield.Providers.Blockfrost qualified as Blockfrost
 
 -- import qualified GeniusYield.Providers.CachedQueryUTxOs as CachedQuery
+
+import Data.Sequence qualified as Seq
 import GeniusYield.Providers.Kupo qualified as KupoApi
 import GeniusYield.Providers.Maestro qualified as MaestroApi
 import GeniusYield.Providers.Node (nodeGetDRepState, nodeGetDRepsState, nodeStakeAddressInfo)
@@ -168,7 +170,7 @@ withCfgProviders
   ns
   f =
     do
-      (gyGetParameters, gySlotActions', gyQueryUTxO', gyLookupDatum, gySubmitTx, gyAwaitTxConfirmed, gyGetStakeAddressInfo, gyGetDRepState, gyGetDRepsState, gyGetStakePools, gyGetConstitution) <- case cfgCoreProvider of
+      (gyGetParameters, gySlotActions', gyQueryUTxO', gyLookupDatum, gySubmitTx, gyAwaitTxConfirmed, gyGetStakeAddressInfo, gyGetDRepState, gyGetDRepsState, gyGetStakePools, gyGetConstitution, gyGetProposals) <- case cfgCoreProvider of
         GYNodeKupo path kupoUrl -> do
           let info = nodeConnectInfo path cfgNetworkId
           kEnv <- KupoApi.newKupoApiEnv $ Text.unpack kupoUrl
@@ -186,6 +188,7 @@ withCfgProviders
             , nodeGetDRepsState info
             , Node.nodeStakePools info
             , Node.nodeConstitution info
+            , Node.nodeProposals info
             )
         GYOgmiosKupo ogmiosUrl kupoUrl -> do
           oEnv <- OgmiosApi.newOgmiosApiEnv $ Text.unpack ogmiosUrl
@@ -209,6 +212,7 @@ withCfgProviders
             , OgmiosApi.ogmiosGetDRepsState oEnv
             , OgmiosApi.ogmiosStakePools oEnv
             , OgmiosApi.ogmiosConstitution oEnv
+            , OgmiosApi.ogmiosProposals oEnv
             )
         GYMaestro (Confidential apiToken) turboSubmit -> do
           maestroApiEnv <- MaestroApi.networkIdToMaestroEnv apiToken cfgNetworkId
@@ -231,6 +235,7 @@ withCfgProviders
             , MaestroApi.maestroDRepsState maestroApiEnv
             , MaestroApi.maestroStakePools maestroApiEnv
             , MaestroApi.maestroConstitution maestroApiEnv
+            , MaestroApi.maestroProposals maestroApiEnv
             )
         GYBlockfrost (Confidential key) -> do
           let proj = Blockfrost.networkIdToProject cfgNetworkId key
@@ -253,6 +258,7 @@ withCfgProviders
             , Blockfrost.blockfrostDRepsState proj
             , Blockfrost.blockfrostStakePools proj
             , Blockfrost.blockfrostConstitution proj
+            , Blockfrost.blockfrostProposals proj
             )
 
       bracket (mkLogEnv ns cfgLogging) closeScribes $ \logEnv -> do
@@ -300,6 +306,7 @@ logTiming providers@GYProviders {..} =
     , gyLog' = gyLog'
     , gyGetStakePools = gyGetStakePools'
     , gyGetConstitution = gyGetConstitution'
+    , gyGetProposals = gyGetProposals'
     }
  where
   wrap :: String -> IO a -> IO a
@@ -375,6 +382,9 @@ logTiming providers@GYProviders {..} =
   gyGetConstitution' :: IO GYConstitution
   gyGetConstitution' = wrap "gyGetConstitution" gyGetConstitution
 
+  gyGetProposals' :: Set GYGovActionId -> IO (Seq.Seq GYGovActionState)
+  gyGetProposals' = wrap "gyGetProposals" . gyGetProposals
+
 duration :: IO a -> IO (a, NominalDiffTime)
 duration m = do
   start <- getCurrentTime

src/GeniusYield/Providers/Blockfrost.hs

@@ -13,6 +13,7 @@ module GeniusYield.Providers.Blockfrost (
   blockfrostDRepState,
   blockfrostDRepsState,
   blockfrostConstitution,
+  blockfrostProposals,
   networkIdToProject,
 ) where
 
@@ -40,6 +41,7 @@ import Data.Either.Combinators (maybeToRight)
 import Data.Foldable (fold)
 import Data.Map.Strict qualified as Map
 import Data.Maybe (fromJust)
+import Data.Sequence qualified as Seq
 import Data.Set qualified as Set
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
@@ -599,6 +601,9 @@ blockfrostDRepsState _p _cs = error "Blockfrost SDK does not support fetching th
 blockfrostConstitution :: Blockfrost.Project -> IO GYConstitution
 blockfrostConstitution = error "Blockfrost does not support fetching the constitution"
 
+blockfrostProposals :: Blockfrost.Project -> Set GYGovActionId -> IO (Seq.Seq GYGovActionState)
+blockfrostProposals _p _actionIds = error "Blockfrost SDK does not support fetching the proposals"
+
 -------------------------------------------------------------------------------
 -- Auxiliary functions
 -------------------------------------------------------------------------------

src/GeniusYield/Providers/LiteChainIndex.hs

@@ -207,6 +207,6 @@ blockDatums (Api.BlockInMode _ block) = goBlock block
 
   goDatum :: Api.TxOutDatum Api.CtxTx era -> [Api.HashableScriptData]
   goDatum Api.TxOutDatumNone = []
-  goDatum (Api.TxOutDatumInTx _ sd) = [sd]
+  goDatum (Api.TxOutSupplementalDatum _ sd) = [sd]
   goDatum (Api.TxOutDatumHash _ _h) = []
   goDatum (Api.TxOutDatumInline _ sd) = [sd]

src/GeniusYield/Providers/Maestro.hs

@@ -24,6 +24,7 @@ module GeniusYield.Providers.Maestro (
   maestroDRepState,
   maestroDRepsState,
   maestroConstitution,
+  maestroProposals,
 ) where
 
 import Cardano.Api qualified as Api
@@ -46,6 +47,7 @@ import Data.Either.Combinators (maybeToRight)
 import Data.Int (Int64)
 import Data.Map.Strict qualified as M
 import Data.Maybe (fromJust)
+import Data.Sequence qualified as Seq
 import Data.Set qualified as Set
 import Data.Text qualified as Text
 import Data.Time qualified as Time
@@ -667,3 +669,6 @@ maestroDRepsState _p _cs = error "Maestro does not support fetching the DReps st
 
 maestroConstitution :: Maestro.MaestroEnv 'Maestro.V1 -> IO GYConstitution
 maestroConstitution = error "Maestro does not support fetching the constitution"
+
+maestroProposals :: Maestro.MaestroEnv 'Maestro.V1 -> Set GYGovActionId -> IO (Seq.Seq GYGovActionState)
+maestroProposals _p _actionIds = error "Maestro does not support fetching the proposals"

src/GeniusYield/Providers/Node.hs

@@ -16,18 +16,23 @@ module GeniusYield.Providers.Node (
   nodeGetDRepState,
   nodeGetDRepsState,
   nodeConstitution,
+  nodeProposals,
+  nodeCommitteeMembersState,
 
   -- * Auxiliary
   networkIdToLocalNodeConnectInfo,
 ) where
 
 import Cardano.Api qualified as Api
+import Cardano.Api.Ledger qualified as Ledger
 import Cardano.Api.Shelley qualified as Api.S
+import Cardano.Ledger.Api.State.Query qualified as Ledger
 import Cardano.Ledger.Coin qualified as Ledger
 import Cardano.Slotting.Time (SystemStart)
 import Control.Exception (throwIO)
 import Data.Map.Strict qualified as Map
 import Data.Maybe (listToMaybe)
+import Data.Sequence qualified as Seq
 import Data.Set qualified as Set
 import Data.Text qualified as Txt
 import GeniusYield.CardanoApi.Query
@@ -90,6 +95,13 @@ nodeGetDRepsState info dreps = do
 nodeConstitution :: Api.LocalNodeConnectInfo -> IO GYConstitution
 nodeConstitution info = constitutionFromLedger <$> queryConwayEra info Api.QueryConstitution
 
+nodeProposals :: Api.LocalNodeConnectInfo -> Set.Set GYGovActionId -> IO (Seq.Seq GYGovActionState)
+nodeProposals info (Set.map govActionIdToLedger -> proposals) = do
+  fmap govActionStateFromLedger <$> queryConwayEra info (Api.QueryProposals proposals)
+
+nodeCommitteeMembersState :: Api.LocalNodeConnectInfo -> IO (Ledger.CommitteeMembersState Ledger.StandardCrypto)
+nodeCommitteeMembersState info = queryConwayEra info $ Api.QueryCommitteeMembersState mempty mempty mempty
+
 nodeStakePools :: Api.LocalNodeConnectInfo -> IO (Set.Set Api.S.PoolId)
 nodeStakePools info = queryConwayEra info Api.QueryStakePools