Merge pull request #3473 from input-output-hk/kderme/CBR-390

[CBR-390] Fixes TxMeta fields and tests

Author: edsko

cardano-sl-wallet-new.cabal

@@ -497,6 +497,7 @@ test-suite wallet-unit-tests
                     , cardano-sl-core-test
                     , cardano-sl-crypto
                     , cardano-sl-db
+                    , cardano-sl-networking
                     , cardano-sl-util
                     , cardano-sl-wallet-new
                     , constraints
@@ -516,6 +517,7 @@ test-suite wallet-unit-tests
                     , servant-server
                     , tabl
                     , text
+                    , time-units
                     , formatting
                     , universum
                     , unordered-containers

src/Cardano/Wallet/Kernel/DB/Resolved.hs

@@ -5,7 +5,7 @@ module Cardano.Wallet.Kernel.DB.Resolved (
   , ResolvedTx(..)
   , ResolvedBlock(..)
     -- * MetaData
-  , toTxMeta
+  , resolvedToTxMeta
     -- ** Lenses
   , rtxInputs
   , rtxOutputs
@@ -20,14 +20,13 @@ import           Universum
 import           Control.Lens.TH (makeLenses)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as Map
-import           Data.Maybe (fromJust)
 import           Formatting (bprint, (%))
 import           Formatting.Buildable
 
 import           Serokell.Util (listJson, mapJson, pairF)
 
 import qualified Pos.Chain.Txp as Core
-import           Pos.Core (SlotId, Timestamp)
+import           Pos.Core (Coin, SlotId, Timestamp)
 
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
 import           Cardano.Wallet.Kernel.DB.InDb
@@ -58,27 +57,30 @@ data ResolvedTx = ResolvedTx {
     , _rtxOutputs :: InDb Core.Utxo
 
      -- | Transaction Meta
-    , _rtxMeta    :: InDb Meta
+    , _rtxMeta    :: InDb (Core.TxId, Timestamp)
     }
 
-type Meta = (Core.TxId, Timestamp)
-
-toTxMeta :: ResolvedTx -> HD.HdAccountId -> TxMeta
-toTxMeta ResolvedTx{..} accountId =
-  fromJust mbMeta
+-- | This is used when apply block is called, during prefiltering, so related inputs
+-- and outputs to the HDAccount are known.
+-- @inCoin@ is the coins from input addresses of the account.
+-- @outCoin@ is the coins from output addresses of the account.
+-- @allOurs@ indictes if all inputs and outputs addresses belong to the account.
+resolvedToTxMeta :: ResolvedTx -> Coin -> Coin -> Bool -> HD.HdAccountId -> TxMeta
+resolvedToTxMeta ResolvedTx{..} inCoin outCoin allOurs accountId =
+  fromMaybe (error "Invalid ResolvedTx") mbMeta
   where
     mbMeta = do
       inps <- NE.nonEmpty $ mapMaybe toInpQuad $ NE.toList (_fromDb _rtxInputs)
       outs <- fromUtxo $ _fromDb _rtxOutputs
       let (txId, timestamp) = _fromDb _rtxMeta
       return TxMeta {
           _txMetaId = txId
-        , _txMetaAmount = minBound
+        , _txMetaAmount = absCoin inCoin outCoin
         , _txMetaInputs = inps
         , _txMetaOutputs = outs
         , _txMetaCreationAt = timestamp
-        , _txMetaIsLocal = False
-        , _txMetaIsOutgoing = False
+        , _txMetaIsLocal = allOurs
+        , _txMetaIsOutgoing = outCoin < inCoin
         , _txMetaWalletId = _fromDb $ HD.getHdRootId (accountId ^. HD.hdAccountIdParent)
         , _txMetaAccountIx = HD.getHdAccountIx $ accountId ^. HD.hdAccountIdIx
       }
@@ -88,7 +90,6 @@ toTxMeta ResolvedTx{..} accountId =
       let (addr, coin) = toOutPair resolvedInput
       return (txId, ix, addr, coin)
 
-
 -- | (Unsigned block) containing resolved transactions
 --
 -- NOTE: We cannot recover the original block from a 'ResolvedBlock'.

src/Cardano/Wallet/Kernel/DB/TxMeta/Types.hs

@@ -166,13 +166,12 @@ data InvariantViolation =
       | DuplicatedInputIn  Txp.TxId
       | DuplicatedOutputIn Txp.TxId
       | UndisputableLookupFailed Text
+        -- ^ The db works in a try-catch style: it always first tries to
+        -- insert data and if the PrimaryKey is already there, we catch the
+        -- exception and do the lookup. This lookup should never fail, because
+        -- the db is append only and if it`s found once, it should always
+        -- be there.
       | TxIdInvariantViolated Txp.TxId
-        -- ^ When looking up a transaction which the storage claims to be
-        -- already present as a duplicate, such lookup failed. This is an
-        -- invariant violation because a 'TxMeta' storage is append-only,
-        -- therefore the data cannot possibly be evicted, and should be there
-        -- by definition (or we wouldn't get a duplicate collision in the
-        -- first place).
       deriving Show
 
 -- | A domain-specific collection of things which might go wrong when

src/Cardano/Wallet/Kernel/Pending.hs

@@ -4,6 +4,7 @@ module Cardano.Wallet.Kernel.Pending (
   , newForeign
   , cancelPending
   , NewPendingError
+  , PartialTxMeta
   ) where
 
 import           Universum hiding (State)
@@ -14,6 +15,7 @@ import           Control.Concurrent.MVar (modifyMVar_)
 
 import           Data.Acid.Advanced (update')
 
+import           Pos.Core (Coin (..))
 import           Pos.Core.Txp (Tx (..), TxAux (..), TxOut (..))
 import           Pos.Crypto (EncryptedSecretKey)
 
@@ -30,6 +32,7 @@ import           Cardano.Wallet.Kernel.PrefilterTx (filterOurs)
 import           Cardano.Wallet.Kernel.Read (getWalletCredentials)
 import           Cardano.Wallet.Kernel.Submission (Cancelled, addPending)
 import           Cardano.Wallet.Kernel.Types (WalletId (..))
+import           Cardano.Wallet.Kernel.Util.Core
 
 import           Pos.Wallet.Web.Tracking.Decrypt (WalletDecrCredentialsKey (..),
                      keyToWalletDecrCredentials)
@@ -38,6 +41,9 @@ import           Pos.Wallet.Web.Tracking.Decrypt (WalletDecrCredentialsKey (..),
   Submit pending transactions
 -------------------------------------------------------------------------------}
 
+
+type PartialTxMeta = Bool -> Coin -> IO TxMeta
+
 -- | Submit a new pending transaction
 --
 -- If the pending transaction is successfully added to the wallet state, the
@@ -47,10 +53,10 @@ import           Pos.Wallet.Web.Tracking.Decrypt (WalletDecrCredentialsKey (..),
 newPending :: ActiveWallet
            -> HdAccountId
            -> TxAux
-           -> Maybe TxMeta
-           -> IO (Either NewPendingError ())
-newPending w accountId tx mbMeta = do
-    newTx w accountId tx mbMeta $ \ourAddrs ->
+           -> PartialTxMeta
+           -> IO (Either NewPendingError TxMeta)
+newPending w accountId tx partialMeta = do
+    newTx w accountId tx partialMeta $ \ourAddrs ->
         update' ((walletPassive w) ^. wallets) $ NewPending accountId (InDb tx) ourAddrs
 
 -- | Submit new foreign transaction
@@ -63,7 +69,7 @@ newForeign :: ActiveWallet
            -> TxMeta
            -> IO (Either NewForeignError ())
 newForeign w accountId tx meta = do
-    newTx w accountId tx (Just meta) $ \ourAddrs ->
+    map void <$> newTx w accountId tx (\_ _ -> return meta) $ \ourAddrs ->
         update' ((walletPassive w) ^. wallets) $ NewForeign accountId (InDb tx) ourAddrs
 
 -- | Submit a new transaction
@@ -78,40 +84,40 @@ newForeign w accountId tx meta = do
 newTx :: forall e. ActiveWallet
       -> HdAccountId
       -> TxAux
-      -> Maybe TxMeta
+      -> PartialTxMeta
       -> ([HdAddress] -> IO (Either e ())) -- ^ the update to run, takes ourAddrs as arg
-      -> IO (Either e ())
-newTx ActiveWallet{..} accountId tx mbMeta upd = do
+      -> IO (Either e TxMeta)
+newTx ActiveWallet{..} accountId tx partialMeta upd = do
     -- run the update
     allOurs' <- allOurs <$> getWalletCredentials walletPassive
-    res <- upd allOurs'
+    let (addrsOurs',coinsOurs) = unzip allOurs'
+        outCoins = sumCoinsUnsafe coinsOurs
+        allOutsOurs = length allOurs' == length txOut
+    res <- upd $ addrsOurs'
     case res of
         Left e   -> return (Left e)
         Right () -> do
             -- process transaction on success
-            putTxMeta' mbMeta
+            meta <- partialMeta allOutsOurs outCoins
+            putTxMeta (walletPassive ^. walletMeta) meta
             submitTx
-            return (Right ())
+            return (Right meta)
     where
-        addrs = NE.toList $ map txOutAddress (_txOutputs . taTx $ tx)
+        (txOut :: [TxOut]) = NE.toList $ (_txOutputs . taTx $ tx)
         wid   = WalletIdHdRnd (accountId ^. hdAccountIdParent)
 
         -- | NOTE: we recognise addresses in the transaction outputs that belong to _all_ wallets,
         --  not only for the wallet to which this transaction is being submitted
-        allOurs :: [(WalletId, EncryptedSecretKey)] -> [HdAddress]
+        allOurs :: [(WalletId, EncryptedSecretKey)] -> [(HdAddress,Coin)]
         allOurs = concatMap (ourAddrs . snd)
 
-        ourAddrs :: EncryptedSecretKey -> [HdAddress]
+        ourAddrs :: EncryptedSecretKey -> [(HdAddress,Coin)]
         ourAddrs esk =
-            map f $ filterOurs wKey identity addrs
+            map f $ filterOurs wKey txOutAddress txOut
             where
-                f (address,addressId) = initHdAddress addressId (InDb address)
+                f (txOut',addressId) = (initHdAddress addressId (InDb (txOutAddress txOut')), txOutValue txOut')
                 wKey = (wid, keyToWalletDecrCredentials $ KeyForRegular esk)
 
-        putTxMeta' :: Maybe TxMeta -> IO ()
-        putTxMeta' (Just meta) = putTxMeta (walletPassive ^. walletMeta) meta
-        putTxMeta' Nothing     = pure ()
-
         submitTx :: IO ()
         submitTx = modifyMVar_ (walletPassive ^. walletSubmission) $
                     return . addPending accountId (Pending.singleton tx)

src/Cardano/Wallet/Kernel/PrefilterTx.hs

@@ -25,7 +25,7 @@ import           Serokell.Util (listJson, mapJson)
 import           Data.SafeCopy (base, deriveSafeCopy)
 
 import           Pos.Chain.Txp (Utxo)
-import           Pos.Core (Address (..), SlotId)
+import           Pos.Core (Address (..), Coin, SlotId)
 import           Pos.Core.Txp (TxId, TxIn (..), TxOut (..), TxOutAux (..))
 import           Pos.Crypto (EncryptedSecretKey)
 import           Pos.Wallet.Web.State.Storage (WAddressMeta (..))
@@ -37,10 +37,11 @@ import           Cardano.Wallet.Kernel.DB.BlockMeta
 import           Cardano.Wallet.Kernel.DB.HdWallet
 import           Cardano.Wallet.Kernel.DB.InDb (InDb (..), fromDb)
 import           Cardano.Wallet.Kernel.DB.Resolved (ResolvedBlock,
-                     ResolvedInput, ResolvedTx, rbSlotId, rbTxs, rtxInputs,
-                     rtxOutputs, toTxMeta)
+                     ResolvedInput, ResolvedTx, rbSlotId, rbTxs,
+                     resolvedToTxMeta, rtxInputs, rtxOutputs)
 import           Cardano.Wallet.Kernel.DB.TxMeta.Types
 import           Cardano.Wallet.Kernel.Types (WalletId (..))
+import           Cardano.Wallet.Kernel.Util.Core
 
 {-------------------------------------------------------------------------------
  Pre-filter Tx Inputs and Outputs; pre-filter a block of transactions.
@@ -127,7 +128,7 @@ prefilterTx :: WalletKey
               , Map HdAccountId UtxoSummaryRaw)
               , [TxMeta])
             -- ^ prefiltered inputs, prefiltered output utxo, extended with address summary
-prefilterTx wKey tx = ((prefInps,prefOuts'),metas)
+prefilterTx wKey tx = ((prefInps',prefOuts'),metas)
     where
         inps = toList (tx ^. rtxInputs  . fromDb)
         outs =         tx ^. rtxOutputs . fromDb
@@ -137,22 +138,29 @@ prefilterTx wKey tx = ((prefInps,prefOuts'),metas)
 
         prefOuts' = Map.map (extendWithSummary (onlyOurInps,onlyOurOuts))
                             prefOuts
+        -- this Set.map does not change the number of elements because TxIn's are unique.
+        prefInps' = map (Set.map fst) prefInps
 
-        allAccounts = toList $ Map.keysSet prefInps <> Map.keysSet prefOuts
+        (prefInCoins  :: (Map HdAccountId Coin)) = map (sumCoinsUnsafe . map snd . Set.toList) prefInps
+        (prefOutCoins :: (Map HdAccountId Coin)) = map (\mp -> sumCoinsUnsafe $ map (toCoin . fst) mp) prefOuts'
 
-        metas = map (toTxMeta tx) allAccounts
+        allAccounts = toList $ Map.keysSet prefInps' <> Map.keysSet prefOuts
+        metas = map (\acc -> resolvedToTxMeta tx
+            (nothingToZero acc prefInCoins)
+            (nothingToZero acc prefOutCoins)
+            (onlyOurInps && onlyOurOuts) acc) allAccounts
 
 -- | Prefilter inputs of a transaction
 prefilterInputs :: WalletKey
           -> [(TxIn, ResolvedInput)]
-          -> (Bool, Map HdAccountId (Set TxIn))
+          -> (Bool, Map HdAccountId (Set (TxIn,Coin)))
 prefilterInputs wKey inps
     = prefilterResolvedTxPairs wKey mergeF inps
     where
         mergeF = Map.fromListWith Set.union . (map f)
 
-        f ((txIn, _txOut),addrId) = (addrId ^. hdAddressIdParent,
-                                     Set.singleton txIn)
+        f ((txIn, out),addrId) = (addrId ^. hdAddressIdParent,
+                                     Set.singleton (txIn, toCoin out))
 
 -- | Prefilter utxo using wallet key
 prefilterUtxo' :: WalletKey -> Utxo -> (Bool, Map HdAccountId UtxoWithAddrId)