Merge #1775

1775: Allow listing pools based on stake instead of wallet id r=KtorZ a=Anviking

# Issue Number

#1720 


# Overview

<!-- Detail in a few bullet points the work accomplished in this PR -->

- [x] Make list stake pool endpoint take `Coin` instead of `WalletId`.
- [x] Adjust corresponding types and tests (A few more I think)
- [x] Fail with `err400` when query param is not present on Shelley.
- [x] Adjust swagger



# Comments

```
Originally:
GET /stake-pools

What was recently introduced:
GET /wallets/:wid/stake-pools

Now:
GET /stake-pools?stake=1000

For jormungandr the query parameter is not required, and unused. This
minimises breaking changes.
```

 - [Slack thread](https://input-output-rnd.slack.com/archives/C819S481Y/p1592322972378700)
- This PR gives greater flexibility to Daedalus and other API users

<!-- Additional comments or screenshots to attach if any -->

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: Johannes Lund <[email protected]>

lib/cli/src/Cardano/CLI.hs

@@ -190,7 +190,14 @@ import Cardano.Wallet.Primitive.AddressDerivation
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     ( AddressPoolGap, defaultAddressPoolGap )
 import Cardano.Wallet.Primitive.Types
-    ( AddressState, Hash, SortOrder, SyncTolerance (..), WalletId, WalletName )
+    ( AddressState
+    , Coin (..)
+    , Hash
+    , SortOrder
+    , SyncTolerance (..)
+    , WalletId
+    , WalletName
+    )
 import Cardano.Wallet.Version
     ( gitRevision, showFullVersion, version )
 import Codec.Binary.Bech32
@@ -1508,7 +1515,7 @@ cmdStakePool mkClient =
 -- | Arguments for 'stake-pool list' command
 data StakePoolListArgs = StakePoolListArgs
     { _port :: Port "Wallet"
-    , _walletId :: WalletId
+    , _stake :: Maybe Coin
     }
 
 cmdStakePoolList
@@ -1520,9 +1527,9 @@ cmdStakePoolList mkClient =
         <> progDesc "List all known stake pools."
   where
     cmd = fmap exec $ StakePoolListArgs
-        <$> portOption <*> walletIdArgument
-    exec (StakePoolListArgs wPort wid) = do
-        runClient wPort Aeson.encodePretty $ listPools mkClient (ApiT wid)
+        <$> portOption <*> stakeOption
+    exec (StakePoolListArgs wPort stake) = do
+        runClient wPort Aeson.encodePretty $ listPools mkClient (ApiT <$> stake)
 
 {-------------------------------------------------------------------------------
                             Commands - 'network'
@@ -1883,6 +1890,14 @@ walletIdArgument :: Parser WalletId
 walletIdArgument = argumentT $ mempty
     <> metavar "WALLET_ID"
 
+-- | <stake=STAKE>
+stakeOption :: Parser (Maybe Coin)
+stakeOption = optional $ optionT $ mempty
+    <> long "stake"
+    <> metavar "STAKE"
+    <> help ("The stake you intend to delegate, which affects the rewards and "
+            <> "the ranking of pools.")
+
 -- | <transaction-id=TX_ID>
 transactionIdArgument :: Parser TxId
 transactionIdArgument = argumentT $ mempty

lib/cli/test/unit/Cardano/CLISpec.hs

@@ -485,13 +485,16 @@ spec = do
             ]
 
         ["stake-pool", "list", "--help"] `shouldShowUsage`
-            [ "Usage:  stake-pool list [--port INT] WALLET_ID"
+            [ "Usage:  stake-pool list [--port INT] [--stake STAKE]"
             , "  List all known stake pools."
             , ""
             , "Available options:"
             , "  -h,--help                Show this help text"
             , "  --port INT               port used for serving the wallet"
             , "                           API. (default: 8090)"
+            , "  --stake STAKE            The stake you intend to delegate,"
+            , "                           which affects the rewards and the"
+            , "                           ranking of pools."
             ]
 
         ["network", "--help"] `shouldShowUsage`

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs

@@ -27,13 +27,13 @@ import Cardano.Wallet.Primitive.AddressDerivation
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
     ( ShelleyKey )
 import Cardano.Wallet.Primitive.Types
-    ( Direction (..), PoolId (..), TxStatus (..), WalletId )
+    ( Coin (..), Direction (..), PoolId (..), TxStatus (..) )
 import Data.Generics.Internal.VL.Lens
     ( view, (^.) )
 import Data.Quantity
     ( Quantity (..) )
 import Data.Text.Class
-    ( fromText, toText )
+    ( toText )
 import Test.Hspec
     ( SpecWith, describe, it, shouldBe, xit )
 import Test.Integration.Framework.DSL
@@ -79,7 +79,6 @@ import Test.Integration.Framework.TestData
 
 import qualified Cardano.Wallet.Api.Link as Link
 import qualified Data.ByteString as BS
-import qualified Data.Text as T
 import qualified Network.HTTP.Types.Status as HTTP
 
 
@@ -109,7 +108,7 @@ spec = do
     it "STAKE_POOLS_JOIN_01 - Cannot join existant stakepool with wrong password" $ \ctx -> do
         w <- fixtureWallet ctx
         pool:_ <- map (view #id) . snd
-            <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools w) Empty
+            <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty
         joinStakePool @n ctx pool (w, "Wrong Passphrase") >>= flip verify
             [ expectResponseCode HTTP.status403
             , expectErrorMessage errMsg403WrongPass
@@ -118,7 +117,7 @@ spec = do
     it "STAKE_POOLS_JOIN_02 - Cannot join already joined stake pool" $ \ctx -> do
         w <- fixtureWallet ctx
         pool:_ <- map (view #id) . snd
-            <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools w) Empty
+            <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty
         joinStakePool @n ctx pool (w, fixturePassphrase) >>= flip verify
             [ expectResponseCode HTTP.status202
             , expectField (#status . #getApiT) (`shouldBe` Pending)
@@ -142,7 +141,7 @@ spec = do
     it "STAKE_POOLS_QUIT_02 - Passphrase must be correct to quit" $ \ctx -> do
         w <- fixtureWallet ctx
         pool:_ <- map (view #id) . snd
-            <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools w) Empty
+            <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty
         joinStakePool @n ctx pool (w, fixturePassphrase) >>= flip verify
             [ expectResponseCode HTTP.status202
             , expectField (#status . #getApiT) (`shouldBe` Pending)
@@ -180,7 +179,8 @@ spec = do
         waitForNextEpoch ctx
 
         pool1:pool2:_ <- map (view #id) . snd
-            <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools w) Empty
+            <$> unsafeRequest @[ApiStakePool] ctx
+                (Link.listStakePools arbitraryStake) Empty
 
         joinStakePool @n ctx pool1 (w, fixturePassphrase) >>= flip verify
             [ expectResponseCode HTTP.status202
@@ -257,7 +257,7 @@ spec = do
     xit "STAKE_POOLS_JOIN_04 - Rewards accumulate and stop" $ \ctx -> do
         w <- fixtureWallet ctx
         pool:_ <- map (view #id) . snd
-            <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools w) Empty
+            <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty
         -- Join a pool
         joinStakePool @n ctx pool (w, fixturePassphrase) >>= flip verify
             [ expectResponseCode HTTP.status202
@@ -321,7 +321,7 @@ spec = do
             w <- fixtureWalletWith @n ctx [fee]
 
             pool:_ <- map (view #id) . snd
-                <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools w) Empty
+                <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty
 
             joinStakePool @n ctx pool (w, passwd)>>= flip verify
                 [ expectResponseCode HTTP.status202
@@ -334,7 +334,7 @@ spec = do
             let (fee, _) = ctx ^. #_feeEstimator $ DelegDescription 1 0 1
             w <- fixtureWalletWith @n ctx [fee - 1]
             pool:_ <- map (view #id) . snd
-                <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools w) Empty
+                <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty
             joinStakePool @n ctx pool (w, passwd) >>= flip verify
                 [ expectResponseCode HTTP.status403
                 , expectErrorMessage (errMsg403DelegationFee 1)
@@ -348,7 +348,7 @@ spec = do
             let initBalance = [feeJoin + feeQuit]
             w <- fixtureWalletWith @n ctx initBalance
             pool:_ <- map (view #id) . snd
-                <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools w) Empty
+                <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty
             joinStakePool @n ctx pool (w, passwd) >>= flip verify
                 [ expectResponseCode HTTP.status202
                 , expectField (#status . #getApiT) (`shouldBe` Pending)
@@ -381,7 +381,7 @@ spec = do
             w <- fixtureWalletWith @n ctx initBalance
 
             pool:_ <- map (view #id) . snd
-                <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools w) Empty
+                <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty
 
             joinStakePool @n ctx pool (w, passwd) >>= flip verify
                 [ expectResponseCode HTTP.status202
@@ -417,9 +417,9 @@ spec = do
             ]
 
     it "STAKE_POOLS_LIST_01 - List stake pools" $ \ctx -> do
-        w <- fixtureWallet ctx
         eventually "Listing stake pools shows expected information" $ do
-            r <- request @[ApiStakePool] ctx (Link.listStakePools w) Default Empty
+            r <- request @[ApiStakePool] ctx
+                (Link.listStakePools arbitraryStake) Default Empty
             expectResponseCode HTTP.status200 r
             verify r
                 [ expectListSize 3
@@ -470,28 +470,29 @@ spec = do
                     (#metrics . #saturation) (.>= 0)
                 ]
 
-    it "STAKE_POOLS_LIST_05 - Fails for unknown wallets" $ \ctx -> do
-        -- FIXME: Type inference breaks without this line:
-        _w <- fixtureWallet ctx
-
-        r <- request @[ApiStakePool] ctx (Link.listStakePools (ApiT invalidWalletId, ())) Default Empty
-        expectResponseCode HTTP.status404 r
+    it "STAKE_POOLS_LIST_05 - Fails without query parameter" $ \ctx -> do
+        _w <- fixtureWallet ctx -- Ambiguous type error without this line
+        r <- request @[ApiStakePool] ctx
+            (Link.listStakePools arbitraryStake) Default Empty
+        expectResponseCode HTTP.status400 r
 
-    it "STAKE_POOLS_LIST_06 - NonMyopicMemberRewards are 0 for empty wallets" $ \ctx -> do
-        w <- emptyWallet ctx
-        eventually "Listing stake pools shows expected information" $ do
-            r <- request @[ApiStakePool] ctx (Link.listStakePools w) Default Empty
-            expectResponseCode HTTP.status200 r
-            verify r
-                [ expectListSize 3
-                , expectListField 0
-                    (#metrics . #nonMyopicMemberRewards) (`shouldBe` Quantity 0)
-                , expectListField 1
-                    (#metrics . #nonMyopicMemberRewards) (`shouldBe` Quantity 0)
-                , expectListField 2
-                    (#metrics . #nonMyopicMemberRewards) (`shouldBe` Quantity 0)
-                ]
+    it "STAKE_POOLS_LIST_06 - NonMyopicMemberRewards are 0 when stake is 0" $ \ctx -> do
+        _w <- fixtureWallet ctx
+        let stake = Coin 0
+        r <- request @[ApiStakePool] ctx (Link.listStakePools stake) Default Empty
+        expectResponseCode HTTP.status200 r
+        verify r
+            [ expectListSize 3
+            , expectListField 0
+                (#metrics . #nonMyopicMemberRewards) (`shouldBe` Quantity 0)
+            , expectListField 1
+                (#metrics . #nonMyopicMemberRewards) (`shouldBe` Quantity 0)
+            , expectListField 2
+                (#metrics . #nonMyopicMemberRewards) (`shouldBe` Quantity 0)
+            ]
   where
-    invalidWalletId :: WalletId
-    invalidWalletId = either (error . show) id $ fromText $ T.pack $ replicate 40 '0'
+    arbitraryStake :: Coin
+    arbitraryStake = ada 10000
+      where ada = Coin . (1000*1000*)
+
     passwd = "Secure Passphrase"

lib/core/src/Cardano/Wallet/Api.hs

@@ -139,6 +139,7 @@ import Cardano.Wallet.Primitive.AddressDerivation
 import Cardano.Wallet.Primitive.Types
     ( AddressState
     , Block
+    , Coin (..)
     , NetworkParameters
     , SortOrder (..)
     , SyncTolerance
@@ -367,9 +368,8 @@ type StakePools n apiPool =
     :<|> DelegationFee
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/edge/#operation/listStakePools
-type ListStakePools apiPool = "wallets"
-    :> Capture "walletId" (ApiT WalletId)
-    :> "stake-pools"
+type ListStakePools apiPool = "stake-pools"
+    :> QueryParam "stake" (ApiT Coin)
     :> Get '[JSON] [apiPool]
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/joinStakePool

lib/core/src/Cardano/Wallet/Api/Client.hs

@@ -83,7 +83,7 @@ import Cardano.Wallet.Api.Types
     , WalletPutPassphraseData (..)
     )
 import Cardano.Wallet.Primitive.Types
-    ( AddressState, SortOrder, WalletId )
+    ( AddressState, Coin (..), SortOrder, WalletId )
 import Control.Monad
     ( void )
 import Data.Coerce
@@ -175,7 +175,7 @@ data AddressClient = AddressClient
 
 data StakePoolClient apiPool = StakePoolClient
     { listPools
-        :: ApiT WalletId -> ClientM [apiPool]
+        :: Maybe (ApiT Coin) -> ClientM [apiPool]
     , joinStakePool
         :: ApiPoolId
         -> ApiT WalletId

lib/core/src/Cardano/Wallet/Api/Link.hs

@@ -96,7 +96,7 @@ import Cardano.Wallet.Api.Types
 import Cardano.Wallet.Primitive.AddressDerivation
     ( NetworkDiscriminant (..) )
 import Cardano.Wallet.Primitive.Types
-    ( AddressState, Hash, PoolId, SortOrder, WalletId (..) )
+    ( AddressState, Coin (..), Hash, PoolId, SortOrder, WalletId (..) )
 import Data.Function
     ( (&) )
 import Data.Generics.Internal.VL.Lens
@@ -107,8 +107,6 @@ import Data.Proxy
     ( Proxy (..) )
 import Data.Text
     ( Text )
-import Data.Text.Class
-    ( fromText )
 import GHC.TypeLits
     ( Symbol )
 import Network.HTTP.Types.Method
@@ -131,7 +129,6 @@ import Web.HttpApiData
     ( ToHttpApiData (..) )
 
 import qualified Cardano.Wallet.Api as Api
-import qualified Data.Text as T
 
 --
 -- Wallets
@@ -383,22 +380,16 @@ deleteTransaction w t = discriminate @style
 --
 
 listStakePools
-    :: forall  w.
-        ( HasType (ApiT WalletId) w
-        )
-    => w
+    :: Coin
     -> (Method, Text)
-listStakePools w =
-    endpoint @(Api.ListStakePools ()) (\mk -> mk wid)
-  where
-    wid = w ^. typed @(ApiT WalletId)
+listStakePools stake =
+    endpoint @(Api.ListStakePools ()) (\mk -> mk $ Just $ ApiT stake)
 
--- | Like @listStakePools@, but with a dummy wallet id.
+-- | Like @listStakePools@ but with out the query parameter for the stake that
+-- the user intends to delegate.
 listJormungandrStakePools :: (Method, Text)
 listJormungandrStakePools =
-    endpoint @(Api.ListStakePools ()) (\mk -> mk wid)
-  where
-    wid = ApiT $ either (error . show) id $ fromText $ T.pack $replicate 40 '0'
+    endpoint @(Api.ListStakePools ()) (\mk -> mk Nothing)
 
 joinStakePool
     :: forall s w.

lib/core/src/Cardano/Wallet/Api/Types.hs

@@ -654,6 +654,7 @@ data ApiErrorCode
     | WalletNotResponding
     | AddressAlreadyExists
     | InvalidWalletType
+    | QueryParamMissing
     deriving (Eq, Generic, Show)
 
 -- | Defines a point in time that can be formatted as and parsed from an

lib/core/src/Cardano/Wallet/Primitive/Types.hs

@@ -188,7 +188,7 @@ import Control.Arrow
 import Control.DeepSeq
     ( NFData (..) )
 import Control.Monad
-    ( (>=>) )
+    ( (<=<), (>=>) )
 import Crypto.Hash
     ( Blake2b_160, Digest, digestFromByteString )
 import Crypto.Number.Generate
@@ -1092,6 +1092,18 @@ newtype Coin = Coin
     { getCoin :: Word64
     } deriving stock (Show, Ord, Eq, Generic)
 
+instance ToText Coin where
+    toText (Coin c) = T.pack $ show c
+
+instance FromText Coin where
+    fromText = validate <=< (fmap (Coin . fromIntegral) . fromText @Natural)
+      where
+        validate x
+            | isValidCoin x =
+                return x
+            | otherwise =
+                Left $ TextDecodingError "Coin value is out of bounds"
+
 instance NFData Coin
 
 instance Bounded Coin where

lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -338,6 +338,7 @@ spec = do
         describe "Can perform roundtrip textual encoding & decoding" $ do
             textRoundtrip $ Proxy @Iso8601Time
             textRoundtrip $ Proxy @SortOrder
+            textRoundtrip $ Proxy @Coin
 
     describe "AddressAmount" $ do
         it "fromText \"22323\"" $

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs

@@ -103,7 +103,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Random
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     ( SeqState )
 import Cardano.Wallet.Primitive.Types
-    ( StakePool (..), StakePoolMetadata, WalletId )
+    ( Coin, StakePool (..), StakePoolMetadata )
 import Control.Applicative
     ( liftA2 )
 import Data.Generics.Internal.VL.Lens
@@ -279,7 +279,7 @@ server byron icarus jormungandr spl ntp =
 listPools
     :: LiftHandler e
     => StakePoolLayer e IO
-    -> ApiT WalletId
+    -> Maybe (ApiT Coin)
     -- ^ Not needed, but there for consistency with haskell node.
     -> Handler [ApiJormungandrStakePool]
 listPools spl _walletId =