From a42e9ae18ae136d6da539e24dc57c174cb9499c5 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Mon, 8 Jun 2020 17:18:00 +0200 Subject: [PATCH] Parameterise API over apiPool to allow differences between jorm and haskell - ApiStakePool -> ApiJormungandrStakePool - Move StakePoolLayer to the jormungandr package - add missing JSON golden file 'ApiJormungandrStakePool.json' - Move jorm listPools handler to server module - re-generate JSON golden file, in hope (commit from Matthias) Hoping to see the windows unit test timeout disappear --- .../src/Cardano/Wallet/Byron/Api/Server.hs | 4 +- lib/cli/src/Cardano/CLI.hs | 6 +- lib/cli/test/unit/Cardano/CLISpec.hs | 2 +- lib/core/cardano-wallet-core.cabal | 1 - lib/core/src/Cardano/Pool.hs | 28 -- lib/core/src/Cardano/Wallet/Api.hs | 15 +- lib/core/src/Cardano/Wallet/Api/Client.hs | 9 +- lib/core/src/Cardano/Wallet/Api/Link.hs | 10 +- lib/core/src/Cardano/Wallet/Api/Server.hs | 46 +-- lib/core/src/Cardano/Wallet/Api/Types.hs | 8 +- .../Wallet/Api/ApiJormungandrStakePool.json | 292 ++++++++++++++++++ .../test/unit/Cardano/Wallet/Api/TypesSpec.hs | 10 +- .../exe/cardano-wallet-jormungandr.hs | 4 +- .../src/Cardano/Pool/Jormungandr/Metrics.hs | 19 +- .../src/Cardano/Wallet/Jormungandr.hs | 13 +- .../Cardano/Wallet/Jormungandr/Api/Server.hs | 74 ++++- lib/jormungandr/test/bench/Latency.hs | 4 +- .../Jormungandr/Scenario/API/StakePools.hs | 56 ++-- .../Cardano/Pool/Jormungandr/MetricsSpec.hs | 3 +- lib/shelley/src/Cardano/Wallet/Shelley.hs | 14 +- .../src/Cardano/Wallet/Shelley/Api/Server.hs | 14 +- 21 files changed, 465 insertions(+), 167 deletions(-) delete mode 100644 lib/core/src/Cardano/Pool.hs create mode 100644 lib/core/test/data/Cardano/Wallet/Api/ApiJormungandrStakePool.json diff --git a/lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs b/lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs index d06a6ad5dae..2d6fd885489 100644 --- a/lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs +++ b/lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs @@ -77,7 +77,7 @@ import Cardano.Wallet.Api.Server , withLegacyLayer' ) import Cardano.Wallet.Api.Types - ( ApiT (..), SomeByronWalletPostData (..) ) + ( ApiJormungandrStakePool, ApiT (..), SomeByronWalletPostData (..) ) import Cardano.Wallet.Primitive.AddressDerivation ( PaymentAddress (..) ) import Cardano.Wallet.Primitive.AddressDerivation.Byron @@ -161,7 +161,7 @@ server byron icarus ntp = (\_ -> throwError err501) :<|> (\_ _ -> throwError err501) - stakePools :: Server (StakePools n) + stakePools :: Server (StakePools n ApiJormungandrStakePool) stakePools = throwError err501 :<|> (\_ _ _ -> throwError err501) diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs index e7fc4063f2a..92a31975e53 100644 --- a/lib/cli/src/Cardano/CLI.hs +++ b/lib/cli/src/Cardano/CLI.hs @@ -1495,7 +1495,8 @@ cmdVersion = command "version" $ info cmd $ mempty -------------------------------------------------------------------------------} cmdStakePool - :: StakePoolClient + :: ToJSON apiPool + => StakePoolClient apiPool -> Mod CommandFields (IO ()) cmdStakePool mkClient = command "stake-pool" $ info (helper <*> cmds) $ mempty @@ -1510,7 +1511,8 @@ newtype StakePoolListArgs = StakePoolListArgs } cmdStakePoolList - :: StakePoolClient + :: ToJSON apiPool + => StakePoolClient apiPool -> Mod CommandFields (IO ()) cmdStakePoolList mkClient = command "list" $ info (helper <*> cmd) $ mempty diff --git a/lib/cli/test/unit/Cardano/CLISpec.hs b/lib/cli/test/unit/Cardano/CLISpec.hs index 6b41eb29bf6..cb607ca5f81 100644 --- a/lib/cli/test/unit/Cardano/CLISpec.hs +++ b/lib/cli/test/unit/Cardano/CLISpec.hs @@ -1031,7 +1031,7 @@ parser = cli $ mempty <> cmdWallet cmdWalletCreate walletClient <> cmdTransaction transactionClient walletClient <> cmdAddress addressClient - <> cmdStakePool stakePoolClient + <> cmdStakePool (stakePoolClient @()) -- Type of pool not important here. <> cmdNetwork networkClient <> cmdKey diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index 47ac5eb155f..6162d4baa2b 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -110,7 +110,6 @@ library Cardano.Byron.Codec.Cbor Cardano.DB.Sqlite Cardano.DB.Sqlite.Delete - Cardano.Pool Cardano.Pool.Metadata Cardano.Pool.DB Cardano.Pool.DB.MVar diff --git a/lib/core/src/Cardano/Pool.hs b/lib/core/src/Cardano/Pool.hs deleted file mode 100644 index d851a6f27ac..00000000000 --- a/lib/core/src/Cardano/Pool.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | --- Copyright: © 2018-2020 IOHK --- License: Apache-2.0 --- --- High-level interface for dealing with stake pools. -module Cardano.Pool - ( StakePoolLayer (..) - ) where - -import Prelude - -import Cardano.Wallet.Primitive.Types - ( PoolId, StakePool, StakePoolMetadata ) -import Control.Monad.Trans.Except - ( ExceptT ) - --- | @StakePoolLayer@ is a thin layer ontop of the DB. It is /one/ value that --- can easily be passed to the API-server, where it can be used in a simple way. -data StakePoolLayer e m = StakePoolLayer - { listStakePools - :: ExceptT e m [(StakePool, Maybe StakePoolMetadata)] - - , knownStakePools - :: m [PoolId] - -- ^ Get a list of known pools that doesn't require fetching things from - -- any registry. This list comes from the registration certificates - -- that have been seen on chain. - } diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs index fab30ae6f72..b1132aeea86 100644 --- a/lib/core/src/Cardano/Wallet/Api.hs +++ b/lib/core/src/Cardano/Wallet/Api.hs @@ -106,13 +106,13 @@ import Cardano.Wallet.Api.Types , ApiByronWallet , ApiCoinSelectionT , ApiFee + , ApiJormungandrStakePool , ApiNetworkClock , ApiNetworkInformation , ApiNetworkParameters , ApiPoolId , ApiPostRandomAddressData , ApiSelectCoinsDataT - , ApiStakePool , ApiT , ApiTransactionT , ApiTxId @@ -183,13 +183,16 @@ import Servant.API.Verbs type ApiV2 n = "v2" :> Api n +-- | The full cardano-wallet API. +-- +-- The API used in cardano-wallet-jormungandr may differ from this one. type Api n = Wallets :<|> Addresses n :<|> CoinSelections n :<|> Transactions n :<|> ShelleyMigrations n - :<|> StakePools n + :<|> StakePools n ApiJormungandrStakePool -- TODO: Make haskell specific :<|> ByronWallets :<|> ByronAddresses n :<|> ByronCoinSelections n @@ -358,15 +361,15 @@ type GetShelleyWalletMigrationInfo = "wallets" See also: https://input-output-hk.github.io/cardano-wallet/api/edge/#tag/Stake-Pools -------------------------------------------------------------------------------} -type StakePools n = - ListStakePools +type StakePools n apiPool = + ListStakePools apiPool :<|> JoinStakePool n :<|> QuitStakePool n :<|> DelegationFee -- | https://input-output-hk.github.io/cardano-wallet/api/edge/#operation/listStakePools -type ListStakePools = "stake-pools" - :> Get '[JSON] [ApiStakePool] +type ListStakePools apiPool = "stake-pools" + :> Get '[JSON] [apiPool] -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/joinStakePool type JoinStakePool n = "stake-pools" diff --git a/lib/core/src/Cardano/Wallet/Api/Client.hs b/lib/core/src/Cardano/Wallet/Api/Client.hs index 30c3f32c84e..94ae9942e24 100644 --- a/lib/core/src/Cardano/Wallet/Api/Client.hs +++ b/lib/core/src/Cardano/Wallet/Api/Client.hs @@ -68,7 +68,6 @@ import Cardano.Wallet.Api.Types , ApiPoolId , ApiPostRandomAddressData , ApiSelectCoinsDataT - , ApiStakePool , ApiT (..) , ApiTransactionT , ApiTxId (..) @@ -174,9 +173,9 @@ data AddressClient = AddressClient -> ClientM NoContent } -data StakePoolClient = StakePoolClient +data StakePoolClient apiPool = StakePoolClient { listPools - :: ClientM [ApiStakePool] + :: ClientM [apiPool] , joinStakePool :: ApiPoolId -> ApiT WalletId @@ -326,14 +325,14 @@ byronAddressClient = -- | Produces an 'StakePoolsClient n' working against the /stake-pools API stakePoolClient - :: StakePoolClient + :: forall apiPool. (Aeson.FromJSON apiPool) => StakePoolClient apiPool stakePoolClient = let _listPools :<|> _joinStakePool :<|> _quitStakePool :<|> _delegationFee - = client (Proxy @("v2" :> StakePools Aeson.Value)) + = client (Proxy @("v2" :> StakePools Aeson.Value apiPool)) in StakePoolClient { listPools = _listPools diff --git a/lib/core/src/Cardano/Wallet/Api/Link.hs b/lib/core/src/Cardano/Wallet/Api/Link.hs index daa76a211cb..fbefee6328d 100644 --- a/lib/core/src/Cardano/Wallet/Api/Link.hs +++ b/lib/core/src/Cardano/Wallet/Api/Link.hs @@ -85,8 +85,6 @@ module Cardano.Wallet.Api.Link import Prelude -import Cardano.Wallet.Api - ( Api ) import Cardano.Wallet.Api.Types ( ApiPoolId (..) , ApiT (..) @@ -383,7 +381,7 @@ deleteTransaction w t = discriminate @style listStakePools :: (Method, Text) listStakePools = - endpoint @Api.ListStakePools id + endpoint @(Api.ListStakePools ()) id joinStakePool :: forall s w. @@ -491,15 +489,15 @@ postExternalTransaction = -- ( "GET", "v2/wallets/2512a00e9653fe49a44a5886202e24d77eeb998f" ) endpoint :: forall endpoint. - ( IsElem endpoint (Api Net) - , HasLink endpoint + ( HasLink endpoint + , IsElem endpoint endpoint , HasVerb endpoint ) => (MkLink endpoint Text -> Text) -> (Method, Text) endpoint mk = ( method (Proxy @endpoint) - , "v2/" <> mk (safeLink' toUrlPiece (Proxy @(Api Net)) (Proxy @endpoint)) + , "v2/" <> mk (safeLink' toUrlPiece (Proxy @endpoint) (Proxy @endpoint)) ) -- Returns first argument for Shelley style wallet, second argument otherwise. diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 0a857757dd4..3261ee1f24a 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -50,7 +50,6 @@ module Cardano.Wallet.Api.Server , getWallet , joinStakePool , listAddresses - , listPools , listTransactions , listWallets , migrateWallet @@ -90,8 +89,6 @@ import Cardano.Address.Derivation ( XPrv, XPub ) import Cardano.Mnemonic ( SomeMnemonic ) -import Cardano.Pool - ( StakePoolLayer (..) ) import Cardano.Wallet ( ErrAdjustForFee (..) , ErrCannotJoin (..) @@ -160,8 +157,6 @@ import Cardano.Wallet.Api.Types , ApiPoolId (..) , ApiPostRandomAddressData (..) , ApiSelectCoinsData (..) - , ApiStakePool (..) - , ApiStakePoolMetrics (..) , ApiT (..) , ApiTimeReference (..) , ApiTransaction (..) @@ -247,8 +242,6 @@ import Cardano.Wallet.Primitive.Types , PassphraseScheme (..) , PoolId , SortOrder (..) - , StakePool (..) - , StakePoolMetadata , SyncProgress , SyncTolerance , TransactionInfo (TransactionInfo) @@ -1196,37 +1189,8 @@ postTransactionFee ctx (ApiT wid) body = do e -> throwE e - -{------------------------------------------------------------------------------- - Stake Pools --------------------------------------------------------------------------------} - -listPools - :: LiftHandler e - => StakePoolLayer e IO - -> Handler [ApiStakePool] -listPools spl = - liftHandler $ map (uncurry mkApiStakePool) <$> listStakePools spl - where - mkApiStakePool - :: StakePool - -> Maybe StakePoolMetadata - -> ApiStakePool - mkApiStakePool sp meta = - ApiStakePool - (ApiT $ poolId sp) - (ApiStakePoolMetrics - (Quantity $ fromIntegral $ getQuantity $ stake sp) - (Quantity $ fromIntegral $ getQuantity $ production sp)) - (sp ^. #performance) - (ApiT <$> meta) - (fromIntegral <$> sp ^. #cost) - (Quantity $ sp ^. #margin) - (sp ^. #desirability) - (sp ^. #saturation) - joinStakePool - :: forall ctx s t n k e. + :: forall ctx s t n k. ( DelegationAddress n k , s ~ SeqState n k , IsOwned s k @@ -1236,19 +1200,21 @@ joinStakePool , ctx ~ ApiLayer s t k ) => ctx - -> StakePoolLayer e IO + -> IO [PoolId] + -- ^ Known pools + -- We could maybe replace this with a @IO (PoolId -> Bool)@ -> ApiPoolId -> ApiT WalletId -> ApiWalletPassphrase -> Handler (ApiTransaction n) -joinStakePool ctx spl apiPoolId (ApiT wid) body = do +joinStakePool ctx knownPools apiPoolId (ApiT wid) body = do let pwd = coerce $ getApiT $ body ^. #passphrase pid <- case apiPoolId of ApiPoolIdPlaceholder -> liftE ErrUnexpectedPoolIdPlaceholder ApiPoolId pid -> pure pid - pools <- liftIO $ knownStakePools spl + pools <- liftIO knownPools (tx, txMeta, txTime) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $ W.joinStakePool @_ @s @t @k wrk wid (pid, pools) (delegationAddress @n) pwd diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index 7a5ade486c9..a4a74610f9a 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -45,7 +45,7 @@ module Cardano.Wallet.Api.Types , ApiSelectCoinsData (..) , ApiCoinSelection (..) , ApiCoinSelectionInput (..) - , ApiStakePool (..) + , ApiJormungandrStakePool (..) , ApiStakePoolMetrics (..) , ApiWallet (..) , ApiWalletPassphrase (..) @@ -391,7 +391,7 @@ newtype ApiWalletPassphrase = ApiWalletPassphrase { passphrase :: ApiT (Passphrase "lenient") } deriving (Eq, Generic, Show) -data ApiStakePool = ApiStakePool +data ApiJormungandrStakePool = ApiJormungandrStakePool { id :: !(ApiT PoolId) , metrics :: !ApiStakePoolMetrics , apparentPerformance :: !Double @@ -1056,9 +1056,9 @@ instance FromJSON ApiWalletDelegationNext where instance ToJSON ApiWalletDelegationNext where toJSON = genericToJSON defaultRecordTypeOptions -instance FromJSON ApiStakePool where +instance FromJSON ApiJormungandrStakePool where parseJSON = genericParseJSON defaultRecordTypeOptions -instance ToJSON ApiStakePool where +instance ToJSON ApiJormungandrStakePool where toJSON = genericToJSON defaultRecordTypeOptions instance FromJSON ApiStakePoolMetrics where diff --git a/lib/core/test/data/Cardano/Wallet/Api/ApiJormungandrStakePool.json b/lib/core/test/data/Cardano/Wallet/Api/ApiJormungandrStakePool.json new file mode 100644 index 00000000000..62d3e236a1a --- /dev/null +++ b/lib/core/test/data/Cardano/Wallet/Api/ApiJormungandrStakePool.json @@ -0,0 +1,292 @@ +{ + "seed": -7826649569111114843, + "samples": [ + { + "saturation": 1.5519793660925632, + "metrics": { + "controlled_stake": { + "quantity": 101792220539, + "unit": "lovelace" + }, + "produced_blocks": { + "quantity": 10323423, + "unit": "block" + } + }, + "cost": { + "quantity": 196, + "unit": "lovelace" + }, + "margin": { + "quantity": 58.29, + "unit": "percent" + }, + "apparent_performance": 3.0472643669770787, + "metadata": { + "homepage": "h\u0003F", + "owner": "ed25519_pk1c7k9l4x2luc5x0deq4rfqla3lr9a5lwqpplf6h39s8prv2su7m4qg208fr", + "name": "\u001fB󷐧x񗺈qIS;񡣚e\u0004u񞔭\u000c\u000egg\u0005o1", + "ticker": "&\u000f(b", + "pledge_address": "򂲩\u0007xLz󝩺OC];򁒳qu^xr/gH񛅁𯵄Qr𲌉\u0006\u001e\u001b\\𡪅&}\u000f", + "description": "\u0018񷾿`􏻇\u0010v$\u001a\u000b9ꏞ롑򒭜UT\t2\r\u000bH񠄟A\\Z񵴤\u001b,A:`󷔫" + }, + "id": "7d4360401c2e9cdbc87a5438a0c3a04f166c703addf32f8c123d6a74404fd557", + "desirability": 59.364944965731645 + }, + { + "saturation": 1.3494398412862032, + "metrics": { + "controlled_stake": { + "quantity": 325597529392, + "unit": "lovelace" + }, + "produced_blocks": { + "quantity": 16792525, + "unit": "block" + } + }, + "cost": { + "quantity": 177, + "unit": "lovelace" + }, + "margin": { + "quantity": 1.67, + "unit": "percent" + }, + "apparent_performance": 4.251575790849382, + "metadata": { + "homepage": "G\u0001񀿲W2\u0000~񻿥4AW.󳙽9.\u0008\"F{%5\u0004g\u001f񩤊\u000eSL\u0017\u0011h\u0017򶉬\u0002?!m\u00163e\u001f,\u0012󸪐@q񭚞񉡕m񯧱,\u001e⋪􃹲|򢊈񡣇scw 52[졼󈁌p#]=\u0011UghH", + "owner": "ed25519_pk1n5ec86jzpreqqx26fuh50xmml0p3vdypjqzftdqjx2wh40h0tgcse639l5", + "name": "񸼶Om%e󜗄򪎛\u001b\u0011򉢞󋄐󈩿W4_T񤥶񡄞\u0012+.\u0011#\u0005󞶱󩓄5A񒔱dm\u0002o", + "ticker": "\u0013񔣊\u0003", + "pledge_address": "m򈪏:CP7񆳖#򸦯Uh}3񞭡@񍞷\u001a&V󙟎򐐲e񔩳𦒃Bq᫳񆧜\u0014󴪔0\u0008󦇬\u0005\u001b\u0016􈸁cObj[@\u0004I", + "owner": "ed25519_pk1k0tecz63s3ymqdtqgh7a4jw4qmgt6uk0q6wmvvu3s0rce92hh40qvflapc", + "name": "yJ~l|e`󻉍\u0011󞜟qi󏍇", + "ticker": "o\u001e_\u001b𰬄", + "pledge_address": "^nw^󊖟U7𬩇^C>fg0󘻟\u0016􎽈񍨯{\u0013!Q\u00141}񤙄y}9W", + "description": "WO\u0006\u0019Q\u001dD򯏌󯲜򝴤\u0002\u0019WN<󂲣>\u0018𚂤zm\u0002\u0006\u0007vT$󚸷J\u001ap4\u0011*Ds𨩼!󣡾\u0005e-\u0004>\u0004󿁠Sp򬁟;񅚺E\u0016\u0011񅝗񄧋-񎚗d𷫪0a\u0018򲡽\t󘧄Km\u0016𫹶L\u001c񩔭\n񴉈o񝘥!N\rq}QQF\u0000h9z𑰡C𿾎,򅼍b`򞯘񷬙󛆐\u0002򝆉MHo\u0003󒀇󍖄󺽀\u001f򆵝g\u000c󷷎zF.8񦞾gp=򥱉V`:򺷫$\u0016h杞\u0006󞨥􎆔2𐎄񥃪񎝛🻱󒶟k\u000eo򈣡\u0006Cb󢨇󹬟\"񥋀v4J񍍙.𧛼5`A\u001a\u000f(񆣕㟐z𻀓$Sp\u0002*𝠣\u001d" + }, + "id": "6f88b39681c8e95832daacac2607caadb9296fe227d7e4002129d0fd89150cec", + "desirability": 96.57249970643599 + }, + { + "saturation": 1.646578466604294, + "metrics": { + "controlled_stake": { + "quantity": 22621029932, + "unit": "lovelace" + }, + "produced_blocks": { + "quantity": 14981837, + "unit": "block" + } + }, + "cost": { + "quantity": 170, + "unit": "lovelace" + }, + "margin": { + "quantity": 73.22, + "unit": "percent" + }, + "apparent_performance": 0.6747156596326076, + "id": "135643368822c084f9b98c6c632c6afea5327d5fe0481d3772a04d3a4607adf1", + "desirability": 8.564894228346876 + }, + { + "saturation": 1.2353682409156277, + "metrics": { + "controlled_stake": { + "quantity": 822407014584, + "unit": "lovelace" + }, + "produced_blocks": { + "quantity": 12592798, + "unit": "block" + } + }, + "cost": { + "quantity": 59, + "unit": "lovelace" + }, + "margin": { + "quantity": 64.06, + "unit": "percent" + }, + "apparent_performance": 4.202651261159843, + "metadata": { + "homepage": "a\u0006FW]EF_񼾡5USQF\n\u001e[񹪃n𼀅VE򵑗CEvf\rP`", + "owner": "ed25519_pk1tgj09u35ph8la7dwp0tcc6thwalj9k2uaslpzrp9p66yyvzdqwhqw5k52a", + "name": "\"\u000eu󇺼O*aP@?\"󻰗􇄣򘦤Y𵛁𱑣.\u0001𵿼\u0003\u0000CS,e򖪉򦈖򾆑Wu\u0012𥠋C$3?K𞁧N\u0015&s8\u0016^P", + "ticker": "񎒄v\"", + "pledge_address": "󒊷}𖚖m\u0019񭿍𯈀8pkz\u001fUf\u0010~\u0002-􀴯m􏜂򗒆h곐񘶣o91\u000e󛚬A\u001b\u0006Z򼍲i$x" + }, + "id": "c446cbeb2fa2c4797c5964950eb1d491ff3565c52dd2804ea638c88731f62c02", + "desirability": 54.7843230282794 + } + ] +} \ No newline at end of file diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs index 068ddc1c63f..f01b8e53098 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs @@ -49,6 +49,7 @@ import Cardano.Wallet.Api.Types , ApiCoinSelectionInput (..) , ApiEpochInfo (..) , ApiFee (..) + , ApiJormungandrStakePool (..) , ApiMnemonicT (..) , ApiNetworkClock (..) , ApiNetworkInformation (..) @@ -57,7 +58,6 @@ import Cardano.Wallet.Api.Types , ApiNtpStatus (..) , ApiPostRandomAddressData , ApiSelectCoinsData (..) - , ApiStakePool (..) , ApiStakePoolMetrics (..) , ApiT (..) , ApiTimeReference (..) @@ -290,7 +290,7 @@ spec = do jsonRoundtripAndGolden $ Proxy @ApiWalletDelegationStatus jsonRoundtripAndGolden $ Proxy @ApiWalletDelegationNext jsonRoundtripAndGolden $ Proxy @(ApiT (Hash "Genesis")) - jsonRoundtripAndGolden $ Proxy @ApiStakePool + jsonRoundtripAndGolden $ Proxy @ApiJormungandrStakePool jsonRoundtripAndGolden $ Proxy @(AddressAmount (ApiT Address, Proxy ('Testnet 0))) jsonRoundtripAndGolden $ Proxy @(ApiTransaction ('Testnet 0)) jsonRoundtripAndGolden $ Proxy @ApiWallet @@ -1001,8 +1001,8 @@ instance Arbitrary ApiStakePoolMetrics where blocks <- Quantity . fromIntegral <$> choose (1::Integer, 22_600_000) pure $ ApiStakePoolMetrics stakes blocks -instance Arbitrary ApiStakePool where - arbitrary = ApiStakePool +instance Arbitrary ApiJormungandrStakePool where + arbitrary = ApiJormungandrStakePool <$> arbitrary <*> arbitrary <*> choose (0.0, 5.0) @@ -1380,7 +1380,7 @@ instance ToSchema ApiWalletPassphrase where declareNamedSchema _ = declareSchemaForDefinition "ApiWalletPassphrase" -instance ToSchema ApiStakePool where +instance ToSchema ApiJormungandrStakePool where declareNamedSchema _ = declareSchemaForDefinition "ApiStakePool" instance ToSchema ApiStakePoolMetrics where diff --git a/lib/jormungandr/exe/cardano-wallet-jormungandr.hs b/lib/jormungandr/exe/cardano-wallet-jormungandr.hs index 411371ab114..00dbb6ea7a3 100644 --- a/lib/jormungandr/exe/cardano-wallet-jormungandr.hs +++ b/lib/jormungandr/exe/cardano-wallet-jormungandr.hs @@ -77,6 +77,8 @@ import Cardano.Wallet.Api.Client ) import Cardano.Wallet.Api.Server ( HostPreference, Listen (..) ) +import Cardano.Wallet.Api.Types + ( ApiJormungandrStakePool ) import Cardano.Wallet.Jormungandr ( TracerSeverities , Tracers @@ -178,7 +180,7 @@ main = withUtf8Encoding $ do <> cmdWallet cmdWalletCreate walletClient <> cmdTransaction transactionClient walletClient <> cmdAddress addressClient - <> cmdStakePool stakePoolClient + <> cmdStakePool @ApiJormungandrStakePool stakePoolClient <> cmdNetwork networkClient <> cmdVersion <> cmdKey diff --git a/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs b/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs index 4f6e76bd9a3..e58d145ad71 100644 --- a/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs +++ b/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs @@ -20,6 +20,7 @@ module Cardano.Pool.Jormungandr.Metrics ( -- * Types Block (..) + , StakePoolLayer (..) -- * Listing stake-pools from the DB , newStakePoolLayer @@ -45,8 +46,6 @@ import Cardano.BM.Data.Severity ( Severity (..) ) import Cardano.BM.Data.Tracer ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) ) -import Cardano.Pool - ( StakePoolLayer (..) ) import Cardano.Pool.DB ( DBLayer (..), ErrPointAlreadyExists ) import Cardano.Pool.Jormungandr.Metadata @@ -139,6 +138,20 @@ data Block = Block -- ^ Any stake pools that were registered in this block. } deriving (Eq, Show, Generic) + +-- | @StakePoolLayer@ is a thin layer ontop of the DB. It is /one/ value that +-- can easily be passed to the API-server, where it can be used in a simple way. +data StakePoolLayer e m = StakePoolLayer + { listStakePools + :: ExceptT e m [(StakePool, Maybe StakePoolMetadata)] + + , knownStakePools + :: m [PoolId] + -- ^ Get a list of known pools that doesn't require fetching things from + -- any registry. This list comes from the registration certificates + -- that have been seen on chain. + } + -------------------------------------------------------------------------------- -- Stake Pool Monitoring -------------------------------------------------------------------------------- @@ -356,7 +369,7 @@ newStakePoolLayer tr block0H getEpCst db@DBLayer{..} nl metadataDir = StakePoolL ) sortByDesirability :: [(StakePool, a)] -> [(StakePool, a)] - sortByDesirability = sortOn (Down . desirability . fst) + sortByDesirability = sortOn (Down . view #desirability . fst) sortArbitrarily :: StdGen -> [a] -> IO [a] sortArbitrarily = shuffleWith diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs index 90c8a673cb2..880799c6b11 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs @@ -61,14 +61,17 @@ import Cardano.DB.Sqlite ( DBLog ) import Cardano.Launcher ( ProcessHasExited (..) ) -import Cardano.Pool - ( StakePoolLayer (..) ) import Cardano.Pool.Jormungandr.Metrics - ( ErrListStakePools, StakePoolLog, monitorStakePools, newStakePoolLayer ) + ( ErrListStakePools + , StakePoolLayer (..) + , StakePoolLog + , monitorStakePools + , newStakePoolLayer + ) import Cardano.Wallet ( WalletLog ) import Cardano.Wallet.Api - ( ApiLayer, ApiV2 ) + ( ApiLayer ) import Cardano.Wallet.Api.Server ( HostPreference, Listen (..), ListenError (..) ) import Cardano.Wallet.Api.Types @@ -76,7 +79,7 @@ import Cardano.Wallet.Api.Types import Cardano.Wallet.DB.Sqlite ( DefaultFieldValues (..), PersistState ) import Cardano.Wallet.Jormungandr.Api.Server - ( server ) + ( ApiV2, server ) import Cardano.Wallet.Jormungandr.Compatibility ( Jormungandr ) import Cardano.Wallet.Jormungandr.Network diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs index 017eb47b3cc..f63d1f73984 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -17,14 +18,13 @@ module Cardano.Wallet.Jormungandr.Api.Server ( server + , ApiV2 ) where import Prelude -import Cardano.Pool - ( StakePoolLayer ) import Cardano.Pool.Jormungandr.Metrics - ( ErrListStakePools (..) ) + ( ErrListStakePools (..), StakePoolLayer (..) ) import Cardano.Wallet ( ErrValidateSelection , genesisData @@ -33,9 +33,9 @@ import Cardano.Wallet ) import Cardano.Wallet.Api ( Addresses - , Api , ApiLayer (..) , ByronAddresses + , ByronCoinSelections , ByronMigrations , ByronTransactions , ByronWallets @@ -61,7 +61,6 @@ import Cardano.Wallet.Api.Server , getWallet , joinStakePool , listAddresses - , listPools , listTransactions , listWallets , migrateWallet @@ -86,7 +85,12 @@ import Cardano.Wallet.Api.Server , withLegacyLayer' ) import Cardano.Wallet.Api.Types - ( ApiErrorCode (..), SomeByronWalletPostData (..) ) + ( ApiErrorCode (..) + , ApiJormungandrStakePool (..) + , ApiStakePoolMetrics (..) + , ApiT (..) + , SomeByronWalletPostData (..) + ) import Cardano.Wallet.Primitive.AddressDerivation ( DelegationAddress (..), NetworkDiscriminant (..) ) import Cardano.Wallet.Primitive.AddressDerivation.Byron @@ -99,12 +103,16 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Random ( RndState ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( SeqState ) +import Cardano.Wallet.Primitive.Types + ( StakePool (..), StakePoolMetadata ) import Control.Applicative ( liftA2 ) import Data.Generics.Internal.VL.Lens - ( (^.) ) + ( view, (^.) ) import Data.List ( sortOn ) +import Data.Quantity + ( Quantity (..) ) import Data.Text.Class ( ToText (..) ) import Fmt @@ -112,7 +120,24 @@ import Fmt import Network.Ntp ( NtpClient ) import Servant - ( (:<|>) (..), Server, err501, err503, throwError ) + ( (:<|>) (..), (:>), Handler, Server, err501, err503, throwError ) + +type ApiV2 n = "v2" :> Api n + +type Api (n :: NetworkDiscriminant ) = + Wallets + :<|> Addresses n + :<|> CoinSelections n + :<|> Transactions n + :<|> ShelleyMigrations n + :<|> StakePools n ApiJormungandrStakePool + :<|> ByronWallets + :<|> ByronAddresses n + :<|> ByronCoinSelections n + :<|> ByronTransactions n + :<|> ByronMigrations n + :<|> Network + :<|> Proxy_ -- | A Servant server for our wallet API server @@ -171,9 +196,9 @@ server byron icarus jormungandr spl ntp = (\_ -> throwError err501) :<|> (\_ _ -> throwError err501) - stakePools :: Server (StakePools n) + stakePools :: Server (StakePools n ApiJormungandrStakePool) stakePools = listPools spl - :<|> joinStakePool jormungandr spl + :<|> joinStakePool jormungandr (knownStakePools spl) :<|> quitStakePool jormungandr :<|> delegationFee jormungandr @@ -264,6 +289,35 @@ server byron icarus jormungandr spl ntp = proxy :: Server Proxy_ proxy = postExternalTransaction jormungandr + +-------------------------------------------------------------------------------- +-- List stake pools API handler +-------------------------------------------------------------------------------- + +listPools + :: LiftHandler e + => StakePoolLayer e IO + -> Handler [ApiJormungandrStakePool] +listPools spl = + liftHandler $ map (uncurry mkApiJormungandrStakePool) <$> listStakePools spl + where + mkApiJormungandrStakePool + :: StakePool + -> Maybe StakePoolMetadata + -> ApiJormungandrStakePool + mkApiJormungandrStakePool sp meta = + ApiJormungandrStakePool + (ApiT $ view #poolId sp) + (ApiStakePoolMetrics + (Quantity $ fromIntegral $ getQuantity $ stake sp) + (Quantity $ fromIntegral $ getQuantity $ production sp)) + (sp ^. #performance) + (ApiT <$> meta) + (fromIntegral <$> sp ^. #cost) + (Quantity $ sp ^. #margin) + (sp ^. #desirability) + (sp ^. #saturation) + instance LiftHandler ErrListStakePools where handler = \case ErrListStakePoolsCurrentNodeTip e -> handler e diff --git a/lib/jormungandr/test/bench/Latency.hs b/lib/jormungandr/test/bench/Latency.hs index 07267e04e5f..15e872653c7 100644 --- a/lib/jormungandr/test/bench/Latency.hs +++ b/lib/jormungandr/test/bench/Latency.hs @@ -40,8 +40,8 @@ import Cardano.Wallet.Api.Server import Cardano.Wallet.Api.Types ( ApiAddress , ApiFee + , ApiJormungandrStakePool , ApiNetworkInformation - , ApiStakePool , ApiTransaction , ApiUtxoStatistics , ApiWallet @@ -358,7 +358,7 @@ main = withUtf8Encoding $ withLatencyLogging $ \logging tvar -> do fmtResult "postTransactionFee " t6 - t7 <- measureApiLogs tvar $ request @[ApiStakePool] ctx + t7 <- measureApiLogs tvar $ request @[ApiJormungandrStakePool] ctx Link.listStakePools Default Empty fmtResult "listStakePools " t7 diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs index 99f9b715ba5..3415d889d7a 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs @@ -16,7 +16,7 @@ import Prelude import Cardano.CLI ( Port (..) ) import Cardano.Wallet.Api.Types - ( ApiStakePool + ( ApiJormungandrStakePool , ApiT (..) , ApiTransaction , ApiWallet @@ -118,7 +118,7 @@ spec = do wk <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey "Wallet from pubkey" -- cannot join stake pool (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty rJoin <- joinStakePool @n ctx (p ^. #id) (wk, fixturePassphrase) expectResponseCode @IO HTTP.status403 rJoin expectErrorMessage (errMsg403NoRootKey $ wk ^. walletId) rJoin @@ -135,7 +135,7 @@ spec = do -- join stake pool (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty r <- joinStakePool @n ctx (p ^. #id) (w, fixturePassphrase) expectResponseCode @IO HTTP.status202 r waitAllTxsInLedger @n ctx w @@ -166,7 +166,7 @@ spec = do it "STAKE_POOLS_LIST_01 - List stake pools" $ \(_,_,ctx) -> do eventually "Listing stake pools shows expected information" $ do - r <- request @[ApiStakePool] ctx Link.listStakePools Default Empty + r <- request @[ApiJormungandrStakePool] ctx Link.listStakePools Default Empty expectResponseCode HTTP.status200 r verify r [ expectListSize 3 @@ -232,7 +232,7 @@ spec = do eventuallyUsingDelay (50*ms) "Shows error when listing stake pools on epoch boundaries" $ do - r <- request @[ApiStakePool] ctx Link.listStakePools Default Empty + r <- request @[ApiJormungandrStakePool] ctx Link.listStakePools Default Empty verify r [ expectResponseCode HTTP.status503 , expectErrorMessage @@ -246,7 +246,7 @@ spec = do let nWithoutMetadata = length . filter (isNothing . view #metadata) (_, pools) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty (poolIdA, poolAOwner) <- registerStakePool nPort feePolicy WithMetadata (poolIdB, _poolBOwner) <- registerStakePool nPort feePolicy WithoutMetadata @@ -254,7 +254,7 @@ spec = do waitForNextEpoch ctx (_, pools') <- eventually "Stake pools are listed again" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty nWithoutMetadata pools' `shouldBe` nWithoutMetadata pools + 1 nWithMetadata pools' `shouldBe` nWithMetadata pools + 2 @@ -271,7 +271,7 @@ spec = do it "STAKE_POOLS_JOIN_01 - Can join a stakepool" $ \(_,_,ctx) -> do w <- fixtureWallet ctx (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty -- Join a pool joinStakePool @n ctx (p ^. #id) (w, fixturePassphrase) >>= flip verify @@ -293,7 +293,7 @@ spec = do it "STAKE_POOLS_JOIN_01 - Controlled stake increases when joining" $ \(_,_,ctx) -> do w <- fixtureWallet ctx (_, Right (p:_)) <- eventually "Stake pools are listed" $ - request @[ApiStakePool] ctx Link.listStakePools Default Empty + request @[ApiJormungandrStakePool] ctx Link.listStakePools Default Empty -- Join a pool joinStakePool @n ctx (p ^. #id) (w, fixturePassphrase) >>= flip verify @@ -316,7 +316,7 @@ spec = do let existingPoolStake = getQuantity $ p ^. #metrics . #controlledStake let contributedStake = faucetUtxoAmt - fee eventually "Controlled stake increases for the stake pool" $ do - v <- request @[ApiStakePool] ctx Link.listStakePools Default Empty + v <- request @[ApiJormungandrStakePool] ctx Link.listStakePools Default Empty verify v [ expectListField 0 (#metrics . #controlledStake) (.> Quantity (existingPoolStake + contributedStake)) @@ -327,7 +327,7 @@ spec = do it "STAKE_POOLS_JOIN_04 - Rewards accumulate and stop" $ \(_,_,ctx) -> do w <- fixtureWallet ctx (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty -- Join a pool joinStakePool @n ctx (p ^. #id) (w, fixturePassphrase) >>= flip verify @@ -386,7 +386,7 @@ spec = do \Delegate, stop in the next epoch, and still earn rewards" $ \(_,_,ctx) -> do w <- fixtureWallet ctx (_, p1:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty joinStakePool @n ctx (p1 ^. #id) (w, fixturePassphrase) >>= flip verify [ expectResponseCode HTTP.status202 @@ -420,7 +420,7 @@ spec = do it "STAKE_POOLS_JOIN_01x - \ \I can join if I have just the right amount" $ \(_,_,ctx) -> do (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty let (fee, _) = ctx ^. #_feeEstimator $ DelegDescription 1 0 1 w <- fixtureWalletWith @n ctx [fee] joinStakePool @n ctx (p ^. #id) (w, "Secure Passphrase")>>= flip verify @@ -432,7 +432,7 @@ spec = do it "STAKE_POOLS_JOIN_01x - \ \I cannot join if I have not enough fee to cover" $ \(_,_,ctx) -> do (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty let (fee, _) = ctx ^. #_feeEstimator $ DelegDescription 1 0 1 w <- fixtureWalletWith @n ctx [fee - 1] r <- joinStakePool @n ctx (p ^. #id) (w, "Secure Passphrase") @@ -441,7 +441,7 @@ spec = do it "STAKE_POOLS_JOIN_01x - I cannot join stake-pool with 0 balance" $ \(_,_,ctx) -> do (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty w <- emptyWallet ctx let (fee, _) = ctx ^. #_feeEstimator $ DelegDescription 0 0 1 r <- joinStakePool @n ctx (p ^. #id) (w, "Secure Passphrase") @@ -500,7 +500,7 @@ spec = do \ If a wallet joins a stake pool, others are not affected" $ \(_,_,ctx) -> do (wA, wB) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty -- Join a pool joinStakePool @n ctx (p ^. #id) (wA, fixturePassphrase) >>= flip verify @@ -537,7 +537,7 @@ spec = do describe "STAKE_POOLS_JOIN_02 - Passphrase must be correct to join" $ do let verifyIt ctx wallet pass expectations = do (_, p:_) <- eventually "Stake pools are listed" $ do - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty w <- wallet ctx r <- joinStakePool @n ctx (p ^. #id) (w, pass) verify r expectations @@ -584,7 +584,7 @@ spec = do let verifyIt ctx doStakePool pass expec = do (_, p:_) <- eventually "Stake pools are listed" $ do - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty w <- emptyWallet ctx r <- doStakePool ctx (p ^. #id) (w, T.pack pass) expectResponseCode HTTP.status400 r @@ -599,7 +599,7 @@ spec = do describe "STAKE_POOLS_JOIN/QUIT_02 - Passphrase must be text" $ do let verifyIt ctx sPoolEndp = do (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty w <- emptyWallet ctx let payload = Json [json| { "passphrase": 123 } |] r <- request @(ApiTransaction n) ctx (sPoolEndp p w) @@ -613,7 +613,7 @@ spec = do it "STAKE_POOLS_JOIN_03 - Byron wallet cannot join stake pool" $ \(_,_,ctx) -> do (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty w <- emptyRandomWallet ctx r <- joinStakePool @n ctx (p ^. #id) (w, "Secure Passprase") expectResponseCode HTTP.status404 r @@ -626,7 +626,7 @@ spec = do -- value) and therefore, the random selection has no influence. it "STAKE_POOLS_ESTIMATE_FEE_01 - fee matches eventual cost" $ \(_,_,ctx) -> do (_, p:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty w <- fixtureWallet ctx r <- delegationFee ctx w verify r @@ -694,7 +694,7 @@ spec = do it "STAKE_POOL_NEXT_01 - Can join/re-join another/quit stake pool" $ \(_,_,ctx) -> do (_, p1:p2:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty w <- fixtureWallet ctx request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty >>= flip verify @@ -763,7 +763,7 @@ spec = do it "STAKE_POOL_NEXT_02 - Override join with join in the same epoch =>\ \ delegating to the last one in the end" $ \(_,_,ctx) -> do (_, p1:p2:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty w <- fixtureWallet ctx request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty @@ -795,7 +795,7 @@ spec = do \ and 2nd in epoch X + 3" $ \(_,_,ctx) -> do (_, p1:p2:_) <- eventually "Stake pools are listed" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty w <- fixtureWallet ctx request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty >>= flip verify @@ -857,11 +857,11 @@ joinStakePoolWithWalletBalance ) => (Context t) -> [Natural] - -> IO (ApiWallet, ApiStakePool) + -> IO (ApiWallet, ApiJormungandrStakePool) joinStakePoolWithWalletBalance ctx balance = do w <- fixtureWalletWith @n ctx balance (_, p:_) <- eventually "Stake pools are listed in joinStakePoolWithWalletBalance" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty r <- joinStakePool @n ctx (p ^. #id) (w, "Secure Passphrase") expectResponseCode HTTP.status202 r -- Verify the certificate was discovered @@ -876,11 +876,11 @@ joinStakePoolWithWalletBalance ctx balance = do joinStakePoolWithFixtureWallet :: forall n t. (DecodeAddress n) => (Context t) - -> IO (ApiWallet, ApiStakePool) + -> IO (ApiWallet, ApiJormungandrStakePool) joinStakePoolWithFixtureWallet ctx = do w <- fixtureWallet ctx (_, p:_) <- eventually "Stake pools are listed in joinStakePoolWithFixtureWallet" $ - unsafeRequest @[ApiStakePool] ctx Link.listStakePools Empty + unsafeRequest @[ApiJormungandrStakePool] ctx Link.listStakePools Empty r <- joinStakePool @n ctx (p ^. #id) (w, fixturePassphrase) expectResponseCode HTTP.status202 r -- Verify the certificate was discovered diff --git a/lib/jormungandr/test/unit/Cardano/Pool/Jormungandr/MetricsSpec.hs b/lib/jormungandr/test/unit/Cardano/Pool/Jormungandr/MetricsSpec.hs index b0f3b896041..46f2bc03232 100644 --- a/lib/jormungandr/test/unit/Cardano/Pool/Jormungandr/MetricsSpec.hs +++ b/lib/jormungandr/test/unit/Cardano/Pool/Jormungandr/MetricsSpec.hs @@ -21,8 +21,6 @@ import Prelude import Cardano.BM.Data.Tracer ( nullTracer ) -import Cardano.Pool - ( StakePoolLayer (..) ) import Cardano.Pool.DB ( DBLayer (..) ) import Cardano.Pool.DB.MVar @@ -32,6 +30,7 @@ import Cardano.Pool.Jormungandr.Metadata import Cardano.Pool.Jormungandr.Metrics ( Block (..) , ErrListStakePools (..) + , StakePoolLayer (..) , StakePoolLog (..) , associateMetadata , combineMetrics diff --git a/lib/shelley/src/Cardano/Wallet/Shelley.hs b/lib/shelley/src/Cardano/Wallet/Shelley.hs index a58b5d661a9..6f585f235a9 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley.hs @@ -54,8 +54,6 @@ import Cardano.BM.Trace ( Trace, appendName ) import Cardano.DB.Sqlite ( DBLog ) -import Cardano.Pool - ( StakePoolLayer (..) ) import Cardano.Wallet ( WalletLog ) import Cardano.Wallet.Api @@ -98,6 +96,7 @@ import Cardano.Wallet.Primitive.Types , ChimericAccount , GenesisParameters (..) , NetworkParameters (..) + , PoolId , PoolId (..) , SyncTolerance , WalletId @@ -231,7 +230,7 @@ serveWallet randomApi <- apiLayer (newTransactionLayer proxy pm el) nl icarusApi <- apiLayer (newTransactionLayer proxy pm el ) nl shelleyApi <- apiLayer (newTransactionLayer proxy pm el) nl - startServer proxy socket randomApi icarusApi shelleyApi mockStakePoolLayer ntpClient + startServer proxy socket randomApi icarusApi shelleyApi mockKnownPools ntpClient pure ExitSuccess networkDiscriminantValFromProxy @@ -254,7 +253,7 @@ serveWallet -> ApiLayer (RndState n) t ByronKey -> ApiLayer (SeqState n IcarusKey) t IcarusKey -> ApiLayer (SeqState n ShelleyKey) t ShelleyKey - -> StakePoolLayer () IO + -> IO [PoolId] -> NtpClient -> IO () startServer _proxy socket byron icarus shelley spl ntp = do @@ -308,10 +307,8 @@ exitCodeApiServer = \case -- | FIXME: Temporary mock stake pool layer until we can get the stake pool -- listing working. These IDs match hard-wired operator credentials in our -- integration setup. See 'Cardano.Wallet.Shelley.Launch'. -mockStakePoolLayer :: StakePoolLayer () IO -mockStakePoolLayer = StakePoolLayer - { listStakePools = pure [] - , knownStakePools = pure +mockKnownPools :: IO [PoolId] +mockKnownPools = pure [ PoolId $ unsafeFromHex "5a7b67c7dcfa8c4c25796bea05bcdfca01590c8c7612cc537c97012bed0dec35" , PoolId $ unsafeFromHex @@ -319,7 +316,6 @@ mockStakePoolLayer = StakePoolLayer , PoolId $ unsafeFromHex "c7258ccc42a43b653aaf2f80dde3120df124ebc3a79353eed782267f78d04739" ] - } {------------------------------------------------------------------------------- Logging diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs index 6cb0f7f31c3..29e1225d835 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs @@ -20,8 +20,6 @@ module Cardano.Wallet.Shelley.Api.Server import Prelude -import Cardano.Pool - ( StakePoolLayer ) import Cardano.Wallet ( ErrCreateRandomAddress (..) , ErrNotASequentialWallet (..) @@ -85,7 +83,7 @@ import Cardano.Wallet.Api.Server , withLegacyLayer' ) import Cardano.Wallet.Api.Types - ( ApiT (..), SomeByronWalletPostData (..) ) + ( ApiJormungandrStakePool, ApiT (..), SomeByronWalletPostData (..) ) import Cardano.Wallet.Primitive.AddressDerivation ( DelegationAddress (..), PaymentAddress (..) ) import Cardano.Wallet.Primitive.AddressDerivation.Byron @@ -98,6 +96,8 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Random ( RndState ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( SeqState ) +import Cardano.Wallet.Primitive.Types + ( PoolId ) import Control.Applicative ( liftA2 ) import Control.Monad.Trans.Except @@ -128,10 +128,10 @@ server => ApiLayer (RndState n) t ByronKey -> ApiLayer (SeqState n IcarusKey) t IcarusKey -> ApiLayer (SeqState n ShelleyKey) t ShelleyKey - -> StakePoolLayer () IO + -> IO [PoolId] -> NtpClient -> Server (Api n) -server byron icarus shelley spl ntp = +server byron icarus shelley knownPools ntp = wallets :<|> addresses :<|> coinSelections @@ -173,10 +173,10 @@ server byron icarus shelley spl ntp = getMigrationInfo shelley :<|> migrateWallet shelley - stakePools :: Server (StakePools n) + stakePools :: Server (StakePools n ApiJormungandrStakePool) stakePools = throwError err501 - :<|> joinStakePool shelley spl + :<|> joinStakePool shelley knownPools :<|> quitStakePool shelley :<|> (\_ -> throwError err501)