Skip to content

Commit 8775410

Browse files
rvlrvl
committed
wip Add transaction expiry slot for pending transactions
1 parent 40a8b5d commit 8775410

File tree

6 files changed

+189
-48
lines changed

6 files changed

+189
-48
lines changed

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

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -287,6 +287,7 @@ import Cardano.Wallet.Primitive.Types
287287
, IsDelegatingTo (..)
288288
, NetworkParameters (..)
289289
, PassphraseScheme (..)
290+
, PendingTx
290291
, PoolId (..)
291292
, PoolLifeCycleStatus (..)
292293
, ProtocolParameters (..)
@@ -310,6 +311,7 @@ import Cardano.Wallet.Primitive.Types
310311
, computeUtxoStatistics
311312
, dlgCertPoolId
312313
, fromTransactionInfo
314+
, fromTransactionInfoPending
313315
, log10
314316
, wholeRange
315317
, withdrawals
@@ -638,13 +640,13 @@ readWallet
638640
:: forall ctx s k. HasDBLayer s k ctx
639641
=> ctx
640642
-> WalletId
641-
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
643+
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set PendingTx)
642644
readWallet ctx wid = db & \DBLayer{..} -> mapExceptT atomically $ do
643645
let pk = PrimaryKey wid
644646
cp <- withNoSuchWallet wid $ readCheckpoint pk
645647
meta <- withNoSuchWallet wid $ readWalletMeta pk
646648
pending <- lift $ readTxHistory pk Nothing Descending wholeRange (Just Pending)
647-
pure (cp, meta, Set.fromList (fromTransactionInfo <$> pending))
649+
pure (cp, meta, Set.fromList (fromTransactionInfoPending <$> pending))
648650
where
649651
db = ctx ^. dbLayer @s @k
650652

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

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -224,10 +224,9 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
224224
-> Maybe (Quantity "lovelace" Natural)
225225
-> SortOrder
226226
-> Range SlotNo
227-
-> Maybe TxStatus
228227
-> stm [TransactionInfo]
229228
-- ^ Fetch the current transaction history of a known wallet, ordered by
230-
-- descending slot number.
229+
-- slot number.
231230
--
232231
-- Returns an empty list if the wallet isn't found.
233232

@@ -240,6 +239,16 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
240239
--
241240
-- If the wallet doesn't exist, this operation returns an error.
242241

242+
, readTxPending
243+
:: PrimaryKey WalletId
244+
-> SortOrder
245+
-> Range SlotId
246+
-> stm [TransactionInfo]
247+
-- ^ Fetch the current transaction history of a known wallet, ordered by
248+
-- slot number first submitted.
249+
--
250+
-- Returns an empty list if the wallet isn't found.
251+
243252
, removePendingTx
244253
:: PrimaryKey WalletId
245254
-> Hash "Tx"

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

