Skip to content
This repository has been archived by the owner on Aug 18, 2020. It is now read-only.

[CO-347] Wallet's UTXO histogram view #3402

Merged
Show file tree
Hide file tree
Changes from 11 commits
Commits
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: 4 additions & 0 deletions pkgs/default.nix
Original file line number Diff line number Diff line change
Expand Up @@ -17774,8 +17774,10 @@ license = stdenv.lib.licenses.mit;
, directory
, exceptions
, filepath
, foldl
, formatting
, gauge
, generic-arbitrary
, generics-sop
, hedgehog
, hspec
Expand Down Expand Up @@ -17883,6 +17885,7 @@ data-default
data-default-class
directory
exceptions
foldl
formatting
generics-sop
http-api-data
Expand Down Expand Up @@ -17997,6 +18000,7 @@ data-default
directory
filepath
formatting
generic-arbitrary
hedgehog
hspec
ixset-typed
Expand Down
6 changes: 3 additions & 3 deletions wallet-new/cardano-sl-wallet-new.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -118,6 +118,7 @@ library
Cardano.Wallet.Server.CLI
Cardano.Wallet.Server.Plugins
Cardano.Wallet.TypeLits
Cardano.Wallet.Types.UtxoStatistics
Cardano.Wallet.Client
Cardano.Wallet.Client.Http

Expand Down Expand Up @@ -161,7 +162,6 @@ library
, cardano-sl-node-ipc
, cardano-sl-util
, cardano-sl-wallet
, cardano-sl-wallet-test
, conduit
, connection
, containers
Expand All @@ -179,6 +179,7 @@ library
, http-types
, ixset-typed
, json-sop
, foldl
, lens
, log-warper
, memory
Expand Down Expand Up @@ -485,7 +486,6 @@ test-suite wallet-unit-tests
, data-default
, formatting
, hspec
, ixset-typed
, lens
, log-warper
, mtl
Expand Down Expand Up @@ -574,6 +574,7 @@ test-suite wallet-new-specs
, formatting
, hedgehog
, hspec
, generic-arbitrary
, lens
, QuickCheck
, quickcheck-instances
Expand Down Expand Up @@ -620,7 +621,6 @@ benchmark cardano-sl-wallet-new-bench
, bytestring
, cardano-sl-client
, cardano-sl-core
, cardano-sl-db
, cardano-sl-wallet
, cassava
, connection
Expand Down
48 changes: 46 additions & 2 deletions wallet-new/integration/TransactionSpecs.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,13 +8,17 @@ import Universum
import Cardano.Wallet.API.V1.Errors hiding (describe)
import Cardano.Wallet.Client.Http
import Control.Lens
import qualified Pos.Core as Core
import Test.Hspec

import Control.Concurrent (threadDelay)
import Text.Show.Pretty (ppShow)
import Util

import qualified Data.Map.Strict as Map
import qualified Pos.Core as Core
import qualified Pos.Core.Txp as Txp


{-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}

log :: MonadIO m => Text -> m ()
Expand All @@ -24,7 +28,7 @@ ppShowT :: Show a => a -> Text
ppShowT = fromString . ppShow

transactionSpecs :: WalletRef -> WalletClient IO -> Spec
transactionSpecs wRef wc = do
transactionSpecs wRef wc =
describe "Transactions" $ do
it "posted transactions appear in the index" $ do
genesis <- genesisWallet wc
Expand Down Expand Up @@ -187,3 +191,43 @@ transactionSpecs wRef wc = do
etxn <- postTransaction wc payment

void $ etxn `shouldPrism` _Left

xit "posted transactions gives rise to nonempty Utxo histogram" $ do
genesis <- genesisWallet wc
(fromAcct, _) <- firstAccountAndId wc genesis

wallet <- sampleWallet wRef wc
(_, toAddr) <- firstAccountAndId wc wallet

let payment val = Payment
{ pmtSource = PaymentSource
{ psWalletId = walId genesis
, psAccountIndex = accIndex fromAcct
}
, pmtDestinations = pure PaymentDistribution
{ pdAddress = addrId toAddr
, pdAmount = V1 (Core.mkCoin val)
}
, pmtGroupingPolicy = Nothing
, pmtSpendingPassword = Nothing
}

eresp0 <- getUtxoStatistics wc (walId wallet)
utxoStatistics0 <- fmap wrData eresp0 `shouldPrism` _Right
let utxoStatistics0Expected = computeUtxoStatistics log10 []
utxoStatistics0 `shouldBe` utxoStatistics0Expected

void $ postTransaction wc (payment 1)
threadDelay 120000000

let txIn = Txp.TxInUnknown 0 "test"
let txOut = Txp.TxOutAux Txp.TxOut
{ Txp.txOutAddress = unV1 (addrId toAddr)
, Txp.txOutValue = Core.mkCoin 1
}
let utxos = [Map.fromList [(txIn, txOut)]]

