Merge #1738

1738: Parameterise `StakePools` API over apiPool type r=Anviking a=Anviking # Issue Number ADP-311, #1718 # Overview  - [x] I parameterised `StakePools` API over `apiPool` - [x] I renamed `ApiStakePool` to `ApiJormungandrStakePool`, such that we can later introduce a haskell `ApiStakePool` - [x] I made the default `Api` type use `ApiJormungandrStakePool`. We should later switch to `ApiStakePool`, and update the swagger scheme such that it targets haskell, and not jormungandr. - [x] I moved `StakePoolLayer` to the jormungandr package. # Comments - I am keeping the Pool DB in core, since I think we still want it. But I have not thought about how it would work with shelley. - changelog: this is pure refactoring, but in combination with follow-up PRs this is a new feature.   Co-authored-by: Johannes Lund <[email protected]> Co-authored-by: KtorZ <[email protected]>
cardano-foundation · Jun 10, 2020 · 99164a1 · 99164a1
2 parents 0233f53 + e240a99
commit 99164a1
Show file tree

Hide file tree

Showing 20 changed files with 471 additions and 153 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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