From 92c2aa01289c6274a94fa07d55eac6181e35ecb5 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Tue, 14 Jan 2020 14:21:42 +0100
Subject: [PATCH 1/9] extend swagger specification with 'forceResync'

As an extreme measure to force re-sync the wallet
---
 .../test/unit/Cardano/Wallet/Api/TypesSpec.hs |  3 +
 specifications/api/swagger.yaml               | 90 ++++++++++++++++---
 2 files changed, 82 insertions(+), 11 deletions(-)

diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs
index a4eda3af4db..4c3c26a81ad 100644
--- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs
+++ b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs
@@ -1412,6 +1412,9 @@ instance ToSchema ApiUtxoStatistics where
 instance ToSchema ApiNetworkInformation where
     declareNamedSchema _ = declareSchemaForDefinition "ApiNetworkInformation"
 
+instance ToSchema ApiNetworkTip where
+    declareNamedSchema _ = declareSchemaForDefinition "ApiNetworkTip"
+
 -- | Utility function to provide an ad-hoc 'ToSchema' instance for a definition:
 -- we simply look it up within the Swagger specification.
 declareSchemaForDefinition :: T.Text -> Declare (Definitions Schema) NamedSchema
diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml
index 955d50f9ca1..cecb1e2b8ae 100644
--- a/specifications/api/swagger.yaml
+++ b/specifications/api/swagger.yaml
@@ -65,6 +65,22 @@ x-blockReference: &blockReference
     epoch_number: *epochNumber
     height: *numberOfBlocks
 
+x-genesisBlock: &genesisBlock
+  description: A reference to a particular block.
+  type: object
+  required:
+    - slot_number
+    - epoch_number
+  properties:
+    slot_number:
+      <<: *slotNumber
+      maximum: 0
+      example: 0
+    epoch_number:
+      <<: *epochNumber
+      maximum: 0
+      example: 0
+
 x-percentage: &percentage
   type: object
   required:
@@ -492,16 +508,6 @@ x-networkInformationNodeTip: &networkInformationNodeTip
   <<: *blockReference
   description: Underlying node's tip
 
-x-networkInformationNetworkTip: &networkInformationNetworkTip
-  description: Projected network's tip
-  type: object
-  required:
-    - slot_number
-    - epoch_number
-  properties:
-    slot_number: *slotNumber
-    epoch_number: *epochNumber
-
 x-networkInformationProtocolUpdate: &networkInformationProtocolUpdate
   type: string
   description: |
@@ -536,6 +542,16 @@ definitions:
       epoch_number: *epochNumber
       epoch_start_time: *date
 
+  ApiNetworkTip: &ApiNetworkTip
+    description: A network tip
+    type: object
+    required:
+      - slot_number
+      - epoch_number
+    properties:
+      slot_number: *slotNumber
+      epoch_number: *epochNumber
+
   ApiNetworkInformation: &ApiNetworkInformation
     type: object
     required:
@@ -546,7 +562,7 @@ definitions:
     properties:
       sync_progress: *networkInformationSyncProgress
       node_tip: *networkInformationNodeTip
-      network_tip: *networkInformationNetworkTip
+      network_tip: *ApiNetworkTip
       next_epoch: *ApiEpochInfo
 
   ApiSelectCoinsData: &ApiSelectCoinsData
@@ -1057,6 +1073,16 @@ x-responsesDeleteWallet: &responsesDeleteWallet
   204:
     description: No Content
 
+x-responsesForceResyncWallet: &responsesForceResyncWallet
+  <<: *responsesErr400
+  <<: *responsesErr403
+  <<: *responsesErr404
+  <<: *responsesErr405
+  <<: *responsesErr406
+  <<: *responsesErr415
+  204:
+    description: No Content
+
 x-responsesPutWallet: &responsesPutWallet
   <<: *responsesErr400
   <<: *responsesErr404
@@ -1277,6 +1303,27 @@ paths:
           schema: *ApiWalletPutData
       responses: *responsesPutWallet
 
+  /wallets/{walletId}/tip:
+    put:
+      operationId: forceResync
+      tags: ["Wallets"]
+      summary: Force Resync
+      description: |
+        <p align="right">status: <strong>stable</strong></p>
+
+        Force the wallet to rewind back to the given block and sync again with the chain.
+        Any incoming transaction will be erased whereas outgoing transactions will be put back
+        as pending. This action should only be taken as an extreme measure to resolve potential
+        syncing issues. If its use is required, please submit a ticket to https://github.com/input-output-hk/cardano-wallet/issues.
+
+        > ⚠️ At this stage, the server only allows resyncing to genesis (i.e. `(0,0)`).
+        > Any other point will yield a `403 Forbidden` error.
+      parameters:
+        - *parametersWalletId
+        - <<: *parametersBody
+          schema: *genesisBlock
+      responses: *responsesForceResyncWallet
+
   /wallets/{walletId}/statistics/utxos:
     get:
       operationId: getUTxOsStatistics
@@ -1571,6 +1618,27 @@ paths:
         - *parametersWalletId
       responses: *responsesDeleteWallet
 
+  /byron-wallets/{walletId}/tip:
+    put:
+      operationId: forceResyncByron
+      tags: ["Byron Wallets"]
+      summary: Force Resync
+      description: |
+        <p align="right">status: <strong>stable</strong></p>
+
+        Force the wallet to rewind back to the given block and sync again with the chain.
+        Any incoming transaction will be erased whereas outgoing transactions will be put back
+        as pending. This action should only be taken as an extreme measure to resolve potential
+        syncing issues. If its use is required, please submit a ticket to https://github.com/input-output-hk/cardano-wallet/issues.
+
+        > ⚠️ At this stage, the server only allows resyncing to genesis (i.e. `(0,0)`).
+        > Any other point will yield a `403 Forbidden` error.
+      parameters:
+        - *parametersWalletId
+        - <<: *parametersBody
+          schema: *genesisBlock
+      responses: *responsesForceResyncWallet
+
   /byron-wallets/{walletId}/transactions:
     get:
       operationId: listByronTransactions

From 206affcab73d87d1e7c0c46c433eb2ea9494993c Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Tue, 14 Jan 2020 14:59:29 +0100
Subject: [PATCH 2/9] extend API with 'forceResync' operation

- Added a 'forceResync' link
- Extended the servant Client
- Provide an initial straightforward implementation re-using 'rollbackBlocks'
---
 lib/core/src/Cardano/Wallet.hs            |  1 +
 lib/core/src/Cardano/Wallet/Api.hs        | 19 ++++++++++++
 lib/core/src/Cardano/Wallet/Api/Client.hs |  7 +++++
 lib/core/src/Cardano/Wallet/Api/Link.hs   | 14 +++++++++
 lib/core/src/Cardano/Wallet/Api/Server.hs | 36 ++++++++++++++++++++++-
 lib/core/src/Cardano/Wallet/Api/Types.hs  |  1 +
 6 files changed, 77 insertions(+), 1 deletion(-)

diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
index 14919b84875..33e84b20711 100644
--- a/lib/core/src/Cardano/Wallet.hs
+++ b/lib/core/src/Cardano/Wallet.hs
@@ -74,6 +74,7 @@ module Cardano.Wallet
     , updateWalletPassphrase
     , walletSyncProgress
     , fetchRewardBalance
+    , rollbackBlocks
     , ErrWalletAlreadyExists (..)
     , ErrNoSuchWallet (..)
     , ErrListUTxOStatistics (..)
diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs
index 0993c99f065..781258c9fc2 100644
--- a/lib/core/src/Cardano/Wallet/Api.hs
+++ b/lib/core/src/Cardano/Wallet/Api.hs
@@ -24,6 +24,7 @@ module Cardano.Wallet.Api
         , PutWallet
         , PutWalletPassphrase
         , GetUTxOsStatistics
+        , ForceResyncWallet
 
     , Addresses
         , ListAddresses
@@ -49,6 +50,7 @@ module Cardano.Wallet.Api
         , GetByronWallet
         , ListByronWallets
         , PostByronWallet
+        , ForceResyncByronWallet
 
     , ByronTransactions
         , ListByronTransactions
@@ -89,6 +91,7 @@ import Cardano.Wallet.Api.Types
     , ApiCoinSelection
     , ApiFee
     , ApiNetworkInformation
+    , ApiNetworkTip
     , ApiSelectCoinsData
     , ApiStakePool
     , ApiT
@@ -192,6 +195,7 @@ type Wallets =
     :<|> PutWallet
     :<|> PutWalletPassphrase
     :<|> GetUTxOsStatistics
+    :<|> ForceResyncWallet
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/deleteWallet
 type DeleteWallet = "wallets"
@@ -232,6 +236,13 @@ type GetUTxOsStatistics = "wallets"
     :> "utxos"
     :> Get '[JSON] ApiUtxoStatistics
 
