PLT-1311 Add JSON-RPC querying of the stake pool delegation (SPD) by epoch in `ma… - input-output-hk/plutus-apps@1660a099

Home / Input Output / plutus-apps / 1660a099

View on GitHub

File Changes

m

marconi-chain-index/src/Marconi/ChainIndex/Indexers/EpochSPD.hs

+36/-7

module Marconi.ChainIndex.Indexers.EpochSPD

  ( -- * EpochSPDIndex

    EpochSPDIndex

+

  , EpochSPDDepth (..)

  , EpochSPDHandle

+

  , EpochSPDRow (..)

  , StorableEvent(..)

  , StorableQuery(..)

  , StorableResult(..)

  , toStorableEvent

-

  , EpochSPDDepth (..)

  , open

  , getEpochNo

  ) where

import Codec.CBOR.Read qualified as CBOR

import Codec.CBOR.Write qualified as CBOR

import Control.Monad (forM_, when)

+

import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (Object), object, (.:), (.=))

import Data.ByteString.Base16 qualified as Base16

import Data.ByteString.Lazy qualified as BS

import Data.Coerce (coerce)

  | LedgerStateAtPointQuery C.ChainPoint

data instance StorableResult EpochSPDHandle =

-

    SPDByEpochNoResult (Map C.PoolId C.Lovelace)

+

    SPDByEpochNoResult [EpochSPDRow]

  | LedgerStateAtPointResult (Maybe (O.LedgerState (O.CardanoBlock O.StandardCrypto)))

    deriving (Eq, Show)

    , epochSPDRowSlotNo          :: !C.SlotNo

    , epochSPDRowBlockHeaderHash :: !(C.Hash C.BlockHeader)

    , epochSPDRowBlockNo         :: !C.BlockNo

-

    } deriving (Eq, Show, Generic, SQL.FromRow, SQL.ToRow)

+

    } deriving (Eq, Ord, Show, Generic, SQL.FromRow, SQL.ToRow)

+

instance FromJSON EpochSPDRow where

+

    parseJSON (Object v) =

+

        EpochSPDRow

+

            <$> (C.EpochNo <$> v .: "epochNo")

+

            <*> v .: "poolId"

+

            <*> v .: "lovelace"

+

            <*> (C.SlotNo <$> v .: "slotNo")

+

            <*> v .: "blockHeaderHash"

+

            <*> (C.BlockNo <$> v .: "blockNo")

+

    parseJSON _ = mempty

+

instance ToJSON EpochSPDRow where

+

  toJSON (EpochSPDRow (C.EpochNo epochNo)

+

                      poolId

+

                      lovelace

+

                      (C.SlotNo slotNo)

+

                      blockHeaderHash

+

                      (C.BlockNo blockNo)) =

+

      object

+

        [ "epochNo" .= epochNo

+

        , "poolId" .= poolId

+

        , "lovelace" .= lovelace

+

        , "slotNo" .= slotNo

+

        , "blockHeaderHash" .= blockHeaderHash

+

        , "blockNo" .= blockNo

+

instance Buffered EpochSPDHandle where

    -- We should only store on disk SPD from the last slot of each epoch.

    queryStorage _ events (EpochSPDHandle c _ _) (SPDByEpochNoQuery epochNo) = do

        case List.find (\e -> epochSPDEventEpochNo e == Just epochNo) (toList events) of

          Just e ->

-

              pure $ SPDByEpochNoResult $ epochSPDEventSPD e

+

              pure $ SPDByEpochNoResult $ eventToEpochSPDRows e

          Nothing -> do

-

              res :: [(C.PoolId, C.Lovelace)] <- SQL.query c

-

                  [r|SELECT poolId, lovelace

+

              res :: [EpochSPDRow] <- SQL.query c

+

                  [r|SELECT epochNo, poolId, lovelace, slotNo, blockHeaderHash, blockNo

                     FROM epoch_spd

                     WHERE epochNo = ?

                  |] (SQL.Only epochNo)

-

              pure $ SPDByEpochNoResult $ Map.fromList res

+

              pure $ SPDByEpochNoResult res

    queryStorage _ _ EpochSPDHandle {} (LedgerStateAtPointQuery C.ChainPointAtGenesis) = do

        pure $ LedgerStateAtPointResult Nothing

m

marconi-chain-index/src/Marconi/ChainIndex/Indexers/Utxo.hs

+7/-3

-- For resuming we need to provide a list of points where we can resume from.

instance Resumable UtxoHandle where

-

  resumeFromStorage h = do

-

    es <- Storable.getStoredEvents h

+

  resumeFromStorage (UtxoHandle c _) = do

+

    chainPoints <- fmap (uncurry C.ChainPoint) <$>

+

            SQL.query c

+

                [r|SELECT slotNo, blockHash

+

                   FROM unspent_transactions

+

                   ORDER BY slotNo DESC|] ()

    -- The ordering here matters. The node will try to find the first point in the

    -- ledger, then move to the next and so on, so we will send the latest point

    -- first.

-

    pure $ map ueChainPoint es ++ [C.ChainPointAtGenesis]

+

    pure $ chainPoints ++ [C.ChainPointAtGenesis]

-- | Convert from 'AddressInEra' of the 'CurrentEra' to 'AddressAny'.

toAddr :: C.AddressInEra era -> C.AddressAny

m

marconi-sidechain/README.md

+45/-18

```

-

#### getUtxoFromAddress

+

#### getUtxoFromAddress (NOT IMPLEMENTED YET)

-

Retrieves user provided addresses.

+

Retrieves UTXOs of a given address until a given point in time (measured in slots).

+

**Parameters**:

-

**Parameters**: Address encoded in the Bech32 representation

+

* `address`: address encoded in the Bech32 format

+

* `slotNo`: slot number.

-

**Returns**: List of UTXOs linked to the provided address.

+

**Returns**: List of resolved UTXOs.

**Example**:

```sh

-

$ curl -d '{"jsonrpc": "2.0" , "method": "getUtxoFromAddress" , "params": "addr_test1qz0ru2w9suwv8mcskg8r9ws3zvguekkkx6kpcnn058pe2ql2ym0y64huzhpu0wl8ewzdxya0hj0z5ejyt3g98lpu8xxs8faq0m", "id": 1}' -H 'Content-Type: application/json' -X POST http://localhost:3000/json-rpc | jq

+

$ curl -d '{"jsonrpc": "2.0" , "method": "getUtxoFromAddress" , "params": { "address": "addr_test1qz0ru2w9suwv8mcskg8r9ws3zvguekkkx6kpcnn058pe2ql2ym0y64huzhpu0wl8ewzdxya0hj0z5ejyt3g98lpu8xxs8faq0m", "slotNo": 1 }, "id": 1}' -H 'Content-Type: application/json' -X POST http://localhost:3000/json-rpc | jq

  "id": 1,

  "jsonrpc": "2.0",

#### getTxWithMintingPolicy (NOT IMPLEMENTED YET)

-

Retrieves transactions that include a minting policy for minting/burning tokens.

+

Retrieves transactions that include a minting policy for minting/burning tokens until a given point in time (measured in slots).

-

**Parameters**: Hash of the minting policy

+

**Parameters**:

+

* `mps`: Hash of the minting policy

+

* `slotNo`: slot number

**Returns**: List of transaction IDs

**Example**:

```sh

