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 a411417edbf..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 @@ -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 @@ -2220,6 +2220,46 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do txDeleteFromDifferentWalletTest emptyWallet "wallets" txDeleteFromDifferentWalletTest emptyRandomWallet "byron-wallets" + 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 + + -- 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 HTTP.status204 + + -- it should be gone + request @(ApiTransaction n) ctx linkSrc Default Empty + >>= expectResponseCode HTTP.status404 + -- yes, gone + request @(ApiTransaction n) ctx linkDel Default Empty + >>= expectResponseCode HTTP.status404 + it "BYRON_TRANS_DELETE -\ \ Cannot delete tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx 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.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..195d08e3b4f 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,18 +2510,18 @@ 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 -> - apiError err403 TransactionNotPending $ mconcat + ErrRemoveTxAlreadyInLedger tid -> + 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/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..7b43ae9062c 100644 --- a/lib/core/src/Cardano/Wallet/DB/MVar.hs +++ b/lib/core/src/Cardano/Wallet/DB/MVar.hs @@ -23,14 +23,13 @@ import Cardano.Address.Derivation import Cardano.Wallet.DB ( DBLayer (..) , ErrNoSuchWallet (..) - , ErrRemovePendingTx (..) + , ErrRemoveTx (..) , ErrWalletAlreadyExists (..) , PrimaryKey (..) ) import Cardano.Wallet.DB.Model ( Database , Err (..) - , ErrErasePendingTx (..) , ModelOp , emptyDatabase , mCheckWallet @@ -51,7 +50,7 @@ import Cardano.Wallet.DB.Model , mReadProtocolParameters , mReadTxHistory , mReadWalletMeta - , mRemovePendingTx + , mRemovePendingOrExpiredTx , mRemoveWallet , mRollbackTo , mUpdatePendingTxForExpiry @@ -178,8 +177,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 +237,13 @@ errNoSuchWallet :: Err (PrimaryKey WalletId) -> Maybe ErrNoSuchWallet errNoSuchWallet (NoSuchWallet (PrimaryKey wid)) = Just (ErrNoSuchWallet wid) errNoSuchWallet _ = Nothing -errCannotRemovePendingTx :: Err (PrimaryKey WalletId) -> Maybe ErrRemovePendingTx -errCannotRemovePendingTx (CannotRemovePendingTx (ErrErasePendingTxNoSuchWallet (PrimaryKey wid))) = - Just (ErrRemovePendingTxNoSuchWallet (ErrNoSuchWallet wid)) -errCannotRemovePendingTx (CannotRemovePendingTx (ErrErasePendingTxNoTx tid)) = - Just (ErrRemovePendingTxNoSuchTransaction tid) -errCannotRemovePendingTx (CannotRemovePendingTx (ErrErasePendingTxNoPendingTx tid)) = - Just (ErrRemovePendingTxTransactionNoMorePending tid) +errCannotRemovePendingTx :: Err (PrimaryKey WalletId) -> Maybe ErrRemoveTx +errCannotRemovePendingTx (NoSuchWallet (PrimaryKey wid)) = + Just (ErrRemoveTxNoSuchWallet (ErrNoSuchWallet wid)) +errCannotRemovePendingTx (NoSuchTx _ tid) = + Just (ErrRemoveTxNoSuchTransaction tid) +errCannotRemovePendingTx (CantRemoveTxInLedger _ 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..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 @@ -55,7 +54,7 @@ module Cardano.Wallet.DB.Model , mPutTxHistory , mReadTxHistory , mUpdatePendingTxForExpiry - , mRemovePendingTx + , mRemovePendingOrExpiredTx , mPutPrivateKey , mReadPrivateKey , mPutProtocolParameters @@ -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) {------------------------------------------------------------------------------- @@ -272,20 +266,15 @@ 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 - Nothing -> - ( Left (CannotRemovePendingTx (ErrErasePendingTxNoSuchWallet wid)), db ) - Just wal -> case Map.lookup tid (txHistory wal) of +mRemovePendingOrExpiredTx :: Ord wid => wid -> Hash "Tx" -> ModelOp wid s xprv () +mRemovePendingOrExpiredTx wid tid = alterModelErr wid $ \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 ) - else ( Left (CannotRemovePendingTx (ErrErasePendingTxNoPendingTx tid)), db ) - where - updateWallets = Map.adjust changeTxMeta wid wallets - changeTxMeta meta = meta { txHistory = Map.delete tid (txHistory meta) } + ( 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/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..6fde0dcdd1b 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 @@ -65,7 +65,6 @@ import Cardano.Wallet.DB.Arbitrary import Cardano.Wallet.DB.Model ( Database , Err (..) - , ErrErasePendingTx (..) , TxHistory , WalletDatabase (..) , emptyDatabase @@ -87,7 +86,7 @@ import Cardano.Wallet.DB.Model , mReadProtocolParameters , mReadTxHistory , mReadWalletMeta - , mRemovePendingTx + , mRemovePendingOrExpiredTx , mRemoveWallet , mRollbackTo , mUpdatePendingTxForExpiry @@ -395,7 +394,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 @@ -448,8 +447,8 @@ 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 $ - mapExceptT atomically $ removePendingTx (PrimaryKey wid) tid + RemovePendingTx wid tid -> (catchCannotRemovePendingTx wid) Unit $ + mapExceptT atomically $ removePendingOrExpiredTx (PrimaryKey wid) tid UpdatePendingTxForExpiry wid sl -> catchNoSuchWallet Unit $ mapExceptT atomically $ updatePendingTxForExpiry (PrimaryKey wid) sl PutPrivateKey wid pk -> catchNoSuchWallet Unit $ @@ -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 :: ErrRemovePendingTx -> Err WalletId - errCannotRemovePendingTx (ErrRemovePendingTxNoSuchWallet (ErrNoSuchWallet wid)) = - CannotRemovePendingTx (ErrErasePendingTxNoSuchWallet wid) - errCannotRemovePendingTx (ErrRemovePendingTxNoSuchTransaction tid) = - CannotRemovePendingTx (ErrErasePendingTxNoTx tid) - errCannotRemovePendingTx (ErrRemovePendingTxTransactionNoMorePending 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 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: