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/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 6b36dd80e7b..534b92d7e7d 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) @@ -1197,37 +1190,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 @@ -1237,19 +1201,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/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..17c3e5ddd53 100644 --- a/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs +++ b/lib/jormungandr/src/Cardano/Pool/Jormungandr/Metrics.hs @@ -20,6 +20,8 @@ module Cardano.Pool.Jormungandr.Metrics ( -- * Types Block (..) + , StakePoolLayer (..) + , listPools -- * Listing stake-pools from the DB , newStakePoolLayer @@ -45,8 +47,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 @@ -55,6 +55,10 @@ import Cardano.Pool.Jormungandr.Performance ( readPoolsPerformances ) import Cardano.Pool.Jormungandr.Ranking ( EpochConstants (..), unsafeMkNonNegative ) +import Cardano.Wallet.Api.Server + ( LiftHandler (liftHandler) ) +import Cardano.Wallet.Api.Types + ( ApiJormungandrStakePool (..), ApiStakePoolMetrics (..), ApiT (..) ) import Cardano.Wallet.Network ( ErrCurrentNodeTip , ErrNetworkUnavailable @@ -118,6 +122,8 @@ import Fmt ( pretty ) import GHC.Generics ( Generic ) +import Servant + ( Handler ) import System.Random ( StdGen ) @@ -139,6 +145,48 @@ 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. + } + +-------------------------------------------------------------------------------- +-- 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) + -------------------------------------------------------------------------------- -- Stake Pool Monitoring -------------------------------------------------------------------------------- @@ -356,7 +404,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..c940a5482cd 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs @@ -17,14 +17,13 @@ module Cardano.Wallet.Jormungandr.Api.Server ( server + , ApiV2 ) where import Prelude -import Cardano.Pool - ( StakePoolLayer ) import Cardano.Pool.Jormungandr.Metrics - ( ErrListStakePools (..) ) + ( ErrListStakePools (..), StakePoolLayer (..), listPools ) import Cardano.Wallet ( ErrValidateSelection , genesisData @@ -33,9 +32,9 @@ import Cardano.Wallet ) import Cardano.Wallet.Api ( Addresses - , Api , ApiLayer (..) , ByronAddresses + , ByronCoinSelections , ByronMigrations , ByronTransactions , ByronWallets @@ -61,7 +60,6 @@ import Cardano.Wallet.Api.Server , getWallet , joinStakePool , listAddresses - , listPools , listTransactions , listWallets , migrateWallet @@ -86,7 +84,10 @@ import Cardano.Wallet.Api.Server , withLegacyLayer' ) import Cardano.Wallet.Api.Types - ( ApiErrorCode (..), SomeByronWalletPostData (..) ) + ( ApiErrorCode (..) + , ApiJormungandrStakePool + , SomeByronWalletPostData (..) + ) import Cardano.Wallet.Primitive.AddressDerivation ( DelegationAddress (..), NetworkDiscriminant (..) ) import Cardano.Wallet.Primitive.AddressDerivation.Byron @@ -112,7 +113,24 @@ import Fmt import Network.Ntp ( NtpClient ) import Servant - ( (:<|>) (..), Server, err501, err503, throwError ) + ( (:<|>) (..), (:>), 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 +189,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 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