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

Commit 830b316

Browse files
edskoedsko
authored
Merge pull request #3473 from input-output-hk/kderme/CBR-390
[CBR-390] Fixes TxMeta fields and tests
2 parents ea2a5b6 + c5b0472 commit 830b316

File tree

13 files changed

+528
-150
lines changed

13 files changed

+528
-150
lines changed

‎pkgs/default.nix

+2
Original file line numberDiff line numberDiff line change
@@ -18017,6 +18017,7 @@ cardano-sl-core
1801718017
cardano-sl-core-test
1801818018
cardano-sl-crypto
1801918019
cardano-sl-db
18020+
cardano-sl-networking
1802018021
cardano-sl-util
1802118022
cardano-sl-util-test
1802218023
cardano-sl-wallet
@@ -18051,6 +18052,7 @@ swagger2
1805118052
tabl
1805218053
text
1805318054
time
18055+
time-units
1805418056
universum
1805518057
unordered-containers
1805618058
vector

‎wallet-new/cardano-sl-wallet-new.cabal

+2
Original file line numberDiff line numberDiff line change
@@ -497,6 +497,7 @@ test-suite wallet-unit-tests
497497
, cardano-sl-core-test
498498
, cardano-sl-crypto
499499
, cardano-sl-db
500+
, cardano-sl-networking
500501
, cardano-sl-util
501502
, cardano-sl-wallet-new
502503
, constraints
@@ -516,6 +517,7 @@ test-suite wallet-unit-tests
516517
, servant-server
517518
, tabl
518519
, text
520+
, time-units
519521
, formatting
520522
, universum
521523
, unordered-containers

‎wallet-new/src/Cardano/Wallet/Kernel/DB/Resolved.hs

+14-13
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ module Cardano.Wallet.Kernel.DB.Resolved (
55
, ResolvedTx(..)
66
, ResolvedBlock(..)
77
-- * MetaData
8-
, toTxMeta
8+
, resolvedToTxMeta
99
-- ** Lenses
1010
, rtxInputs
1111
, rtxOutputs
@@ -20,14 +20,13 @@ import Universum
2020
import Control.Lens.TH (makeLenses)
2121
import qualified Data.List.NonEmpty as NE
2222
import qualified Data.Map as Map
23-
import Data.Maybe (fromJust)
2423
import Formatting (bprint, (%))
2524
import Formatting.Buildable
2625

2726
import Serokell.Util (listJson, mapJson, pairF)
2827

2928
import qualified Pos.Chain.Txp as Core
30-
import Pos.Core (SlotId, Timestamp)
29+
import Pos.Core (Coin, SlotId, Timestamp)
3130

3231
import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
3332
import Cardano.Wallet.Kernel.DB.InDb
@@ -58,27 +57,30 @@ data ResolvedTx = ResolvedTx {
5857
, _rtxOutputs :: InDb Core.Utxo
5958

6059
-- | Transaction Meta
61-
, _rtxMeta :: InDb Meta
60+
, _rtxMeta :: InDb (Core.TxId, Timestamp)
6261
}
6362

64-
type Meta = (Core.TxId, Timestamp)
65-
66-
toTxMeta :: ResolvedTx -> HD.HdAccountId -> TxMeta
67-
toTxMeta ResolvedTx{..} accountId =
68-
fromJust mbMeta
63+
-- | This is used when apply block is called, during prefiltering, so related inputs
64+
-- and outputs to the HDAccount are known.
65+
-- @inCoin@ is the coins from input addresses of the account.
66+
-- @outCoin@ is the coins from output addresses of the account.
67+
-- @allOurs@ indictes if all inputs and outputs addresses belong to the account.
68+
resolvedToTxMeta :: ResolvedTx -> Coin -> Coin -> Bool -> HD.HdAccountId -> TxMeta
69+
resolvedToTxMeta ResolvedTx{..} inCoin outCoin allOurs accountId =
70+
fromMaybe (error "Invalid ResolvedTx") mbMeta
6971
where
7072
mbMeta = do
7173
inps <- NE.nonEmpty $ mapMaybe toInpQuad $ NE.toList (_fromDb _rtxInputs)
7274
outs <- fromUtxo $ _fromDb _rtxOutputs
7375
let (txId, timestamp) = _fromDb _rtxMeta
7476
return TxMeta {
7577
_txMetaId = txId
76-
, _txMetaAmount = minBound
78+
, _txMetaAmount = absCoin inCoin outCoin
7779
, _txMetaInputs = inps
7880
, _txMetaOutputs = outs
7981
, _txMetaCreationAt = timestamp
80-
, _txMetaIsLocal = False
81-
, _txMetaIsOutgoing = False
82+
, _txMetaIsLocal = allOurs
83+
, _txMetaIsOutgoing = outCoin < inCoin
8284
, _txMetaWalletId = _fromDb $ HD.getHdRootId (accountId ^. HD.hdAccountIdParent)
8385
, _txMetaAccountIx = HD.getHdAccountIx $ accountId ^. HD.hdAccountIdIx
8486
}
@@ -88,7 +90,6 @@ toTxMeta ResolvedTx{..} accountId =
8890
let (addr, coin) = toOutPair resolvedInput
8991
return (txId, ix, addr, coin)
9092

91-
9293
-- | (Unsigned block) containing resolved transactions
9394
--
9495
-- NOTE: We cannot recover the original block from a 'ResolvedBlock'.

‎wallet-new/src/Cardano/Wallet/Kernel/DB/TxMeta/Types.hs

+5-6
Original file line numberDiff line numberDiff line change
@@ -166,13 +166,12 @@ data InvariantViolation =
166166
| DuplicatedInputIn Txp.TxId
167167
| DuplicatedOutputIn Txp.TxId
168168
| UndisputableLookupFailed Text
169+
-- ^ The db works in a try-catch style: it always first tries to
170+
-- insert data and if the PrimaryKey is already there, we catch the
171+
-- exception and do the lookup. This lookup should never fail, because
172+
-- the db is append only and if it`s found once, it should always
173+
-- be there.
169174
| TxIdInvariantViolated Txp.TxId
170-
-- ^ When looking up a transaction which the storage claims to be
171-
-- already present as a duplicate, such lookup failed. This is an
172-
-- invariant violation because a 'TxMeta' storage is append-only,
173-
-- therefore the data cannot possibly be evicted, and should be there
174-
-- by definition (or we wouldn't get a duplicate collision in the
175-
-- first place).
176175
deriving Show
177176

178177
-- | A domain-specific collection of things which might go wrong when

‎wallet-new/src/Cardano/Wallet/Kernel/Pending.hs

+26-20
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ module Cardano.Wallet.Kernel.Pending (
44
, newForeign
55
, cancelPending
66
, NewPendingError
7+
, PartialTxMeta
78
) where
89

910
import Universum hiding (State)
@@ -14,6 +15,7 @@ import Control.Concurrent.MVar (modifyMVar_)
1415

1516
import Data.Acid.Advanced (update')
1617

18+
import Pos.Core (Coin (..))
1719
import Pos.Core.Txp (Tx (..), TxAux (..), TxOut (..))
1820
import Pos.Crypto (EncryptedSecretKey)
1921

@@ -30,6 +32,7 @@ import Cardano.Wallet.Kernel.PrefilterTx (filterOurs)
3032
import Cardano.Wallet.Kernel.Read (getWalletCredentials)
3133
import Cardano.Wallet.Kernel.Submission (Cancelled, addPending)
3234
import Cardano.Wallet.Kernel.Types (WalletId (..))
35+
import Cardano.Wallet.Kernel.Util.Core
3336

3437
import Pos.Wallet.Web.Tracking.Decrypt (WalletDecrCredentialsKey (..),
3538
keyToWalletDecrCredentials)
@@ -38,6 +41,9 @@ import Pos.Wallet.Web.Tracking.Decrypt (WalletDecrCredentialsKey (..),
3841
Submit pending transactions
3942
-------------------------------------------------------------------------------}
4043

44+
45+
type PartialTxMeta = Bool -> Coin -> IO TxMeta
46+
4147
-- | Submit a new pending transaction
4248
--
4349
-- If the pending transaction is successfully added to the wallet state, the
@@ -47,10 +53,10 @@ import Pos.Wallet.Web.Tracking.Decrypt (WalletDecrCredentialsKey (..),
4753
newPending :: ActiveWallet
4854
-> HdAccountId
4955
-> TxAux
50-
-> Maybe TxMeta
51-
-> IO (Either NewPendingError ())
52-
newPending w accountId tx mbMeta = do
53-
newTx w accountId tx mbMeta $ \ourAddrs ->
56+
-> PartialTxMeta
57+
-> IO (Either NewPendingError TxMeta)
58+
newPending w accountId tx partialMeta = do
59+
newTx w accountId tx partialMeta $ \ourAddrs ->
5460
update' ((walletPassive w) ^. wallets) $ NewPending accountId (InDb tx) ourAddrs
5561

5662
-- | Submit new foreign transaction
@@ -63,7 +69,7 @@ newForeign :: ActiveWallet
6369
-> TxMeta
6470
-> IO (Either NewForeignError ())
6571
newForeign w accountId tx meta = do
66-
newTx w accountId tx (Just meta) $ \ourAddrs ->
72+
map void <$> newTx w accountId tx (\_ _ -> return meta) $ \ourAddrs ->
6773
update' ((walletPassive w) ^. wallets) $ NewForeign accountId (InDb tx) ourAddrs
6874

6975
-- | Submit a new transaction
@@ -78,40 +84,40 @@ newForeign w accountId tx meta = do
7884
newTx :: forall e. ActiveWallet
7985
-> HdAccountId
8086
-> TxAux
81-
-> Maybe TxMeta
87+
-> PartialTxMeta
8288
-> ([HdAddress] -> IO (Either e ())) -- ^ the update to run, takes ourAddrs as arg
83-
-> IO (Either e ())
84-
newTx ActiveWallet{..} accountId tx mbMeta upd = do
89+
-> IO (Either e TxMeta)
90+
newTx ActiveWallet{..} accountId tx partialMeta upd = do
8591
-- run the update
8692
allOurs' <- allOurs <$> getWalletCredentials walletPassive
87-
res <- upd allOurs'
93+
let (addrsOurs',coinsOurs) = unzip allOurs'
94+
outCoins = sumCoinsUnsafe coinsOurs
95+
allOutsOurs = length allOurs' == length txOut
96+
res <- upd $ addrsOurs'
8897
case res of
8998
Left e -> return (Left e)
9099
Right () -> do
91100
-- process transaction on success
92-
putTxMeta' mbMeta
101+
meta <- partialMeta allOutsOurs outCoins
102+
putTxMeta (walletPassive ^. walletMeta) meta
93103
submitTx
94-
return (Right ())
104+
return (Right meta)
95105
where
96-
addrs = NE.toList $ map txOutAddress (_txOutputs . taTx $ tx)
106+
(txOut :: [TxOut]) = NE.toList $ (_txOutputs . taTx $ tx)
97107
wid = WalletIdHdRnd (accountId ^. hdAccountIdParent)
98108

99109
-- | NOTE: we recognise addresses in the transaction outputs that belong to _all_ wallets,
100110
-- not only for the wallet to which this transaction is being submitted
101-
allOurs :: [(WalletId, EncryptedSecretKey)] -> [HdAddress]
111+
allOurs :: [(WalletId, EncryptedSecretKey)] -> [(HdAddress,Coin)]
102112
allOurs = concatMap (ourAddrs . snd)
103113

104-
ourAddrs :: EncryptedSecretKey -> [HdAddress]
114+
ourAddrs :: EncryptedSecretKey -> [(HdAddress,Coin)]
105115
ourAddrs esk =
106-
map f $ filterOurs wKey identity addrs
116+
map f $ filterOurs wKey txOutAddress txOut
107117
where
108-
f (address,addressId) = initHdAddress addressId (InDb address)
118+
f (txOut',addressId) = (initHdAddress addressId (InDb (txOutAddress txOut')), txOutValue txOut')
109119
wKey = (wid, keyToWalletDecrCredentials $ KeyForRegular esk)
110120

111-
putTxMeta' :: Maybe TxMeta -> IO ()
112-
putTxMeta' (Just meta) = putTxMeta (walletPassive ^. walletMeta) meta
113-
putTxMeta' Nothing = pure ()
114-
115121
submitTx :: IO ()
116122
submitTx = modifyMVar_ (walletPassive ^. walletSubmission) $
117123
return . addPending accountId (Pending.singleton tx)

‎wallet-new/src/Cardano/Wallet/Kernel/PrefilterTx.hs

+17-9
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ import Serokell.Util (listJson, mapJson)
2525
import Data.SafeCopy (base, deriveSafeCopy)
2626

2727
import Pos.Chain.Txp (Utxo)
28-
import Pos.Core (Address (..), SlotId)
28+
import Pos.Core (Address (..), Coin, SlotId)
2929
import Pos.Core.Txp (TxId, TxIn (..), TxOut (..), TxOutAux (..))
3030
import Pos.Crypto (EncryptedSecretKey)
3131
import Pos.Wallet.Web.State.Storage (WAddressMeta (..))
@@ -37,10 +37,11 @@ import Cardano.Wallet.Kernel.DB.BlockMeta
3737
import Cardano.Wallet.Kernel.DB.HdWallet
3838
import Cardano.Wallet.Kernel.DB.InDb (InDb (..), fromDb)
3939
import Cardano.Wallet.Kernel.DB.Resolved (ResolvedBlock,
40-
ResolvedInput, ResolvedTx, rbSlotId, rbTxs, rtxInputs,
41-
rtxOutputs, toTxMeta)
40+
ResolvedInput, ResolvedTx, rbSlotId, rbTxs,
41+
resolvedToTxMeta, rtxInputs, rtxOutputs)
4242
import Cardano.Wallet.Kernel.DB.TxMeta.Types
4343
import Cardano.Wallet.Kernel.Types (WalletId (..))
44+
import Cardano.Wallet.Kernel.Util.Core
4445

4546
{-------------------------------------------------------------------------------
4647
Pre-filter Tx Inputs and Outputs; pre-filter a block of transactions.
@@ -127,7 +128,7 @@ prefilterTx :: WalletKey
127128
, Map HdAccountId UtxoSummaryRaw)
128129
, [TxMeta])
129130
-- ^ prefiltered inputs, prefiltered output utxo, extended with address summary
130-
prefilterTx wKey tx = ((prefInps,prefOuts'),metas)
131+
prefilterTx wKey tx = ((prefInps',prefOuts'),metas)
131132
where
132133
inps = toList (tx ^. rtxInputs . fromDb)
133134
outs = tx ^. rtxOutputs . fromDb
@@ -137,22 +138,29 @@ prefilterTx wKey tx = ((prefInps,prefOuts'),metas)
137138

138139
prefOuts' = Map.map (extendWithSummary (onlyOurInps,onlyOurOuts))
139140
prefOuts
141+
-- this Set.map does not change the number of elements because TxIn's are unique.
142+
prefInps' = map (Set.map fst) prefInps
140143

141-
allAccounts = toList $ Map.keysSet prefInps <> Map.keysSet prefOuts
144+
(prefInCoins :: (Map HdAccountId Coin)) = map (sumCoinsUnsafe . map snd . Set.toList) prefInps
145+
(prefOutCoins :: (Map HdAccountId Coin)) = map (\mp -> sumCoinsUnsafe $ map (toCoin . fst) mp) prefOuts'
142146

143-
metas = map (toTxMeta tx) allAccounts
147+
allAccounts = toList $ Map.keysSet prefInps' <> Map.keysSet prefOuts
148+
metas = map (\acc -> resolvedToTxMeta tx
149+
(nothingToZero acc prefInCoins)
150+
(nothingToZero acc prefOutCoins)
151+
(onlyOurInps && onlyOurOuts) acc) allAccounts
144152

145153
-- | Prefilter inputs of a transaction
146154
prefilterInputs :: WalletKey
147155
-> [(TxIn, ResolvedInput)]
148-
-> (Bool, Map HdAccountId (Set TxIn))
156+
-> (Bool, Map HdAccountId (Set (TxIn,Coin)))
149157
prefilterInputs wKey inps
150158
= prefilterResolvedTxPairs wKey mergeF inps
151159
where
152160
mergeF = Map.fromListWith Set.union . (map f)
153161

154-
f ((txIn, _txOut),addrId) = (addrId ^. hdAddressIdParent,
155-
Set.singleton txIn)
162+
f ((txIn, out),addrId) = (addrId ^. hdAddressIdParent,
163+
Set.singleton (txIn, toCoin out))
156164

157165
-- | Prefilter utxo using wallet key
158166
prefilterUtxo' :: WalletKey -> Utxo -> (Bool, Map HdAccountId UtxoWithAddrId)

0 commit comments

Comments
 (0)