Lines changed: 110 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -81,6 +81,7 @@ import Cardano.Wallet.DB.Sqlite.TH
8181
, TxIn (..)
8282
, TxMeta (..)
8383
, TxOut (..)
84+
, TxPending (..)
8485
, TxWithdrawal (..)
8586
, UTxO (..)
8687
, Wallet (..)
@@ -625,16 +626,14 @@ newDBLayer trace defaultFieldValues mDatabaseFile timeInterpreter = do
625626
deleteDelegationCertificates wid
626627
[ CertSlot >. nearestPoint
627628
]
628-
updateTxMetas wid
629-
[ TxMetaDirection ==. W.Outgoing
630-
, TxMetaSlot >. nearestPoint
629+
deleteTxMetas wid
630+
[ TxMetaSlot >. nearestPoint
631631
]
632-
[ TxMetaStatus =. W.Pending
633-
, TxMetaSlot =. nearestPoint
632+
updateWhere
633+
[ TxPendingWalletId ==. wid
634+
, TxPendingAccepted >. Just nearestPoint
634635
]
635-
deleteTxMetas wid
636-
[ TxMetaDirection ==. W.Incoming
637-
, TxMetaSlot >. nearestPoint
636+
[ TxPendingAccepted =. Nothing
638637
]
639638
deleteStakeKeyCerts wid
640639
[ StakeKeyCertSlot >. nearestPoint
@@ -714,12 +713,16 @@ newDBLayer trace defaultFieldValues mDatabaseFile timeInterpreter = do
714713
putTxs txins txouts txws
715714
pure $ Right ()
716715

717-
, readTxHistory = \(PrimaryKey wid) minWithdrawal order range status -> do
718-
selectTxHistory
719-
timeInterpreter wid minWithdrawal order $ catMaybes
716+
, readTxHistory = \(PrimaryKey wid) minWithdrawal order range -> do
717+
selectTxHistory timeInterpreter wid minWithdrawal order $ catMaybes
720718
[ (TxMetaSlot >=.) <$> W.inclusiveLowerBound range
721719
, (TxMetaSlot <=.) <$> W.inclusiveUpperBound range
722-
, (TxMetaStatus ==.) <$> status
720+
]
721+
722+
, readTxPending = \(PrimaryKey wid) order range -> do
723+
selectTxPending wid order $ catMaybes
724+
[ (TxPendingSlotCreated >=.) <$> W.inclusiveLowerBound range
725+
, (TxPendingSlotCreated <=.) <$> W.inclusiveUpperBound range
723726
]
724727

725728
, removePendingTx = \(PrimaryKey wid) tid -> ExceptT $ do
@@ -732,14 +735,13 @@ newDBLayer trace defaultFieldValues mDatabaseFile timeInterpreter = do
732735
selectWallet wid >>= \case
733736
Nothing -> pure errNoSuchWallet
734737
Just _ -> do
735-
metas <- selectPendingTxs wid (TxId tid)
736-
let isPending meta = txMetaStatus meta == W.Pending
737-
case metas of
738-
[] -> pure errNoSuchTransaction
739-
txs | any isPending txs -> do
740-
deletePendingTx wid (TxId tid)
741-
pure $ Right ()
742-
_ -> pure errNoMorePending
738+
txs <- selectPendingTxs wid (TxId tid)
739+
deletePendingTx wid (TxId tid)
740+
pure $ case txs of
741+
[] -> errNoSuchTransaction
742+
txs | all (isJust . txPendingAccepted) txs ->
743+
errNoMorePending
744+
_ -> Right ()
743745

744746
, getTx = \(PrimaryKey wid) tid -> ExceptT $ do
745747
selectWallet wid >>= \case
@@ -748,7 +750,9 @@ newDBLayer trace defaultFieldValues mDatabaseFile timeInterpreter = do
748750
metas <- selectTxHistory
749751
timeInterpreter wid Nothing W.Descending
750752
[ TxMetaTxId ==. (TxId tid) ]
751-
case metas of
753+
pendings <- selectTxPending wid W.Descending
754+
[ TxPendingTxId ==. (TxId tid) ]
755+
case metas ++ pendings of
752756
[] -> pure (Right Nothing)
753757
meta:_ -> pure (Right $ Just meta)
754758

@@ -1058,7 +1062,6 @@ mkTxMetaEntity :: W.WalletId -> W.Hash "Tx" -> W.TxMeta -> TxMeta
10581062
mkTxMetaEntity wid txid meta = TxMeta
10591063
{ txMetaTxId = TxId txid
10601064
, txMetaWalletId = wid
1061-
, txMetaStatus = meta ^. #status
10621065
, txMetaDirection = meta ^. #direction
10631066
, txMetaSlot = meta ^. #slotNo
10641067
, txMetaBlockHeight = getQuantity (meta ^. #blockHeight)
@@ -1125,6 +1128,60 @@ txHistoryFromEntity ti tip metas ins outs ws =
11251128
, W.amount = Quantity (txMetaAmount m)
11261129
}
11271130

1131+
txHistoryFromPendingEntity
1132+
:: W.SlotParameters
1133+
-> W.BlockHeader
1134+
-> [TxPending]
1135+
-> [(TxIn, Maybe TxOut)]
1136+
-> [TxOut]
1137+
-> [W.TransactionInfo]
1138+
txHistoryFromPendingEntity sp tip pendings ins outs =
1139+
map mkItem pendings
1140+
where
1141+
mkItem m = mkTxWith (txMetaTxId m) (mkTxMeta m)
1142+
mkTxWith txid meta = W.TransactionInfo
1143+
{ W.txInfoId =
1144+
getTxId txid
1145+
, W.txInfoInputs =
1146+
map mkTxIn $ filter ((== txid) . txInputTxId . fst) ins
1147+
, W.txInfoOutputs =
1148+
map mkTxOut $ filter ((== txid) . txOutputTxId) outs
1149+
, W.txInfoWithdrawals =
1150+
Map.fromList $ map mkTxWithdrawal $ filter ((== txid) . txWithdrawalTxId) ws
1151+
, W.txInfoMeta =
1152+
meta
1153+
, W.txInfoDepth =
1154+
Quantity $ fromIntegral $ if tipH > txH then tipH - txH else 0
1155+
, W.txInfoTime =
1156+
W.slotStartTime sp (meta ^. #slotId)
1157+
}
1158+
where
1159+
txH = getQuantity (meta ^. #blockHeight)
1160+
tipH = getQuantity (tip ^. #blockHeight)
1161+
mkTxIn (tx, out) =
1162+
( W.TxIn
1163+
{ W.inputId = getTxId (txInputSourceTxId tx)
1164+
, W.inputIx = txInputSourceIndex tx
1165+
}
1166+
, txInputSourceAmount tx
1167+
, mkTxOut <$> out
1168+
)
1169+
mkTxOut tx = W.TxOut
1170+
{ W.address = txOutputAddress tx
1171+
, W.coin = txOutputAmount tx
1172+
}
1173+
mkTxWithdrawal w =
1174+
( txWithdrawalAccount w
1175+
, txWithdrawalAmount w
1176+
)
1177+
mkTxMeta m = W.TxMeta
1178+
{ W.status = txMetaStatus m
1179+
, W.direction = txMetaDirection m
1180+
, W.slotId = txMetaSlot m
1181+
, W.blockHeight = Quantity (txMetaBlockHeight m)
1182+
, W.amount = Quantity (txMetaAmount m)
1183+
}
1184+
11281185
mkProtocolParametersEntity
11291186
:: W.WalletId
11301187
-> W.ProtocolParameters
@@ -1208,14 +1265,6 @@ deleteStakeKeyCerts
12081265
deleteStakeKeyCerts wid filters =
12091266
deleteWhere ((StakeKeyCertWalletId ==. wid) : filters)
12101267

1211-
updateTxMetas
1212-
:: W.WalletId
1213-
-> [Filter TxMeta]
1214-
-> [Update TxMeta]
1215-
-> SqlPersistT IO ()
1216-
updateTxMetas wid filters =
1217-
updateWhere ((TxMetaWalletId ==. wid) : filters)
1218-
12191268
-- | Add new TxMeta rows, overwriting existing ones.
12201269
putTxMetas :: [TxMeta] -> SqlPersistT IO ()
12211270
putTxMetas metas = dbChunked repsertMany
@@ -1376,20 +1425,48 @@ selectTxHistory ti wid minWithdrawal order conditions = do
13761425
W.Ascending -> [Asc TxMetaSlot, Desc TxMetaTxId]
13771426
W.Descending -> [Desc TxMetaSlot, Asc TxMetaTxId]
13781427

1428+
selectTxPending
1429+
:: W.WalletId
1430+
-> W.SortOrder
1431+
-> [Filter TxPending]
1432+
-> SqlPersistT IO [W.TransactionInfo]
1433+
selectTxPending wid order conditions = do
1434+
selectLatestCheckpoint wid >>= \case
1435+
Nothing -> pure []
1436+
Just cp -> do
1437+
pendings <- fmap entityVal <$> selectList
1438+
((TxPendingWalletId ==. wid):conditions)
1439+
sortOpt
1440+
1441+
let txids = map txPendingTxId pendings
1442+
(ins, outs, _) <- selectTxs txids
1443+
1444+
let wal = checkpointFromEntity cp [] ()
1445+
let tip = W.currentTip wal
1446+
let slp = W.slotParams $ W.blockchainParameters wal
1447+
1448+
return $ txHistoryFromEntity slp tip pendings ins outs
1449+
where
1450+
-- Note: The secondary sort by TxId is to make the ordering stable
1451+
-- so that testing with random data always works.
1452+
sortOpt = case order of
1453+
W.Ascending -> [Asc TxPendingSlotCreated, Desc TxPendingTxId]
1454+
W.Descending -> [Desc TxPendingSlotCreated, Asc TxPendingTxId]
1455+
13791456
selectPendingTxs
13801457
:: W.WalletId
13811458
-> TxId
1382-
-> SqlPersistT IO [TxMeta]
1459+
-> SqlPersistT IO [TxPending]
13831460
selectPendingTxs wid tid =
13841461
fmap entityVal <$> selectList
1385-
[TxMetaWalletId ==. wid, TxMetaTxId ==. tid] []
1462+
[TxPendingWalletId ==. wid, TxPendingTxId ==. tid] []
13861463

13871464
deletePendingTx
13881465
:: W.WalletId
13891466
-> TxId
13901467
-> SqlPersistT IO ()
13911468
deletePendingTx wid tid = deleteWhere
1392-
[TxMetaWalletId ==. wid, TxMetaTxId ==. tid, TxMetaStatus ==. W.Pending ]
1469+
[TxPendingWalletId ==. wid, TxPendingTxId ==. tid]
13931470

13941471
selectPrivateKey
13951472
:: (MonadIO m, PersistPrivateKey (k 'RootK))

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

Lines changed: 21 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -90,7 +90,6 @@ PrivateKey sql=private_key
9090
TxMeta
9191
txMetaTxId TxId sql=tx_id
9292
txMetaWalletId W.WalletId sql=wallet_id
93-
txMetaStatus W.TxStatus sql=status
9493
txMetaDirection W.Direction sql=direction
9594
txMetaSlot SlotNo sql=slot
9695
txMetaBlockHeight Word32 sql=block_height
@@ -100,7 +99,26 @@ TxMeta
10099
Foreign Wallet fk_wallet_tx_meta txMetaWalletId ! ON DELETE CASCADE
101100
deriving Show Generic
102101

103-
-- A transaction input associated with TxMeta.
102+
-- Metadata for a transaction which has been submitted but has
103+
-- not yet appeared in a stable block of the ledger.
104+
--
105+
-- A transaction is removed from the wallet pending set once
106+
-- it appears in the ledger -- i.e. txPendingAccepted is not
107+
-- Nothing. However, it is not removed from this table until
108+
-- it can never be rolled back.
109+
TxPending
110+
txPendingTxId TxId sql=tx_id
111+
txPendingWalletId W.WalletId sql=wallet_id
112+
txPendingAmount Natural sql=amount
113+
txPendingSlotCreated W.SlotId sql=slot_created
114+
txPendingSlotExpires W.SlotId sql=slot_expires
115+
txPendingSlotAccepted W.SlotId Maybe sql=slot_accepted
116+
117+
Primary txPendingTxId txPendingWalletId
118+
Foreign Wallet fk_wallet_pending_tx txPendingWalletId ! ON DELETE CASCADE
119+
deriving Show Generic
120+
121+
-- A transaction input associated with TxMeta or TxPending.
104122
--
105123
-- There is no wallet ID because these values depend only on the transaction,
106124
-- not the wallet. txInputTxId is referred to by TxMeta
@@ -114,7 +132,7 @@ TxIn
114132
Primary txInputTxId txInputSourceTxId txInputSourceIndex
115133
deriving Show Generic
116134

117-
-- A transaction output associated with TxMeta.
135+
-- A transaction output associated with TxMeta or TxPending.
118136
--
119137
-- There is no wallet ID because these values depend only on the transaction,
120138
-- not the wallet. txOutputTxId is referred to by TxMeta

‎lib/core/src/Cardano/Wallet/Primitive/Model.hs

Lines changed: 11 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,7 @@ import Cardano.Wallet.Primitive.Types
6565
, Direction (..)
6666
, Dom (..)
6767
, GenesisParameters (..)
68+
, PendingTx (..)
6869
, Tx (..)
6970
, TxIn (..)
7071
, TxMeta (..)
@@ -285,14 +286,17 @@ applyBlocks (block0 :| blocks) cp =
285286
-------------------------------------------------------------------------------}
286287

287288
-- | Available balance = 'balance' . 'availableUTxO'
288-
availableBalance :: Set Tx -> Wallet s -> Natural
289+
--
290+
-- fixme: not sure whether to "infect" this module with PendingTx.
291+
-- Maybe better to extract 'pendingTx' before calling these functions.
292+
availableBalance :: Set PendingTx -> Wallet s -> Natural
289293
availableBalance pending =
290294
balance . availableUTxO pending
291295

292296
-- | Total balance = 'balance' . 'totalUTxO' +? rewards
293297
totalBalance
294298
:: IsOurs s Address
295-
=> Set Tx
299+
=> Set PendingTx
296300
-> Quantity "lovelace" Natural
297301
-> Wallet s
298302
-> Natural
@@ -306,16 +310,16 @@ totalBalance pending (Quantity rewards) s =
306310

307311
-- | Available UTxO = @pending ⋪ utxo@
308312
availableUTxO
309-
:: Set Tx
313+
:: Set PendingTx
310314
-> Wallet s
311315
-> UTxO
312316
availableUTxO pending (Wallet u _ _ _) =
313-
u `excluding` txIns pending
317+
u `excluding` txIns (Set.map pendingTx pending)
314318

315319
-- | Total UTxO = 'availableUTxO' @<>@ 'changeUTxO'
316320
totalUTxO
317321
:: IsOurs s Address
318-
=> Set Tx
322+
=> Set PendingTx
319323
-> Wallet s
320324
-> UTxO
321325
totalUTxO pending wallet@(Wallet _ _ s _) =
@@ -407,11 +411,11 @@ prefilterBlock b u0 = runState $ do
407411
-- therefore use in a read-only mode here.
408412
changeUTxO
409413
:: IsOurs s Address
410-
=> Set Tx
414+
=> Set PendingTx
411415
-> s
412416
-> UTxO
413417
changeUTxO pending = evalState $
414-
mconcat <$> mapM (state . utxoOurs) (Set.toList pending)
418+
mconcat <$> mapM (state . utxoOurs . pendingTx) (Set.toList pending)
415419

416420
-- | Construct our _next_ UTxO (possible empty) from a transaction by selecting
417421
-- outputs that are ours. It is important for the transaction outputs to be

0 commit comments

Comments
 (0)