wip

lib/core/src/Cardano/Wallet/DB.hs

@@ -226,7 +226,7 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
         -> Range SlotId
         -> stm [TransactionInfo]
         -- ^ Fetch the current transaction history of a known wallet, ordered by
-        -- descending slot number.
+        -- slot number.
         --
         -- Returns an empty list if the wallet isn't found.
 
@@ -239,14 +239,13 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
         --
         -- If the wallet doesn't exist, this operation returns an error.
 
-    , readTxHistory
+    , readTxPending
         :: PrimaryKey WalletId
-        -> Maybe (Quantity "lovelace" Natural)
         -> SortOrder
         -> Range SlotId
         -> stm [TransactionInfo]
         -- ^ Fetch the current transaction history of a known wallet, ordered by
-        -- descending slot number.
+        -- slot number first submitted.
         --
         -- Returns an empty list if the wallet isn't found.
 

lib/core/src/Cardano/Wallet/DB/Sqlite.hs

@@ -688,11 +688,16 @@ newDBLayer trace defaultFieldValues mDatabaseFile = do
                     putTxs txins txouts txws
                     pure $ Right ()
 
-        , readTxHistory = \(PrimaryKey wid) minWithdrawal order range status -> do
+        , readTxHistory = \(PrimaryKey wid) minWithdrawal order range -> do
             selectTxHistory wid minWithdrawal order $ catMaybes
                 [ (TxMetaSlot >=.) <$> W.inclusiveLowerBound range
                 , (TxMetaSlot <=.) <$> W.inclusiveUpperBound range
-                , (TxMetaStatus ==.) <$> status
+                ]
+
+        , readTxPending = \(PrimaryKey wid) order range -> do
+            selectTxPending wid order $ catMaybes
+                [ (TxPendingSlotCreated >=.) <$> W.inclusiveLowerBound range
+                , (TxPendingSlotCreated <=.) <$> W.inclusiveUpperBound range
                 ]
 
         , removePendingTx = \(PrimaryKey wid) tid -> ExceptT $ do
@@ -719,7 +724,9 @@ newDBLayer trace defaultFieldValues mDatabaseFile = do
                 Just _ -> do
                     metas <- selectTxHistory wid Nothing W.Descending
                             [ TxMetaTxId ==. (TxId tid) ]
-                    case metas of
+                    pendings <- selectTxPending wid W.Descending
+                            [ TxPendingTxId ==. (TxId tid) ]
+                    case metas ++ pendings of
                         [] -> pure (Right Nothing)
                         meta:_ -> pure (Right $ Just meta)
 
@@ -1089,6 +1096,60 @@ txHistoryFromEntity sp tip metas ins outs ws =
         , W.amount = Quantity (txMetaAmount m)
         }
 
+txHistoryFromPendingEntity
+    :: W.SlotParameters
+    -> W.BlockHeader
+    -> [TxPending]
+    -> [(TxIn, Maybe TxOut)]
+    -> [TxOut]
+    -> [W.TransactionInfo]
+txHistoryFromPendingEntity sp tip pendings ins outs =
+    map mkItem pendings
+  where
+    mkItem m = mkTxWith (txMetaTxId m) (mkTxMeta m)
+    mkTxWith txid meta = W.TransactionInfo
+        { W.txInfoId =
+            getTxId txid
+        , W.txInfoInputs =
+            map mkTxIn $ filter ((== txid) . txInputTxId . fst) ins
+        , W.txInfoOutputs =
+            map mkTxOut $ filter ((== txid) . txOutputTxId) outs
+        , W.txInfoWithdrawals =
+            Map.fromList $ map mkTxWithdrawal $ filter ((== txid) . txWithdrawalTxId) ws
+        , W.txInfoMeta =
+            meta
+        , W.txInfoDepth =
+            Quantity $ fromIntegral $ if tipH > txH then tipH - txH else 0
+        , W.txInfoTime =
+            W.slotStartTime sp (meta ^. #slotId)
+        }
+      where
+        txH  = getQuantity (meta ^. #blockHeight)
+        tipH = getQuantity (tip ^. #blockHeight)
+    mkTxIn (tx, out) =
+        ( W.TxIn
+            { W.inputId = getTxId (txInputSourceTxId tx)
+            , W.inputIx = txInputSourceIndex tx
+            }
+        , txInputSourceAmount tx
+        , mkTxOut <$> out
+        )
+    mkTxOut tx = W.TxOut
+        { W.address = txOutputAddress tx
+        , W.coin = txOutputAmount tx
+        }
+    mkTxWithdrawal w =
+        ( txWithdrawalAccount w
+        , txWithdrawalAmount w
+        )
+    mkTxMeta m = W.TxMeta
+        { W.status = txMetaStatus m
+        , W.direction = txMetaDirection m
+        , W.slotId = txMetaSlot m
+        , W.blockHeight = Quantity (txMetaBlockHeight m)
+        , W.amount = Quantity (txMetaAmount m)
+        }
+
 mkProtocolParametersEntity
     :: W.WalletId
     -> W.ProtocolParameters
@@ -1330,6 +1391,34 @@ selectTxHistory wid minWithdrawal order conditions = do
         W.Ascending -> [Asc TxMetaSlot, Desc TxMetaTxId]
         W.Descending -> [Desc TxMetaSlot, Asc TxMetaTxId]
 
+selectTxPending
+    :: W.WalletId
+    -> W.SortOrder
+    -> [Filter TxPending]
+    -> SqlPersistT IO [W.TransactionInfo]
+selectTxPending wid order conditions = do
+    selectLatestCheckpoint wid >>= \case
+        Nothing -> pure []
+        Just cp -> do
+            pendings <- fmap entityVal <$> selectList
+                ((TxPendingWalletId ==. wid):conditions)
+                sortOpt
+
+            let txids = map txPendingTxId pendings
+            (ins, outs, _) <- selectTxs txids
+
+            let wal = checkpointFromEntity cp [] ()
+            let tip = W.currentTip wal
+            let slp = W.slotParams $ W.blockchainParameters wal
+
+            return $ txHistoryFromEntity slp tip pendings ins outs
+  where
+    -- Note: The secondary sort by TxId is to make the ordering stable
+    -- so that testing with random data always works.
+    sortOpt = case order of
+        W.Ascending -> [Asc TxPendingSlotCreated, Desc TxPendingTxId]
+        W.Descending -> [Desc TxPendingSlotCreated, Asc TxPendingTxId]
+
 selectPendingTxs
     :: W.WalletId
     -> TxId

lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs

@@ -105,11 +105,12 @@ TxMeta
 -- Nothing. However, it is not removed from this table until
 -- it can never be rolled back.
 TxPending
-    txPendingTxId      TxId            sql=tx_id
-    txPendingWalletId  W.WalletId      sql=wallet_id
-    txPendingAmount    Natural         sql=amount
-    txPendingExpiry    W.SlotId        sql=expiry_slot
-    txPendingAccepted  W.SlotId Maybe  sql=accepted_slot
+    txPendingTxId          TxId            sql=tx_id
+    txPendingWalletId      W.WalletId      sql=wallet_id
+    txPendingAmount        Natural         sql=amount
+    txPendingSlotCreated   W.SlotId        sql=slot_created
+    txPendingSlotExpires   W.SlotId        sql=slot_expires
+    txPendingSlotAccepted  W.SlotId Maybe  sql=slot_accepted
 
     Primary txPendingTxId txPendingWalletId
     Foreign Wallet fk_wallet_pending_tx txPendingWalletId ! ON DELETE CASCADE