From 4eceb7e0703dbf0c2f443f8ccbe59f106e7e4bcc Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Wed, 21 Oct 2020 17:42:10 +1000 Subject: [PATCH 1/5] Also permit deleting expired transactions --- lib/core/src/Cardano/Wallet.hs | 22 +++--- lib/core/src/Cardano/Wallet/Api/Server.hs | 12 ++-- lib/core/src/Cardano/Wallet/DB.hs | 16 ++--- lib/core/src/Cardano/Wallet/DB/MVar.hs | 16 ++--- lib/core/src/Cardano/Wallet/DB/Model.hs | 10 +-- lib/core/src/Cardano/Wallet/DB/Sqlite.hs | 68 ++++++++++--------- .../src/Cardano/Wallet/Primitive/Types.hs | 6 ++ .../unit/Cardano/Wallet/DB/StateMachine.hs | 16 ++--- 8 files changed, 90 insertions(+), 76 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index b2c3e54f52e..23c1866be8d 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -146,7 +146,7 @@ module Cardano.Wallet , handleCannotCover -- ** Transaction - , forgetPendingTx + , forgetTx , listTransactions , getTransaction , submitExternalTx @@ -155,7 +155,7 @@ module Cardano.Wallet , ErrMkTx (..) , ErrSubmitTx (..) , ErrSubmitExternalTx (..) - , ErrRemovePendingTx (..) + , ErrRemoveTx (..) , ErrPostTx (..) , ErrDecodeSignedTx (..) , ErrListTransactions (..) @@ -198,7 +198,7 @@ import Cardano.Slotting.Slot import Cardano.Wallet.DB ( DBLayer (..) , ErrNoSuchWallet (..) - , ErrRemovePendingTx (..) + , ErrRemoveTx (..) , ErrWalletAlreadyExists (..) , PrimaryKey (..) , SparseCheckpointsConfig (..) @@ -1945,18 +1945,22 @@ submitExternalTx ctx bytes = do nw = ctx ^. networkLayer @t tl = ctx ^. transactionLayer @t @k --- | Forget pending transaction. This happens at the request of the user and --- will remove the transaction from the history. -forgetPendingTx +-- | Remove a pending or expired transaction from the transaction history. This +-- happens at the request of the user. If the transaction is already on chain, +-- or is missing from the transaction history, an error will be returned. +-- +-- If a 'Pending' transaction is removed, but later appears in a block, it will +-- be added back to the transaction history. +forgetTx :: forall ctx s k. ( HasDBLayer s k ctx ) => ctx -> WalletId -> Hash "Tx" - -> ExceptT ErrRemovePendingTx IO () -forgetPendingTx ctx wid tid = db & \DBLayer{..} -> do - mapExceptT atomically $ removePendingTx (PrimaryKey wid) tid + -> ExceptT ErrRemoveTx IO () +forgetTx ctx wid tid = db & \DBLayer{..} -> do + mapExceptT atomically $ removePendingOrExpiredTx (PrimaryKey wid) tid where db = ctx ^. dbLayer @s @k diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index d0347c150b2..d7ae5437366 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -125,7 +125,7 @@ import Cardano.Wallet , ErrPostTx (..) , ErrQuitStakePool (..) , ErrReadChimericAccount (..) - , ErrRemovePendingTx (..) + , ErrRemoveTx (..) , ErrSelectCoinsExternal (..) , ErrSelectForDelegation (..) , ErrSelectForMigration (..) @@ -1405,7 +1405,7 @@ deleteTransaction -> Handler NoContent deleteTransaction ctx (ApiT wid) (ApiTxId (ApiT (tid))) = do withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $ - W.forgetPendingTx wrk wid tid + W.forgetTx wrk wid tid return NoContent listTransactions @@ -2510,15 +2510,15 @@ instance LiftHandler ErrSubmitExternalTx where , errReasonPhrase = errReasonPhrase err400 } -instance LiftHandler ErrRemovePendingTx where +instance LiftHandler ErrRemoveTx where handler = \case - ErrRemovePendingTxNoSuchWallet wid -> handler wid - ErrRemovePendingTxNoSuchTransaction tid -> + ErrRemoveTxNoSuchWallet wid -> handler wid + ErrRemoveTxNoSuchTransaction tid -> apiError err404 NoSuchTransaction $ mconcat [ "I couldn't find a transaction with the given id: " , toText tid ] - ErrRemovePendingTxTransactionNoMorePending tid -> + ErrRemoveTxAlreadyInLedger tid -> apiError err403 TransactionNotPending $ mconcat [ "The transaction with id: ", toText tid, " cannot be forgotten as it is not pending anymore." diff --git a/lib/core/src/Cardano/Wallet/DB.hs b/lib/core/src/Cardano/Wallet/DB.hs index bae2cddb6cc..dc6747ead2b 100644 --- a/lib/core/src/Cardano/Wallet/DB.hs +++ b/lib/core/src/Cardano/Wallet/DB.hs @@ -27,7 +27,7 @@ module Cardano.Wallet.DB , gapSize -- * Errors - , ErrRemovePendingTx (..) + , ErrRemoveTx (..) , ErrNoSuchWallet(..) , ErrWalletAlreadyExists(..) ) where @@ -252,10 +252,10 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer -- ^ Removes any expired transactions from the pending set and marks -- their status as expired. - , removePendingTx + , removePendingOrExpiredTx :: PrimaryKey WalletId -> Hash "Tx" - -> ExceptT ErrRemovePendingTx stm () + -> ExceptT ErrRemoveTx stm () -- ^ Manually remove a pending transaction. , putPrivateKey @@ -310,11 +310,11 @@ newtype ErrNoSuchWallet = ErrNoSuchWallet WalletId -- Wallet is gone or doesn't exist yet deriving (Eq, Show) --- | Can't perform removing pending transaction -data ErrRemovePendingTx - = ErrRemovePendingTxNoSuchWallet ErrNoSuchWallet - | ErrRemovePendingTxNoSuchTransaction (Hash "Tx") - | ErrRemovePendingTxTransactionNoMorePending (Hash "Tx") +-- | Can't remove pending or expired transaction. +data ErrRemoveTx + = ErrRemoveTxNoSuchWallet ErrNoSuchWallet + | ErrRemoveTxNoSuchTransaction (Hash "Tx") + | ErrRemoveTxAlreadyInLedger (Hash "Tx") deriving (Eq, Show) -- | Can't perform given operation because there's no transaction diff --git a/lib/core/src/Cardano/Wallet/DB/MVar.hs b/lib/core/src/Cardano/Wallet/DB/MVar.hs index a9bbc56c3a4..ced079e244d 100644 --- a/lib/core/src/Cardano/Wallet/DB/MVar.hs +++ b/lib/core/src/Cardano/Wallet/DB/MVar.hs @@ -23,7 +23,7 @@ import Cardano.Address.Derivation import Cardano.Wallet.DB ( DBLayer (..) , ErrNoSuchWallet (..) - , ErrRemovePendingTx (..) + , ErrRemoveTx (..) , ErrWalletAlreadyExists (..) , PrimaryKey (..) ) @@ -51,7 +51,7 @@ import Cardano.Wallet.DB.Model , mReadProtocolParameters , mReadTxHistory , mReadWalletMeta - , mRemovePendingTx + , mRemovePendingOrExpiredTx , mRemoveWallet , mRollbackTo , mUpdatePendingTxForExpiry @@ -178,8 +178,8 @@ newDBLayer timeInterpreter = do , updatePendingTxForExpiry = \pk tip -> ExceptT $ do alterDB errNoSuchWallet db (mUpdatePendingTxForExpiry pk tip) - , removePendingTx = \pk tid -> ExceptT $ do - alterDB errCannotRemovePendingTx db (mRemovePendingTx pk tid) + , removePendingOrExpiredTx = \pk tid -> ExceptT $ do + alterDB errCannotRemovePendingTx db (mRemovePendingOrExpiredTx pk tid) {----------------------------------------------------------------------- Protocol Parameters @@ -238,13 +238,13 @@ errNoSuchWallet :: Err (PrimaryKey WalletId) -> Maybe ErrNoSuchWallet errNoSuchWallet (NoSuchWallet (PrimaryKey wid)) = Just (ErrNoSuchWallet wid) errNoSuchWallet _ = Nothing -errCannotRemovePendingTx :: Err (PrimaryKey WalletId) -> Maybe ErrRemovePendingTx +errCannotRemovePendingTx :: Err (PrimaryKey WalletId) -> Maybe ErrRemoveTx errCannotRemovePendingTx (CannotRemovePendingTx (ErrErasePendingTxNoSuchWallet (PrimaryKey wid))) = - Just (ErrRemovePendingTxNoSuchWallet (ErrNoSuchWallet wid)) + Just (ErrRemoveTxNoSuchWallet (ErrNoSuchWallet wid)) errCannotRemovePendingTx (CannotRemovePendingTx (ErrErasePendingTxNoTx tid)) = - Just (ErrRemovePendingTxNoSuchTransaction tid) + Just (ErrRemoveTxNoSuchTransaction tid) errCannotRemovePendingTx (CannotRemovePendingTx (ErrErasePendingTxNoPendingTx tid)) = - Just (ErrRemovePendingTxTransactionNoMorePending tid) + Just (ErrRemoveTxAlreadyInLedger tid) errCannotRemovePendingTx _ = Nothing errWalletAlreadyExists diff --git a/lib/core/src/Cardano/Wallet/DB/Model.hs b/lib/core/src/Cardano/Wallet/DB/Model.hs index 479e2d1bbd2..a188810c6d7 100644 --- a/lib/core/src/Cardano/Wallet/DB/Model.hs +++ b/lib/core/src/Cardano/Wallet/DB/Model.hs @@ -55,7 +55,7 @@ module Cardano.Wallet.DB.Model , mPutTxHistory , mReadTxHistory , mUpdatePendingTxForExpiry - , mRemovePendingTx + , mRemovePendingOrExpiredTx , mPutPrivateKey , mReadPrivateKey , mPutProtocolParameters @@ -272,20 +272,20 @@ mUpdatePendingTxForExpiry wid currentTip = alterModel wid $ \wal -> _ -> txMeta -mRemovePendingTx :: Ord wid => wid -> (Hash "Tx") -> ModelOp wid s xprv () -mRemovePendingTx wid tid db@(Database wallets txs) = case Map.lookup wid wallets of +mRemovePendingOrExpiredTx :: Ord wid => wid -> Hash "Tx" -> ModelOp wid s xprv () +mRemovePendingOrExpiredTx wid tid db@(Database wallets txs) = case Map.lookup wid wallets of Nothing -> ( Left (CannotRemovePendingTx (ErrErasePendingTxNoSuchWallet wid)), db ) Just wal -> case Map.lookup tid (txHistory wal) of Nothing -> ( Left (CannotRemovePendingTx (ErrErasePendingTxNoTx tid)), db ) Just txMeta -> - if (status :: TxMeta -> TxStatus) txMeta == Pending then - ( Right (), Database updateWallets txs ) + if isPendingOrExpired txMeta then ( Right (), Database updateWallets txs ) else ( Left (CannotRemovePendingTx (ErrErasePendingTxNoPendingTx tid)), db ) where updateWallets = Map.adjust changeTxMeta wid wallets changeTxMeta meta = meta { txHistory = Map.delete tid (txHistory meta) } + isPendingOrExpired = (/= InLedger) . (status :: TxMeta -> TxStatus) mRollbackTo :: Ord wid => wid -> SlotNo -> ModelOp wid s xprv SlotNo mRollbackTo wid requested db@(Database wallets txs) = case Map.lookup wid wallets of diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs index 603fef6b365..a9d7f377841 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs @@ -57,7 +57,7 @@ import Cardano.Wallet.DB ( DBFactory (..) , DBLayer (..) , ErrNoSuchWallet (..) - , ErrRemovePendingTx (..) + , ErrRemoveTx (..) , ErrWalletAlreadyExists (..) , PrimaryKey (..) , defaultSparseCheckpointsConfig @@ -166,6 +166,7 @@ import Database.Persist.Sql , Update (..) , deleteCascadeWhere , deleteWhere + , deleteWhereCount , insertMany_ , insert_ , rawExecute @@ -917,24 +918,22 @@ newDBLayer trace defaultFieldValues mDatabaseFile timeInterpreter = do updatePendingTxForExpiryQuery wid tip pure $ Right () - , removePendingTx = \(PrimaryKey wid) tid -> ExceptT $ do + , removePendingOrExpiredTx = \(PrimaryKey wid) tid -> ExceptT $ do let errNoSuchWallet = - Left $ ErrRemovePendingTxNoSuchWallet $ ErrNoSuchWallet wid + Left $ ErrRemoveTxNoSuchWallet $ ErrNoSuchWallet wid let errNoMorePending = - Left $ ErrRemovePendingTxTransactionNoMorePending tid + Left $ ErrRemoveTxAlreadyInLedger tid let errNoSuchTransaction = - Left $ ErrRemovePendingTxNoSuchTransaction tid + Left $ ErrRemoveTxNoSuchTransaction tid selectWallet wid >>= \case Nothing -> pure errNoSuchWallet - Just _ -> do - metas <- selectPendingTxs wid (TxId tid) - let isPending meta = txMetaStatus meta == W.Pending - case metas of - [] -> pure errNoSuchTransaction - txs | any isPending txs -> do - deletePendingTx wid (TxId tid) - pure $ Right () - _ -> pure errNoMorePending + Just _ -> selectTxMeta wid tid >>= \case + Nothing -> pure errNoSuchTransaction + Just _ -> do + count <- deletePendingOrExpiredTx wid tid + pure $ if count == 0 + then errNoMorePending + else Right () , getTx = \(PrimaryKey wid) tid -> ExceptT $ do selectLatestCheckpoint wid >>= \case @@ -1573,26 +1572,31 @@ selectTxHistory cp ti wid minWithdrawal order conditions = do W.Ascending -> [Asc TxMetaSlot, Desc TxMetaTxId] W.Descending -> [Desc TxMetaSlot, Asc TxMetaTxId] -selectPendingTxs +selectTxMeta :: W.WalletId - -> TxId - -> SqlPersistT IO [TxMeta] -selectPendingTxs wid tid = - fmap entityVal <$> selectList - [TxMetaWalletId ==. wid, TxMetaTxId ==. tid] [] - -deletePendingTx + -> W.Hash "Tx" + -> SqlPersistT IO (Maybe TxMeta) +selectTxMeta wid tid = + fmap entityVal <$> selectFirst + [ TxMetaWalletId ==. wid, TxMetaTxId ==. (TxId tid)] + [ Desc TxMetaSlot ] + +-- | Delete the transaction, but only if it's not in ledger. +-- Returns non-zero if this was a success. +deletePendingOrExpiredTx :: W.WalletId - -> TxId - -> SqlPersistT IO () -deletePendingTx wid tid = do - deleteWhere - [ TxMetaWalletId ==. wid, TxMetaTxId ==. tid - , TxMetaStatus ==. W.Pending ] - --- Mutates all pending transaction entries which have exceeded their TTL so that --- their status becomes expired. Transaction expiry is not something which can --- be rolled back. + -> W.Hash "Tx" + -> SqlPersistT IO Int +deletePendingOrExpiredTx wid tid = do + let filt = [ TxMetaWalletId ==. wid, TxMetaTxId ==. (TxId tid) ] + selectFirst ((TxMetaStatus ==. W.InLedger):filt) [] >>= \case + Just _ -> pure 0 -- marked in ledger - refuse to delete + Nothing -> fromIntegral <$> deleteWhereCount + ((TxMetaStatus <-. [W.Pending, W.Expired]):filt) + +-- | Mutates all pending transaction entries which have exceeded their TTL so +-- that their status becomes expired. Transaction expiry is not something which +-- can be rolled back. updatePendingTxForExpiryQuery :: W.WalletId -> W.SlotNo diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index f2efe82d4e9..6059383578b 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -946,6 +946,9 @@ instance Buildable TxOut where instance Buildable (TxIn, TxOut) where build (txin, txout) = build txin <> " ==> " <> build txout +-- | Additional information about a transaction, derived from the transaction +-- and ledger state. This should not be confused with 'TxMetadata' which is +-- application-specific data included with the transaction. data TxMeta = TxMeta { status :: !TxStatus , direction :: !Direction @@ -969,8 +972,11 @@ instance Buildable TxMeta where data TxStatus = Pending + -- ^ Created, but not yet in a block. | InLedger + -- ^ Has been found in a block. | Expired + -- ^ Time to live (TTL) has passed. deriving (Show, Eq, Ord, Bounded, Enum, Generic) instance NFData TxStatus diff --git a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs index c80133d97f0..e18cd97bf90 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs @@ -55,7 +55,7 @@ import Cardano.Address.Derivation import Cardano.Wallet.DB ( DBLayer (..) , ErrNoSuchWallet (..) - , ErrRemovePendingTx (..) + , ErrRemoveTx (..) , ErrWalletAlreadyExists (..) , PrimaryKey (..) , cleanDB @@ -87,7 +87,7 @@ import Cardano.Wallet.DB.Model , mReadProtocolParameters , mReadTxHistory , mReadWalletMeta - , mRemovePendingTx + , mRemovePendingOrExpiredTx , mRemoveWallet , mRollbackTo , mUpdatePendingTxForExpiry @@ -395,7 +395,7 @@ runMock = \case RollbackTo wid sl -> first (Resp . fmap Point) . mRollbackTo wid sl RemovePendingTx wid tid -> - first (Resp . fmap Unit) . mRemovePendingTx wid tid + first (Resp . fmap Unit) . mRemovePendingOrExpiredTx wid tid UpdatePendingTxForExpiry wid sl -> first (Resp . fmap Unit) . mUpdatePendingTxForExpiry wid sl where @@ -449,7 +449,7 @@ runIO db@DBLayer{..} = fmap Resp . go ReadTxHistory wid minWith order range status -> Right . TxHistory <$> atomically (readTxHistory (PrimaryKey wid) minWith order range status) RemovePendingTx wid tid -> catchCannotRemovePendingTx Unit $ - mapExceptT atomically $ removePendingTx (PrimaryKey wid) tid + mapExceptT atomically $ removePendingOrExpiredTx (PrimaryKey wid) tid UpdatePendingTxForExpiry wid sl -> catchNoSuchWallet Unit $ mapExceptT atomically $ updatePendingTxForExpiry (PrimaryKey wid) sl PutPrivateKey wid pk -> catchNoSuchWallet Unit $ @@ -480,12 +480,12 @@ runIO db@DBLayer{..} = fmap Resp . go errWalletAlreadyExists :: ErrWalletAlreadyExists -> Err WalletId errWalletAlreadyExists (ErrWalletAlreadyExists wid) = WalletAlreadyExists wid - errCannotRemovePendingTx :: ErrRemovePendingTx -> Err WalletId - errCannotRemovePendingTx (ErrRemovePendingTxNoSuchWallet (ErrNoSuchWallet wid)) = + errCannotRemovePendingTx :: ErrRemoveTx -> Err WalletId + errCannotRemovePendingTx (ErrRemoveTxNoSuchWallet (ErrNoSuchWallet wid)) = CannotRemovePendingTx (ErrErasePendingTxNoSuchWallet wid) - errCannotRemovePendingTx (ErrRemovePendingTxNoSuchTransaction tid) = + errCannotRemovePendingTx (ErrRemoveTxNoSuchTransaction tid) = CannotRemovePendingTx (ErrErasePendingTxNoTx tid) - errCannotRemovePendingTx (ErrRemovePendingTxTransactionNoMorePending tid) = + errCannotRemovePendingTx (ErrRemoveTxAlreadyInLedger tid) = CannotRemovePendingTx (ErrErasePendingTxNoPendingTx tid) unPrimaryKey :: PrimaryKey key -> key From 594d7c39abe4a71401fe06c7fdad565c512f80a4 Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Thu, 22 Oct 2020 22:29:02 +1000 Subject: [PATCH 2/5] Simplify mRemovePendingTx model and state machine --- lib/core/src/Cardano/Wallet/DB/MVar.hs | 7 ++- lib/core/src/Cardano/Wallet/DB/Model.hs | 50 ++++++++++--------- .../unit/Cardano/Wallet/DB/StateMachine.hs | 21 ++++---- 3 files changed, 40 insertions(+), 38 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/DB/MVar.hs b/lib/core/src/Cardano/Wallet/DB/MVar.hs index ced079e244d..7b43ae9062c 100644 --- a/lib/core/src/Cardano/Wallet/DB/MVar.hs +++ b/lib/core/src/Cardano/Wallet/DB/MVar.hs @@ -30,7 +30,6 @@ import Cardano.Wallet.DB import Cardano.Wallet.DB.Model ( Database , Err (..) - , ErrErasePendingTx (..) , ModelOp , emptyDatabase , mCheckWallet @@ -239,11 +238,11 @@ errNoSuchWallet (NoSuchWallet (PrimaryKey wid)) = Just (ErrNoSuchWallet wid) errNoSuchWallet _ = Nothing errCannotRemovePendingTx :: Err (PrimaryKey WalletId) -> Maybe ErrRemoveTx -errCannotRemovePendingTx (CannotRemovePendingTx (ErrErasePendingTxNoSuchWallet (PrimaryKey wid))) = +errCannotRemovePendingTx (NoSuchWallet (PrimaryKey wid)) = Just (ErrRemoveTxNoSuchWallet (ErrNoSuchWallet wid)) -errCannotRemovePendingTx (CannotRemovePendingTx (ErrErasePendingTxNoTx tid)) = +errCannotRemovePendingTx (NoSuchTx _ tid) = Just (ErrRemoveTxNoSuchTransaction tid) -errCannotRemovePendingTx (CannotRemovePendingTx (ErrErasePendingTxNoPendingTx tid)) = +errCannotRemovePendingTx (CantRemoveTxInLedger _ tid) = Just (ErrRemoveTxAlreadyInLedger tid) errCannotRemovePendingTx _ = Nothing diff --git a/lib/core/src/Cardano/Wallet/DB/Model.hs b/lib/core/src/Cardano/Wallet/DB/Model.hs index a188810c6d7..cae21b836be 100644 --- a/lib/core/src/Cardano/Wallet/DB/Model.hs +++ b/lib/core/src/Cardano/Wallet/DB/Model.hs @@ -38,7 +38,6 @@ module Cardano.Wallet.DB.Model -- * Model Operation Types , ModelOp , Err (..) - , ErrErasePendingTx (..) -- * Model database functions , mCleanDB , mInitializeWallet @@ -183,13 +182,8 @@ type ModelOp wid s xprv a = data Err wid = NoSuchWallet wid | WalletAlreadyExists wid - | CannotRemovePendingTx (ErrErasePendingTx wid) - deriving (Show, Eq, Functor, Foldable, Traversable) - -data ErrErasePendingTx wid - = ErrErasePendingTxNoSuchWallet wid - | ErrErasePendingTxNoTx (Hash "Tx") - | ErrErasePendingTxNoPendingTx (Hash "Tx") + | NoSuchTx wid (Hash "Tx") + | CantRemoveTxInLedger wid (Hash "Tx") deriving (Show, Eq, Functor, Foldable, Traversable) {------------------------------------------------------------------------------- @@ -273,19 +267,14 @@ mUpdatePendingTxForExpiry wid currentTip = alterModel wid $ \wal -> txMeta mRemovePendingOrExpiredTx :: Ord wid => wid -> Hash "Tx" -> ModelOp wid s xprv () -mRemovePendingOrExpiredTx wid tid db@(Database wallets txs) = case Map.lookup wid wallets of - Nothing -> - ( Left (CannotRemovePendingTx (ErrErasePendingTxNoSuchWallet wid)), db ) - Just wal -> case Map.lookup tid (txHistory wal) of +mRemovePendingOrExpiredTx wid tid = alterModelErr wid $ \wal -> + case Map.lookup tid (txHistory wal) of Nothing -> - ( Left (CannotRemovePendingTx (ErrErasePendingTxNoTx tid)), db ) - Just txMeta -> - if isPendingOrExpired txMeta then ( Right (), Database updateWallets txs ) - else ( Left (CannotRemovePendingTx (ErrErasePendingTxNoPendingTx tid)), db ) - where - updateWallets = Map.adjust changeTxMeta wid wallets - changeTxMeta meta = meta { txHistory = Map.delete tid (txHistory meta) } - isPendingOrExpired = (/= InLedger) . (status :: TxMeta -> TxStatus) + ( Left (NoSuchTx wid tid), wal ) + Just txMeta | txMeta ^. #status == InLedger -> + ( Left (CantRemoveTxInLedger wid tid), wal ) + Just _ -> + ( Right (), wal { txHistory = Map.delete tid (txHistory wal) } ) mRollbackTo :: Ord wid => wid -> SlotNo -> ModelOp wid s xprv SlotNo mRollbackTo wid requested db@(Database wallets txs) = case Map.lookup wid wallets of @@ -508,14 +497,29 @@ mReadDelegationRewardBalance wid db@(Database wallets _) = Model function helpers -------------------------------------------------------------------------------} +-- | Create a 'ModelOp' which mutates the database for a certain wallet id. +-- +-- The given function returns a value and a modified wallet database. alterModel :: Ord wid => wid -> (WalletDatabase s xprv -> (a, WalletDatabase s xprv)) -> ModelOp wid s xprv a -alterModel wid f db@Database{wallets,txs} = case f <$> Map.lookup wid wallets of - Just (a, wal) -> (Right a, Database (Map.insert wid wal wallets) txs) - Nothing -> (Left (NoSuchWallet wid), db) +alterModel wid f = alterModelErr wid (first Right . f) + +-- | Create a 'ModelOp' which mutates the database for a certain wallet id. +-- +-- The given function returns a either a value or error, and a modified wallet +-- database. +alterModelErr + :: Ord wid + => wid + -> (WalletDatabase s xprv -> (Either (Err wid) a, WalletDatabase s xprv)) + -> ModelOp wid s xprv a +alterModelErr wid f db@Database{wallets,txs} = + case f <$> Map.lookup wid wallets of + Just (a, wal) -> (a, Database (Map.insert wid wal wallets) txs) + Nothing -> (Left (NoSuchWallet wid), db) -- | Apply optional filters on slotNo and sort using the default sort order -- (first time/slotNo, then by TxId) to a 'TxHistory'. diff --git a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs index e18cd97bf90..6fde0dcdd1b 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs @@ -65,7 +65,6 @@ import Cardano.Wallet.DB.Arbitrary import Cardano.Wallet.DB.Model ( Database , Err (..) - , ErrErasePendingTx (..) , TxHistory , WalletDatabase (..) , emptyDatabase @@ -448,7 +447,7 @@ runIO db@DBLayer{..} = fmap Resp . go mapExceptT atomically $ putTxHistory (PrimaryKey wid) txs ReadTxHistory wid minWith order range status -> Right . TxHistory <$> atomically (readTxHistory (PrimaryKey wid) minWith order range status) - RemovePendingTx wid tid -> catchCannotRemovePendingTx Unit $ + RemovePendingTx wid tid -> (catchCannotRemovePendingTx wid) Unit $ mapExceptT atomically $ removePendingOrExpiredTx (PrimaryKey wid) tid UpdatePendingTxForExpiry wid sl -> catchNoSuchWallet Unit $ mapExceptT atomically $ updatePendingTxForExpiry (PrimaryKey wid) sl @@ -471,8 +470,8 @@ runIO db@DBLayer{..} = fmap Resp . go fmap (bimap errWalletAlreadyExists f) . runExceptT catchNoSuchWallet f = fmap (bimap errNoSuchWallet f) . runExceptT - catchCannotRemovePendingTx f = - fmap (bimap errCannotRemovePendingTx f) . runExceptT + catchCannotRemovePendingTx wid f = + fmap (bimap (errCannotRemovePendingTx wid) f) . runExceptT errNoSuchWallet :: ErrNoSuchWallet -> Err WalletId errNoSuchWallet (ErrNoSuchWallet wid) = NoSuchWallet wid @@ -480,13 +479,13 @@ runIO db@DBLayer{..} = fmap Resp . go errWalletAlreadyExists :: ErrWalletAlreadyExists -> Err WalletId errWalletAlreadyExists (ErrWalletAlreadyExists wid) = WalletAlreadyExists wid - errCannotRemovePendingTx :: ErrRemoveTx -> Err WalletId - errCannotRemovePendingTx (ErrRemoveTxNoSuchWallet (ErrNoSuchWallet wid)) = - CannotRemovePendingTx (ErrErasePendingTxNoSuchWallet wid) - errCannotRemovePendingTx (ErrRemoveTxNoSuchTransaction tid) = - CannotRemovePendingTx (ErrErasePendingTxNoTx tid) - errCannotRemovePendingTx (ErrRemoveTxAlreadyInLedger tid) = - CannotRemovePendingTx (ErrErasePendingTxNoPendingTx tid) + errCannotRemovePendingTx :: WalletId -> ErrRemoveTx -> Err WalletId + errCannotRemovePendingTx _ (ErrRemoveTxNoSuchWallet e) = + errNoSuchWallet e + errCannotRemovePendingTx wid (ErrRemoveTxNoSuchTransaction tid) = + NoSuchTx wid tid + errCannotRemovePendingTx wid (ErrRemoveTxAlreadyInLedger tid) = + CantRemoveTxInLedger wid tid unPrimaryKey :: PrimaryKey key -> key unPrimaryKey (PrimaryKey key) = key From 9cee2c68e64071da2ffd0512396fe285cdaca5a4 Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Mon, 26 Oct 2020 16:45:56 +1000 Subject: [PATCH 3/5] Add integration test for deleting expired transactions --- .../Scenario/API/Shelley/Transactions.hs | 39 +++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index a411417edbf..7f70b2a3414 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -2220,6 +2220,45 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do txDeleteFromDifferentWalletTest emptyWallet "wallets" txDeleteFromDifferentWalletTest emptyRandomWallet "byron-wallets" + it "TRANS_TTL_DELETE_01 - Shelley: can remove expired tx" $ \ctx -> do + (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx + let amt = minUTxOValue :: Natural + + -- this transaction is going to expire really soon. + basePayload <- mkTxPayload ctx wb amt fixturePassphrase + let payload = addTxTTL 0.1 basePayload + + ra <- request @(ApiTransaction n) ctx + (Link.createTransaction @'Shelley wa) Default payload + + expectSuccess ra + + let txid = ApiTxId (getFromResponse #id ra) + let linkSrc = Link.getTransaction @'Shelley wa txid + + rb <- eventually "transaction is no longer pending" $ do + rr <- request @(ApiTransaction n) ctx linkSrc Default Empty + verify rr + [ expectSuccess + , expectField (#status . #getApiT) (`shouldNotBe` Pending) + ] + pure rr + + -- it should be expired + expectField (#status . #getApiT) (`shouldBe` Expired) rb + + -- remove it + let linkDel = Link.deleteTransaction @'Shelley wa txid + request @(ApiTransaction n) ctx linkDel Default Empty + >>= expectResponseCode @IO HTTP.status204 + + -- it should be gone + request @(ApiTransaction n) ctx linkSrc Default Empty + >>= expectResponseCode @IO HTTP.status404 + -- yes, gone + request @(ApiTransaction n) ctx linkDel Default Empty + >>= expectResponseCode @IO HTTP.status404 + it "BYRON_TRANS_DELETE -\ \ Cannot delete tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx From 77ca6c8924119217989e80cb0ac278fba61165e4 Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Tue, 27 Oct 2020 15:18:57 +1000 Subject: [PATCH 4/5] Review rework --- .../src/Test/Integration/Framework/TestData.hs | 8 ++++---- .../Integration/Scenario/API/Shelley/Transactions.hs | 6 +++--- .../Integration/Scenario/CLI/Shelley/Transactions.hs | 4 ++-- lib/core/src/Cardano/Wallet/Api/Server.hs | 4 ++-- lib/core/src/Cardano/Wallet/Api/Types.hs | 2 +- .../Jormungandr/Scenario/CLI/Transactions.hs | 4 ++-- specifications/api/swagger.yaml | 10 +++++----- 7 files changed, 19 insertions(+), 19 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs index 6fcbc5c4ebc..f766e98748d 100644 --- a/lib/core-integration/src/Test/Integration/Framework/TestData.hs +++ b/lib/core-integration/src/Test/Integration/Framework/TestData.hs @@ -44,7 +44,7 @@ module Test.Integration.Framework.TestData , errMsg403NotEnoughMoney , errMsg403NotEnoughMoney_ , errMsg403WrongPass - , errMsg403NoPendingAnymore + , errMsg403AlreadyInLedger , errMsg404NoSuchPool , errMsg403PoolAlreadyJoined , errMsg403NotDelegating @@ -351,9 +351,9 @@ errMsg404NoEndpoint = "I couldn't find the requested endpoint. If the endpoint\ \ contains path parameters, please ensure they are well-formed, otherwise I\ \ won't be able to route them correctly." -errMsg403NoPendingAnymore :: Text -> String -errMsg403NoPendingAnymore tid = "The transaction with id: " ++ unpack tid ++ - " cannot be forgotten as it is not pending anymore." +errMsg403AlreadyInLedger :: Text -> String +errMsg403AlreadyInLedger tid = "The transaction with id: " ++ unpack tid ++ + " cannot be forgotten as it is already in the ledger." errMsg404NoSuchPool :: Text -> String errMsg404NoSuchPool pid = "I couldn't find any stake pool with the given id: " diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index 7f70b2a3414..3f444d501f9 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -148,9 +148,9 @@ import Test.Integration.Framework.TestData ( errMsg400MinWithdrawalWrong , errMsg400StartTimeLaterThanEndTime , errMsg400TxMetadataStringTooLong + , errMsg403AlreadyInLedger , errMsg403Fee , errMsg403InputsDepleted - , errMsg403NoPendingAnymore , errMsg403NotAShelleyWallet , errMsg403NotEnoughMoney , errMsg403NotEnoughMoney_ @@ -2208,7 +2208,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do let ep = Link.deleteTransaction @'Shelley wSrc (ApiTxId txid) rDel <- request @ApiTxId ctx ep Default Empty expectResponseCode HTTP.status403 rDel - let err = errMsg403NoPendingAnymore (toUrlPiece (ApiTxId txid)) + let err = errMsg403AlreadyInLedger (toUrlPiece (ApiTxId txid)) expectErrorMessage err rDel describe "TRANS_DELETE_03 - checking no transaction id error for " $ do @@ -2221,7 +2221,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do txDeleteFromDifferentWalletTest emptyRandomWallet "byron-wallets" it "TRANS_TTL_DELETE_01 - Shelley: can remove expired tx" $ \ctx -> do - (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx + (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx let amt = minUTxOValue :: Natural -- this transaction is going to expire really soon. diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs index c5feb22cc4f..f014bf30a88 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs @@ -103,7 +103,7 @@ import Test.Integration.Framework.DSL ) import Test.Integration.Framework.TestData ( arabicWalletName - , errMsg403NoPendingAnymore + , errMsg403AlreadyInLedger , errMsg403WrongPass , errMsg404CannotFindTx , errMsg404NoWallet @@ -749,7 +749,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do -- Try Forget transaction once it's no longer pending (Exit c2, Stdout out2, Stderr err2) <- deleteTransactionViaCLI @t ctx wSrcId txId - err2 `shouldContain` errMsg403NoPendingAnymore (T.pack txId) + err2 `shouldContain` errMsg403AlreadyInLedger (T.pack txId) out2 `shouldBe` "" c2 `shouldBe` ExitFailure 1 diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index d7ae5437366..195d08e3b4f 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -2519,9 +2519,9 @@ instance LiftHandler ErrRemoveTx where , toText tid ] ErrRemoveTxAlreadyInLedger tid -> - apiError err403 TransactionNotPending $ mconcat + apiError err403 TransactionAlreadyInLedger $ mconcat [ "The transaction with id: ", toText tid, - " cannot be forgotten as it is not pending anymore." + " cannot be forgotten as it is already in the ledger." ] instance LiftHandler ErrPostTx where diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index d69d4aa7f6a..a78ec3fce31 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -855,7 +855,7 @@ newtype ApiVerificationKey = ApiVerificationKey data ApiErrorCode = NoSuchWallet | NoSuchTransaction - | TransactionNotPending + | TransactionAlreadyInLedger | WalletAlreadyExists | NoRootKey | WrongEncryptionPassphrase diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs index 37deec4c1e4..4af580ae8a0 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs @@ -64,7 +64,7 @@ import Test.Integration.Framework.DSL import Test.Integration.Framework.TestData ( errMsg400MalformedTxPayload , errMsg400WronglyEncodedTxPayload - , errMsg403NoPendingAnymore + , errMsg403AlreadyInLedger ) import Test.Integration.Jormungandr.Scenario.API.Transactions ( ExternalTxFixture (..), fixtureExternalTx, getWalletBalance ) @@ -203,6 +203,6 @@ spec = do -- Try to forget external tx (Exit c2, Stdout out2, Stderr err2) <- deleteTransactionViaCLI @t ctx (T.unpack $ w ^. walletId) txid - err2 `shouldContain` errMsg403NoPendingAnymore (T.pack txid) + err2 `shouldContain` errMsg403AlreadyInLedger (T.pack txid) out2 `shouldBe` "" c2 `shouldBe` ExitFailure 1 diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 25d4474d3cb..5fcecfef2b7 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -2105,16 +2105,16 @@ x-errNoSuchTransaction: &errNoSuchTransaction type: string enum: ['no_such_transaction'] -x-errTransactionNotPending: &errTransactionNotPending +x-errTransactionAlreadyInLedger: &errTransactionAlreadyInLedger <<: *responsesErr - title: transaction_not_pending + title: transaction_already_in_ledger properties: message: type: string - description: May occur when trying to forget a transaction that is not pending. + description: Occurs when attempting to delete a transaction which is neither pending nor expired. code: type: string - enum: ['transaction_not_pending'] + enum: ['transaction_already_in_ledger'] x-errWalletAlreadyExists: &errWalletAlreadyExists <<: *responsesErr @@ -2815,7 +2815,7 @@ x-responsesDeleteTransaction: &responsesDeleteTransaction description: Forbidden content: application/json: - schema: *errTransactionNotPending + schema: *errTransactionAlreadyInLedger 404: description: Not Found content: From d9da8682c18834864622c4da7ba53a35bee9afae Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Fri, 6 Nov 2020 18:51:47 +1000 Subject: [PATCH 5/5] Mark test TRANS_TTL_DELETE_01 pending For the same reason as TRANS_TTL_03. --- .../Integration/Scenario/API/Shelley/Transactions.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index 3f444d501f9..30b8f47fe71 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -2220,7 +2220,8 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do txDeleteFromDifferentWalletTest emptyWallet "wallets" txDeleteFromDifferentWalletTest emptyRandomWallet "byron-wallets" - it "TRANS_TTL_DELETE_01 - Shelley: can remove expired tx" $ \ctx -> do + it "TRANS_TTL_DELETE_01 - Shelley: can remove expired tx" $ \ctx -> runResourceT $ do + liftIO $ pendingWith "#1840 this is flaky -- need a better approach" (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx let amt = minUTxOValue :: Natural @@ -2250,14 +2251,14 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do -- remove it let linkDel = Link.deleteTransaction @'Shelley wa txid request @(ApiTransaction n) ctx linkDel Default Empty - >>= expectResponseCode @IO HTTP.status204 + >>= expectResponseCode HTTP.status204 -- it should be gone request @(ApiTransaction n) ctx linkSrc Default Empty - >>= expectResponseCode @IO HTTP.status404 + >>= expectResponseCode HTTP.status404 -- yes, gone request @(ApiTransaction n) ctx linkDel Default Empty - >>= expectResponseCode @IO HTTP.status404 + >>= expectResponseCode HTTP.status404 it "BYRON_TRANS_DELETE -\ \ Cannot delete tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do