-

$ curl -d '{"jsonrpc": "2.0" , "method": "getTxWithMintingPolicy" , "params": "...", "id": 1}' -H 'Content-Type: application/json' -X POST http://localhost:3000/json-rpc | jq

+

$ curl -d '{"jsonrpc": "2.0" , "method": "getTxWithMintingPolicy" , "params": { "mps": "284d60f7e56f5fd54faed4c50fd5cab0307da1c4034d6a92c5dbb940", "slotNo": 1 }, "id": 1}' -H 'Content-Type: application/json' -X POST http://localhost:3000/json-rpc | jq

  "id": 1,

  "jsonrpc": "2.0",

```

-

#### getStakePoolDelegationByEpoch (NOT IMPLEMENTED YET)

+

#### getStakePoolDelegationByEpoch

Retrieves the stake pool delegation per epoch.

**Parameters**: Epoch number

-

**Returns**: List of stake pool IDs with the amount of staked lovelace

+

**Returns**: List of stake pool IDs in Bech32 format with the total staked lovelace for that epoch.

**Example**:

```sh

-

$ curl -d '{"jsonrpc": "2.0" , "method": "getStakePoolDelegationByEpoch" , "params": "...", "id": 1}' -H 'Content-Type: application/json' -X POST http://localhost:3000/json-rpc | jq

+

$ curl -d '{"jsonrpc": "2.0" , "method": "getStakePoolDelegationByEpoch" , "params": 6, "id": 1}' -H 'Content-Type: application/json' -X POST http://localhost:3000/json-rpc | jq

  "id": 1,

  "jsonrpc": "2.0",

-

  "result": [

-

      "poolId": "...",

-

      "lovelace": 10000000

-

+

  "result":

+

            "blockHeaderHash": "578f3cb70f4153e1622db792fea9005c80ff80f83df028210c7a914fb780a6f6",

+

            "blockNo": 64903,

+

            "epochNo": 6,

+

            "lovelace": 100000000000000,

+

            "poolId": "pool1z22x50lqsrwent6en0llzzs9e577rx7n3mv9kfw7udwa2rf42fa",

+

            "slotNo": 1382422

+

},

+

            "blockHeaderHash": "578f3cb70f4153e1622db792fea9005c80ff80f83df028210c7a914fb780a6f6",

+

            "blockNo": 64903,

+

            "epochNo": 6,

+

            "lovelace": 100000000000000,

+

            "poolId": "pool1547tew8vmuj0g6vj3k5jfddudextcw6hsk2hwgg6pkhk7lwphe6",

+

            "slotNo": 1382422

+

},

+

            "blockHeaderHash": "578f3cb70f4153e1622db792fea9005c80ff80f83df028210c7a914fb780a6f6",

+

            "blockNo": 64903,

+

            "epochNo": 6,

+

            "lovelace": 100000000000000,

+

            "poolId": "pool174mw7e20768e8vj4fn8y6p536n8rkzswsapwtwn354dckpjqzr8",

+

            "slotNo": 1382422

+

```

**Example**:

```sh

-

$ curl -d '{"jsonrpc": "2.0" , "method": "getNonceByEpoch " , "params": 398, "id": 1}' -H 'Content-Type: application/json' -X POST http://localhost:3000/json-rpc | jq

+

$ curl -d '{"jsonrpc": "2.0" , "method": "getNonceByEpoch" , "params": 398, "id": 1}' -H 'Content-Type: application/json' -X POST http://localhost:3000/json-rpc | jq

  "id": 1,

  "jsonrpc": "2.0",

m

marconi-sidechain/app/Main.hs

+2/-3

import Control.Concurrent.Async (race_)

import Marconi.Sidechain.Api.HttpServer qualified as Http

import Marconi.Sidechain.Api.Types (CliArgs (CliArgs, httpPort, targetAddresses))

-

import Marconi.Sidechain.Bootstrap (bootstrapIndexers, initializeIndexerEnv)

+

import Marconi.Sidechain.Bootstrap (bootstrapIndexers, initializeSidechainEnv)

import Marconi.Sidechain.CLI (parseCli)

-- | Concurrently start:

main :: IO ()

main = do

    cli@CliArgs { httpPort, targetAddresses } <- parseCli

-

    rpcEnv <- initializeIndexerEnv httpPort targetAddresses

+

    rpcEnv <- initializeSidechainEnv httpPort targetAddresses

    race_

       (Http.bootstrap rpcEnv) -- Start HTTP server

m

marconi-sidechain/examples/json-rpc-server/src/Main.hs

+12/-11

import Control.Concurrent.Async (race_)

import Control.Concurrent.STM (atomically)

import Control.Lens.Operators ((^.))

-

import Options.Applicative (Parser, execParser, help, helper, info, long, metavar, optional, short, strOption, (<**>))

-

import System.FilePath ((</>))

-

import Marconi.ChainIndex.CLI (multiString)

import Marconi.ChainIndex.Indexers.Utxo qualified as Utxo

import Marconi.ChainIndex.Types (TargetAddresses)

import Marconi.Sidechain.Api.HttpServer qualified as Http

import Marconi.Sidechain.Api.Query.Indexers.Utxo qualified as UIQ

-

import Marconi.Sidechain.Api.Types (IndexerEnv, queryEnv, uiIndexer)

-

import Marconi.Sidechain.Bootstrap (initializeIndexerEnv)

+

import Marconi.Sidechain.Api.Types (IndexerEnv, SidechainEnv, queryEnv, sidechainAddressUtxoIndexer,

+

                                    sidechainEnvIndexers, uiIndexer)

+

import Marconi.Sidechain.Bootstrap (bootstrapHttp, initializeSidechainEnv)

+

import Options.Applicative (Parser, execParser, help, helper, info, long, metavar, optional, short, strOption, (<**>))

+

import System.FilePath ((</>))

data CliOptions = CliOptions

