Skip to content

Commit

Permalink
property test listAssets
Browse files Browse the repository at this point in the history
  • Loading branch information
Unisay committed Feb 17, 2022
1 parent b8bfc06 commit 35e453b
Show file tree
Hide file tree
Showing 3 changed files with 59 additions and 23 deletions.
15 changes: 9 additions & 6 deletions lib/core/src/Cardano/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -158,7 +158,7 @@ module Cardano.Wallet
-- ** Transaction
, forgetTx
, listTransactions
, extractWalletAssetsFromTxs
, listAssets
, getTransaction
, submitExternalTx
, submitTx
Expand Down Expand Up @@ -2413,22 +2413,25 @@ listTransactions ctx wid mMinWithdrawal mStart mEnd order = db & \DBLayer{..} ->
$ Range mStart mEnd

-- | Extract assets associated with a given wallet from its transaction history.
extractWalletAssetsFromTxs
listAssets
:: forall s k ctx. (HasDBLayer IO s k ctx, IsOurs s Address)
=> ctx
-> WalletId
-> [TransactionInfo]
-> ExceptT ErrNoSuchWallet IO [TokenMap.AssetId]
extractWalletAssetsFromTxs ctx wid txInfos = db & \DBLayer{..} -> do
-> ExceptT ErrNoSuchWallet IO (Set TokenMap.AssetId)
listAssets ctx wid = db & \DBLayer{..} -> do
cp <- mapExceptT atomically $ withNoSuchWallet wid $ readCheckpoint wid
txs <- lift . atomically $
let noMinWithdrawal = Nothing
allTxStatuses = Nothing
in readTxHistory wid noMinWithdrawal Ascending wholeRange allTxStatuses
let txAssets :: TransactionInfo -> Set TokenMap.AssetId
txAssets = Set.unions
. map (TokenBundle.getAssets . view #tokens)
. filter ourOut
. txInfoOutputs
ourOut TxOut {address} = ourAddress address
ourAddress addr = isJust . fst . isOurs addr $ getState cp
pure $ Set.toList $ Set.unions $ map txAssets txInfos
pure $ Set.unions $ map txAssets txs
where
db = ctx ^. dbLayer @IO @s @k

Expand Down
10 changes: 4 additions & 6 deletions lib/core/src/Cardano/Wallet/Api/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1733,20 +1733,18 @@ listAssets
-> Handler [ApiAsset]
listAssets ctx wid = do
assets <- listAssetsBase ctx wid
liftIO $ fillMetadata client assets toApiAsset
liftIO $ fillMetadata client (Set.toList assets) toApiAsset
where
client = ctx ^. tokenMetadataClient

-- | Return a list of all AssetIds involved in the transaction history of this
-- wallet.
listAssetsBase
:: forall s k. IsOurs s Address =>
ApiLayer s k -> ApiT WalletId -> Handler [AssetId]
ApiLayer s k -> ApiT WalletId -> Handler (Set AssetId)
listAssetsBase ctx (ApiT wallet) =
withWorkerCtx ctx wallet liftE liftE $ \wctx -> do
txs <- liftHandler $
W.listTransactions wctx wallet Nothing Nothing Nothing Descending
liftHandler $ W.extractWalletAssetsFromTxs wctx wallet txs
withWorkerCtx ctx wallet liftE liftE $ \wctx ->
liftHandler $ W.listAssets wctx wallet

-- | Look up a single asset and its metadata.
--
Expand Down
57 changes: 46 additions & 11 deletions lib/core/test/unit/Cardano/WalletSpec.hs
Original file line number Diff line number Diff line change
@@ -1,9 +1,11 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand Down Expand Up @@ -115,7 +117,7 @@ import Cardano.Wallet.Primitive.Types.Hash
import Cardano.Wallet.Primitive.Types.RewardAccount
( RewardAccount (..) )
import Cardano.Wallet.Primitive.Types.TokenBundle
( TokenBundle )
( TokenBundle (TokenBundle), getAssets )
import Cardano.Wallet.Primitive.Types.Tx
( Direction (..)
, LocalTxSubmissionStatus (..)
Expand Down Expand Up @@ -224,6 +226,7 @@ import Test.QuickCheck
, counterexample
, cover
, elements
, forAll
, forAllBlind
, label
, liftArbitrary
Expand Down Expand Up @@ -273,6 +276,11 @@ import qualified Cardano.Wallet.DB.Sqlite.AddressBook as Sqlite
import qualified Cardano.Wallet.Primitive.Migration as Migration
import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
import Cardano.Wallet.Primitive.Types.TokenMap.Gen
( genAssetIdLargeRange )
import Cardano.Wallet.Primitive.Types.TokenQuantity.Gen
( genTokenQuantityPositive )
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
Expand Down Expand Up @@ -322,6 +330,8 @@ spec = parallel $ describe "Cardano.WalletSpec" $ do
(withMaxSuccess 10 $ property walletKeyIsReencrypted)
it "Wallet can list transactions"
(property walletListTransactionsSorted)
it "Wallet can list assets"
(property walletListAssets)

describe "Tx fee estimation" $
it "Fee estimates are sound"
Expand Down Expand Up @@ -628,7 +638,7 @@ walletListTransactionsSorted
-> Property
walletListTransactionsSorted wallet@(wid, _, _) _order (_mstart, _mend) history =
monadicIO $ liftIO $ do
WalletLayerFixture DBLayer{..} wl _ slotNoTime <- liftIO $ setupFixture wallet
WalletLayerFixture DBLayer{..} wl _ slotNoTime <- setupFixture wallet
atomically $ unsafeRunExceptT $ putTxHistory wid history
txs <- unsafeRunExceptT $
W.listTransactions @_ @_ @_ wl wid Nothing Nothing Nothing Descending
Expand All @@ -642,6 +652,36 @@ walletListTransactionsSorted wallet@(wid, _, _) _order (_mstart, _mend) history
| (tx, meta) <- history ]
times `shouldBe` expTimes

walletListAssets
:: (WalletId, WalletName, DummyState) -> Hash "Tx" -> TxMeta -> Property
walletListAssets wallet@(wid, _, _) txId txm =
forAll genParams $ \out@TxOut{tokens} -> monadicIO $ do
WalletLayerFixture DBLayer{..} wl _ _ <- liftIO $ setupFixture wallet
let listHistoricalAssets hry = do
liftIO . atomically . unsafeRunExceptT $ putTxHistory wid hry
liftIO . unsafeRunExceptT $ W.listAssets wl wid

let tx = Tx { txId
, fee = Nothing
, resolvedCollateral = mempty
, resolvedInputs = mempty
, outputs = [out]
, metadata = mempty
, withdrawals = mempty
, scriptValidity = Nothing
}
assets <- listHistoricalAssets [ (tx, txm) ]
monitor $ counterexample $ "Discovered assets: " <> show assets
assert $ assets == getAssets tokens
where
genParams :: Gen TxOut
genParams = do
assetId <- genAssetIdLargeRange
address <- genAddress
coin <- genCoinPositive
tokenMap <- TokenMap.singleton assetId <$> genTokenQuantityPositive
pure TxOut {tokens = TokenBundle coin tokenMap, ..}

{-------------------------------------------------------------------------------
Properties of tx fee estimation
-------------------------------------------------------------------------------}
Expand Down Expand Up @@ -1048,15 +1088,10 @@ genMigrationUTxO mockTxConstraints = do
UTxO . Map.fromList <$> replicateM entryCount genUTxOEntry
where
genUTxOEntry :: Gen (TxIn, TxOut)
genUTxOEntry = (,) <$> genTxIn <*> genTxOut
where
genTxIn :: Gen TxIn
genTxIn = genTxInLargeRange

genTxOut :: Gen TxOut
genTxOut = TxOut
<$> genAddress
<*> genTokenBundleMixed mockTxConstraints
genUTxOEntry =
(,)
<$> genTxInLargeRange
<*> (TxOut <$> genAddress <*> genTokenBundleMixed mockTxConstraints)

-- Tests that user-specified target addresses are assigned to generated outputs
-- in the correct cyclical order.
Expand Down

0 comments on commit 35e453b

Please sign in to comment.