Merge #1268

1268: endpoint: force wallet resync r=KtorZ a=KtorZ

# Issue Number

<!-- Put here a reference to the issue this PR relates to and which requirements it tackles -->

#1146 

# Overview

<!-- Detail in a few bullet points the work accomplished in this PR -->
- 06ee934
  extend swagger specification with 'forceResync'
  As an extreme measure to force re-sync the wallet

- 0938999
  extend API with 'forceResync' operation
  - Added a 'forceResync' link
- Extended the servant Client
- Provide an initial straightforward implementation re-using 'rollbackBlocks'

- 8f2b197
  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

- 7d3e281
  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]
```

- e134d52
  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!

- 1577706
  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

# Comments

<!-- Additional comments or screenshots to attach if any -->

![Screenshot from 2020-01-15 16-50-37](https://user-images.githubusercontent.com/5680256/72448387-3373ee80-37b7-11ea-962d-60c507ea4617.png)

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: KtorZ <[email protected]>

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)

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."

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"
+        ]

lib/core/cardano-wallet-core.cabal

@@ -62,6 +62,7 @@ library
     , http-media
     , http-types
     , iohk-monitoring
+    , lifted-base
     , memory
     , monad-logger
     , network

lib/core/src/Cardano/Wallet.hs

@@ -74,6 +74,7 @@ module Cardano.Wallet
     , updateWalletPassphrase
     , walletSyncProgress
     , fetchRewardBalance
+    , rollbackBlocks
     , ErrWalletAlreadyExists (..)
     , ErrNoSuchWallet (..)
     , ErrListUTxOStatistics (..)

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
 

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

lib/core/src/Cardano/Wallet/Api/Link.hs

@@ -48,6 +48,7 @@ module Cardano.Wallet.Api.Link
     , getUTxOsStatistics
     , getMigrationInfo
     , migrateWallet
+    , forceResyncWallet
 
       -- * Addresses
     , listAddresses
@@ -76,6 +77,7 @@ module Cardano.Wallet.Api.Link
     , postExternalTransaction
 
     , PostWallet
+    , Discriminate
     ) where
 
 import Prelude
@@ -241,6 +243,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
 --