Skip to content
Permalink
Browse files

Discard pending txs in isolation property & account for them in state…

…-machine when reading checkpoint

Pending transactions can actually be inserted independently of the
wallet checkpoints. So, if we insert a checkpoint after we inserted
some pending txs, reading that checkpoint again should yield those
pending txs.
  • Loading branch information...
KtorZ committed Jun 12, 2019
1 parent ba673d4 commit 9ae58b816fe092b339fbac0489210386446b87c6
@@ -625,7 +625,6 @@ deleteLooseTransactions = do
"LEFT OUTER JOIN tx_meta ON tx_meta.tx_id = "<> t <>".tx_id " <>
"WHERE (tx_meta.tx_id IS NULL))"


selectLatestCheckpoint
:: W.WalletId
-> SqlPersistM (Maybe Checkpoint)
@@ -41,6 +41,7 @@ module Cardano.Wallet.Primitive.Types
, TxStatus(..)
, TxWitness (..)
, txIns
, isPending

-- * Address
, Address (..)
@@ -474,6 +475,10 @@ data TxWitness
-- ^ Used to redeem ADA from the pre-sale
deriving (Eq, Show)

-- | True if the given tuple refers to a pending transaction
isPending :: (Tx, TxMeta) -> Bool
isPending = (== Pending) . (status :: TxMeta -> TxStatus) . snd

{-------------------------------------------------------------------------------
Address
-------------------------------------------------------------------------------}
@@ -59,9 +59,15 @@ import Cardano.Wallet.Primitive.AddressDerivation
import Cardano.Wallet.Primitive.AddressDiscovery
( SeqState (..) )
import Cardano.Wallet.Primitive.Model
( Wallet )
( Wallet, currentTip, getPending, getState, unsafeInitWallet, utxo )
import Cardano.Wallet.Primitive.Types
( Hash (..), Tx (..), TxMeta (..), WalletId (..), WalletMetadata (..) )
( Hash (..)
, Tx (..)
, TxMeta (..)
, WalletId (..)
, WalletMetadata (..)
, isPending
)
import Control.Foldl
( Fold (..) )
import Control.Monad.IO.Class
@@ -220,7 +226,18 @@ mPutCheckpoint wid wal m@(M cp metas txs pk)
| otherwise = (Left (NoSuchWallet wid), m)

mReadCheckpoint :: MWid -> MockOp (Maybe MWallet)
mReadCheckpoint wid m@(M cp _ _ _) = (Right (Map.lookup wid cp), m)
mReadCheckpoint wid m@(M cp _ txs _) =
(Right (withPendingTxs <$> Map.lookup wid cp), m)
where
pending = maybe
mempty
(Set.fromList . fmap fst . Map.elems . Map.filter isPending)
(Map.lookup wid txs)
withPendingTxs c = unsafeInitWallet
(utxo c)
(getPending c <> pending)
(currentTip c)
(getState c)

mPutWalletMeta :: MWid -> WalletMetadata -> MockOp ()
mPutWalletMeta wid meta m@(M cp metas txs pk)
@@ -85,6 +85,7 @@ import Cardano.Wallet.Primitive.Types
, WalletName (..)
, WalletPassphraseInfo (..)
, WalletState (..)
, isPending
)
import Control.Concurrent.Async
( forConcurrently_ )
@@ -728,7 +729,7 @@ dbPropertyTests = do
readPrivateKey)
)
it "Tx History vs Checkpoint & Wallet Metadata & Private Key"
(property . (prop_isolation putTxHistoryF
(property . discardPending (prop_isolation putTxHistoryF
readCheckpoint
readWalletMeta
readPrivateKey)
@@ -767,6 +768,19 @@ dbPropertyTests = do
it "Private Key"
(checkCoverage . (prop_parallelPut putPrivateKey readPrivateKey
(length . lrp @Maybe)))
where
-- NOTE
-- For the isolation property, we discard pending transaction since
-- inserting a pending transaction actually has an effect on the
-- checkpoint's pending transactions of a same wallet.
discardPending
:: (db -> (k, GenTxHistory) -> Property)
-> db
-> (k, GenTxHistory)
-> Property
discardPending prop db (wid, GenTxHistory txs) =
let txs' = Map.filter (not . isPending) txs
in prop db (wid, GenTxHistory txs')

-- | Provide a DBLayer to a Spec that requires it. The database is initialised
-- once, and cleared with 'cleanDB' before each test.

0 comments on commit 9ae58b8

Please sign in to comment.
You can’t perform that action at this time.