-

    { _utxoDirPath :: FilePath -- ^ Filepath to utxo sqlite database

-

    , _addresses   :: Maybe TargetAddresses

+

    { _utxoDirPath :: !FilePath -- ^ Filepath to utxo sqlite database

+

    , _addresses   :: !(Maybe TargetAddresses)

utxoDbFileName :: String

utxoDbFileName = "utxodb"

+

cliParser :: Parser CliOptions

cliParser = CliOptions

    <$> strOption (long "utxo-db"

        <>"\nport =" <> show (3000 :: Int)

        <> "\nmarconi-db-dir =" <> dbpath

        <> "\nnumber of addresses to index = " <> show (length <$> addresses)

-

    env <- initializeIndexerEnv Nothing addresses

-

    race_ (Http.bootstrap env) (mocUtxoIndexer dbpath (env ^. queryEnv) )

+

    env <- initializeSidechainEnv Nothing addresses

+

    race_ (bootstrapHttp env) (mocUtxoIndexer dbpath env)

-- | moc marconi utxo indexer.

-- This will allow us to use the UtxoIndexer query interface without having cardano-node or marconi online

-- Effectively we are going to query SQLite only

-

mocUtxoIndexer :: FilePath -> IndexerEnv -> IO ()

+

mocUtxoIndexer :: FilePath -> SidechainEnv -> IO ()

mocUtxoIndexer dbpath env =

        Utxo.open dbpath (Utxo.Depth 4) >>= callback >> innerLoop

    where

      callback :: Utxo.UtxoIndexer -> IO ()

-

      callback = atomically . UIQ.writeTMVar' (env ^. uiIndexer)

+

      callback = atomically . UIQ.updateEnvState (env ^. sidechainEnvIndexers . sidechainAddressUtxoIndexer)

      innerLoop = threadDelay 1000000 >> innerLoop -- create some latency

m

marconi-sidechain/marconi-sidechain.cabal

+4/-0

  hs-source-dirs:  src

  exposed-modules:

    Marconi.Sidechain.Api.HttpServer

+

    Marconi.Sidechain.Api.Query.Indexers.EpochSPD

    Marconi.Sidechain.Api.Query.Indexers.Utxo

    Marconi.Sidechain.Api.Routes

    Marconi.Sidechain.Api.Types

    Marconi.Sidechain.Bootstrap

    Marconi.Sidechain.CLI

+

    Marconi.Sidechain.Utils

  --------------------

  -- Local components

  build-depends:

    , aeson

    , base                  >=4.9 && <5

+

    , containers

    , filepath

    , lens

    , optparse-applicative

    , stm                   >=2.5

    , text

    , time

+

    , vector

    , warp

executable marconi-sidechain

m

marconi-sidechain/src/Marconi/Sidechain/Api/HttpServer.hs

+33/-22

import Data.Text (Text, pack)

import Data.Time (defaultTimeLocale, formatTime, getCurrentTime)

import Data.Word (Word64)

+

import Marconi.Sidechain.Api.Query.Indexers.EpochSPD qualified as EpochSPD

import Marconi.Sidechain.Api.Query.Indexers.Utxo qualified as Q.Utxo

import Marconi.Sidechain.Api.Routes (API, AddressUtxoResult, CurrentSyncedPointResult, EpochNonceResult,

                                     EpochStakePoolDelegationResult, JsonRpcAPI, MintingPolicyHashTxResult, RestAPI)

-

import Marconi.Sidechain.Api.Types (HasSidechainEnv (httpSettings, queryEnv), IndexerEnv, QueryExceptions, SidechainEnv)

+

import Marconi.Sidechain.Api.Types (QueryExceptions, SidechainEnv, sidechainAddressUtxoIndexer,

+

                                    sidechainEnvHttpSettings, sidechainEnvIndexers)

import Network.JsonRpc.Server.Types ()

import Network.JsonRpc.Types (JsonRpcErr (JsonRpcErr, errorCode, errorData, errorMessage), parseErrorCode)

import Network.Wai.Handler.Warp (runSettings)

-- | Bootstraps the HTTP server

bootstrap :: SidechainEnv -> IO ()

bootstrap env =  runSettings

-

        (env ^. httpSettings)

-

        (marconiApp (env ^. queryEnv))

+

        (env ^. sidechainEnvHttpSettings)

+

        (marconiApp env)

-

marconiApp :: IndexerEnv -> Application

+

marconiApp :: SidechainEnv -> Application

marconiApp env = serve (Proxy @API) (httpRpcServer env)

jsonRpcServer

-

  :: IndexerEnv -- ^  Utxo Environment to access Utxo Storage running on the marconi thread

+

  :: SidechainEnv -- ^  Utxo Environment to access Utxo Storage running on the marconi thread

  -> Server JsonRpcAPI

jsonRpcServer env = echo

  :<|> getTargetAddressesQueryHandler env

  :<|> getEpochNonceHandler env

restApiServer

-

  :: IndexerEnv

+

  :: SidechainEnv

  -> Server RestAPI

restApiServer env  = getTimeHandler :<|> getTargetAddressesHandler env

httpRpcServer

-

  :: IndexerEnv -- ^  Utxo Environment to access Utxo Storage running on the marconi thread

+

  :: SidechainEnv -- ^  Utxo Environment to access Utxo Storage running on the marconi thread

  -> Server API

httpRpcServer env = jsonRpcServer env :<|> restApiServer env

    where

    timeString = formatTime defaultTimeLocale "%T"

-

-- | prints TargetAddresses Bech32 representation to the console

+

-- | Prints TargetAddresses Bech32 representation to the console

getTargetAddressesHandler

-

    :: IndexerEnv -- ^  Utxo Environment to access Utxo Storage running on the marconi thread

+

    :: SidechainEnv -- ^  Utxo Environment to access Utxo Storage running on the marconi thread

    -> Handler [Text]

-

getTargetAddressesHandler =  pure . Q.Utxo.reportBech32Addresses

+

getTargetAddressesHandler env =

+

    pure $ Q.Utxo.reportBech32Addresses

+

         $ env ^. sidechainEnvIndexers . sidechainAddressUtxoIndexer

-- | prints TargetAddresses Bech32 representation as thru JsonRpc

getTargetAddressesQueryHandler

-

    :: IndexerEnv -- ^ database configuration

+

    :: SidechainEnv -- ^ database configuration

    -> String

    -- ^ Will always be an empty string as we are ignoring this param, and returning everything

    -> Handler (Either (JsonRpcErr String) [Text])

-

getTargetAddressesQueryHandler env _ = pure . Right . Q.Utxo.reportBech32Addresses $ env

+

getTargetAddressesQueryHandler env _ =

+

    pure $ Right

+

         $ Q.Utxo.reportBech32Addresses (env ^. sidechainEnvIndexers . sidechainAddressUtxoIndexer)

-- | Handler for retrieving current synced chain point.

getCurrentSyncedPointHandler

-

    :: IndexerEnv       -- ^ Utxo Environment to access Utxo Storage running on the marconi thread

+

    :: SidechainEnv -- ^ Utxo Environment to access Utxo Storage running on the marconi thread

    -> String -- ^ Dummy parameter

    -> Handler (Either (JsonRpcErr String) CurrentSyncedPointResult)

getCurrentSyncedPointHandler _ _ =

    pure $ Left $ JsonRpcErr 1 "Endpoint not implemented yet" Nothing

-- | Handler for retrieving UTXOs by Address

getAddressUtxoHandler

-

    :: IndexerEnv       -- ^ Utxo Environment to access Utxo Storage running on the marconi thread

-

    -> String           -- ^ Bech32 addressCredential

+

    :: SidechainEnv -- ^ Utxo Environment to access Utxo Storage running on the marconi thread

+

    -> String -- ^ Bech32 addressCredential

    -> Handler (Either (JsonRpcErr String) AddressUtxoResult)

getAddressUtxoHandler env address = liftIO $

-

    first toRpcErr <$> (Q.Utxo.findByBech32Address env . pack $ address)

+

    first toRpcErr

+

    <$> Q.Utxo.findByBech32Address

+

            (env ^. sidechainEnvIndexers . sidechainAddressUtxoIndexer)

+

            (pack address)

-

-- | Handler for retrieving TXs by Minting Policy Hash.

+

-- | Handler for retrieving Txs by Minting Policy Hash.

getMintingPolicyHashTxHandler

-

    :: IndexerEnv       -- ^ Utxo Environment to access Utxo Storage running on the marconi thread

+

    :: SidechainEnv -- ^ Utxo Environment to access Utxo Storage running on the marconi thread

    -> String           -- ^ Minting policy hash

    -> Handler (Either (JsonRpcErr String) MintingPolicyHashTxResult)

getMintingPolicyHashTxHandler _ _ = pure $ Left $ JsonRpcErr 1 "Endpoint not implemented yet" Nothing

-- | Handler for retrieving stake pool delegation per epoch

getEpochStakePoolDelegationHandler

-

    :: IndexerEnv       -- ^ Utxo Environment to access Utxo Storage running on the marconi thread

+

    :: SidechainEnv -- ^ Utxo Environment to access Utxo Storage running on the marconi thread

    -> Word64           -- ^ EpochNo

    -> Handler (Either (JsonRpcErr String) EpochStakePoolDelegationResult)

-

getEpochStakePoolDelegationHandler _ _ = pure $ Left $ JsonRpcErr 1 "Endpoint not implemented yet" Nothing

+

getEpochStakePoolDelegationHandler env epochNo = liftIO $

+

    first toRpcErr

+

    <$> EpochSPD.querySPDByEpochNo env epochNo

-- | Handler for retrieving stake pool delegation per epoch

getEpochNonceHandler

-

    :: IndexerEnv       -- ^ Utxo Environment to access Utxo Storage running on the marconi thread

+

    :: SidechainEnv -- ^ Utxo Environment to access Utxo Storage running on the marconi thread

    -> Word64           -- ^ EpochNo

    -> Handler (Either (JsonRpcErr String) EpochNonceResult)

getEpochNonceHandler _ _ = pure $ Left $ JsonRpcErr 1 "Endpoint not implemented yet" Nothing

-

-- | convert form to Jsonrpc protocal error

+

-- | Convert to JSON-RPC protocol error.

toRpcErr

    :: QueryExceptions

    -> JsonRpcErr String

a

marconi-sidechain/src/Marconi/Sidechain/Api/Query/Indexers/EpochSPD.hs

+52/-0

+

module Marconi.Sidechain.Api.Query.Indexers.EpochSPD

+

    ( initializeEnv

+

    , updateEnvState

+

    , querySPDByEpochNo

+

    ) where

+

import Cardano.Api qualified as C

+

import Control.Concurrent.STM.TMVar (TMVar, newEmptyTMVarIO, tryReadTMVar)

+

import Control.Lens ((^.))

+

import Control.Monad.STM (STM, atomically)

+

import Data.Word (Word64)

+

import Marconi.ChainIndex.Indexers.EpochSPD (EpochSPDHandle, StorableQuery (SPDByEpochNoQuery),

+

                                             StorableResult (SPDByEpochNoResult))

+

import Marconi.Core.Storable (State)

+

import Marconi.Core.Storable qualified as Storable

+

import Marconi.Sidechain.Api.Routes (EpochStakePoolDelegationResult (EpochStakePoolDelegationResult))

+

import Marconi.Sidechain.Api.Types (EpochSPDIndexerEnv (EpochSPDIndexerEnv), QueryExceptions (QueryError), SidechainEnv,

+

                                    epochSpdIndexerEnvIndexer, sidechainEnvIndexers,

+

                                    sidechainEpochStakePoolDelegationIndexer)

+

import Marconi.Sidechain.Utils (writeTMVar)

+

-- | Bootstraps the EpochSPD query environment.

+

-- The module is responsible for accessing SQLite for queries.

+

-- The main issue we try to avoid here is mixing inserts and quries in SQLite to avoid locking the database

+

initializeEnv

+

    :: IO EpochSPDIndexerEnv -- ^ returns Query runtime environment

+

initializeEnv = EpochSPDIndexerEnv <$> newEmptyTMVarIO

+

updateEnvState :: TMVar (State EpochSPDHandle) -> State EpochSPDHandle -> STM ()

+

updateEnvState = writeTMVar

+

-- | Retrieve SPD associated at the given 'EpochNo'

+

-- We return an empty list if the 'EpochNo' is not found.

+

querySPDByEpochNo

+

    :: SidechainEnv -- ^ Query run time environment

+

    -> Word64 -- ^ Bech32 Address

+

    -> IO (Either QueryExceptions EpochStakePoolDelegationResult)  -- ^ Plutus address conversion error may occur

+

querySPDByEpochNo env epochNo = do

+

    -- We must stop the indexer inserts before doing the query.

+

    epochSpdIndexer <-

+

        atomically

+

        $ tryReadTMVar

+

        $ env ^. sidechainEnvIndexers . sidechainEpochStakePoolDelegationIndexer . epochSpdIndexerEnvIndexer

+

    case epochSpdIndexer of

+

      Nothing      -> pure $ Left $ QueryError "Failed to read EpochSPD indexer"

+

      Just indexer -> query indexer

+

    where

+

        query indexer = do

+

            (SPDByEpochNoResult epochSpdRows) <-

+

                Storable.query Storable.QEverything indexer (SPDByEpochNoQuery $ C.EpochNo epochNo)

+

            pure $ Right $ EpochStakePoolDelegationResult epochSpdRows

m

marconi-sidechain/src/Marconi/Sidechain/Api/Query/Indexers/Utxo.hs

+22/-35

    , Utxo.UtxoIndexer

    , reportBech32Addresses

    , withQueryAction

-

    , writeTMVar

-

    , writeTMVar'

+

    , updateEnvState

    ) where

+

import Cardano.Api qualified as C

import Control.Concurrent.STM (atomically)

-

import Control.Concurrent.STM.TMVar (TMVar, newEmptyTMVar, putTMVar, tryReadTMVar, tryTakeTMVar)

+

import Control.Concurrent.STM.TMVar (newEmptyTMVarIO, tryReadTMVar)

import Control.Lens ((^.))

import Control.Monad.STM (STM)

import Data.Functor ((<&>))

import Data.List.NonEmpty qualified as NonEmpty

import Data.Text (Text, unpack)

-

import Cardano.Api qualified as C

import Marconi.ChainIndex.Indexers.Utxo qualified as Utxo

import Marconi.ChainIndex.Types (TargetAddresses)

import Marconi.Core.Storable qualified as Storable

import Marconi.Sidechain.Api.Routes (AddressUtxoResult (AddressUtxoResult))

-

import Marconi.Sidechain.Api.Types (HasIndexerEnv (uiIndexer, uiQaddresses),

-

                                    IndexerEnv (IndexerEnv, _uiIndexer, _uiQaddresses),

-

                                    IndexerWrapper (IndexerWrapper, unWrapUtxoIndexer), QueryExceptions (QueryError))

+

import Marconi.Sidechain.Api.Types (AddressUtxoIndexerEnv (AddressUtxoIndexerEnv), QueryExceptions (QueryError),

+

                                    addressUtxoIndexerEnvIndexer, addressUtxoIndexerEnvTargetAddresses)

+

import Marconi.Sidechain.Utils (writeTMVar)

-- | Bootstraps the utxo query environment.

-- The module is responsible for accessing SQLite for quries.

-- The main issue we try to avoid here is mixing inserts and quries in SQLite to avoid locking the database

initializeEnv

-

    :: Maybe TargetAddresses      -- ^ user provided target addresses

-

    -> IO IndexerEnv        -- ^ returns Query runtime environment

+

    :: Maybe TargetAddresses -- ^ user provided target addresses

+

    -> IO AddressUtxoIndexerEnv -- ^ returns Query runtime environment

initializeEnv targetAddresses = do

-

    ix <- atomically (newEmptyTMVar :: STM (TMVar Utxo.UtxoIndexer) )

-

    pure $ IndexerEnv

-

        { _uiIndexer = IndexerWrapper ix

-

        , _uiQaddresses = targetAddresses

-

+

    ix <- newEmptyTMVarIO

+

    pure $ AddressUtxoIndexerEnv targetAddresses ix

-- | Query utxos by Address

--  Address conversion error from Bech32 may occur

findByAddress

-

    :: IndexerEnv           -- ^ Query run time environment

+

    :: AddressUtxoIndexerEnv           -- ^ Query run time environment

    -> C.AddressAny         -- ^ Cardano address to query

    -> IO [Utxo.UtxoRow]

-

findByAddress  = withQueryAction

+

findByAddress = withQueryAction

-- | Retrieve Utxos associated with the given address

-

-- We return an empty list if no address is found

+

-- We return an empty list if no address is not found

findByBech32Address

-

    :: IndexerEnv -- ^ Query run time environment

+

    :: AddressUtxoIndexerEnv -- ^ Query run time environment

    -> Text -- ^ Bech32 Address

    -> IO (Either QueryExceptions AddressUtxoResult)  -- ^ Plutus address conversion error may occur

findByBech32Address env addressText =

-- | Execute the query function

-- We must stop the utxo inserts before doing the query

withQueryAction

-

    :: IndexerEnv       -- ^ Query run time environment

+

    :: AddressUtxoIndexerEnv -- ^ Query run time environment

    -> C.AddressAny     -- ^ Cardano address to query

    -> IO [Utxo.UtxoRow]

withQueryAction env address =

-

  (atomically . tryReadTMVar . unWrapUtxoIndexer $ env ^. uiIndexer) >>= action

+

  (atomically $ tryReadTMVar $ env ^. addressUtxoIndexerEnvIndexer) >>= action

  where

    action Nothing = pure [] -- may occures at startup before marconi-chain-index gets to update the indexer

    action (Just indexer) = do

-- | report target addresses

-- Used by JSON-RPC

reportQueryAddresses

-

    :: IndexerEnv

+

    :: AddressUtxoIndexerEnv

    -> IO [C.Address C.ShelleyAddr]

-

reportQueryAddresses env = pure $ maybe [] NonEmpty.toList (env ^. uiQaddresses)

+

reportQueryAddresses env = pure $ maybe [] NonEmpty.toList (env ^. addressUtxoIndexerEnvTargetAddresses)

reportBech32Addresses

-

    :: IndexerEnv

+

    :: AddressUtxoIndexerEnv

    -> [Text]

reportBech32Addresses env =

-

    let addrs = maybe [] NonEmpty.toList (env ^. uiQaddresses)

+

    let addrs = maybe [] NonEmpty.toList (env ^. addressUtxoIndexerEnvTargetAddresses)

     in fmap C.serialiseAddress addrs

-

-- | Non-blocking write of a new value to a 'TMVar'

-

-- Puts if empty. Replaces if populated.

-

--

-

-- Only exists in GHC9, but we're on GHC8.

-

-- TODO: Remove once we migrate to GHC9.

-

writeTMVar :: TMVar a -> a -> STM ()

-

writeTMVar t new = tryTakeTMVar t >> putTMVar t new

-

writeTMVar' :: IndexerWrapper -> Utxo.UtxoIndexer -> STM ()

-

writeTMVar' (IndexerWrapper t) =  writeTMVar t

+

updateEnvState :: AddressUtxoIndexerEnv -> Utxo.UtxoIndexer -> STM ()

+

updateEnvState (AddressUtxoIndexerEnv _ t) =  writeTMVar t

m

marconi-sidechain/src/Marconi/Sidechain/Api/Routes.hs

+2/-2

module Marconi.Sidechain.Api.Routes where

import Cardano.Api qualified as C

-

import Cardano.Api.Shelley qualified as C

import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (Object), object, (.:), (.=))

import Data.Text (Text)

import Data.Word (Word64)

import GHC.Generics (Generic)

+

import Marconi.ChainIndex.Indexers.EpochSPD qualified as EpochSPD

import Marconi.ChainIndex.Indexers.MintBurn qualified as MpsTx

import Marconi.ChainIndex.Indexers.Utxo qualified as Utxo

import Network.JsonRpc.Types (JsonRpc, RawJsonRpc)

    deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)

newtype EpochStakePoolDelegationResult =

-

    EpochStakePoolDelegationResult [(C.PoolId, C.Lovelace)]

+

    EpochStakePoolDelegationResult [EpochSPD.EpochSPDRow]

    deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)

