Allow deleting expired transactions from the API

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: "

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

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
 

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
 

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

lib/core/src/Cardano/Wallet/Api/Types.hs

@@ -855,7 +855,7 @@ newtype ApiVerificationKey = ApiVerificationKey
 data ApiErrorCode
     = NoSuchWallet
     | NoSuchTransaction
-    | TransactionNotPending
+    | TransactionAlreadyInLedger
     | WalletAlreadyExists
     | NoRootKey
     | WrongEncryptionPassphrase

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

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