+-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/forceResync
+type ForceResyncWallet = "wallets"
+    :> Capture "walletId" (ApiT WalletId)
+    :> "tip"
+    :> ReqBody '[JSON] ApiNetworkTip
+    :> PutNoContent '[Any] NoContent
+
 {-------------------------------------------------------------------------------
                                   Addresses
 
@@ -362,6 +373,7 @@ type ByronWallets =
     :<|> DeleteByronWallet
     :<|> GetByronWallet
     :<|> ListByronWallets
+    :<|> ForceResyncByronWallet
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/postByronWallet
 type PostByronWallet (style :: ByronWalletStyle) = "byron-wallets"
@@ -383,6 +395,13 @@ type GetByronWallet = "byron-wallets"
 type ListByronWallets = "byron-wallets"
     :> Get '[JSON] [ApiByronWallet]
 
+-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/forceResyncByron
+type ForceResyncByronWallet = "byron-wallets"
+    :> Capture "walletId" (ApiT WalletId)
+    :> "tip"
+    :> ReqBody '[JSON] ApiNetworkTip
+    :> PutNoContent '[Any] NoContent
+
 {-------------------------------------------------------------------------------
                                  Byron Transactions
 
diff --git a/lib/core/src/Cardano/Wallet/Api/Client.hs b/lib/core/src/Cardano/Wallet/Api/Client.hs
index 49b2feeab1a..169aca4880d 100644
--- a/lib/core/src/Cardano/Wallet/Api/Client.hs
+++ b/lib/core/src/Cardano/Wallet/Api/Client.hs
@@ -38,6 +38,7 @@ import Cardano.Wallet.Api.Types
     ( ApiAddress
     , ApiFee
     , ApiNetworkInformation (..)
+    , ApiNetworkTip
     , ApiStakePool
     , ApiT (..)
     , ApiTransaction
@@ -103,6 +104,10 @@ data WalletClient t = WalletClient
         :: ApiT WalletId
         -> WalletPutPassphraseData
         -> ClientM NoContent
+    , forceResyncWallet
+        :: ApiT WalletId
+        -> ApiNetworkTip
+        -> ClientM NoContent
     , listTransactions
         :: ApiT WalletId
         -> Maybe Iso8601Time
@@ -167,6 +172,7 @@ walletClient =
             :<|> _putWallet
             :<|> _putWalletPassphrase
             :<|> _getWalletUtxoStatistics
+            :<|> _forceResyncWallet
             = wallets
 
         _listAddresses =
@@ -200,6 +206,7 @@ walletClient =
             , postWallet = _postWallet
             , putWallet = _putWallet
             , putWalletPassphrase = _putWalletPassphrase
+            , forceResyncWallet = _forceResyncWallet
             , listTransactions = _listTransactions
             , postTransaction = _postTransaction
             , postExternalTransaction = _postExternalTransaction
diff --git a/lib/core/src/Cardano/Wallet/Api/Link.hs b/lib/core/src/Cardano/Wallet/Api/Link.hs
index b9e1c5995e9..6191adf4fab 100644
--- a/lib/core/src/Cardano/Wallet/Api/Link.hs
+++ b/lib/core/src/Cardano/Wallet/Api/Link.hs
@@ -48,6 +48,7 @@ module Cardano.Wallet.Api.Link
     , getUTxOsStatistics
     , getMigrationInfo
     , migrateWallet
+    , forceResyncWallet
 
       -- * Addresses
     , listAddresses
@@ -241,6 +242,19 @@ getMigrationInfo w =
   where
     wid = w ^. typed @(ApiT WalletId)
 
+forceResyncWallet
+    :: forall style w.
+        ( HasType (ApiT WalletId) w
+        , Discriminate style
+        )
+    => w
+    -> (Method, Text)
+forceResyncWallet w = discriminate @style
+    (endpoint @Api.ForceResyncWallet (wid &))
+    (endpoint @Api.ForceResyncByronWallet (wid &))
+  where
+    wid = w ^. typed @(ApiT WalletId)
+
 --
 -- Addresses
 --
diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
index 1156a1be8ad..960cdee78aa 100644
--- a/lib/core/src/Cardano/Wallet/Api/Server.hs
+++ b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -210,7 +210,7 @@ import Control.DeepSeq
 import Control.Exception
     ( IOException, bracket, tryJust )
 import Control.Monad
-    ( forM, forM_, void )
+    ( forM, forM_, void, when )
 import Control.Monad.IO.Class
     ( MonadIO, liftIO )
 import Control.Monad.Trans.Except
@@ -458,6 +458,7 @@ server byron icarus shelley spl =
         :<|> putWallet shelley mkShelleyWallet
         :<|> putWalletPassphrase shelley
         :<|> getUTxOsStatistics shelley
+        :<|> forceResyncWallet shelley
 
     addresses :: Server (Addresses n)
     addresses = listAddresses shelley
@@ -495,6 +496,10 @@ server byron icarus shelley spl =
         :<|> liftA2 (\xs ys -> fmap fst $ sortOn snd $ xs ++ ys)
             (listWallets byron  mkLegacyWallet)
             (listWallets icarus mkLegacyWallet)
+        :<|> (\wid tip -> withLegacyLayer wid
+                (byron , forceResyncWallet byron  wid tip)
+                (icarus, forceResyncWallet icarus wid tip)
+             )
 
     byronTransactions :: Server (ByronTransactions n)
     byronTransactions =
@@ -877,6 +882,22 @@ getUTxOsStatistics ctx (ApiT wid) = do
   where
     liftE = throwE . ErrListUTxOStatisticsNoSuchWallet
 
+forceResyncWallet
+    :: forall ctx s t k.
+        ( ctx ~ ApiLayer s t k
+        )
+    => ctx
+    -> ApiT WalletId
+    -> ApiNetworkTip
+    -> Handler NoContent
+forceResyncWallet ctx (ApiT wid) tip = guardTip >> do
+    liftHandler $ withWorkerCtx ctx wid throwE $ \wrk ->
+        W.rollbackBlocks wrk wid W.slotMinBound
+    pure NoContent
+  where
+    guardTip :: Handler ()
+    guardTip = when (tip /= ApiNetworkTip (ApiT 0) (ApiT 0))
+        $ liftHandler $ throwE $ ErrRejectedTip tip
 
 {-------------------------------------------------------------------------------
                                   Coin Selections
@@ -1496,10 +1517,23 @@ data ErrCreateWallet
         -- ^ Somehow, we couldn't create a worker or open a db connection
     deriving (Eq, Show)
 
+data ErrRejectedTip
+    = ErrRejectedTip ApiNetworkTip
+    deriving (Eq, Show)
+
 -- | Small helper to easy show things to Text
 showT :: Show a => a -> Text
 showT = T.pack . show
 
+instance LiftHandler ErrRejectedTip where
+    handler = \case
+        ErrRejectedTip {} ->
+            apiError err403 RejectedTip $ mconcat
+                [ "I am sorry but I refuse to rollback to the given point. "
+                , "Notwithstanding I'll willingly rollback to the genesis point "
+                , "(0, 0) if you demand it."
+                ]
+
 instance LiftHandler ErrSelectForMigration where
     handler = \case
         ErrSelectForMigrationNoSuchWallet e -> handler e
diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs
index 979cebe8235..16a1cd3e15b 100644
--- a/lib/core/src/Cardano/Wallet/Api/Types.hs
+++ b/lib/core/src/Cardano/Wallet/Api/Types.hs
@@ -415,6 +415,7 @@ data ApiErrorCode
     | PoolAlreadyJoined
     | NotDelegatingTo
     | InvalidRestorationParameters
+    | RejectedTip
     deriving (Eq, Generic, Show)
 
 -- | Defines a point in time that can be formatted as and parsed from an

From 3d9bc77220fa58341cfe803d4720db04d0422e92 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Tue, 14 Jan 2020 16:09:52 +0100
Subject: [PATCH 3/9] implement 'forceResync' handler properly

Taking care of concurrent workers possibly acting on the database
at the same time as well as restarting the restoration worker at
the right point
---
 lib/core/cardano-wallet-core.cabal        |   1 +
 lib/core/src/Cardano/Wallet/Api/Link.hs   |   1 +
 lib/core/src/Cardano/Wallet/Api/Server.hs | 110 ++++++++++++++--------
 lib/core/src/Cardano/Wallet/DB.hs         |   7 +-
 lib/core/src/Cardano/Wallet/Registry.hs   |  13 ++-
 5 files changed, 87 insertions(+), 45 deletions(-)

diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal
index cf798eb98d5..4b54376acbb 100644
--- a/lib/core/cardano-wallet-core.cabal
+++ b/lib/core/cardano-wallet-core.cabal
@@ -62,6 +62,7 @@ library
     , http-media
     , http-types
     , iohk-monitoring
+    , lifted-base
     , memory
     , monad-logger
     , network
diff --git a/lib/core/src/Cardano/Wallet/Api/Link.hs b/lib/core/src/Cardano/Wallet/Api/Link.hs
index 6191adf4fab..426477ce5b4 100644
--- a/lib/core/src/Cardano/Wallet/Api/Link.hs
+++ b/lib/core/src/Cardano/Wallet/Api/Link.hs
@@ -77,6 +77,7 @@ module Cardano.Wallet.Api.Link
     , postExternalTransaction
 
     , PostWallet
+    , Discriminate
     ) where
 
 import Prelude
diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
index 960cdee78aa..eb085e536e5 100644
--- a/lib/core/src/Cardano/Wallet/Api/Server.hs
+++ b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -70,6 +70,7 @@ import Cardano.Wallet
     , ErrWrongPassphrase (..)
     , HasLogger
     , genesisData
+    , logger
     , networkLayer
     )
 import Cardano.Wallet.Api
@@ -130,7 +131,7 @@ import Cardano.Wallet.Api.Types
     , getApiMnemonicT
     )
 import Cardano.Wallet.DB
-    ( DBFactory )
+    ( DBFactory (..) )
 import Cardano.Wallet.Logging
     ( fromLogObject, transformTextTrace )
 import Cardano.Wallet.Network
@@ -209,12 +210,14 @@ import Control.DeepSeq
     ( NFData )
 import Control.Exception
     ( IOException, bracket, tryJust )
+import Control.Exception.Lifted
+    ( finally )
 import Control.Monad
-    ( forM, forM_, void, when )
+    ( forM, forM_, unless, void )
 import Control.Monad.IO.Class
     ( MonadIO, liftIO )
 import Control.Monad.Trans.Except
-    ( ExceptT, catchE, throwE, withExceptT )
+    ( ExceptT (..), catchE, runExceptT, throwE, withExceptT )
 import Control.Tracer
     ( Tracer, contramap )
 import Data.Aeson
@@ -787,7 +790,7 @@ deleteWallet
     -> Handler NoContent
 deleteWallet ctx (ApiT wid) = do
     liftHandler $ withWorkerCtx @_ @s @k ctx wid throwE $ \_ -> pure ()
-    liftIO $ (df ^. #removeDatabase) wid
+    liftIO $ removeDatabase df wid
     liftIO $ Registry.remove re wid
     return NoContent
   where
@@ -890,14 +893,35 @@ forceResyncWallet
     -> ApiT WalletId
     -> ApiNetworkTip
     -> Handler NoContent
-forceResyncWallet ctx (ApiT wid) tip = guardTip >> do
-    liftHandler $ withWorkerCtx ctx wid throwE $ \wrk ->
-        W.rollbackBlocks wrk wid W.slotMinBound
-    pure NoContent
+forceResyncWallet ctx (ApiT wid) tip = guardTip (== W.slotMinBound) $ \pt -> do
+    liftIO $ Registry.remove re wid
+    liftHandler (safeRollback pt) `finally` liftIO (registerWorker ctx wid)
   where
-    guardTip :: Handler ()
-    guardTip = when (tip /= ApiNetworkTip (ApiT 0) (ApiT 0))
-        $ liftHandler $ throwE $ ErrRejectedTip tip
+    re = ctx ^. workerRegistry @s @k
+    tr = ctx ^. logger
+    df = ctx ^. dbFactory @s @k
+
+    -- NOTE Safe because it happens without any worker running and, we've
+    -- controlled that 'point' is genesis.
+    safeRollback :: W.SlotId -> ExceptT ErrNoSuchWallet IO ()
+    safeRollback point = do
+        let tr' = Registry.transformTrace wid tr
+        ExceptT $ withDatabase df wid $ \db -> do
+            let wrk = hoistResource db (ctx & logger .~ tr')
+            runExceptT $ W.rollbackBlocks wrk wid point
+
+    guardTip
+        :: (W.SlotId -> Bool)
+        -> (W.SlotId -> Handler ())
+        -> Handler NoContent
+    guardTip predicate handler_ = do
+        unless (predicate point) $ liftHandler $ throwE $ ErrRejectedTip tip
+        handler_ point $> NoContent
+      where
+        point = W.SlotId
+            { epochNumber = tip ^. #epochNumber . #getApiT
+            , slotNumber  = tip ^. #slotNumber  . #getApiT
+            }
 
 {-------------------------------------------------------------------------------
                                   Coin Selections
@@ -1345,7 +1369,7 @@ initWorker ctx wid createWallet restoreWallet =
             defaultWorkerAfter . transformTextTrace
 
         , workerAcquire =
-            (df ^. #withDatabase) wid
+            withDatabase df wid
         }
     re = ctx ^. workerRegistry @s @k
     df = ctx ^. dbFactory @s @k
@@ -1440,31 +1464,42 @@ newApiLayer tr g0 nw tl df wids = do
     re <- Registry.empty
     let tr' = contramap MsgFromWorker tr
     let ctx = ApiLayer (fromLogObject tr') g0 nw tl df re
-    forM_ wids (registerWorker re ctx)
+    forM_ wids (registerWorker ctx)
     return ctx
+
+-- | Register a restoration worker to the registry.
+registerWorker
+    :: forall ctx s t k.
+        ( ctx ~ ApiLayer s t k
+        )
+    => ApiLayer s t k
+    -> WalletId
+    -> IO ()
+registerWorker ctx wid = do
+    newWorker @_ @_ @ctx ctx wid config >>= \case
+        Nothing ->
+            return ()
+        Just worker ->
+            Registry.insert re worker
   where
-    registerWorker re ctx wid = do
-        let config = MkWorker
-                { workerBefore =
-                    \_ _ -> return ()
-
-                , workerMain = \ctx' _ -> do
-                    -- FIXME:
-                    -- Review error handling here
-                    unsafeRunExceptT $
-                        W.restoreWallet @(WorkerCtx ctx) @s @t ctx' wid
-
-                , workerAfter =
-                    defaultWorkerAfter . transformTextTrace
-
-                , workerAcquire =
-                    (df ^. #withDatabase) wid
-                }
-        newWorker @_ @_ @ctx ctx wid config >>= \case
-            Nothing ->
-                return ()
-            Just worker ->
-                Registry.insert re worker
+    re = ctx ^. workerRegistry
+    df = ctx ^. dbFactory
+    config = MkWorker
+        { workerBefore =
+            \_ _ -> return ()
+
+        , workerMain = \ctx' _ -> do
+            -- FIXME:
+            -- Review error handling here
+            unsafeRunExceptT $
+                W.restoreWallet @(WorkerCtx ctx) @s @t ctx' wid
+
+        , workerAfter =
+            defaultWorkerAfter . transformTextTrace
+
+        , workerAcquire =
+            withDatabase df wid
+        }
 
 -- | Run an action in a particular worker context. Fails if there's no worker
 -- for a given id.
@@ -1517,8 +1552,7 @@ data ErrCreateWallet
         -- ^ Somehow, we couldn't create a worker or open a db connection
     deriving (Eq, Show)
 
-data ErrRejectedTip
-    = ErrRejectedTip ApiNetworkTip
+newtype ErrRejectedTip = ErrRejectedTip ApiNetworkTip
     deriving (Eq, Show)
 
 -- | Small helper to easy show things to Text
@@ -1531,7 +1565,7 @@ instance LiftHandler ErrRejectedTip where
             apiError err403 RejectedTip $ mconcat
                 [ "I am sorry but I refuse to rollback to the given point. "
                 , "Notwithstanding I'll willingly rollback to the genesis point "
-                , "(0, 0) if you demand it."
+                , "(0, 0) should you demand it."
                 ]
 
 instance LiftHandler ErrSelectForMigration where
diff --git a/lib/core/src/Cardano/Wallet/DB.hs b/lib/core/src/Cardano/Wallet/DB.hs
index 8a224f1aa1f..8346c1ab49c 100644
--- a/lib/core/src/Cardano/Wallet/DB.hs
+++ b/lib/core/src/Cardano/Wallet/DB.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
@@ -57,20 +56,18 @@ import Data.Quantity
     ( Quantity (..) )
 import Data.Word
     ( Word32 )
-import GHC.Generics
-    ( Generic )
 
 import qualified Data.List as L
 
 -- | Instantiate database layers at will
 data DBFactory m s k = DBFactory
-    { withDatabase :: WalletId -> (DBLayer m s k -> IO ()) -> IO ()
+    { withDatabase :: forall a. WalletId -> (DBLayer m s k -> IO a) -> IO a
         -- ^ Creates a new or use an existing database, maintaining an open
         -- connection so long as necessary
 
     , removeDatabase :: WalletId -> IO ()
         -- ^ Erase any trace of the database
-    } deriving (Generic)
+    }
 
 -- | A Database interface for storing various things in a DB. In practice,
 -- we'll need some extra contraints on the wallet state that allows us to
diff --git a/lib/core/src/Cardano/Wallet/Registry.hs b/lib/core/src/Cardano/Wallet/Registry.hs
index 3420bced3ea..10ac4a1852d 100644
--- a/lib/core/src/Cardano/Wallet/Registry.hs
+++ b/lib/core/src/Cardano/Wallet/Registry.hs
@@ -29,6 +29,7 @@ module Cardano.Wallet.Registry
       -- * Logging
     , WithWorkerKey (..)
     , WorkerRegistryLog (..)
+    , transformTrace
     ) where
 
 import Prelude hiding
@@ -224,8 +225,8 @@ newWorker ctx k (MkWorker before main after acquire) = do
             , workerResource = resource
             }
   where
-    tr = ctx ^. logger
-    tr' = contramap (fmap (toText . WithWorkerKey k)) $ appendName "worker" tr
+    tr  = ctx ^. logger
+    tr' = transformTrace k tr
     cleanup mvar e = tryPutMVar mvar Nothing *> after tr' e
 
 -- | A worker log event includes the key (i.e. wallet ID) as context.
@@ -240,6 +241,14 @@ instance ToText key => ToText (WithWorkerKey key) where
                                     Logging
 -------------------------------------------------------------------------------}
 
+transformTrace
+    :: ToText key
+    => key
+    -> Trace IO Text
+    -> Trace IO Text
+transformTrace k tr =
+    contramap (fmap (toText . WithWorkerKey k)) $ appendName "worker" tr
+
 data WorkerRegistryLog
     = MsgFinished
     | MsgThreadKilled

From 4b06845b9fdacccf268302aa443fbf4cfb812366 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Wed, 15 Jan 2020 11:53:49 +0100
Subject: [PATCH 4/9] add integration test for the 'forceResync' endpoint

Doesn't pass currently because of the in-memory sqlite implementation.
It works like a charm with the file database though:

```
(Right before making the request, observe the thread id #142)
[cardano-wallet.wallet-engine:Info:142] [2020-01-15 10:38:04.54 UTC] bdb212cc: In sync with the node.

(Upon receiving the request)
[cardano-wallet.api-server:Info:526] [2020-01-15 10:38:04.97 UTC] [RequestId 10] [DELETE] /v2/wallets/bdb212ccd1d556b62a59f4a4a1de0cff29f61ac1/utxos

(Turning off the worker, rolling back, and switching the worker back on)
[cardano-wallet.wallet-engine:Info:142] [2020-01-15 10:38:04.97 UTC] bdb212cc: Worker has exited: main action is over.
[cardano-wallet.wallet-engine:Info:526] [2020-01-15 10:38:04.98 UTC] bdb212cc: Try rolling back to 0.0
[cardano-wallet.wallet-engine:Info:526] [2020-01-15 10:38:05.00 UTC] bdb212cc: Rolled back to 0.0

(Responding to the request)
[cardano-wallet.api-server:Info:526] [2020-01-15 10:38:05.01 UTC] [RequestId 10] 204 No Content in 0.044038928s

(And later, the worker restarted, applying blocks from the start, new thread id #528).
[cardano-wallet.wallet-engine:Info:528] [2020-01-15 10:38:05.03 UTC] bdb212cc: Applying blocks [1136063.1 ... 1144130.1]
[cardano-wallet.wallet-engine:Info:528] [2020-01-15 10:38:05.03 UTC] bdb212cc: Creating checkpoint at feb1b2c2-[1136063.1#1]
[cardano-wallet.wallet-engine:Info:528] [2020-01-15 10:38:05.04 UTC] bdb212cc: Creating checkpoint at 8920cbb4-[1136063.2#2]
[cardano-wallet.wallet-engine:Info:528] [2020-01-15 10:38:05.04 UTC] bdb212cc: Creating checkpoint at 73a21e9f-[1136063.3#3]

[...]

(Eventually, reaches the tip)
[cardano-wallet.wallet-engine:Info:528] [2020-01-15 10:38:05.18 UTC] bdb212cc: MyWallet, created at 2020-01-15 10:35:28.24351865 UTC, not delegating
[cardano-wallet.wallet-engine:Info:528] [2020-01-15 10:38:05.18 UTC] bdb212cc: syncProgress: restored
[cardano-wallet.wallet-engine:Info:528] [2020-01-15 10:38:05.18 UTC] bdb212cc: discovered 0 new transaction(s)
[cardano-wallet.wallet-engine:Info:528] [2020-01-15 10:38:05.18 UTC] bdb212cc: local tip: 8b9aba60-[1144130.1#100]
```
---
 .../Test/Integration/Framework/TestData.hs    |   7 ++
 .../Test/Integration/Scenario/API/Wallets.hs  | 114 ++++++++++++++++++
 2 files changed, 121 insertions(+)

diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs
index 64d3adbc3fb..993b00aabfe 100644
--- a/lib/core-integration/src/Test/Integration/Framework/TestData.hs
+++ b/lib/core-integration/src/Test/Integration/Framework/TestData.hs
@@ -77,6 +77,7 @@ module Test.Integration.Framework.TestData
     , errMsg500
     , errMsg400NumberOfWords
     , errMsgNotInDictionary
+    , errMsg403RejectedTip
     ) where
 
 import Prelude
@@ -480,3 +481,9 @@ errMsgNotInDictionary = "Found an unknown word not present in the pre-defined\
 
 errMsg400NumberOfWords :: String
 errMsg400NumberOfWords = "Invalid number of words:"
+
+errMsg403RejectedTip :: String
+errMsg403RejectedTip =
+    "I am sorry but I refuse to rollback to the given point. \
+    \Notwithstanding I'll willingly rollback to the genesis point (0, 0) \
+    \should you demand it."
diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Wallets.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Wallets.hs
index 2fa11387dc2..964139af5cc 100644
--- a/lib/core-integration/src/Test/Integration/Scenario/API/Wallets.hs
+++ b/lib/core-integration/src/Test/Integration/Scenario/API/Wallets.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -13,6 +15,8 @@ module Test.Integration.Scenario.API.Wallets
 
 import Prelude
 
+import Cardano.Wallet.Api.Link
+    ( Discriminate )
 import Cardano.Wallet.Api.Types
     ( AddressAmount (..)
     , ApiCoinSelection
@@ -29,13 +33,20 @@ import Cardano.Wallet.Primitive.Mnemonic
 import Cardano.Wallet.Primitive.Types
     ( SyncProgress (..)
     , WalletDelegation (..)
+    , WalletId
     , walletNameMaxLength
     , walletNameMinLength
     )
 import Control.Monad
     ( forM_ )
+import Data.Aeson
+    ( FromJSON )
 import Data.Generics.Internal.VL.Lens
     ( view, (^.) )
+import Data.Generics.Product.Fields
+    ( HasField' )
+import Data.Generics.Product.Typed
+    ( HasType )
 import Data.List.NonEmpty
     ( NonEmpty ((:|)) )
 import Data.Quantity
@@ -44,6 +55,8 @@ import Data.Text
     ( Text )
 import Data.Text.Class
     ( toText )
+import GHC.Generics
+    ( Generic )
 import Numeric.Natural
     ( Natural )
 import Test.Hspec
@@ -59,8 +72,10 @@ import Test.Integration.Framework.DSL
     , coinSelectionInputs
     , coinSelectionOutputs
     , delegation
+    , emptyIcarusWallet
     , emptyRandomWallet
     , emptyWallet
+    , eventually
     , expectErrorMessage
     , expectEventually
     , expectFieldEqual
@@ -93,6 +108,7 @@ import Test.Integration.Framework.TestData
     , chineseMnemonics18
     , chineseMnemonics9
     , errMsg400ParseError
+    , errMsg403RejectedTip
     , errMsg403WrongPass
     , errMsg404NoEndpoint
     , errMsg404NoWallet
@@ -1779,3 +1795,101 @@ spec = do
         ru <- request @ApiWallet ctx ("GET", endpoint) Default newName
         expectResponseCode @IO HTTP.status404 ru
         expectErrorMessage (errMsg404NoWallet wid) ru
+
+    describe "WALLETS_RESYNC_01" $ do
+        scenarioWalletResync01_happyPath @'Shelley emptyWallet
+        scenarioWalletResync01_happyPath @'Byron emptyRandomWallet
+        scenarioWalletResync01_happyPath @'Byron emptyIcarusWallet
+
+    describe "WALLETS_RESYNC_02" $ do
+        scenarioWalletResync02_notGenesis @'Shelley emptyWallet
+        scenarioWalletResync02_notGenesis @'Byron emptyRandomWallet
+        scenarioWalletResync02_notGenesis @'Byron emptyIcarusWallet
+
+    describe "WALLETS_RESYNC_03" $ do
+        scenarioWalletResync03_invalidPayload @'Shelley emptyWallet
+        scenarioWalletResync03_invalidPayload @'Byron emptyRandomWallet
+        scenarioWalletResync03_invalidPayload @'Byron emptyIcarusWallet
+
+
+-- force resync eventually get us back to the same point
+scenarioWalletResync01_happyPath
+    :: forall style t n wallet.
+        ( n ~ 'Testnet
+        , Discriminate style
+        , HasType (ApiT WalletId) wallet
+        , HasField' "state" wallet (ApiT SyncProgress)
+        , FromJSON wallet
+        , Generic wallet
+        , Show wallet
+        )
+    => (Context t -> IO wallet)
+    -> SpecWith (Context t)
+scenarioWalletResync01_happyPath fixture = it
+  "force resync eventually get us back to the same point" $ \ctx -> do
+    w <- fixture ctx
+
+    -- 1. Wait for wallet to be synced
+    eventually $ do
+        v <- request @wallet ctx (Link.getWallet @style w) Default Empty
+        verify v [ expectFieldSatisfy @IO #state (== (ApiT Ready)) ]
+
+    -- 2. Force a resync
+    let payload = Json [json|{ "epoch_number": 0, "slot_number": 0 }|]
+    r <- request @wallet ctx (Link.forceResyncWallet @style w) Default payload
+    verify r [ expectResponseCode @IO HTTP.status204 ]
+
+    -- 3. The wallet eventually re-sync
+    eventually $ do
+        v <- request @wallet ctx (Link.getWallet @style w) Default Empty
+        verify v [ expectFieldSatisfy @IO #state (== (ApiT Ready)) ]
+
+-- force resync eventually get us back to the same point
+scenarioWalletResync02_notGenesis
+    :: forall style t n wallet.
+        ( n ~ 'Testnet
+        , Discriminate style
+        , HasType (ApiT WalletId) wallet
+        , HasField' "state" wallet (ApiT SyncProgress)
+        , FromJSON wallet
+        , Generic wallet
+        , Show wallet
+        )
+    => (Context t -> IO wallet)
+    -> SpecWith (Context t)
+scenarioWalletResync02_notGenesis fixture = it
+  "given point is not genesis (i.e. (0, 0))" $ \ctx -> do
+    w <- fixture ctx
+
+    -- 1. Force a resync on an invalid point (/= from genesis)
+    let payload = Json [json|{ "epoch_number": 14, "slot_number": 42 }|]
+    r <- request @wallet ctx (Link.forceResyncWallet @style w) Default payload
+    verify r
+        [ expectResponseCode @IO HTTP.status403
+        , expectErrorMessage errMsg403RejectedTip
+        ]
+
+-- force resync eventually get us back to the same point
+scenarioWalletResync03_invalidPayload
+    :: forall style t n wallet.
+        ( n ~ 'Testnet
+        , Discriminate style
+        , HasType (ApiT WalletId) wallet
+        , HasField' "state" wallet (ApiT SyncProgress)
+        , FromJSON wallet
+        , Generic wallet
+        , Show wallet
+        )
+    => (Context t -> IO wallet)
+    -> SpecWith (Context t)
+scenarioWalletResync03_invalidPayload fixture = it
+  "given payload is invalid (camelCase)" $ \ctx -> do
+    w <- fixture ctx
+
+    -- 1. Force a resync using an invalid payload
+    let payload = Json [json|{ "epochNumber": 0, "slot_number": 0 }|]
+    r <- request @wallet ctx (Link.forceResyncWallet @style w) Default payload
+    verify r
+        [ expectResponseCode @IO HTTP.status400
+        , expectErrorMessage "key 'epoch_number' not present"
+        ]

From d196fd1be0d19021ca500e53ba32881765c4ac55 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Wed, 15 Jan 2020 11:57:30 +0100
Subject: [PATCH 5/9] preserve in-memory database states between calls

For the in-memory Sqlite database, we do actually preserve the database
after the 'action' is done. This allows for calling 'withDatabase'
several times within the same execution and get back the same database.
The memory is only cleaned up when calling 'removeDatabase', to mimic
the way the file database works!

Without this, code like:

```hs
  Registry.remove re wid
  registerWorker ctx wid
```

would lead to weird behavior where the wallet `wid` which existed when
the worker was stopped didn't exist anymore when register the worker
again. This was because, killing the worker closes the connection
to the database and re-opening the "same" connection on the in-memory
database actually yield a completely different memory representation!
---
 lib/core/src/Cardano/Wallet/DB/Sqlite.hs | 27 ++++++++++++++++++------
 1 file changed, 20 insertions(+), 7 deletions(-)

diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
index e57fed46575..e667ae22fa2 100644
--- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
+++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
@@ -96,7 +96,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery
 import Control.Arrow
     ( (***) )
 import Control.Concurrent.MVar
-    ( modifyMVar_, newMVar )
+    ( modifyMVar, modifyMVar_, newMVar )
 import Control.DeepSeq
     ( NFData )
 import Control.Exception
@@ -223,17 +223,30 @@ newDBFactory
 newDBFactory tr mDatabaseDir = do
     mvar <- newMVar mempty
     case mDatabaseDir of
+        -- NOTE
+        -- For the in-memory database, we do actually preserve the database
+        -- after the 'action' is done. This allows for calling 'withDatabase'
+        -- several times within the same execution and get back the same
+        -- database. The memory is only cleaned up when calling
+        -- 'removeDatabase', to mimic the way the file database works!
         Nothing -> pure DBFactory
-            { withDatabase = \_ action ->
-                withDBLayer tr Nothing (action . snd)
-            , removeDatabase = \_ ->
-                pure ()
+            { withDatabase = \wid action -> do
+                db <- modifyMVar mvar $ \m -> case Map.lookup wid m of
+                    Just (_, db) -> pure (m, db)
+                    Nothing -> do
+                        (ctx, db) <- newDBLayer tr Nothing
+                        pure (Map.insert wid (ctx, db) m, db)
+                action db
+            , removeDatabase = \wid ->
+                modifyMVar_ mvar $ \m -> case Map.lookup wid m of
+                    Nothing -> pure m
+                    Just (ctx, _) -> destroyDBLayer ctx $> Map.delete wid m
             }
         Just databaseDir -> pure DBFactory
             { withDatabase = \wid action -> do
                 withDBLayer tr (Just $ databaseFile wid)
                     $ \(ctx, db) -> do
-                        modifyMVar_ mvar (pure . Map.insert wid ctx)
+                        modifyMVar_ mvar (pure . Map.insert wid (ctx, db))
                         action db
             , removeDatabase = \wid -> do
                 let files =
@@ -243,7 +256,7 @@ newDBFactory tr mDatabaseDir = do
                         ]
                 modifyMVar_ mvar $ \m -> case Map.lookup wid m of
                     Nothing -> pure m
-                    Just ctx -> destroyDBLayer ctx $> Map.delete wid m
+                    Just (ctx, _) -> destroyDBLayer ctx $> Map.delete wid m
                 mapM_ removePathForcibly files
             }
           where

From 423296b5e3a62db258a269027f5672b703f0a09c Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Wed, 15 Jan 2020 16:49:33 +0100
Subject: [PATCH 6/9] revise 'expectResponseCode' to give more details on
 failure

It was kinda hard to understand what was going on from the error message.
This is now slightly better and at least, allow some reasonning
---
 .../src/Test/Integration/Framework/DSL.hs           | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs
index 71c084a8f21..d4b85d8de50 100644
--- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs
+++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs
@@ -338,12 +338,19 @@ expectSuccess (_, res) = case res of
 
 -- | Expect a given response code on the response.
 expectResponseCode
-    :: (MonadIO m)
+    :: (MonadIO m, Show a)
     => HTTP.Status
     -> (HTTP.Status, a)
     -> m ()
-expectResponseCode want (got, _) =
-    got `shouldBe` want
+expectResponseCode want (got, a) =
+    if got == want
+        then pure ()
+        else liftIO $ expectationFailure $ unlines
+            [ "expected: " <> show want
+            , " but got: " <> show got
+            , ""
+            , "from the following response: " <> show a
+            ]
 
 expectFieldEqual
     :: (MonadIO m, MonadFail m, Show a, Eq a)

From 5eae1fa032ec1c62935236bd04b903eaccc17829 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Wed, 15 Jan 2020 18:05:25 +0100
Subject: [PATCH 7/9] re-generate nix machinery

---
 nix/.stack.nix/cardano-wallet-core.nix | 1 +
 1 file changed, 1 insertion(+)

diff --git a/nix/.stack.nix/cardano-wallet-core.nix b/nix/.stack.nix/cardano-wallet-core.nix
index c7401ba9084..e405ea9f057 100644
--- a/nix/.stack.nix/cardano-wallet-core.nix
+++ b/nix/.stack.nix/cardano-wallet-core.nix
@@ -88,6 +88,7 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
           (hsPkgs."http-media" or (buildDepError "http-media"))
           (hsPkgs."http-types" or (buildDepError "http-types"))
           (hsPkgs."iohk-monitoring" or (buildDepError "iohk-monitoring"))
+          (hsPkgs."lifted-base" or (buildDepError "lifted-base"))
           (hsPkgs."memory" or (buildDepError "memory"))
           (hsPkgs."monad-logger" or (buildDepError "monad-logger"))
           (hsPkgs."network" or (buildDepError "network"))

From fab6e17d2c88a073a1a883a80491318537a0ca83 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Thu, 16 Jan 2020 16:34:18 +0100
Subject: [PATCH 8/9] fix database closing error handling

- Added some additional log messages
- Added an extra exception handler
- Swapped worker removal with database closing
- Reviewed how the in-memory database got cleaned up to avoid race condition
---
 lib/core/src/Cardano/DB/Sqlite.hs         | 33 +++++++++++++++++++----
 lib/core/src/Cardano/Wallet/Api/Server.hs |  2 +-
 lib/core/src/Cardano/Wallet/DB/Sqlite.hs  | 23 +++++++---------
 3 files changed, 38 insertions(+), 20 deletions(-)

diff --git a/lib/core/src/Cardano/DB/Sqlite.hs b/lib/core/src/Cardano/DB/Sqlite.hs
index 7ae08851e35..98f9f5f01d3 100644
--- a/lib/core/src/Cardano/DB/Sqlite.hs
+++ b/lib/core/src/Cardano/DB/Sqlite.hs
@@ -90,6 +90,7 @@ import System.Log.FastLogger
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
+import qualified Database.Persist.Sql as Persist
 import qualified Database.Sqlite as Sqlite
 
 {-------------------------------------------------------------------------------
@@ -155,16 +156,26 @@ handleConstraint e = handleJust select handler . fmap Right
 destroyDBLayer :: SqliteContext -> IO ()
 destroyDBLayer (SqliteContext {getSqlBackend, trace, dbFile}) = do
     traceWith trace (MsgClosing dbFile)
-    handleIf
-        isAlreadyClosed
-        (const $ pure ())
-        (recovering pol [const $ Handler isBusy] (const $ close' getSqlBackend))
+    recovering pol [const $ Handler isBusy] (const $ close' getSqlBackend)
+        & handleIf isAlreadyClosed
+            (traceWith trace . MsgIsAlreadyClosed . showT)
+        & handleIf statementAlreadyFinalized
+            (traceWith trace . MsgStatementAlreadyFinalized . showT)
   where
     isAlreadyClosed = \case
         -- Thrown when an attempt is made to close a connection that is already
         -- in the closed state:
         Sqlite.SqliteException Sqlite.ErrorMisuse _ _ -> True
         Sqlite.SqliteException {}                     -> False
+
+    statementAlreadyFinalized = \case
+        -- Thrown
+        Persist.StatementAlreadyFinalized{} -> True
+        Persist.Couldn'tGetSQLConnection{}  -> False
+
+    showT :: Show a => a -> Text
+    showT = T.pack . show
+
     isBusy (SqliteException name _ _) = pure (name == Sqlite.ErrorBusy)
     pol = limitRetriesByCumulativeDelay (60000*ms) $ constantDelay (25*ms)
     ms = 1000 -- microseconds in a millisecond
@@ -244,6 +255,9 @@ data DBLog
     | MsgConnStr Text
     | MsgClosing (Maybe FilePath)
     | MsgDatabaseReset
+    | MsgIsAlreadyClosed Text
+    | MsgStatementAlreadyFinalized Text
+    | MsgRemoving Text
     deriving (Generic, Show, Eq, ToJSON)
 
 instance DefinePrivacyAnnotation DBLog
@@ -257,9 +271,12 @@ instance DefineSeverity DBLog where
         MsgConnStr _ -> Debug
         MsgClosing _ -> Debug
         MsgDatabaseReset -> Notice
+        MsgIsAlreadyClosed _ -> Warning
+        MsgStatementAlreadyFinalized _ -> Warning
+        MsgRemoving _ -> Info
 
 instance ToText DBLog where
-    toText msg = case msg of
+    toText = \case
         MsgMigrations (Right 0) ->
             "No database migrations were necessary."
         MsgMigrations (Right n) ->
@@ -274,6 +291,12 @@ instance ToText DBLog where
         MsgDatabaseReset ->
             "Non backward compatible database found. Removing old database \
             \and re-creating it from scratch. Ignore the previous error."
+        MsgIsAlreadyClosed msg ->
+            "Attempted to close an already closed connection: " <> msg
+        MsgStatementAlreadyFinalized msg ->
+            "Statement already finalized: " <> msg
+        MsgRemoving wid ->
+            "Removing wallet's database. Wallet id was " <> wid
 
 {-------------------------------------------------------------------------------
                                Extra DB Helpers
diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
index eb085e536e5..133a9f21812 100644
--- a/lib/core/src/Cardano/Wallet/Api/Server.hs
+++ b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -790,8 +790,8 @@ deleteWallet
     -> Handler NoContent
 deleteWallet ctx (ApiT wid) = do
     liftHandler $ withWorkerCtx @_ @s @k ctx wid throwE $ \_ -> pure ()
-    liftIO $ removeDatabase df wid
     liftIO $ Registry.remove re wid
+    liftIO $ removeDatabase df wid
     return NoContent
   where
     re = ctx ^. workerRegistry @s @k
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
index e667ae22fa2..682bac815b4 100644
--- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
+++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
@@ -41,7 +41,7 @@ import Cardano.BM.Data.Severity
 import Cardano.BM.Data.Tracer
     ( DefinePrivacyAnnotation (..), DefineSeverity (..) )
 import Cardano.DB.Sqlite
-    ( DBLog
+    ( DBLog (..)
     , SqliteContext (..)
     , chunkSize
     , dbChunked
@@ -117,8 +117,6 @@ import Data.Coerce
     ( coerce )
 import Data.Either
     ( isRight )
-import Data.Functor
-    ( ($>) )
 import Data.Generics.Internal.VL.Lens
     ( (^.) )
 import Data.List.Split
@@ -163,6 +161,8 @@ import Database.Persist.Sql
     )
 import Database.Persist.Sqlite
     ( SqlPersistT )
+import Fmt
+    ( pretty )
 import System.Directory
     ( doesFileExist, listDirectory, removePathForcibly )
 import System.FilePath
@@ -237,26 +237,21 @@ newDBFactory tr mDatabaseDir = do
                         (ctx, db) <- newDBLayer tr Nothing
                         pure (Map.insert wid (ctx, db) m, db)
                 action db
-            , removeDatabase = \wid ->
-                modifyMVar_ mvar $ \m -> case Map.lookup wid m of
-                    Nothing -> pure m
-                    Just (ctx, _) -> destroyDBLayer ctx $> Map.delete wid m
+            , removeDatabase = \wid -> do
+                traceWith tr $ MsgRemoving (pretty wid)
+                modifyMVar_ mvar (pure . Map.delete wid)
             }
+
         Just databaseDir -> pure DBFactory
             { withDatabase = \wid action -> do
-                withDBLayer tr (Just $ databaseFile wid)
-                    $ \(ctx, db) -> do
-                        modifyMVar_ mvar (pure . Map.insert wid (ctx, db))
-                        action db
+                withDBLayer tr (Just $ databaseFile wid) (action . snd)
             , removeDatabase = \wid -> do
+                traceWith tr $ MsgRemoving (pretty wid)
                 let files =
                         [ databaseFile wid
                         , databaseFile wid <> "-wal"
                         , databaseFile wid <> "-shm"
                         ]
-                modifyMVar_ mvar $ \m -> case Map.lookup wid m of
-                    Nothing -> pure m
-                    Just (ctx, _) -> destroyDBLayer ctx $> Map.delete wid m
                 mapM_ removePathForcibly files
             }
           where

From 9babcc2c202a51d300520f0618d50c3871f476c3 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Thu, 16 Jan 2020 16:34:32 +0100
Subject: [PATCH 9/9] use on-disk database in integration tests

---
 lib/jormungandr/test/integration/Main.hs | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/lib/jormungandr/test/integration/Main.hs b/lib/jormungandr/test/integration/Main.hs
index b8c033647d2..9cf515a17a5 100644
--- a/lib/jormungandr/test/integration/Main.hs
+++ b/lib/jormungandr/test/integration/Main.hs
@@ -66,6 +66,8 @@ import System.Environment
     ( setEnv )
 import System.FilePath
     ( (</>) )
+import System.IO.Temp
+    ( withSystemTempDirectory )
 import Test.Hspec
     ( Spec, SpecWith, after, describe, hspec, parallel )
 import Test.Hspec.Extra
@@ -171,8 +173,15 @@ specWithServer tr = aroundAll withContext . after tearDown
     withServer setup =
         withConfig $ \jmCfg ->
         withMetadataRegistry $
-            serveWallet @'Testnet tracers (SyncTolerance 10) Nothing "127.0.0.1"
-                ListenOnRandomPort (Launch jmCfg) setup
+        withSystemTempDirectory "cardano-wallet-databases" $ \db ->
+            serveWallet @'Testnet
+                tracers
+                (SyncTolerance 10)
+                (Just db)
+                "127.0.0.1"
+                ListenOnRandomPort
+                (Launch jmCfg)
+                setup
 
     tracers = setupTracers (tracerSeverities (Just Info)) tr