Wallet: Change transaction history to a Map TxId (TxMeta, Tx)

cardano-foundation · Apr 2, 2019 · 8d996b9 · 8d996b9
1 parent a918f26
commit 8d996b9
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 9 deletions.
diff --git a/src/Cardano/Wallet/Primitive/Model.hs b/src/Cardano/Wallet/Primitive/Model.hs
@@ -47,6 +47,7 @@ import Cardano.Wallet.Primitive.Types
     ( Block (..)
     , Direction (..)
     , Dom (..)
+    , Hash (..)
     , IsOurs (..)
     , SlotId (..)
     , Tx (..)
@@ -78,6 +79,8 @@ import Data.Maybe
     ( catMaybes )
 import Data.Set
     ( Set )
+import Data.Map
+    ( Map )
 import Data.Traversable
     ( for )
 import Numeric.Natural
@@ -101,7 +104,7 @@ data Wallet s where
         :: (IsOurs s, NFData s, Show s)
         => UTxO -- Unspent tx outputs belonging to this wallet
         -> Set Tx -- Pending transactions
-        -> Set TxMeta -- Transaction history
+        -> Map (Hash "Tx") (TxMeta, Tx) -- Transaction history
         -> SlotId -- Latest applied block (current tip)
         -> s -- Address discovery state
         -> Wallet s
@@ -135,7 +138,7 @@ applyBlock !b (cp@(Wallet !utxo !pending !txMeta _ _) :| checkpoints) =
         utxo' = (utxo <> ourUtxo) `excluding` ourIns
         pending' = updatePending b pending
         currentSlot = b ^. #header . #slotId
-        txMeta' = foldr Set.insert txMeta (blockTxMetas currentSlot ourOuts ourTxs utxo)
+        txMeta' = Map.union txMeta (blockTxMetas currentSlot ourOuts ourTxs utxo)
         cp' = Wallet utxo' pending' txMeta' currentSlot s'
     in
         -- NOTE
@@ -155,7 +158,7 @@ getState :: Wallet s -> s
 getState (Wallet _ _ _ _ s) = s
 
 -- | Get the transaction metadata for transactions associated with the wallet.
-getTxMetas :: Wallet s -> Set TxMeta
+getTxMetas :: Wallet s -> Map (Hash "Tx") (TxMeta, Tx)
 getTxMetas (Wallet _ _ txs _ _) = txs
 
 -- | Available balance = 'balance' . 'availableUTxO'
@@ -240,8 +243,9 @@ blockTxMetas
     -> Set TxOut
     -> Set Tx
     -> UTxO
-    -> Set TxMeta
-blockTxMetas slot outs txs utxo = Set.map mkTxMeta txs
+    -> Map (Hash "Tx") (TxMeta, Tx)
+blockTxMetas slot outs txs utxo =
+    Map.fromList $ map mkTxMetaAssoc $ Set.toList txs
   where
     isOutgoing tx = utxo `restrictedBy` Set.fromList (inputs tx) /= mempty
     isIncoming tx = txOutAddrs `intersects` ourOutAddrs
@@ -258,6 +262,8 @@ blockTxMetas slot outs txs utxo = Set.map mkTxMeta txs
             (_, _) -> Outgoing
         , txMetaSlotId = slot
         }
+    mkTxMetaAssoc tx = (txMetaId meta, (meta, tx))
+      where meta = mkTxMeta tx
 
 changeUTxO
     :: IsOurs s

diff --git a/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs b/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs
@@ -134,17 +134,18 @@ prop_applyBlockBasic s =
             utxo = totalUTxO wallet
             utxo' = evalState (foldM (flip updateUTxO) mempty blockchain) s
             txMeta = getTxMetas wallet
+            txMetaSet = Set.fromList $ map fst $ Map.elems txMeta
         in
             (ShowFmt utxo === ShowFmt utxo') .&&.
             (availableBalance wallet === balance utxo') .&&.
             (totalBalance wallet === balance utxo') .&&.
 
             -- TxMeta properties ... fairly trivial properties
             (cond0 ==> (
-              (Set.map direction txMeta === Set.singleton Incoming) .&&.
-              (Set.map status txMeta === Set.singleton InLedger) .&&.
-              (Set.findMin (Set.map txMetaSlotId txMeta) >=? SlotId 14 0) .&&.
-              (Set.findMax (Set.map txMetaSlotId txMeta) <=? SlotId 14 19)
+              (Set.map direction txMetaSet === Set.singleton Incoming) .&&.
+              (Set.map status txMetaSet === Set.singleton InLedger) .&&.
+              (Set.findMin (Set.map txMetaSlotId txMetaSet) >=? SlotId 14 0) .&&.
+              (Set.findMax (Set.map txMetaSlotId txMetaSet) <=? SlotId 14 19)
             ))