eresp <- getUtxoStatistics wc (walId wallet)
utxoStatistics <- fmap wrData eresp `shouldPrism` _Right
let utxoStatisticsExpected = computeUtxoStatistics log10 utxos
utxoStatistics `shouldBe` utxoStatisticsExpected
11 changes: 10 additions & 1 deletion wallet-new/integration/WalletSpecs.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ import Util


walletSpecs :: WalletRef -> WalletClient IO -> Spec
walletSpecs _ wc = do
walletSpecs _ wc =
describe "Wallets" $ do
it "Creating a wallet makes it available." $ do
newWallet <- randomWallet CreateWallet
Expand Down Expand Up @@ -53,6 +53,15 @@ walletSpecs _ wc = do
}

eresp `shouldPrism_` _Right

it "creating wallet gives rise to an empty Utxo histogram" $ do
newWallet <- randomWallet CreateWallet
wallet <- createWalletCheck wc newWallet

eresp <- getUtxoStatistics wc (walId wallet)
utxoStatistics <- fmap wrData eresp `shouldPrism` _Right
let utxoStatisticsExpected = computeUtxoStatistics log10 []
utxoStatistics `shouldBe` utxoStatisticsExpected
where
testWalletAlreadyExists action = do
newWallet1 <- randomWallet action
Expand Down
21 changes: 16 additions & 5 deletions wallet-new/src/Cardano/Wallet/API/V1/Handlers/Wallets.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,18 +2,18 @@ module Cardano.Wallet.API.V1.Handlers.Wallets where

import Universum

import Servant

import Cardano.Wallet.API.Request
import Cardano.Wallet.API.Response
import Cardano.Wallet.API.V1.Types as V1
import qualified Cardano.Wallet.API.V1.Wallets as Wallets

import Cardano.Wallet.WalletLayer (PassiveWalletLayer (..))
import qualified Cardano.Wallet.WalletLayer.Types as WalletLayer

import qualified Cardano.Wallet.API.V1.Wallets as Wallets
import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as KernelIxSet
import qualified Cardano.Wallet.WalletLayer.Types as WalletLayer
import qualified Data.IxSet.Typed as IxSet

import Servant

-- | All the @Servant@ handlers for wallet-specific operations.
handlers :: PassiveWalletLayer IO -> ServerT Wallets.API Handler
Expand All @@ -23,7 +23,7 @@ handlers pwl = newWallet pwl
:<|> deleteWallet pwl
:<|> getWallet pwl
:<|> updateWallet pwl

:<|> getUtxoStatistics pwl

-- | Creates a new or restores an existing @wallet@ given a 'NewWallet' payload.
-- Returns to the client the representation of the created or restored
Expand Down Expand Up @@ -97,3 +97,14 @@ updateWallet pwl wid walletUpdateRequest = do
case res of
Left e -> throwM e
Right w -> return $ single w

getUtxoStatistics
:: PassiveWalletLayer IO
-> WalletId
-> Handler (WalletResponse UtxoStatistics)
getUtxoStatistics pwl wid = do
res <- liftIO $ WalletLayer.getUtxos pwl wid
case res of
Left e -> throwM e
Right w ->
return $ single $ V1.computeUtxoStatistics V1.log10 (map snd w)
12 changes: 11 additions & 1 deletion wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,7 @@ import Pos.Wallet.Web.Methods.Logic (MonadWalletLogic,
import Pos.Wallet.Web.Tracking.Types (SyncQueue)
import Servant


-- | All the @Servant@ handlers for wallet-specific operations.
handlers :: HasConfigurations
=> ServerT Wallets.API MonadV1
Expand All @@ -41,7 +42,7 @@ handlers = newWallet
:<|> deleteWallet
:<|> getWallet
:<|> updateWallet

:<|> getUtxoStatistics

-- | Pure function which returns whether or not the underlying node is
-- \"synced enough\" to allow wallet creation/restoration. The notion of
Expand Down Expand Up @@ -185,3 +186,12 @@ updateWallet wid WalletUpdate{..} = do
-- reacquire the snapshot because we did an update
ws' <- V0.askWalletSnapshot
addWalletInfo ws' updated

-- | Gets Utxo statistics for a wallet.
-- | Stub, not calling data layer.
getUtxoStatistics
:: (MonadWalletLogic ctx m)
=> WalletId
-> m (WalletResponse UtxoStatistics)
getUtxoStatistics _ =
return $ single (V1.computeUtxoStatistics V1.log10 [])
24 changes: 21 additions & 3 deletions wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs
Original file line number Diff line number Diff line change
Expand Up @@ -733,8 +733,8 @@ curl -X POST \
--cacert ./scripts/tls-files/ca.crt \
--cert ./scripts/tls-files/client.pem \
-d '{
"walletId": "Ae2tdPwUPE...V3AVTnqGZ4",
"accountIndex": 2147483648
"walletId": "Ae2tdPwUPE...V3AVTnqGZ4",
"accountIndex": 2147483648
}'
```

Expand Down Expand Up @@ -829,6 +829,24 @@ curl -X GET 'https://127.0.0.1:8090/api/v1/transactions?wallet_id=Ae2tdPwU...3AV
--cert ./scripts/tls-files/client.pem
```