newtype EpochNonceResult =

m

marconi-sidechain/src/Marconi/Sidechain/Api/Types.hs

+35/-24

{-# LANGUAGE TypeOperators         #-}

{-# LANGUAGE UndecidableInstances  #-}

-

{-# OPTIONS_GHC -Wno-orphans #-}

-

-- | This module provides support for writing handlers for JSON-RPC endpoints.

-

module Marconi.Sidechain.Api.Types  where

+

module Marconi.Sidechain.Api.Types where

import Cardano.Api qualified as C

import Control.Concurrent.STM.TMVar (TMVar)

import Control.Exception (Exception)

-

import Control.Lens (makeClassy)

-

import Marconi.ChainIndex.Indexers.Utxo qualified as Utxo

+

import Control.Lens (makeLenses)

+

import Marconi.ChainIndex.Indexers.EpochSPD (EpochSPDHandle)

+

import Marconi.ChainIndex.Indexers.Utxo (UtxoHandle)

import Marconi.ChainIndex.Types as Export (TargetAddresses)

+

import Marconi.Core.Storable (State)

import Network.Wai.Handler.Warp (Settings)

-- | Type represents http port for JSON-RPC

data CliArgs = CliArgs

-

  { socket          :: FilePath -- ^ POSIX socket file to communicate with cardano node

-

  , dbDir           :: FilePath -- ^ Directory path containing the SQLite database files

-

  , httpPort        :: Maybe Int -- ^ optional tcp/ip port number for JSON-RPC http server

-

  , networkId       :: C.NetworkId -- ^ cardano network id

-

  , targetAddresses :: Maybe TargetAddresses -- ^ white-space sepparated list of Bech32 Cardano Shelley addresses

+

  { socket          :: !FilePath -- ^ POSIX socket file to communicate with cardano node

+

  , nodeConfigPath  :: !FilePath -- ^ Path to the node config

+

  , dbDir           :: !FilePath -- ^ Directory path containing the SQLite database files

+

  , httpPort        :: !(Maybe Int) -- ^ optional tcp/ip port number for JSON-RPC http server

+

  , networkId       :: !C.NetworkId -- ^ cardano network id

+

  , targetAddresses :: !(Maybe TargetAddresses) -- ^ white-space sepparated list of Bech32 Cardano Shelley addresses

  } deriving (Show)

-

-- | Should contain all the indexers required by Sidechain

-

newtype IndexerWrapper = IndexerWrapper

-

    { unWrapUtxoIndexer :: TMVar Utxo.UtxoIndexer     -- ^ for query thread to access in-memory utxos

+

-- | JSON-RPC as well as the Query Indexer Env

+

data SidechainEnv = SidechainEnv

+

    { _sidechainEnvHttpSettings :: !Settings -- ^ HTTP server setting

+

    , _sidechainEnvIndexers     :: !SidechainIndexers -- ^ Used for query the indexers

-

data IndexerEnv = IndexerEnv

-

    { _uiIndexer    :: IndexerWrapper

-

    , _uiQaddresses :: Maybe TargetAddresses        -- ^ user provided addresses to filter

+

-- | Should contain all the indexers required by Sidechain.

+

data SidechainIndexers = SidechainIndexers

+

    { _sidechainAddressUtxoIndexer              :: !AddressUtxoIndexerEnv

+

    -- ^ For query thread to access in-memory utxos

+

    , _sidechainEpochStakePoolDelegationIndexer :: !EpochSPDIndexerEnv

+

    -- ^ For query thread to access in-memory epoch stake pool delegation

-

makeClassy ''IndexerEnv

-

-- | JSON-RPC as well as the Query Indexer Env

-

data SidechainEnv = SidechainEnv

-

    { _httpSettings :: Settings               -- ^ HTTP server setting

-

    , _queryEnv     :: IndexerEnv         -- ^ used for query sqlite

+

data AddressUtxoIndexerEnv = AddressUtxoIndexerEnv

+

    { _addressUtxoIndexerEnvTargetAddresses :: !(Maybe TargetAddresses)

+

    , _addressUtxoIndexerEnvIndexer         :: !(TMVar (State UtxoHandle))

+

newtype EpochSPDIndexerEnv = EpochSPDIndexerEnv

+

    { _epochSpdIndexerEnvIndexer         :: TMVar (State EpochSPDHandle)

-

makeClassy ''SidechainEnv

data QueryExceptions

-

    = AddressConversionError QueryExceptions

-

    | QueryError String

+

    = AddressConversionError !QueryExceptions

+

    | QueryError !String

    deriving stock Show

    deriving anyclass  Exception

+

makeLenses ''SidechainEnv

+

makeLenses ''SidechainIndexers

+

makeLenses ''AddressUtxoIndexerEnv

+

makeLenses ''EpochSPDIndexerEnv

m

marconi-sidechain/src/Marconi/Sidechain/Bootstrap.hs

+37/-22

import Cardano.Api qualified as C

import Control.Concurrent.STM (atomically)

import Control.Lens ((^.))

+

import Marconi.ChainIndex.Indexers (epochStakepoolSizeWorker', runIndexers, utxoWorker)

+

import Marconi.ChainIndex.Indexers.EpochSPD (EpochSPDHandle)

+

import Marconi.ChainIndex.Indexers.Utxo (UtxoHandle)

+

import Marconi.ChainIndex.Types (TargetAddresses, epochStakepoolSizeDbName, utxoDbName)

+

import Marconi.Core.Storable (State)

+

import Marconi.Sidechain.Api.Query.Indexers.EpochSPD qualified as EpochSPD

+

import Marconi.Sidechain.Api.Query.Indexers.Utxo qualified as AddressUtxo

+

import Marconi.Sidechain.Api.Types (CliArgs (CliArgs), SidechainEnv (SidechainEnv),

+

                                    SidechainIndexers (SidechainIndexers), epochSpdIndexerEnvIndexer,

+

                                    sidechainAddressUtxoIndexer, sidechainEnvIndexers,

+

                                    sidechainEpochStakePoolDelegationIndexer)

import Network.Wai.Handler.Warp (Port, defaultSettings, setPort)

import System.FilePath ((</>))

-

import Marconi.ChainIndex.Indexers (runIndexers, utxoWorker)

-

import Marconi.ChainIndex.Types (TargetAddresses, utxoDbName)

-

import Marconi.Sidechain.Api.Query.Indexers.Utxo (UtxoIndexer, initializeEnv, writeTMVar')

-

import Marconi.Sidechain.Api.Types (CliArgs (CliArgs), HasIndexerEnv (uiIndexer), HasSidechainEnv (queryEnv),

-

                                    SidechainEnv (SidechainEnv, _httpSettings, _queryEnv))

-

-- | Bootstraps the JSON-RPC  http server with appropriate settings and marconi cache

-- this is just a wrapper for the bootstrapHttp in json-rpc package

-

initializeIndexerEnv

+

initializeSidechainEnv

    :: Maybe Port

    -> Maybe TargetAddresses

    -> IO SidechainEnv

-

initializeIndexerEnv maybePort targetAddresses = do

-

    queryenv <- initializeEnv targetAddresses

-

    let httpsettings =  maybe defaultSettings (flip setPort defaultSettings ) maybePort

-

    pure $ SidechainEnv

-

        { _httpSettings = httpsettings

-

        , _queryEnv = queryenv

-

+

initializeSidechainEnv maybePort targetAddresses = do

+

    let httpsettings = maybe defaultSettings (flip setPort defaultSettings ) maybePort

+

    sidechainIndexers <-

+

        SidechainIndexers

+

            <$> AddressUtxo.initializeEnv targetAddresses

+

            <*> EpochSPD.initializeEnv

+

    pure $ SidechainEnv httpsettings sidechainIndexers

-- |  Marconi cardano blockchain indexer

bootstrapIndexers

    :: CliArgs

    -> SidechainEnv

    -> IO ()

-

bootstrapIndexers (CliArgs socketPath dbPath _ networkId targetAddresses) env = do

-

  let callbackIndexer :: UtxoIndexer -> IO ()

-

      callbackIndexer = atomically . writeTMVar' (env ^. queryEnv . uiIndexer)

+

bootstrapIndexers (CliArgs socketPath nodeConfigPath dbPath _ networkId targetAddresses) env = do

+

  let addressUtxoCallback :: State UtxoHandle -> IO ()

+

      addressUtxoCallback =

+

          atomically

+

        . AddressUtxo.updateEnvState (env ^. sidechainEnvIndexers . sidechainAddressUtxoIndexer)

+

  let epochSPDCallback :: State EpochSPDHandle -> IO ()

+

      epochSPDCallback =

+

          atomically

+

        . EpochSPD.updateEnvState (env ^. sidechainEnvIndexers . sidechainEpochStakePoolDelegationIndexer . epochSpdIndexerEnvIndexer)

+

  let indexers =

+

          [ ( utxoWorker addressUtxoCallback targetAddresses

+

            , Just $ dbPath </> utxoDbName

+

          , ( epochStakepoolSizeWorker' nodeConfigPath epochSPDCallback

+

            , Just $ dbPath </> epochStakepoolSizeDbName

+

  runIndexers

    socketPath

    networkId

    C.ChainPointAtGenesis

    "marconi-sidechain"

-

    [ ( utxoWorker callbackIndexer targetAddresses

-

      , Just (dbPath </> utxoDbName)

-

+

    indexers

m

marconi-sidechain/src/Marconi/Sidechain/CLI.hs

+4/-0

parserCliArgs :: Opt.Parser CliArgs

parserCliArgs = CliArgs

  <$> Cli.commonSocketPath

+

  <*> Opt.strOption

+

        (  Opt.long "node-config-path"

+

        <> Opt.help "Path to node configuration which you are connecting to."

+

  <*> Cli.commonDbDir

  <*> Cli.commonMaybePort

  <*> Cli.pNetworkId

a

marconi-sidechain/src/Marconi/Sidechain/Utils.hs

+11/-0

+

module Marconi.Sidechain.Utils where

+

import Control.Concurrent.STM (STM, TMVar, putTMVar, tryTakeTMVar)

+

-- | Non-blocking write of a new value to a 'TMVar'

+

-- Puts if empty. Replaces if populated.

+

--

+

-- Only exists in GHC9, but we're on GHC8.

+

-- TODO: Remove once we migrate to GHC9.

+

writeTMVar :: TMVar a -> a -> STM ()

+

writeTMVar t new = tryTakeTMVar t >> putTMVar t new

m

marconi-sidechain/test/Spec.hs

+2/-2

tests :: TestTree

tests = localOption (HedgehogTestLimit $ Just 200) $

    testGroup "marconi-sidechain"

-

        [ Api.Query.Indexers.Utxo.tests

-

        , CLI.tests

+

        [ CLI.tests

        , Routes.tests

+

        , Api.Query.Indexers.Utxo.tests

m

marconi-sidechain/test/Spec/Golden/Cli/marconi-sidechain___help.help

+4/-1

querying the Cardano blockchain

Usage: marconi-sidechain [--version] (-s|--socket-path FILE-PATH)

-

                         (-d|--db-dir DIR) [--http-port HTTP-PORT]

+

                         --node-config-path ARG (-d|--db-dir DIR)

+

                         [--http-port HTTP-PORT]

                         (--mainnet | --testnet-magic NATURAL)

                         [(-a|--addresses-to-index BECH32-ADDRESS)]

  --version                Show git SHA

  -s,--socket-path FILE-PATH

                           Path to node socket.

+

  --node-config-path ARG   Path to node configuration which you are connecting

+

to.

  -d,--db-dir DIR          Directory path where all SQLite databases are

                           located.

  --http-port HTTP-PORT    JSON-RPC http port number, default is port 3000.

m

marconi-sidechain/test/Spec/Golden/Cli/marconi-sidechain___socket.help

+2/-1

Invalid option `--socket'

Usage: marconi-sidechain [--version] (-s|--socket-path FILE-PATH)

-

                         (-d|--db-dir DIR) [--http-port HTTP-PORT]

+

                         --node-config-path ARG (-d|--db-dir DIR)

+

                         [--http-port HTTP-PORT]

                         (--mainnet | --testnet-magic NATURAL)

                         [(-a|--addresses-to-index BECH32-ADDRESS)]

m

marconi-sidechain/test/Spec/Marconi/Sidechain/Api/Query/Indexers/Utxo.hs

+17/-14

{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE OverloadedStrings #-}

-

{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

-

{-# OPTIONS_GHC -Wno-orphans #-}

-

module Spec.Marconi.Sidechain.Api.Query.Indexers.Utxo (tests) where

import Cardano.Api qualified as C

import Marconi.ChainIndex.Indexers.Utxo qualified as Utxo

import Marconi.Core.Storable qualified as Storable

import Marconi.Sidechain.Api.HttpServer (marconiApp)

+

import Marconi.Sidechain.Api.Query.Indexers.Utxo qualified as AddressUtxoIndexer

import Marconi.Sidechain.Api.Query.Indexers.Utxo qualified as UIQ

import Marconi.Sidechain.Api.Routes (AddressUtxoResult (AddressUtxoResult), JsonRpcAPI)

-

import Marconi.Sidechain.Api.Types (HasIndexerEnv (uiIndexer), IndexerEnv)

+

import Marconi.Sidechain.Api.Types (SidechainEnv, sidechainAddressUtxoIndexer, sidechainEnvIndexers)

+

import Marconi.Sidechain.Bootstrap (initializeSidechainEnv)

import Network.HTTP.Client (defaultManagerSettings, newManager)

import Network.JsonRpc.Client.Types ()

import Network.JsonRpc.Types (JsonRpcResponse (Result))

-- | Alias for the storable-action and RPC-client-Action pair, to simplify the type signatures

type RpcClientAction = IO ( RpcEnv, String -> IO (JsonRpcResponse String AddressUtxoResult))

-

mkRpcEnv :: IndexerEnv -> RpcEnv

-

mkRpcEnv ixenv =

+

mkRpcEnv :: SidechainEnv -> RpcEnv

+

mkRpcEnv env =

  let cb :: Utxo.UtxoIndexer -> IO ()

-

      cb = atomically . UIQ.writeTMVar' (ixenv ^. uiIndexer)

+

      cb = atomically . UIQ.updateEnvState (env ^. sidechainEnvIndexers . sidechainAddressUtxoIndexer)

  in RpcEnv (mocUtxoWorker cb)

-- | Initialize RPC server on a free available port

initRpcTestEnv :: RpcClientAction

initRpcTestEnv = do

-

  ixenv <- UIQ.initializeEnv Nothing

-

  let f= \s -> Warp.testWithApplication (pure $ marconiApp ixenv)(queryUtxoFromRpcServer s)

-

  pure (mkRpcEnv ixenv, f)

+

  env <- initializeSidechainEnv Nothing Nothing

+

  let f = \s -> Warp.testWithApplication

+

                    (pure $ marconiApp env)

+

                    (queryUtxoFromRpcServer s)

+

  pure (mkRpcEnv env, f)

depth :: Utxo.Depth

depth = Utxo.Depth 5

-- Note, the in-memory DB provides the isolation we need per property test as the memory cache

-- is owned and visible only o the process that opened the connection

mocUtxoWorker

-

  :: (UIQ.UtxoIndexer -> IO ())

+

  :: (AddressUtxoIndexer.UtxoIndexer -> IO ())

  -> [Utxo.StorableEvent Utxo.UtxoHandle]

  -> IO ()

mocUtxoWorker callback events  =

queryTargetAddressTest :: Property

queryTargetAddressTest = property $ do

  events <- forAll genUtxoEvents

-

  env <- liftIO . UIQ.initializeEnv $ Nothing

+

  env <- liftIO $ initializeSidechainEnv Nothing Nothing

let

    callback :: Utxo.UtxoIndexer -> IO ()

-

    callback = atomically . UIQ.writeTMVar' (env ^. uiIndexer) -- update the indexer

+

    callback = atomically

+

             . AddressUtxoIndexer.updateEnvState

+

                (env ^. sidechainEnvIndexers . sidechainAddressUtxoIndexer) -- update the indexer

  liftIO $ mocUtxoWorker callback events

  fetchedRows <-

    liftIO

    . fmap concat

-

    . traverse (UIQ.findByAddress env)

+

    . traverse (AddressUtxoIndexer.findByAddress $ env ^. sidechainEnvIndexers . sidechainAddressUtxoIndexer)

    . Set.toList . Set.fromList  -- required to remove the potential duplicate addresses

    . fmap Utxo._address

    . concatMap (Set.toList . Utxo.ueUtxos)

m

marconi-sidechain/test/Spec/Marconi/Sidechain/Api/Routes/Golden/epoch-stakepooldelegation-response.json

+26/-0

+

        "blockHeaderHash": "578f3cb70f4153e1622db792fea9005c80ff80f83df028210c7a914fb780a6f6",

+

        "blockNo": 64903,

+

        "epochNo": 6,

+

        "lovelace": 100000000000000,

+

        "poolId": "pool1z22x50lqsrwent6en0llzzs9e577rx7n3mv9kfw7udwa2rf42fa",

+

        "slotNo": 1382422

+

},

+

        "blockHeaderHash": "578f3cb70f4153e1622db792fea9005c80ff80f83df028210c7a914fb780a6f6",

+

        "blockNo": 64903,

+

        "epochNo": 6,

+

        "lovelace": 100000000000000,

+

        "poolId": "pool1547tew8vmuj0g6vj3k5jfddudextcw6hsk2hwgg6pkhk7lwphe6",

+

        "slotNo": 1382422

+

},

+

        "blockHeaderHash": "578f3cb70f4153e1622db792fea9005c80ff80f83df028210c7a914fb780a6f6",

+

        "blockNo": 64903,

+

        "epochNo": 6,

+

        "lovelace": 100000000000000,

+

        "poolId": "pool174mw7e20768e8vj4fn8y6p536n8rkzswsapwtwn354dckpjqzr8",

+

        "slotNo": 1382422

+

\ No newline at end of file

m

marconi-sidechain/test/Spec/Marconi/Sidechain/Routes.hs

+51/-1

module Spec.Marconi.Sidechain.Routes (tests) where

import Cardano.Api qualified as C

+

import Cardano.Api.Shelley qualified as C

+

import Control.Monad (forM)

import Data.Aeson qualified as Aeson

import Data.Aeson.Encode.Pretty qualified as Aeson

import Data.ByteString.Lazy (ByteString)

import Data.Proxy (Proxy (Proxy))

+

import Gen.Cardano.Api.Typed qualified as CGen

import Gen.Marconi.ChainIndex.Types qualified as CGen

+

import Gen.Marconi.ChainIndex.Types qualified as Gen

import Hedgehog (Property, forAll, property, tripping)

+

import Hedgehog.Gen qualified as Gen

+

import Hedgehog.Range qualified as Range

+

import Marconi.ChainIndex.Indexers.EpochSPD (EpochSPDRow (EpochSPDRow))

import Marconi.ChainIndex.Indexers.MintBurn (TxMintRow (TxMintRow))

import Marconi.ChainIndex.Indexers.Utxo (Utxo (Utxo), UtxoRow (UtxoRow))

import Marconi.Sidechain.Api.Routes (AddressUtxoResult (AddressUtxoResult),

                                     CurrentSyncedPointResult (CurrentSyncedPointResult),

+

                                     EpochStakePoolDelegationResult (EpochStakePoolDelegationResult),

                                     MintingPolicyHashTxResult (MintingPolicyHashTxResult))

import Test.Tasty (TestTree, testGroup)

import Test.Tasty.Golden (goldenVsStringDiff)

            "CurrentSyncedPointResult"

            "propJSONRountripCurrentSyncedPointResult"

            propJSONRountripCurrentSyncedPointResult

+

        , testPropertyNamed

+

            "EpochStakePoolDelegationResult"

+

            "propJSONRountripEpochStakePoolDelegationResult"

+

            propJSONRountripEpochStakePoolDelegationResult

    , testGroup "Golden test for query results"

        [ goldenVsStringDiff

    cp <- CurrentSyncedPointResult <$> forAll CGen.genChainPoint

    tripping cp Aeson.encode Aeson.decode

+

propJSONRountripEpochStakePoolDelegationResult :: Property

+

propJSONRountripEpochStakePoolDelegationResult = property $ do

+

    spds <- fmap EpochStakePoolDelegationResult $ forAll $ Gen.list (Range.linear 1 10) $ do

+

        EpochSPDRow

+

            <$> Gen.genEpochNo

+

            <*> Gen.genPoolId

+

            <*> CGen.genLovelace

+

            <*> Gen.genSlotNo

+

            <*> Gen.genHashBlockHeader

+

            <*> Gen.genBlockNo

+

    tripping spds Aeson.encode Aeson.decode

+

goldenCurrentChainPointGenesisResult :: IO ByteString

goldenCurrentChainPointGenesisResult = do

    pure $ Aeson.encodePretty $ CurrentSyncedPointResult C.ChainPointAtGenesis

    pure $ Aeson.encodePretty result

goldenEpochStakePoolDelegationResult :: IO ByteString

-

goldenEpochStakePoolDelegationResult = pure ""

+

goldenEpochStakePoolDelegationResult = do

+

    let blockHeaderHashRawBytes = "578f3cb70f4153e1622db792fea9005c80ff80f83df028210c7a914fb780a6f6"

+

    blockHeaderHash <-

+

        either

+

            (error . show)

+

            pure

+

            $ C.deserialiseFromRawBytesHex (C.AsHash (C.proxyToAsType $ Proxy @C.BlockHeader)) blockHeaderHashRawBytes

+

    let poolIdsBech32 =

+

            [ "pool1z22x50lqsrwent6en0llzzs9e577rx7n3mv9kfw7udwa2rf42fa"

+

            , "pool1547tew8vmuj0g6vj3k5jfddudextcw6hsk2hwgg6pkhk7lwphe6"

+

            , "pool174mw7e20768e8vj4fn8y6p536n8rkzswsapwtwn354dckpjqzr8"

+

    poolIds <- forM poolIdsBech32 $ \poolIdBech32 -> do

+

        either

+

            (error . show)

+

            pure

+

            $ C.deserialiseFromBech32 (C.AsHash (C.proxyToAsType $ Proxy @C.StakePoolKey)) poolIdBech32

+

    let lovelace = C.Lovelace 100000000000000

+

        slotNo = C.SlotNo 1382422

+

        epochNo = C.EpochNo 6

+

        blockNo = C.BlockNo 64903

+

    let spds = fmap (\poolId -> EpochSPDRow epochNo poolId lovelace slotNo blockHeaderHash blockNo) poolIds

+

        result = EpochStakePoolDelegationResult spds

+

    pure $ Aeson.encodePretty result

goldenEpochNonceResult :: IO ByteString

goldenEpochNonceResult = pure ""

4,492 commits this week Sep 23, 2023 - Sep 30, 2023

Showing 25 of 4492 recent commits.

Yesterday's Report

New Repo Discovered

New Releases