From bc9e2140abc2f284844edab68c53fe84c4eeb46d Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Fri, 30 Oct 2020 09:35:07 +0100 Subject: [PATCH 1/6] Increase bors timeout from 2h to 3h MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It seems hydra is often slow to schedule/run the jobs. (≈18% of bors r+ it seems) It should be better to increase the timeout to 3h, than to have it fail. This doesn't affect the timeout of buildkite or hydra themselves. --- bors.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From b5faf6548168dda7de2f319621528d023dba30d0 Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Wed, 21 Oct 2020 17:42:10 +1000 Subject: [PATCH 2/6] 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 469d747b869..2a315249f35 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 71783ea5679..3e98f40d057 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 @@ -2503,15 +2503,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 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..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 193985ebe1ccec90ae41cf2e04046423f3eb549d Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Thu, 22 Oct 2020 22:29:02 +1000 Subject: [PATCH 3/6] 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 63711bd7c0948f793871b43c5db825821000ea59 Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Mon, 26 Oct 2020 16:45:56 +1000 Subject: [PATCH 4/6] 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 1443c4fddf4..57a46284cf7 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 <*> 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 -> do w <- emptyRandomWallet ctx From b8df4bec5080f2bd56ac0bfa5e1b3b8bc7f2f0dd Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Tue, 27 Oct 2020 15:18:57 +1000 Subject: [PATCH 5/6] Review rework --- .../src/Test/Integration/Scenario/API/Shelley/Transactions.hs | 2 +- lib/core/src/Cardano/Wallet/Api/Server.hs | 2 +- 2 files changed, 2 insertions(+), 2 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 57a46284cf7..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 @@ -2187,7 +2187,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/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 3e98f40d057..0a540bf6d91 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -2514,7 +2514,7 @@ instance LiftHandler ErrRemoveTx where ErrRemoveTxAlreadyInLedger tid -> apiError err403 TransactionNotPending $ 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 From 737ffd32519d29ddf792b03533bcd2966ae2bdee Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Mon, 2 Nov 2020 19:24:04 +1000 Subject: [PATCH 6/6] Review rework --- lib/core/src/Cardano/Wallet/Api/Server.hs | 2 +- lib/core/src/Cardano/Wallet/Api/Types.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 0a540bf6d91..2685d8338f5 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -2512,7 +2512,7 @@ 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 already in the ledger." ] diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index d2293e1768e..aef31968592 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -771,7 +771,7 @@ newtype ApiVerificationKey = ApiVerificationKey data ApiErrorCode = NoSuchWallet | NoSuchTransaction - | TransactionNotPending + | TransactionAlreadyInLedger | WalletAlreadyExists | NoRootKey | WrongEncryptionPassphrase