Merge #3818

3818: [ADP-2878] remove remove wallet from dblayer r=paolino a=paolino

This is part of the epic to remove (unused) multi-wallet support in DBLayer

- [x] Remove removeWallet from DBLayer record
- [x] Remove deleteWallet functionality from Wallet module

ADP-2878


Co-authored-by: paolino <paolo.veronelli@gmail.com>

lib/wallet/bench/restore-bench.hs

@@ -831,8 +831,6 @@ bench_restoration
                     results <-
                         benchmarks proxy w wid0 wname0 benchname restorationTime
                     saveBenchmarkPoints benchname results
-                    forM_ wallets $ \(wid, _, _) ->
-                        unsafeRunExceptT (W.deleteWallet w wid)
                     pure $ SomeBenchmarkResults results
   where
     fst' (x,_,_) = x

lib/wallet/src/Cardano/Wallet.hs

@@ -72,7 +72,6 @@ module Cardano.Wallet
     , getWalletUtxoSnapshot
     , listUtxoStatistics
     , readWallet
-    , deleteWallet
     , restoreWallet
     , updateWallet
     , updateWalletPassphraseWithOldPassphrase
@@ -1209,21 +1208,6 @@ restoreBlocks ctx tr wid blocks nodeTip = db & \DBLayer{..} ->
     isParentOf cp = (== Just parent) . parentHeaderHash
       where parent = headerHash $ currentTip cp
 
--- | Remove an existing wallet. Note that there's no particular work to
--- be done regarding the restoration worker as it will simply terminate
--- on the next tick when noticing that the corresponding wallet is gone.
-deleteWallet
-    :: forall ctx s k.
-        ( HasDBLayer IO s k ctx
-        )
-    => ctx
-    -> WalletId
-    -> ExceptT ErrNoSuchWallet IO ()
-deleteWallet ctx wid = db & \DBLayer{..} -> do
-    mapExceptT atomically $ removeWallet wid
-  where
-    db = ctx ^. dbLayer @IO @s @k
-
 -- | Fetch the cached reward balance of a given wallet from the database.
 fetchRewardBalance :: forall s k. DBLayer IO s k -> WalletId -> IO Coin
 fetchRewardBalance DBLayer{..} = atomically . readDelegationRewardBalance

lib/wallet/src/Cardano/Wallet/DB.hs

@@ -190,12 +190,6 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
         -- 'putWalletMeta', 'putTxHistory' or 'putProtocolParameters' will
         -- actually all fail if they are called _first_ on a wallet.
 
-    , removeWallet
-        :: WalletId
-        -> ExceptT ErrNoSuchWallet stm ()
-        -- ^ Remove a given wallet and all its associated data (checkpoints,
-        -- metadata, tx history ...)
-
     , listWallets
         :: stm [WalletId]
         -- ^ Get the list of all known wallets in the DB, possibly empty.
