View on GitHub
File Changes
+
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
+
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE QuasiQuotes #-}

                      
import Prelude

                      
+
import Cardano.Wallet.Api.Link
+
    ( Discriminate )
import Cardano.Wallet.Api.Types
    ( AddressAmount (..)
    , ApiCoinSelection
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
    ( Text )
import Data.Text.Class
    ( toText )
+
import GHC.Generics
+
    ( Generic )
import Numeric.Natural
    ( Natural )
import Test.Hspec
    , coinSelectionInputs
    , coinSelectionOutputs
    , delegation
+
    , emptyIcarusWallet
    , emptyRandomWallet
    , emptyWallet
+
    , eventually
    , expectErrorMessage
    , expectEventually
    , expectFieldEqual
        ru <- request @ApiWallet ctx ("GET", endpoint) Default newName
        expectResponseCode @IO HTTP.status404 ru
        expectErrorMessage (errMsg404NoWallet wid) ru
+

                      
+
    describe "WALLETS_RESYNC_01 - \
+
        \ force resync eventually get us back to the same point" $ do
+
        -- scenarioWalletResync01 @'Shelley emptyWallet
+
        -- scenarioWalletResync01 @'Byron emptyRandomWallet
+
        scenarioWalletResync01 @'Byron emptyIcarusWallet
+

                      
+

                      
+

                      
+
-- force resync eventually get us back to the same point
+
scenarioWalletResync01
+
    :: forall style t n wallet.
+
        ( n ~ 'Testnet
+
        , Discriminate style
+
        , HasType (ApiT WalletId) wallet
+
        , HasField' "state" wallet (ApiT SyncProgress)
+
        , FromJSON wallet
+
        , Generic wallet
+
        )
+
    => (Context t -> IO wallet)
+
    -> SpecWith (Context t)
+
scenarioWalletResync01 fixture = it "scenario" $ \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
+
    r <- request @wallet ctx
+
        (Link.forceResyncWallet @style w) Default Empty
+
    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)) ]
    , postExternalTransaction

                      
    , PostWallet
+
    , Discriminate
    ) where

                      
import Prelude
forceResyncWallet ctx (ApiT wid) = do
    liftHandler $ withWorkerCtx @_ @s @k ctx wid throwE $ \_ -> pure ()
    flip finally (liftIO $ registerWorker ctx wid) $ do
-
        liftIO $ Registry.remove re wid
+
        -- liftIO $ Registry.remove re wid
        liftHandler $ ExceptT safeRollback
    pure NoContent
  where
-
    re = ctx ^. workerRegistry @s @k
+
    -- re = ctx ^. workerRegistry @s @k
    tr = ctx ^. logger
    df = ctx ^. dbFactory @s @k
    -- NOTE Safe because it happens without any worker running.
    safeRollback = do
        let tr' = Registry.transformTrace wid tr
        withDatabase df wid $ \db -> do
            let wrk = hoistResource db (ctx & logger .~ tr')
-
            runExceptT $ W.rollbackBlocks wrk wid W.slotMinBound
+
            e <- runExceptT $ W.rollbackBlocks wrk wid W.slotMinBound
+
            print e
+
            return e

                      
{-------------------------------------------------------------------------------
                                  Coin Selections