From b385c0282cbc9180a2aae972612bb337c6e36474 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 6 Jul 2018 14:51:06 +0200 Subject: [PATCH 1/4] [CO-324] Draft endpoints to get accounts' address and balance Ideally, we want the /.../account/addresses to be paginated, otherwise there's no real value in isolating it as such. Also, for now, the implementation is rather heavy and requires the full account to be retrieved from the DB. On the long-term, we could imagine fetching only the addresses from the DB and streaming the response. --- .../src/Cardano/Wallet/API/V1/Accounts.hs | 8 +++ .../Wallet/API/V1/LegacyHandlers/Accounts.hs | 19 +++++++ wallet-new/src/Cardano/Wallet/API/V1/Types.hs | 57 ++++++++++++++----- wallet-new/src/Cardano/Wallet/Client.hs | 43 +++----------- wallet-new/src/Cardano/Wallet/Client/Http.hs | 14 ++--- 5 files changed, 85 insertions(+), 56 deletions(-) diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs b/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs index dc47b2f7a8e..cf125271971 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs @@ -37,4 +37,12 @@ type API :> "certificates" :> ReqBody '[ValidJSON] Redemption :> Post '[ValidJSON] (WalletResponse Transaction) + :<|> "wallets" :> CaptureWalletId :> "accounts" + :> CaptureAccountId :> "addresses" + :> Summary "Retrieve only account's addressees." + :> Get '[ValidJSON] (WalletResponse AccountAddresses) + :<|> "wallets" :> CaptureWalletId :> "accounts" + :> CaptureAccountId :> "balance" + :> Summary "Retrieve only account's balance." + :> Get '[ValidJSON] (WalletResponse AccountBalance) ) diff --git a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs index fd748947869..5e977048feb 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs @@ -36,6 +36,8 @@ handlers pm txpConfig submitTx = :<|> newAccount :<|> updateAccount :<|> redeemAda pm txpConfig submitTx + :<|> getAccountAddresses + :<|> getAccountBalance deleteAccount :: (V0.MonadWalletLogic ctx m) @@ -108,3 +110,20 @@ redeemAda pm txpConfig submitTx walletId accountIndex r = do , V0.crSeed = seed } V0.redeemAda pm txpConfig submitTx spendingPassword cwalletRedeem + +getAccountAddresses + :: (V0.MonadWalletLogic ctx m) + => WalletId -> AccountIndex -> m (WalletResponse AccountAddresses) +getAccountAddresses wId accIdx = + partialResponse (AccountAddresses . accAddresses) <$> getAccount wId accIdx + +getAccountBalance + :: (V0.MonadWalletLogic ctx m) + => WalletId -> AccountIndex -> m (WalletResponse AccountBalance) +getAccountBalance wId accIdx = + partialResponse (AccountBalance . accAmount) <$> getAccount wId accIdx + +partialResponse :: (Account -> a) -> WalletResponse Account -> WalletResponse a +partialResponse extract res = res + { wrData = extract (wrData res) + } diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Types.hs b/wallet-new/src/Cardano/Wallet/API/V1/Types.hs index 1dc69613710..926f764c629 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Types.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Types.hs @@ -42,6 +42,8 @@ module Cardano.Wallet.API.V1.Types ( , Account (..) , accountsHaveSameId , AccountIndex + , AccountAddresses (..) + , AccountBalance (..) -- * Addresses , WalletAddress (..) , NewAddress (..) @@ -902,6 +904,7 @@ data Account = Account , accWalletId :: !WalletId } deriving (Show, Ord, Eq, Generic) + -- -- IxSet indices -- @@ -918,6 +921,15 @@ instance IxSet.Indexable (AccountIndex ': SecondaryAccountIxs) (OrdByPrimKey Account) where indices = ixList +-- | Datatype wrapping addresses for per-field endpoint +newtype AccountAddresses = AccountAddresses + { acaAddresses :: [WalletAddress] + } deriving (Show, Ord, Eq, Generic) + +-- | Datatype wrapping balance for per-field endpoint +newtype AccountBalance = AccountBalance + { acbAmount :: V1 Core.Coin + } deriving (Show, Ord, Eq, Generic) accountsHaveSameId :: Account -> Account -> Bool accountsHaveSameId a b = @@ -926,6 +938,8 @@ accountsHaveSameId a b = accIndex a == accIndex b deriveJSON Serokell.defaultOptions ''Account +deriveJSON Serokell.defaultOptions ''AccountAddresses +deriveJSON Serokell.defaultOptions ''AccountBalance instance ToSchema Account where declareNamedSchema = @@ -937,6 +951,18 @@ instance ToSchema Account where & ("walletId" --^ "Id of the wallet this account belongs to.") ) +instance ToSchema AccountAddresses where + declareNamedSchema = + genericSchemaDroppingPrefix "aca" (\(--^) props -> props + & ("addresses" --^ "Public addresses pointing to this account.") + ) + +instance ToSchema AccountBalance where + declareNamedSchema = + genericSchemaDroppingPrefix "acb" (\(--^) props -> props + & ("amount" --^ "Available funds, in Lovelace.") + ) + instance Arbitrary Account where arbitrary = Account <$> arbitrary <*> arbitrary @@ -944,6 +970,14 @@ instance Arbitrary Account where <*> pure "My account" <*> arbitrary +instance Arbitrary AccountAddresses where + arbitrary = + AccountAddresses <$> arbitrary + +instance Arbitrary AccountBalance where + arbitrary = + AccountBalance <$> arbitrary + deriveSafeBuildable ''Account instance BuildableSafeGen Account where buildSafeGen sl Account{..} = bprint ("{" @@ -959,8 +993,17 @@ instance BuildableSafeGen Account where accAmount accWalletId +instance Buildable AccountAddresses where + build = + bprint listJson . acaAddresses + +instance Buildable AccountBalance where + build = + bprint build . acbAmount + instance Buildable [Account] where - build = bprint listJson + build = + bprint listJson -- | Account Update data AccountUpdate = AccountUpdate { @@ -1901,15 +1944,3 @@ instance Arbitrary Redemption where -- type family Update (original :: *) :: * where - Update Wallet = WalletUpdate - Update Account = AccountUpdate - Update WalletAddress = () -- read-only - -type family New (original :: *) :: * where - New Wallet = NewWallet - New Account = NewAccount - New WalletAddress = NewAddress - -type CaptureWalletId = Capture "walletId" WalletId - -type CaptureAccountId = Capture "accountId" AccountIndex diff --git a/wallet-new/src/Cardano/Wallet/Client.hs b/wallet-new/src/Cardano/Wallet/Client.hs index 8a826874916..332f142bdec 100644 --- a/wallet-new/src/Cardano/Wallet/Client.hs +++ b/wallet-new/src/Cardano/Wallet/Client.hs @@ -101,6 +101,10 @@ data WalletClient m :: WalletId -> AccountIndex -> Update Account -> Resp m Account , redeemAda :: WalletId -> AccountIndex -> Redemption -> Resp m Transaction + , getAccountAddresses + :: WalletId -> AccountIndex -> Resp m AccountAddresses + , getAccountBalance + :: WalletId -> AccountIndex -> Resp m AccountBalance -- transactions endpoints , postTransaction :: Payment -> Resp m Transaction @@ -214,6 +218,10 @@ hoistClient phi wc = WalletClient \x y -> phi . updateAccount wc x y , redeemAda = \x y -> phi . redeemAda wc x y + , getAccountAddresses = + \x -> phi . getAccountAddresses wc x + , getAccountBalance = + \x -> phi . getAccountBalance wc x , postTransaction = phi . postTransaction wc , getTransactionIndexFilterSorts = @@ -231,38 +239,3 @@ hoistClient phi wc = WalletClient -- 'WalletClient' m@. liftClient :: MonadIO m => WalletClient IO -> WalletClient m liftClient = hoistClient liftIO - --- | Calls 'getWalletIndexPaged' using the 'Default' values for 'Page' and --- 'PerPage'. -getWalletIndex :: Monad m => WalletClient m -> Resp m [Wallet] -getWalletIndex = paginateAll . getWalletIndexPaged - --- | A type alias shorthand for the response from the 'WalletClient'. -type Resp m a = m (Either ClientError (WalletResponse a)) - --- | The type of errors that the wallet might return. -data ClientError - = ClientWalletError V1Errors.WalletError - -- ^ The 'WalletError' type represents known failures that the API - -- might return. - | ClientHttpError ServantError - -- ^ We directly expose the 'ServantError' type as part of this - | UnknownClientError SomeException - -- ^ This constructor is used when the API client reports an error that - -- isn't represented in either the 'ServantError' HTTP errors or the - -- 'WalletError' for API errors. - deriving (Show, Generic) - --- | General (and naive) equality instance. -instance Eq ClientError where - ClientWalletError e1 == ClientWalletError e2 = e1 == e2 - ClientHttpError e1 == ClientHttpError e2 = e1 == e2 - UnknownClientError _ == UnknownClientError _ = True - _ == _ = False - --- | General exception instance. -instance Exception ClientError where - toException (ClientWalletError e) = toException e - toException (ClientHttpError e) = toException e - toException (UnknownClientError e) = toException e - diff --git a/wallet-new/src/Cardano/Wallet/Client/Http.hs b/wallet-new/src/Cardano/Wallet/Client/Http.hs index 423ccacafa0..42256cea868 100644 --- a/wallet-new/src/Cardano/Wallet/Client/Http.hs +++ b/wallet-new/src/Cardano/Wallet/Client/Http.hs @@ -118,6 +118,10 @@ mkHttpClient baseUrl manager = WalletClient = \x y -> run . updateAccountR x y , redeemAda = run ... redeemAdaR + , getAccountAddresses + = \x -> run . getAccountAddressesR x + , getAccountBalance + = \x -> run . getAccountBalanceR x -- transactions endpoints , postTransaction = run . postTransactionR @@ -169,17 +173,11 @@ mkHttpClient baseUrl manager = WalletClient :<|> postAccountR :<|> updateAccountR :<|> redeemAdaR + :<|> getAccountAddressesR + :<|> getAccountBalanceR = accountsAPI postTransactionR :<|> getTransactionIndexFilterSortsR :<|> getTransactionFeeR = transactionsAPI - - addressesAPI - :<|> walletsAPI - :<|> accountsAPI - :<|> transactionsAPI - :<|> getNodeSettingsR - :<|> getNodeInfoR - = client (Proxy @("api" :> "v1" :> V1.API)) From 172d2e00aa2a22de563692fcfe5da4d34f4c6d99 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 6 Jul 2018 16:23:26 +0200 Subject: [PATCH 2/4] [CO-324] Introduce pagination for getAccountAddresses This is not 'ideal' yet because we are sorting and filtering on a plain list. Instead, we could have these operation at a DB-level, but this won't probably be achieved with acid-state. Perhaps if one day we switch to SQL --- wallet-new/src/Cardano/Wallet/API/Indices.hs | 6 ++++- .../src/Cardano/Wallet/API/V1/Accounts.hs | 6 +++++ .../Wallet/API/V1/LegacyHandlers/Accounts.hs | 25 +++++++++++-------- wallet-new/src/Cardano/Wallet/Client.hs | 10 ++++++-- wallet-new/src/Cardano/Wallet/Client/Http.hs | 2 +- 5 files changed, 35 insertions(+), 14 deletions(-) diff --git a/wallet-new/src/Cardano/Wallet/API/Indices.hs b/wallet-new/src/Cardano/Wallet/API/Indices.hs index ee7bced5de2..f3a0cd0ba43 100644 --- a/wallet-new/src/Cardano/Wallet/API/Indices.hs +++ b/wallet-new/src/Cardano/Wallet/API/Indices.hs @@ -52,6 +52,10 @@ instance ToIndex Transaction (V1 Core.Timestamp) where toIndex _ = fmap V1 . Core.parseTimestamp accessIx Transaction{..} = txCreationTime +instance ToIndex WalletAddress (V1 Core.Address) where + toIndex _ = fmap V1 . either (const Nothing) Just . Core.decodeTextAddress + accessIx WalletAddress{..} = addrId + -- | A type family mapping a resource 'a' to all its indices. type family IndicesOf a :: [*] where IndicesOf Wallet = WalletIxs @@ -118,7 +122,7 @@ type family IndexToQueryParam resource ix where IndexToQueryParam Wallet WalletId = "id" IndexToQueryParam Wallet (V1 Core.Timestamp) = "created_at" - IndexToQueryParam WalletAddress (V1 Core.Address) = "id" + IndexToQueryParam WalletAddress (V1 Core.Address) = "address" IndexToQueryParam Transaction (V1 Txp.TxId) = "id" IndexToQueryParam Transaction (V1 Core.Timestamp) = "created_at" diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs b/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs index cf125271971..b5a72600a13 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs @@ -2,11 +2,14 @@ module Cardano.Wallet.API.V1.Accounts where import Servant +import Cardano.Wallet.API.Request import Cardano.Wallet.API.Response import Cardano.Wallet.API.Types import Cardano.Wallet.API.V1.Parameters import Cardano.Wallet.API.V1.Types +import qualified Pos.Core as Core + type API = Tags '["Accounts"] :> @@ -40,6 +43,9 @@ type API :<|> "wallets" :> CaptureWalletId :> "accounts" :> CaptureAccountId :> "addresses" :> Summary "Retrieve only account's addressees." + :> WalletRequestParams + :> FilterBy '[V1 Core.Address] WalletAddress + :> SortBy '[V1 Core.Address] WalletAddress :> Get '[ValidJSON] (WalletResponse AccountAddresses) :<|> "wallets" :> CaptureWalletId :> "accounts" :> CaptureAccountId :> "balance" diff --git a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs index 5e977048feb..af2e5469c31 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs @@ -113,17 +113,22 @@ redeemAda pm txpConfig submitTx walletId accountIndex r = do getAccountAddresses :: (V0.MonadWalletLogic ctx m) - => WalletId -> AccountIndex -> m (WalletResponse AccountAddresses) -getAccountAddresses wId accIdx = - partialResponse (AccountAddresses . accAddresses) <$> getAccount wId accIdx + => WalletId + -> AccountIndex + -> RequestParams + -> FilterOperations WalletAddress + -> SortOperations WalletAddress + -> m (WalletResponse AccountAddresses) +getAccountAddresses wId accIdx pagination filters sorts = do + resp <- respondWith pagination filters sorts (getAddresses <$> getAccount wId accIdx) + return resp { wrData = AccountAddresses . wrData $ resp } + where + getAddresses = + IxSet.fromList . accAddresses . wrData getAccountBalance :: (V0.MonadWalletLogic ctx m) => WalletId -> AccountIndex -> m (WalletResponse AccountBalance) -getAccountBalance wId accIdx = - partialResponse (AccountBalance . accAmount) <$> getAccount wId accIdx - -partialResponse :: (Account -> a) -> WalletResponse Account -> WalletResponse a -partialResponse extract res = res - { wrData = extract (wrData res) - } +getAccountBalance wId accIdx = do + resp <- getAccount wId accIdx + return resp { wrData = AccountBalance . accAmount . wrData $ resp } diff --git a/wallet-new/src/Cardano/Wallet/Client.hs b/wallet-new/src/Cardano/Wallet/Client.hs index 332f142bdec..2b6d47f66fb 100644 --- a/wallet-new/src/Cardano/Wallet/Client.hs +++ b/wallet-new/src/Cardano/Wallet/Client.hs @@ -102,7 +102,13 @@ data WalletClient m , redeemAda :: WalletId -> AccountIndex -> Redemption -> Resp m Transaction , getAccountAddresses - :: WalletId -> AccountIndex -> Resp m AccountAddresses + :: WalletId + -> AccountIndex + -> Maybe Page + -> Maybe PerPage + -> FilterOperations WalletAddress + -> SortOperations WalletAddress + -> Resp m AccountAddresses , getAccountBalance :: WalletId -> AccountIndex -> Resp m AccountBalance -- transactions endpoints @@ -219,7 +225,7 @@ hoistClient phi wc = WalletClient , redeemAda = \x y -> phi . redeemAda wc x y , getAccountAddresses = - \x -> phi . getAccountAddresses wc x + \x y p pp f s -> phi $ getAccountAddresses wc x y p pp f s , getAccountBalance = \x -> phi . getAccountBalance wc x , postTransaction = diff --git a/wallet-new/src/Cardano/Wallet/Client/Http.hs b/wallet-new/src/Cardano/Wallet/Client/Http.hs index 42256cea868..37ee6215f27 100644 --- a/wallet-new/src/Cardano/Wallet/Client/Http.hs +++ b/wallet-new/src/Cardano/Wallet/Client/Http.hs @@ -119,7 +119,7 @@ mkHttpClient baseUrl manager = WalletClient , redeemAda = run ... redeemAdaR , getAccountAddresses - = \x -> run . getAccountAddressesR x + = \x y p pp filters sorts -> run $ getAccountAddressesR x y p pp filters sorts , getAccountBalance = \x -> run . getAccountBalanceR x -- transactions endpoints From 08005452f0512b171e03e180adcf38646d272a49 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Mon, 9 Jul 2018 09:30:17 +0200 Subject: [PATCH 3/4] [CO-324] Extend integration test suites for account per-field endpoint There was no integration tests for any accounts endpoints :s ... We should work on that in the future as I didn't take care of it in this commit / task, but solely add a few one for the newly added endpoints --- wallet-new/cardano-sl-wallet-new.cabal | 1 + wallet-new/integration/AccountSpecs.hs | 57 ++++++++++++++++++++++++++ wallet-new/integration/Main.hs | 19 +++++---- wallet-new/integration/Util.hs | 23 +++++++++++ 4 files changed, 92 insertions(+), 8 deletions(-) create mode 100644 wallet-new/integration/AccountSpecs.hs diff --git a/wallet-new/cardano-sl-wallet-new.cabal b/wallet-new/cardano-sl-wallet-new.cabal index b56dca1a78a..39b83489f91 100755 --- a/wallet-new/cardano-sl-wallet-new.cabal +++ b/wallet-new/cardano-sl-wallet-new.cabal @@ -328,6 +328,7 @@ executable wal-integr-test Error Util WalletSpecs + AccountSpecs AddressSpecs TransactionSpecs QuickCheckSpecs diff --git a/wallet-new/integration/AccountSpecs.hs b/wallet-new/integration/AccountSpecs.hs new file mode 100644 index 00000000000..3c899db0763 --- /dev/null +++ b/wallet-new/integration/AccountSpecs.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} + +module AccountSpecs (accountSpecs) where + +import Universum + +import Cardano.Wallet.API.Indices (accessIx) +import Cardano.Wallet.Client.Http +import Control.Lens +import Pos.Core.Common (mkCoin) +import Test.Hspec +import Util + +import qualified Pos.Core as Core +import qualified Prelude + + +accountSpecs :: WalletRef -> WalletClient IO -> Spec +accountSpecs _ wc = + describe "Accounts" $ do + it "can retrieve only an accounts balance" $ do + let zero = V1 (mkCoin 0) + (Wallet{..}, Account{..}) <- randomAccount wc + eresp <- getAccountBalance wc walId accIndex + + partialAccount <- wrData <$> eresp `shouldPrism` _Right + partialAccount `shouldBe` AccountBalance zero + + it "can retrieve only an account's addresses" $ do + pair@(Wallet{..}, Account{..}) <- randomAccount wc + addresses <- createAddresses wc 10 pair + let addr = Prelude.head addresses + let tests = + [ PaginationTest (Just 1) (Just 5) NoFilters NoSorts + (expectNAddresses 5) + , PaginationTest (Just 1) (Just 5) (filterByAddress addr) NoSorts + (expectExactlyAddresses [addr]) + , PaginationTest (Just 2) (Just 5) (filterByAddress addr) NoSorts + (expectExactlyAddresses []) + ] + + forM_ tests $ \PaginationTest{..} -> do + eresp <- getAccountAddresses wc walId accIndex page perPage filters sorts + expectations . acaAddresses . wrData =<< eresp `shouldPrism` _Right + where + filterByAddress :: WalletAddress -> FilterOperations WalletAddress + filterByAddress addr = + FilterOp (FilterByIndex $ accessIx @_ @(V1 Core.Address) addr) NoFilters + + expectNAddresses :: Int -> [WalletAddress] -> IO () + expectNAddresses n addrs = + length addrs `shouldBe` n + + expectExactlyAddresses :: [WalletAddress] -> [WalletAddress] -> IO () + expectExactlyAddresses as bs = + sort as `shouldBe` sort bs diff --git a/wallet-new/integration/Main.hs b/wallet-new/integration/Main.hs index 7bf9610bd56..42745ce7618 100644 --- a/wallet-new/integration/Main.hs +++ b/wallet-new/integration/Main.hs @@ -6,7 +6,6 @@ module Main where import Universum import Cardano.Wallet.Client.Http -import qualified Data.ByteString.Char8 as B8 import Data.Map (fromList) import Data.Traversable (for) import Data.X509.File (readSignedObject) @@ -15,20 +14,23 @@ import System.Environment (withArgs) import System.IO (hSetEncoding, stdout, utf8) import Test.Hspec +import AccountSpecs (accountSpecs) import AddressSpecs (addressSpecs) import CLI import Functions -import qualified QuickCheckSpecs as QuickCheck import TransactionSpecs (transactionSpecs) import Types import Util (WalletRef, newWalletRef) import WalletSpecs (walletSpecs) +import qualified Data.ByteString.Char8 as B8 +import qualified QuickCheckSpecs as QuickCheck + + -- | Here we want to run main when the (local) nodes -- have started. main :: IO () main = do - hSetEncoding stdout utf8 CLOptions {..} <- getOptions @@ -53,9 +55,9 @@ main = do -- some monadic fold or smth similar _ <- runActionCheck - walletClient - walletState - actionDistribution + walletClient + walletState + actionDistribution -- Acquire the initial state for the deterministic tests wRef <- newWalletRef @@ -75,7 +77,7 @@ main = do either (fail . ("Error decoding X509 certificates: " <>)) return actionDistribution :: ActionProbabilities - actionDistribution = do + actionDistribution = (PostWallet, Weight 2) :| (PostTransaction, Weight 5) : fmap (, Weight 1) [minBound .. maxBound] @@ -94,12 +96,13 @@ initialWalletState wc = do _transactions = mempty _actionsNum = 0 _successActions = mempty - pure $ WalletState {..} + return WalletState {..} where fromResp = (either throwM (pure . wrData) =<<) deterministicTests :: WalletRef -> WalletClient IO -> Manager -> Spec deterministicTests wref wc manager = do + accountSpecs wref wc addressSpecs wref wc walletSpecs wref wc transactionSpecs wref wc diff --git a/wallet-new/integration/Util.hs b/wallet-new/integration/Util.hs index 064f268f60f..39d0b31d500 100644 --- a/wallet-new/integration/Util.hs +++ b/wallet-new/integration/Util.hs @@ -13,6 +13,14 @@ import Test.QuickCheck (arbitrary, generate) type WalletRef = MVar Wallet +data PaginationTest a = PaginationTest + { page :: Maybe Page + , perPage :: Maybe PerPage + , filters :: FilterOperations a + , sorts :: SortOperations a + , expectations :: [a] -> IO () + } + randomWallet :: WalletOperation -> IO NewWallet randomWallet walletOp = generate $ @@ -29,6 +37,12 @@ randomCreateWallet = randomWallet CreateWallet randomRestoreWallet :: IO NewWallet randomRestoreWallet = randomWallet RestoreWallet +randomAccount :: WalletClient IO -> IO (Wallet, Account) +randomAccount wc = do + newWallet <- randomWallet CreateWallet + wallet@Wallet{..} <- createWalletCheck wc newWallet + (\(account, _) -> (wallet, account)) <$> firstAccountAndId wc wallet + createWalletCheck :: WalletClient IO -> NewWallet -> IO Wallet createWalletCheck wc newWallet = do result <- fmap wrData <$> postWallet wc newWallet @@ -47,6 +61,15 @@ firstAccountAndId wc wallet = do pure (toAcct, toAddr) +createAddress :: WalletClient IO -> (Wallet, Account) -> IO WalletAddress +createAddress wc (Wallet{..}, Account{..}) = do + eresp <- postAddress wc (NewAddress Nothing accIndex walId) + wrData <$> eresp `shouldPrism` _Right + +createAddresses :: WalletClient IO -> Int -> (Wallet, Account) -> IO [WalletAddress] +createAddresses wc n src = + replicateM n (createAddress wc src) + newWalletRef :: IO WalletRef newWalletRef = newEmptyMVar From 5820d558d24f930495e1b0fb4a090164cf84f8d2 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Mon, 9 Jul 2018 10:17:59 +0200 Subject: [PATCH 4/4] [CO-324] Write about partial account representations in API doc Also, this rename the balance endpoint to '/api/v1/wallets/{id}/accounts/{ix}/amount' to reflect the actual name of the field in the Account representation. --- .../src/Cardano/Wallet/API/V1/Accounts.hs | 2 +- .../src/Cardano/Wallet/API/V1/Swagger.hs | 39 +++++++++++++++---- .../Cardano/Wallet/API/V1/Swagger/Example.hs | 2 + 3 files changed, 34 insertions(+), 9 deletions(-) diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs b/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs index b5a72600a13..3255d408e55 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Accounts.hs @@ -48,7 +48,7 @@ type API :> SortBy '[V1 Core.Address] WalletAddress :> Get '[ValidJSON] (WalletResponse AccountAddresses) :<|> "wallets" :> CaptureWalletId :> "accounts" - :> CaptureAccountId :> "balance" + :> CaptureAccountId :> "amount" :> Summary "Retrieve only account's balance." :> Get '[ValidJSON] (WalletResponse AccountBalance) ) diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs b/wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs index bdd1416edb5..64f539ea43c 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs @@ -652,6 +652,27 @@ curl -X GET \ $readAccounts ``` +Partial Representations +----------------------- + +The previous endpoint gives you a list of full representations. However, in some cases, it might be interesting to retrieve only a partial representation of an account (e.g. only the balance). There are two extra endpoints one could use to either fetch a given account's balance, and another to retrieve the list of addresses associated to a specific account. + +[`GET /api/v1/wallets/{{walletId}}/accounts/{{accountId}}/addresses`](#tag/Accounts%2Fpaths%2F~1api~1v1~1wallets~1%7BwalletId%7D~1accounts~1%7BaccountId%7D~1addresses%2Fget) + +```json +$readAccountAddresses +``` + +Note that this endpoint is paginated and allow basic filtering and sorting on +addresses. Similarly, you can retrieve only the account balance with: + +[`GET /api/v1/wallets/{{walletId}}/accounts/{{accountId}}/amount`](#tag/Accounts%2Fpaths%2F~1api~1v1~1wallets~1%7BwalletId%7D~1accounts~1%7BaccountId%7D~1amount%2Fget) + + +```json +$readAccountBalance +``` + Managing Addresses ------------------ @@ -769,14 +790,16 @@ Make sure to carefully read the section about [Pagination](#section/Pagination) leverage the API capabilities. |] where - createAccount = decodeUtf8 $ encodePretty $ genExample @(WalletResponse Account) - createAddress = decodeUtf8 $ encodePretty $ genExample @(WalletResponse WalletAddress) - createWallet = decodeUtf8 $ encodePretty $ genExample @(WalletResponse Wallet) - readAccounts = decodeUtf8 $ encodePretty $ genExample @(WalletResponse [Account]) - readAddresses = decodeUtf8 $ encodePretty $ genExample @(WalletResponse [Address]) - readFees = decodeUtf8 $ encodePretty $ genExample @(WalletResponse EstimatedFees) - readNodeInfo = decodeUtf8 $ encodePretty $ genExample @(WalletResponse NodeInfo) - readTransactions = decodeUtf8 $ encodePretty $ genExample @(WalletResponse [Transaction]) + createAccount = decodeUtf8 $ encodePretty $ genExample @(WalletResponse Account) + createAddress = decodeUtf8 $ encodePretty $ genExample @(WalletResponse WalletAddress) + createWallet = decodeUtf8 $ encodePretty $ genExample @(WalletResponse Wallet) + readAccounts = decodeUtf8 $ encodePretty $ genExample @(WalletResponse [Account]) + readAccountBalance = decodeUtf8 $ encodePretty $ genExample @(WalletResponse AccountBalance) + readAccountAddresses = decodeUtf8 $ encodePretty $ genExample @(WalletResponse AccountAddresses) + readAddresses = decodeUtf8 $ encodePretty $ genExample @(WalletResponse [Address]) + readFees = decodeUtf8 $ encodePretty $ genExample @(WalletResponse EstimatedFees) + readNodeInfo = decodeUtf8 $ encodePretty $ genExample @(WalletResponse NodeInfo) + readTransactions = decodeUtf8 $ encodePretty $ genExample @(WalletResponse [Transaction]) -- | Provide an alternative UI (ReDoc) for rendering Swagger documentation. diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs b/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs index 313b57a45ad..f39854b1611 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs @@ -74,6 +74,8 @@ instance Example BackupPhrase where instance Example Address instance Example Metadata instance Example AccountIndex +instance Example AccountBalance +instance Example AccountAddresses instance Example WalletId instance Example AssuranceLevel instance Example SyncPercentage