Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Parameterise StakePools API over apiPool type #1738

Merged
merged 1 commit into from
Jun 12, 2020
Merged

Parameterise StakePools API over apiPool type #1738

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
6 changes: 4 additions & 2 deletions lib/cli/src/Cardano/CLI.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -1510,7 +1511,8 @@ newtype StakePoolListArgs = StakePoolListArgs
}

cmdStakePoolList
:: StakePoolClient
:: ToJSON apiPool
=> StakePoolClient apiPool
-> Mod CommandFields (IO ())
cmdStakePoolList mkClient =
command "list" $ info (helper <*> cmd) $ mempty
Expand Down
2 changes: 1 addition & 1 deletion lib/cli/test/unit/Cardano/CLISpec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
1 change: 0 additions & 1 deletion lib/core/cardano-wallet-core.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
28 changes: 0 additions & 28 deletions lib/core/src/Cardano/Pool.hs
View file
Open in desktop

This file was deleted.

15 changes: 9 additions & 6 deletions lib/core/src/Cardano/Wallet/Api.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -106,13 +106,13 @@ import Cardano.Wallet.Api.Types
, ApiByronWallet
, ApiCoinSelectionT
, ApiFee
, ApiJormungandrStakePool
, ApiNetworkClock
, ApiNetworkInformation
, ApiNetworkParameters
, ApiPoolId
, ApiPostRandomAddressData
, ApiSelectCoinsDataT
, ApiStakePool
, ApiT
, ApiTransactionT
, ApiTxId
Expand Down Expand Up @@ -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 =
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I assume this one can be fully moved to each target package, alongside the server instantiation.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No! Sadly not easily, because we have a swagger spec in core!

My plan is to keep this type, but let jormungandr use a custom Api type.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hmmm. Well no, we can also declare an "Api" type in the relevant test.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Well no, we can also declare an "Api" type in the relevant test

That might make our test meaningless since if it is no longer testing the Api type that is actually used.

I say we keep the haskell API in core as the most important api, and test it, but not the jormungandr one.

…or, we define and test both APIs in core 🤔

…or, maybe one could do something with a ApiStakePool | ApiJormungandrStakePool sum type 🤔

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can sort out later.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

…or, maybe one could do something with a ApiStakePool | ApiJormungandrStakePool sum type thinking

Yeah, I thought of it. Since the stake pools are only something the server produces, it might just be okay to go down that path and fairly transparent for clients.

Wallets
:<|> Addresses n
:<|> CoinSelections n
:<|> Transactions n
:<|> ShelleyMigrations n
:<|> StakePools n
:<|> StakePools n ApiJormungandrStakePool -- TODO: Make haskell specific
:<|> ByronWallets
:<|> ByronAddresses n
:<|> ByronCoinSelections n
Expand Down Expand Up @@ -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"
Expand Down
9 changes: 4 additions & 5 deletions lib/core/src/Cardano/Wallet/Api/Client.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,6 @@ import Cardano.Wallet.Api.Types
, ApiPoolId
, ApiPostRandomAddressData
, ApiSelectCoinsDataT
, ApiStakePool
, ApiT (..)
, ApiTransactionT
, ApiTxId (..)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
10 changes: 4 additions & 6 deletions lib/core/src/Cardano/Wallet/Api/Link.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -85,8 +85,6 @@ module Cardano.Wallet.Api.Link

import Prelude

import Cardano.Wallet.Api
( Api )
import Cardano.Wallet.Api.Types
( ApiPoolId (..)
, ApiT (..)
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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.
Expand Down
46 changes: 6 additions & 40 deletions lib/core/src/Cardano/Wallet/Api/Server.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,6 @@ module Cardano.Wallet.Api.Server
, getWallet
, joinStakePool
, listAddresses
, listPools
, listTransactions
, listWallets
, migrateWallet
Expand Down Expand Up @@ -90,8 +89,6 @@ import Cardano.Address.Derivation
( XPrv, XPub )
import Cardano.Mnemonic
( SomeMnemonic )
import Cardano.Pool
( StakePoolLayer (..) )
import Cardano.Wallet
( ErrAdjustForFee (..)
, ErrCannotJoin (..)
Expand Down Expand Up @@ -160,8 +157,6 @@ import Cardano.Wallet.Api.Types
, ApiPoolId (..)
, ApiPostRandomAddressData (..)
, ApiSelectCoinsData (..)
, ApiStakePool (..)
, ApiStakePoolMetrics (..)
, ApiT (..)
, ApiTimeReference (..)
, ApiTransaction (..)
Expand Down Expand Up @@ -247,8 +242,6 @@ import Cardano.Wallet.Primitive.Types
, PassphraseScheme (..)
, PoolId
, SortOrder (..)
, StakePool (..)
, StakePoolMetadata
, SyncProgress
, SyncTolerance
, TransactionInfo (TransactionInfo)
Expand Down Expand Up @@ -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
Expand All @@ -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)@
Copy link
Member Author

@Anviking Anviking Jun 10, 2020 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No need to have a common StakePoolLayer at this point. No need to have a common StakePool type in core either.

We just need to make sure the target packages can provide a Handler (ListStakePool apiPool), for some apiPool, and can provide this IO [PoolId].

-> 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
Expand Down
8 changes: 4 additions & 4 deletions lib/core/src/Cardano/Wallet/Api/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,7 @@ module Cardano.Wallet.Api.Types
, ApiSelectCoinsData (..)
, ApiCoinSelection (..)
, ApiCoinSelectionInput (..)
, ApiStakePool (..)
, ApiJormungandrStakePool (..)
, ApiStakePoolMetrics (..)
, ApiWallet (..)
, ApiWalletPassphrase (..)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading