diff --git a/bors.toml b/bors.toml index 7c6afba9b17..27e5100b63b 100644 --- a/bors.toml +++ b/bors.toml @@ -2,6 +2,6 @@ status = [ "buildkite/cardano-wallet", "ci/hydra-build:required", ] -timeout_sec = 7200 +timeout_sec = 10800 required_approvals = 1 delete_merged_branches = false 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 1443c4fddf4..9e36c3bb242 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 @@ -2186,6 +2186,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 <*> 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 @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 -> do w <- emptyRandomWallet ctx 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 8e827cc73fd..d0f7f42a112 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 (..) @@ -1386,7 +1386,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 @@ -2491,18 +2491,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 3314f58b746..f783b1018ed 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -776,7 +776,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 a1b3812ab3b..adab5a13869 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -936,6 +936,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 @@ -959,8 +962,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