Clean up transaction metadata after deleting an account or wallet

This fix is actually two folds:

- It discards incoherent transactions fetched from the DB, if any,
  and shout a warning in the log. This is in order to make the system
  more resilient to conconcurrent calls while a wallet or account is
  being deleted (since metadata and accounts / wallets are stored in
  separated databases, we can't easily run both delete in a single
  transaction).

- It also deletes corresponding metadata when an account or a wallet
  is removed. This may cause extra damage? What if there are pending
  transactions when we delete the account or wallet.

wallet-new/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

wallet-new/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

wallet-new/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

wallet-new/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

wallet-new/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