@@ -466,7 +460,6 @@ mkDBLayerFromParts
     -> DBLayer m s k
 mkDBLayerFromParts ti DBLayerCollection{..} = DBLayer
     { initializeWallet = initializeWallet_ dbWallets
-    , removeWallet = removeWallet_ dbWallets
     , listWallets = listWallets_ dbWallets
     , walletsDB = walletsDB_ dbCheckpoints
     , putCheckpoint = putCheckpoint_ dbCheckpoints
@@ -615,12 +608,6 @@ data DBWallets stm s = DBWallets
         -> stm (Maybe GenesisParameters)
         -- ^ Read the *Byron* genesis parameters.
 
-    , removeWallet_
-        :: WalletId
-        -> ExceptT ErrNoSuchWallet stm ()
-        -- ^ Remove a given wallet and all its associated data (checkpoints,
-        -- metadata, tx history ...)
-
     , listWallets_
         :: stm [WalletId]
         -- ^ Get the list of all known wallets in the DB, possibly empty.

lib/wallet/src/Cardano/Wallet/DB/Layer.hs

@@ -568,10 +568,6 @@ newDBLayerWith _cacheBehavior _tr ti SqliteContext{runQuery} = mdo
                                 [ UpdateCheckpoints [ RestrictTo $ Map.keys slots ] ]
                         in  (Just delta, ())
 
-    -- Delete the a wallet from the checkpoint DBVar
-    let deleteCheckpoints :: W.WalletId -> SqlPersistT IO ()
-        deleteCheckpoints wid = updateDBVar walletsDB $ Delete wid
-
         {-----------------------------------------------------------------------
                                       Wallets
         -----------------------------------------------------------------------}
@@ -589,16 +585,6 @@ newDBLayerWith _cacheBehavior _tr ti SqliteContext{runQuery} = mdo
 
         , readGenesisParameters_ = selectGenesisParameters
 
-        , removeWallet_ = \wid -> do
-            ExceptT $ do
-                selectWallet wid >>= \case
-                    Nothing -> pure $ Left $ ErrNoSuchWallet wid
-                    Just _  -> Right <$> do
-                        deleteWhere [WalId ==. wid]
-                        deleteCheckpoints wid
-                        updateS (store transactionsQS) Nothing
-                            $ RemoveWallet wid
-
         , listWallets_ = map unWalletKey <$> selectKeysList [] [Asc WalId]
 
         , hasWallet_ = fmap isJust . selectWallet

lib/wallet/src/Cardano/Wallet/DB/Pure/Implementation.hs

@@ -50,7 +50,6 @@ module Cardano.Wallet.DB.Pure.Implementation
     -- * Model database functions
     , mCleanDB
     , mInitializeWallet
-    , mRemoveWallet
     , mListWallets
     , mPutCheckpoint
     , mReadCheckpoint
@@ -241,12 +240,6 @@ mInitializeWallet wid cp meta txs0 gp db@Database{wallets,txs}
         in
             (Right (), Database (Map.insert wid wal wallets) (txs <> txs'))
 
-mRemoveWallet :: Ord wid => wid -> ModelOp wid s xprv ()
-mRemoveWallet wid db@Database{wallets,txs}
-    | wid `Map.member` wallets =
-        (Right (), Database (Map.delete wid wallets) txs)
-    | otherwise = (Left (NoSuchWallet wid), db)
-
 mCheckWallet :: Ord wid => wid -> ModelOp wid s xprv ()
 mCheckWallet wid db@Database{wallets}
     | wid `Map.member` wallets =

lib/wallet/src/Cardano/Wallet/DB/Pure/Layer.hs

@@ -51,7 +51,6 @@ import Cardano.Wallet.DB.Pure.Implementation
     , mReadTxHistory
     , mReadWalletMeta
     , mRemovePendingOrExpiredTx
-    , mRemoveWallet
     , mRollbackTo
     , mUpdatePendingTxForExpiry
     )
@@ -101,8 +100,6 @@ newDBLayer timeInterpreter = do
                 alterDB errWalletAlreadyExists db $
                 mInitializeWallet pk cp meta txs gp
 
-        , removeWallet = ExceptT . alterDB errNoSuchWallet db . mRemoveWallet
-
         , listWallets = readDB db mListWallets
 
         {-----------------------------------------------------------------------

lib/wallet/test/unit/Cardano/Wallet/DB/Properties.hs

@@ -148,8 +148,6 @@ properties = describe "DB.Properties" $ do
             (property . prop_createListWallet)
         it "creating same wallet twice yields an error"
             (property . prop_createWalletTwice)
-        it "removing the same wallet twice yields an error"
-            (property . prop_removeWalletTwice)
 
     describe "put . read yields a result" $ do
         it "Checkpoint" $
@@ -219,24 +217,6 @@ properties = describe "DB.Properties" $ do
                 (\DBLayer{..} -> atomically . readWalletMeta)
                 (\DBLayer{..} -> atomically . readPrivateKey)
 
-    describe "can't read after delete" $ do
-        it "Checkpoint" $
-            property . prop_readAfterDelete
-                (\DBLayer{..} -> atomically . readCheckpoint)
-                Nothing
-        it "Wallet Metadata" $
-            property . prop_readAfterDelete
-                (\DBLayer{..} -> atomically . readWalletMeta)
-                Nothing
-        it "Tx History" $
-            property . prop_readAfterDelete
-                readTxHistory_
-                (pure mempty)
-        it "Private Key" $
-            property . prop_readAfterDelete
-                (\DBLayer{..} -> atomically . readPrivateKey)
-                Nothing
-
     describe "sequential puts replace values in order" $ do
         it "Checkpoint" $
             checkCoverage . prop_sequentialPut
@@ -417,24 +397,6 @@ prop_createWalletTwice DBLayer{..} (wid, InitialCheckpoint cp0, meta) =
         atomically (runExceptT $ initializeWallet wid cp0 meta mempty gp)
             `shouldReturn` Left err
 
--- | Trying to remove a same wallet twice should yield an error
-prop_removeWalletTwice
-    :: DBLayer IO s ShelleyKey
-    -> ( WalletId
-       , InitialCheckpoint s
-       , WalletMetadata
-       )
-    -> Property
-prop_removeWalletTwice DBLayer{..} (wid, InitialCheckpoint cp0, meta) =
-    monadicIO (setup >> prop)
-  where
-    setup = liftIO $ do
-        atomically $ unsafeRunExceptT $ initializeWallet wid cp0 meta mempty gp
-    prop = liftIO $ do
-        let err = ErrNoSuchWallet wid
-        atomically (runExceptT $ removeWallet wid) `shouldReturn` Right ()
-        atomically (runExceptT $ removeWallet wid) `shouldReturn` Left err
-
 -- | Checks that a given resource can be read after having been inserted in DB.
 prop_readAfterPut
     :: ( Buildable (f a), Eq (f a), Applicative f, GenState s )
@@ -613,29 +575,6 @@ prop_isolation putA readB readC readD db@DBLayer{..} (ShowFmt wid, ShowFmt a) =
         (ShowFmt <$> readC db wid) `shouldReturn` ShowFmt c
         (ShowFmt <$> readD db wid) `shouldReturn` ShowFmt d
 
--- | Can't read back data after delete
-prop_readAfterDelete
-    :: (Buildable (f a), Eq (f a), GenState s)
-    => (  DBLayer IO s ShelleyKey
-       -> WalletId
-       -> IO (f a)
-       ) -- ^ Read Operation
-    -> f a
-        -- ^ An 'empty' value for the 'Applicative' f
-    -> DBLayer IO s ShelleyKey
-    -> ShowFmt WalletId
-    -> Property
-prop_readAfterDelete readOp empty db@DBLayer{..} (ShowFmt wid) =
-    monadicIO (setup >> prop)
-  where
-    setup = do
-        (InitialCheckpoint cp0, meta) <- pick arbitrary
-        run $ atomically $ unsafeRunExceptT $
-            initializeWallet wid cp0 meta mempty gp
-    prop = liftIO $ do
-        atomically $ unsafeRunExceptT $ removeWallet wid
-        (ShowFmt <$> readOp db wid) `shouldReturn` ShowFmt empty
-
 -- | Check that the DB supports multiple sequential puts for a given resource
 prop_sequentialPut
     :: (Buildable (f a), Eq (f a), GenState s)

lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs

@@ -82,7 +82,6 @@ import Cardano.Wallet.DB.Pure.Implementation
     , mReadPrivateKey
     , mReadTxHistory
     , mReadWalletMeta
-    , mRemoveWallet
     , mRollbackTo
     )
 import Cardano.Wallet.DB.WalletState
@@ -208,7 +207,7 @@ import Data.Map
 import Data.Map.Strict.NonEmptyMap
     ( NonEmptyMap )
 import Data.Maybe
-    ( catMaybes, fromJust, isJust, isNothing )
+    ( catMaybes, fromJust, isJust )
 import Data.Quantity
     ( Percentage (..), Quantity (..) )
 import Data.Set
@@ -341,7 +340,6 @@ unMockPrivKeyHash = PassphraseHash .  BA.convert . B8.pack
 
 data Cmd s wid
     = CreateWallet MWid (Wallet s) WalletMetadata TxHistory GenesisParameters
-    | RemoveWallet wid
     | ListWallets
     | PutCheckpoint wid (Wallet s)
     | ReadCheckpoint wid
@@ -405,8 +403,6 @@ runMock = \case
     CreateWallet wid wal meta txs gp ->
         first (Resp . fmap (const (NewWallet wid)))
             . mInitializeWallet wid wal meta txs gp
-    RemoveWallet wid ->
-        first (Resp . fmap Unit) . mRemoveWallet wid
     ListWallets ->
         first (Resp . fmap WalletIds) . mListWallets
     PutCheckpoint wid wal ->
@@ -469,8 +465,6 @@ runIO DBLayer{..} = fmap Resp . go
             catchWalletAlreadyExists (const (NewWallet (unMockWid wid))) $
             mapExceptT atomically $
             initializeWallet (unMockWid wid) wal meta txs gp
-        RemoveWallet wid -> catchNoSuchWallet Unit $
-            mapExceptT atomically $ removeWallet wid
         ListWallets -> Right . WalletIds <$>
             atomically listWallets
         PutCheckpoint wid wal -> catchNoSuchWallet Unit $
@@ -639,9 +633,7 @@ generatorWithWid
     => [Reference WalletId r]
     -> [(String, (Int, Gen (Cmd s (Reference WalletId r))))]
 generatorWithWid wids =
-    [ declareGenerator "RemoveWallet" 3
-        $ RemoveWallet <$> genId
-    , declareGenerator "ListWallets" 5
+    [ declareGenerator "ListWallets" 5
         $ pure ListWallets
     , declareGenerator "PutCheckpoints" 5
         $ PutCheckpoint <$> genId <*> arbitrary
@@ -1007,8 +999,6 @@ data Tag
       -- ^ Three different wallets created.
     | CreateWalletTwice
       -- ^ The same wallet id is used twice.
-    | RemoveWalletTwice
-      -- ^ The same wallet is removed twice.
     | CreateThenList
     | SuccessfulReadTxHistory
     | UnsuccessfulReadTxHistory
@@ -1017,12 +1007,8 @@ data Tag
     | TxUnsortedOutputs
     | SuccessfulReadCheckpoint
       -- ^ Read the checkpoint of a wallet that's been created.
-    | UnsuccessfulReadCheckpoint
-      -- ^ No such wallet error.
     | SuccessfulReadPrivateKey
       -- ^ Private key was written then read.
-    | ReadTxHistoryAfterDelete
-      -- ^ wallet deleted, then tx history read.
     | PutCheckpointTwice
       -- ^ Multiple checkpoints are successfully saved to a wallet.
     | RolledBackOnce
@@ -1039,15 +1025,12 @@ tag :: forall s. [Event s Symbolic] -> [Tag]
 tag = Foldl.fold $ catMaybes <$> sequenceA
     [ createThreeWallets
     , createWalletTwice
-    , removeWalletTwice
     , createThenList
     , readTransactions (not . null) SuccessfulReadTxHistory
     , readTransactions null UnsuccessfulReadTxHistory
     , txUnsorted inputs TxUnsortedInputs
     , txUnsorted outputs TxUnsortedOutputs
     , readCheckpoint isJust SuccessfulReadCheckpoint
-    , readCheckpoint isNothing UnsuccessfulReadCheckpoint
-    , readAfterDelete
     , countAction SuccessfulReadPrivateKey (>= 1) isReadPrivateKeySuccess
     , countAction PutCheckpointTwice (>= 2) isPutCheckpointSuccess
     , countAction RolledBackOnce (>= 1) isRollbackSuccess
@@ -1061,33 +1044,6 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
         _otherwise ->
             Nothing
 
-    readAfterDelete :: Fold (Event s Symbolic) (Maybe Tag)
-    readAfterDelete = Fold update mempty extract
-      where
-        update :: Map MWid Int -> Event s Symbolic -> Map MWid Int
-        update created ev =
-            case (isReadTxHistory ev, cmd ev, mockResp ev, before ev) of
-                (Just wid, _, _, _) ->
-                    Map.alter (fmap (+1)) wid created
-                (Nothing
-                    , At (RemoveWallet wid)
-                    , Resp (Right _)
-                    , Model _ wids) ->
-                        Map.insert (wids ! wid) 0 created
-                _otherwise ->
-                    created
-
-        extract :: Map MWid Int -> Maybe Tag
-        extract created | any (> 0) created = Just ReadTxHistoryAfterDelete
-                        | otherwise = Nothing
-
-    isReadTxHistory :: Event s Symbolic -> Maybe MWid
-    isReadTxHistory ev = case (cmd ev, mockResp ev, before ev) of
-        (At (ReadTxHistory wid _ _ _ _), Resp (Right (TxHistory _)), Model _ wids)
-            -> Just (wids ! wid)
-        _otherwise
-            -> Nothing
-
     createThreeWallets :: Fold (Event s Symbolic) (Maybe Tag)
     createThreeWallets = Fold update Set.empty extract
       where
@@ -1112,15 +1068,6 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
             (At (CreateWallet wid _ _ _ _), Resp _) -> Just wid
             _otherwise -> Nothing
 
-    removeWalletTwice :: Fold (Event s Symbolic) (Maybe Tag)
-    removeWalletTwice = countAction RemoveWalletTwice (>= 2) match
-      where
-        match ev = case (cmd ev, mockResp ev) of
-            (At (RemoveWallet wid), Resp _) ->
-                Just wid
-            _otherwise ->
-                Nothing
-
     countAction
         :: forall k. Ord k => Tag -> (Int -> Bool)
         -> (Event s Symbolic -> Maybe k)