Fix Metadata Inconsistency After Wallet or Account Deletion

src/Cardano/Wallet/Kernel/DB/Sqlite.hs

@@ -18,6 +18,7 @@ module Cardano.Wallet.Kernel.DB.Sqlite (
     , putTxMeta
     , getTxMeta
     , getTxMetas
+    , deleteTxMetas
 
     -- * Unsafe functions
     , unsafeMigrateMetaDB
@@ -447,6 +448,34 @@ clearMetaDB conn = do
 putTxMeta :: Sqlite.Connection -> Kernel.TxMeta -> IO ()
 putTxMeta conn txMeta = void $ putTxMetaT conn txMeta
 
+-- | Clear some metadata from the database
+deleteTxMetas
+    :: Sqlite.Connection
+        -- | Database Handle
+    -> Core.Address
+        -- | Target wallet
+    -> Maybe Word32
+        -- |  A target account index. If none, delete metas for all accounts
+    -> IO ()
+deleteTxMetas conn walletId mAccountIx = do
+    runBeamSqlite conn $ SQL.runDelete $ SQL.delete (_mDbMeta metaDB) $ \meta ->
+        conditionWalletId meta &&. conditionAccountIx meta
+  where
+    conditionWalletId
+        :: TxMetaT (SQL.QExpr SqliteExpressionSyntax s)
+        -> SQL.QGenExpr SQL.QValueContext SqliteExpressionSyntax s Bool
+    conditionWalletId meta =
+        _txMetaTableWalletId meta ==. SQL.val_ walletId
+    conditionAccountIx
+        :: TxMetaT (SQL.QExpr SqliteExpressionSyntax s)
+        -> SQL.QGenExpr SQL.QValueContext SqliteExpressionSyntax s Bool
+    conditionAccountIx meta = case mAccountIx of
+        Nothing ->
+            SQL.val_ True
+        Just ix ->
+            _txMetaTableAccountIx meta ==. SQL.val_ ix
+
+
 -- | Inserts a new 'Kernel.TxMeta' in the database, given its opaque
 -- 'MetaDBHandle'.
 putTxMetaT :: Sqlite.Connection -> Kernel.TxMeta -> IO Kernel.PutReturn
@@ -469,17 +498,16 @@ putTxMetaT conn txMeta =
                 -- This is the only acceptable exception here. If anything else is thrown, that`s an error.
                 t <- getTxMetasById conn txId
                 case (Kernel.txIdIsomorphic txMeta <$> t) of
-                    Nothing   ->
-                        -- Output is there but not TxMeta. This should never happen.
-                        -- This could be improved with foreign keys, which indicate
-                        -- the existence of at least one Meta entry for each Output.
-                        throwIO $ Kernel.InvariantViolated (Kernel.UndisputableLookupFailed "txId")
                     Just False ->
                         -- This violation means the Tx has same TxId but different
                         -- Inputs (as set) or Outputs (ordered).
                         throwIO $ Kernel.InvariantViolated (Kernel.TxIdInvariantViolated txId)
-                    Just True  -> do
-                        -- If there not a  TxId violation, we can try to insert TxMeta.
+                    _  -> do
+                        -- If there is not a  TxId violation, we can try to insert TxMeta.
+                        -- We handle Nothing and (Just True) the same here, since
+                        -- it's possible that there is no Meta with this Inputs/Outputs.
+                        -- In the future we may consider doing a better cleanup to avoid
+                        -- such cases.
                         res2 <- Sqlite.runDBAction $ runBeamSqlite conn $
                                     SQL.runInsert $ SQL.insert (_mDbMeta metaDB) $ SQL.insertValues [tMeta]
                         case res2 of

src/Cardano/Wallet/Kernel/DB/TxMeta.hs

@@ -24,6 +24,7 @@ openMetaDB fp = do
           closeMetaDB   = withMVar lock ConcreteStorage.closeMetaDB
         , migrateMetaDB = withMVar lock ConcreteStorage.unsafeMigrateMetaDB
         , clearMetaDB   = withMVar lock ConcreteStorage.clearMetaDB
+        , deleteTxMetas = \w a   -> withMVar lock $ \c -> ConcreteStorage.deleteTxMetas c w a
         , getTxMeta     = \t w a -> withMVar lock $ \c -> ConcreteStorage.getTxMeta c t w a
         , putTxMeta     = \ t    -> withMVar lock $ \c -> ConcreteStorage.putTxMeta c t
         , putTxMetaT    = \ t    -> withMVar lock $ \c -> ConcreteStorage.putTxMetaT c t

src/Cardano/Wallet/Kernel/DB/TxMeta/Types.hs

@@ -292,6 +292,7 @@ data MetaDBHandle = MetaDBHandle {
       closeMetaDB   :: IO ()
     , migrateMetaDB :: IO ()
     , clearMetaDB   :: IO ()
+    , deleteTxMetas :: Core.Address -> Maybe Word32 -> IO ()
     , getTxMeta     :: Txp.TxId -> Core.Address -> Word32 -> IO (Maybe TxMeta)
     , putTxMeta     :: TxMeta -> IO ()
     , putTxMetaT    :: TxMeta -> IO PutReturn

src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs

@@ -22,7 +22,9 @@ import           Cardano.Wallet.API.V1.Types (V1 (..), WalletAddress)
 import qualified Cardano.Wallet.API.V1.Types as V1
 import qualified Cardano.Wallet.Kernel.Accounts as Kernel
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
+import           Cardano.Wallet.Kernel.DB.InDb (fromDb)
 import           Cardano.Wallet.Kernel.DB.Read (addressesByAccountId)
+import qualified Cardano.Wallet.Kernel.DB.TxMeta.Types as Kernel
 import           Cardano.Wallet.Kernel.DB.Util.IxSet (Indexed (..), IxSet)
 import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 import qualified Cardano.Wallet.Kernel.Internal as Kernel
@@ -122,10 +124,15 @@ deleteAccount :: MonadIO m
               -> V1.AccountIndex
               -> m (Either DeleteAccountError ())
 deleteAccount wallet wId accIx = runExceptT $ do
+    rootId <- withExceptT DeleteAccountWalletIdDecodingFailed $
+        fromRootId wId
     accId <- withExceptT DeleteAccountWalletIdDecodingFailed $
-               fromAccountId wId accIx
-    withExceptT DeleteAccountError $ ExceptT $ liftIO $
-      Kernel.deleteAccount accId wallet
+        fromAccountId wId accIx
+    withExceptT DeleteAccountError $ ExceptT $ liftIO $ do
+        let walletId = HD.getHdRootId rootId ^. fromDb
+        let accountIx = Just $ V1.getAccIndex accIx
+        Kernel.deleteTxMetas (wallet ^. Kernel.walletMeta) walletId accountIx
+        Kernel.deleteAccount accId wallet
 
 updateAccount :: MonadIO m
               => Kernel.PassiveWallet

src/Cardano/Wallet/WalletLayer/Kernel/Transactions.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
 module Cardano.Wallet.WalletLayer.Kernel.Transactions (
       getTransactions
     , toTransaction
@@ -6,11 +8,13 @@ module Cardano.Wallet.WalletLayer.Kernel.Transactions (
 import           Universum
 
 import           Control.Monad.Except
+import           Formatting (build, sformat)
 import           GHC.TypeLits (symbolVal)
 
 import           Pos.Chain.Txp (TxId)
 import           Pos.Core (Address, Coin, SlotCount, SlotId, Timestamp,
                      decodeTextAddress, flattenSlotId, getBlockCount)
+import           Pos.Util.Wlog (Severity (..))
 
 import           Cardano.Wallet.API.Indices
 import           Cardano.Wallet.API.Request
@@ -43,23 +47,52 @@ getTransactions wallet mbWalletId mbAccountIndex mbAddress params fop sop = lift
     let PaginationParams{..}  = rpPaginationParams params
     let PerPage pp = ppPerPage
     let Page cp = ppPage
-    accountFops <- castAccountFiltering mbWalletId mbAccountIndex
-    mbSorting <- castSorting sop
-    db <- liftIO $ Kernel.getWalletSnapshot wallet
-    sc <- liftIO $ Node.getSlotCount (wallet ^. Kernel.walletNode)
-    currentSlot <- liftIO $ Node.getTipSlotId (wallet ^. Kernel.walletNode)
-    (meta, mbTotalEntries) <- liftIO $ TxMeta.getTxMetas
-        (wallet ^. Kernel.walletMeta)
-        (TxMeta.Offset . fromIntegral $ (cp - 1) * pp)
-        (TxMeta.Limit . fromIntegral $ pp)
-        accountFops
-        (unV1 <$> mbAddress)
-        (castFiltering $ mapIx unV1 <$> F.findMatchingFilterOp fop)
-        (castFiltering $ mapIx unV1 <$> F.findMatchingFilterOp fop)
-        mbSorting
-    txs <- withExceptT GetTxUnknownHdAccount $
-             mapM (metaToTx db sc currentSlot) meta
-    return $ respond params txs mbTotalEntries
+    (txs, total) <- go cp pp ([], Nothing)
+    return $ respond params txs total
+  where
+    -- NOTE: See cardano-wallet#141
+    --
+    -- We may end up with some inconsistent metadata in the store. When fetching
+    -- them all, instead of failing with a non very helpful 'WalletNotfound' or
+    -- 'AccountNotFound' error because one or more metadata in the list contains
+    -- unknown ids, we simply discard them from what we fetched and we fetch
+    -- another batch up until we have enough (== pp).
+    go cp pp (acc, total)
+        | length acc >= pp =
+            return $ (take pp acc, total)
+        | otherwise = do
+            accountFops <- castAccountFiltering mbWalletId mbAccountIndex
+            mbSorting <- castSorting sop
+            (metas, mbTotalEntries) <- liftIO $ TxMeta.getTxMetas
+                (wallet ^. Kernel.walletMeta)
+                (TxMeta.Offset . fromIntegral $ (cp - 1) * pp)
+                (TxMeta.Limit . fromIntegral $ pp)
+                accountFops
+                (unV1 <$> mbAddress)
+                (castFiltering $ mapIx unV1 <$> F.findMatchingFilterOp fop)
+                (castFiltering $ mapIx unV1 <$> F.findMatchingFilterOp fop)
+                mbSorting
+            db <- liftIO $ Kernel.getWalletSnapshot wallet
+            sc <- liftIO $ Node.getSlotCount (wallet ^. Kernel.walletNode)
+            currentSlot <- liftIO $ Node.getTipSlotId (wallet ^. Kernel.walletNode)
+            if null metas then
+                -- A bit artificial, but we force the termination and make sure
+                -- in the meantime that the algorithm only exits by one and only
+                -- one branch.
+                go cp (min pp $ length acc) (acc, total <|> mbTotalEntries)
+            else do
+                txs <- catMaybes <$> forM metas (\meta -> do
+                    runExceptT (metaToTx db sc currentSlot meta) >>= \case
+                        Left e -> do
+                            let warn = lift . ((wallet ^. Kernel.walletLogMessage) Warning)
+                            warn $ "Inconsistent entry in the metadata store: " <> sformat build e
+                            return Nothing
+
+                        Right tx ->
+                            return (Just tx)
+                    )
+                go (cp + 1) pp (acc ++ txs, total <|> mbTotalEntries)
+
 
 toTransaction :: MonadIO m
               => Kernel.PassiveWallet

src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs

@@ -33,10 +33,11 @@ import           Cardano.Wallet.Kernel.DB.AcidState (dbHdWallets)
 import qualified Cardano.Wallet.Kernel.DB.EosHdWallet as EosHD
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
 import           Cardano.Wallet.Kernel.DB.InDb (fromDb)
+import qualified Cardano.Wallet.Kernel.DB.TxMeta.Types as Kernel
 import           Cardano.Wallet.Kernel.DB.Util.IxSet (IxSet)
 import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 import           Cardano.Wallet.Kernel.EosWalletId (EosWalletId)
-import           Cardano.Wallet.Kernel.Internal (walletKeystore,
+import           Cardano.Wallet.Kernel.Internal (walletKeystore, walletMeta,
                      walletProtocolMagic, _wriProgress)
 import qualified Cardano.Wallet.Kernel.Internal as Kernel
 import qualified Cardano.Wallet.Kernel.Keystore as Keystore
@@ -229,9 +230,11 @@ deleteWallet :: MonadIO m
 deleteWallet wallet wId = runExceptT $ do
     rootId <- withExceptT DeleteWalletWalletIdDecodingFailed $ fromRootId wId
     withExceptT DeleteWalletError $ ExceptT $ liftIO $ do
-      let nm = makeNetworkMagic (wallet ^. walletProtocolMagic)
-      Kernel.removeRestoration wallet (WalletIdHdRnd rootId)
-      Kernel.deleteHdWallet nm wallet rootId
+        let nm = makeNetworkMagic (wallet ^. walletProtocolMagic)
+        let walletId = HD.getHdRootId rootId ^. fromDb
+        Kernel.removeRestoration wallet (WalletIdHdRnd rootId)
+        Kernel.deleteTxMetas (wallet ^. walletMeta) walletId Nothing
+        Kernel.deleteHdWallet nm wallet rootId
 
 -- | Deletes external wallets. Please note that there's no actions in the
 -- 'Keystore', because it contains only root secret keys.

test/integration/Test/Integration/Framework/DSL.hs

@@ -12,11 +12,13 @@ module Test.Integration.Framework.DSL
     -- * Steps
     , setup
     , request
+    , request_
     , verify
 
     -- * Requests (Only API types)
     , NewAddress(..)
     , NewWallet (..)
+    , NewAccount (..)
     , Payment (..)
     , Redemption (..)
     , Setup(..)
@@ -54,6 +56,7 @@ module Test.Integration.Framework.DSL
     , expectTxStatusEventually
     , expectTxStatusNever
     , expectWalletError
+    , expectWalletEventuallyRestored
     , expectWalletUTxO
 
     -- * Helpers
@@ -94,7 +97,7 @@ import           Pos.Core.NetworkMagic (NetworkMagic (..))
 import           Pos.Crypto (ShouldCheckPassphrase (..),
                      safeDeterministicKeyGen)
 import           Test.Integration.Framework.Request (HasHttpClient, request,
-                     successfulRequest, ($-))
+                     request_, successfulRequest, ($-))
 import           Test.Integration.Framework.Scenario (Scenario)
 
 --
@@ -420,6 +423,20 @@ expectTxStatusNever w statuses = \case
             Just _  -> fail "expectTxStatusNever: reached one of the provided statuses."
 
 
+-- | Wait until a wallet is restored, up to a certain point.
+expectWalletEventuallyRestored
+    :: (MonadIO m, MonadFail m, MonadReader ctx m, HasHttpClient ctx)
+    => Either ClientError Wallet
+    -> m ()
+expectWalletEventuallyRestored = \case
+    Left e -> wantedSuccessButError e
+    Right w -> do
+        result <- ask >>= \ctx -> timeout (60 * second) (waitForRestored ctx w)
+        case result of
+            Nothing -> fail "expectWalletEventuallyRestored: waited too long for restoration."
+            Just _  -> return ()
+
+
 expectWalletError
     :: (MonadIO m, MonadFail m, Show a)
     => WalletError
@@ -497,6 +514,21 @@ waitForTxStatus ctx w statuses txn = do
     else
         threadDelay (5 * second) >> waitForTxStatus ctx w statuses txn
 
+-- | Wait until the given wallet is restored.
+waitForRestored
+    :: HasHttpClient ctx
+    => ctx
+    -> Wallet
+    -> IO ()
+waitForRestored ctx w = do
+    response <- flip runReaderT ctx $ successfulRequest $ Client.getWallet
+        $- w ^. walletId
+
+    case walSyncState response of
+        Synced -> return ()
+        _      -> threadDelay (5  * second) >> waitForRestored ctx w
+
+
 -- | Make a backup phrase from a raw list of words.
 mkBackupPhrase
     :: (MonadIO m, MonadFail m)

test/integration/Test/Integration/Framework/Request.hs

@@ -1,6 +1,7 @@
 module Test.Integration.Framework.Request
     ( HasHttpClient
     , request
+    , request_
     , successfulRequest
     , ($-)
     ) where
@@ -28,6 +29,14 @@ class Request originalResponse where
         => (WalletClient IO -> IO (Either ClientError originalResponse))
         -> m (Either ClientError (Response originalResponse))
 
+    -- | Run a given request and discard the response
+    request_
+        :: forall m ctx. (MonadIO m, MonadReader ctx m, HasHttpClient ctx)
+        => (WalletClient IO -> IO (Either ClientError originalResponse))
+        -> m ()
+    request_ =
+        void . request
+
     -- | Run a given request as above, but throws if it fails
     successfulRequest
         :: forall m ctx. (MonadIO m, MonadFail m, MonadReader ctx m, HasHttpClient ctx)