Getting Utxo statistics
---------------------------------

You can get Utxo statistics of a given wallet using
[`GET /api/v1/wallets/{{walletId}}/statistics/utxos`](#tag/Accounts%2Fpaths%2F~1api~1v1~1wallets~1{walletId}~1statistics~1utxos%2Fget)
```
curl -X GET \
https://127.0.0.1:8090/api/v1/wallets/Ae2tdPwUPE...8V3AVTnqGZ/statistics/utxos \
-H 'Accept: application/json;charset=utf-8' \
--cacert ./scripts/tls-files/ca.crt \
--cert ./scripts/tls-files/client.pem
```

```json
$readUtxoStatistics
```

Copy link
Contributor

Choose a reason for hiding this comment

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

❤️

Make sure to carefully read the section about [Pagination](#section/Pagination) to fully
leverage the API capabilities.
|]
Expand All @@ -843,7 +861,7 @@ leverage the API capabilities.
readFees = decodeUtf8 $ encodePretty $ genExample @(WalletResponse EstimatedFees)
readNodeInfo = decodeUtf8 $ encodePretty $ genExample @(WalletResponse NodeInfo)
readTransactions = decodeUtf8 $ encodePretty $ genExample @(WalletResponse [Transaction])

readUtxoStatistics = decodeUtf8 $ encodePretty $ genExample @(WalletResponse UtxoStatistics)

-- | Provide an alternative UI (ReDoc) for rendering Swagger documentation.
swaggerSchemaUIServer
Expand Down
5 changes: 5 additions & 0 deletions wallet-new/src/Cardano/Wallet/API/V1/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -87,6 +87,9 @@ module Cardano.Wallet.API.V1.Types (
, CaptureAccountId
-- * Core re-exports
, Core.Address

, module Cardano.Wallet.Types.UtxoStatistics

) where

import Universum
Expand Down Expand Up @@ -129,6 +132,7 @@ import Cardano.Wallet.API.Types.UnitOfMeasure (MeasuredIn (..),
import Cardano.Wallet.Kernel.DB.Util.IxSet (HasPrimKey (..),
IndicesOf, OrdByPrimKey, ixFun, ixList)
import Cardano.Wallet.Orphans.Aeson ()
import Cardano.Wallet.Types.UtxoStatistics

-- V0 logic
import Pos.Util.Mnemonic (Mnemonic)
Expand Down Expand Up @@ -852,6 +856,7 @@ instance BuildableSafeGen Wallet where
instance Buildable [Wallet] where
build = bprint listJson


--------------------------------------------------------------------------------
-- Addresses
--------------------------------------------------------------------------------
Expand Down
3 changes: 3 additions & 0 deletions wallet-new/src/Cardano/Wallet/API/V1/Wallets.hs
Original file line number Diff line number Diff line change
Expand Up @@ -37,4 +37,7 @@ type API = Tags '["Wallets"] :>
:> Summary "Update the Wallet identified by the given walletId."
:> ReqBody '[ValidJSON] (Update Wallet)
:> Put '[ValidJSON] (WalletResponse Wallet)
:<|> "wallets" :> CaptureWalletId :> "statistics" :> "utxos"
:> Summary "Returns Utxo statistics for the Wallet identified by the given walletId."
:> Get '[ValidJSON] (WalletResponse UtxoStatistics)
)
4 changes: 4 additions & 0 deletions wallet-new/src/Cardano/Wallet/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -88,6 +88,8 @@ data WalletClient m
:: WalletId -> Resp m Wallet
, updateWallet
:: WalletId -> Update Wallet -> Resp m Wallet
, getUtxoStatistics
:: WalletId -> Resp m UtxoStatistics
-- account endpoints
, deleteAccount
:: WalletId -> AccountIndex -> m (Either ClientError ())
Expand Down Expand Up @@ -211,6 +213,8 @@ hoistClient phi wc = WalletClient
phi . getWallet wc
, updateWallet =
\x -> phi . updateWallet wc x
, getUtxoStatistics =
phi . getUtxoStatistics wc
, deleteAccount =
\x -> phi . deleteAccount wc x
, getAccount =
Expand Down
3 changes: 3 additions & 0 deletions wallet-new/src/Cardano/Wallet/Client/Http.hs
Original file line number Diff line number Diff line change
Expand Up @@ -105,6 +105,8 @@ mkHttpClient baseUrl manager = WalletClient
= run . getWalletR
, updateWallet
= \x -> run . updateWalletR x
, getUtxoStatistics
= run . getUtxoStatisticsR
-- account endpoints
, deleteAccount
= \x -> unNoContent . run . deleteAccountR x
Expand Down Expand Up @@ -165,6 +167,7 @@ mkHttpClient baseUrl manager = WalletClient
:<|> deleteWalletR
:<|> getWalletR
:<|> updateWalletR
:<|> getUtxoStatisticsR
= walletsAPI

deleteAccountR
Expand Down
Loading