From fc676e4be5333f3c961cbdbbc699cdfd9fdb92d9 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 6 May 2021 11:18:05 +0000 Subject: [PATCH 01/29] Make `ApiWalletMigrationPostData.addresses` non-empty. Supplying an empty list of addresses would make it impossible to perform a migration. --- lib/core/src/Cardano/Wallet/Api/Types.hs | 2 +- lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs | 4 ++-- lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs | 8 +++++--- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index 56bddd352eb..35b1d24458b 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -1026,7 +1026,7 @@ newtype ApiWalletMigrationPlanPostData (n :: NetworkDiscriminant) = data ApiWalletMigrationPostData (n :: NetworkDiscriminant) (s :: Symbol) = ApiWalletMigrationPostData { passphrase :: !(ApiT (Passphrase s)) - , addresses :: ![(ApiT Address, Proxy n)] + , addresses :: !(NonEmpty (ApiT Address, Proxy n)) } deriving (Eq, Generic, Show) deriving anyclass NFData diff --git a/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs b/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs index 125938e3fc8..38b159ba7f3 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs @@ -1686,13 +1686,13 @@ migrateDataCases = { "passphrase": #{wPassphrase} , "addresses": "not_a_array" }|] - , "Error in $.addresses: parsing [] failed, expected Array, but encountered String" + , "Error in $.addresses: parsing NonEmpty failed, expected Array, but encountered String" ) , ( [aesonQQ| { "passphrase": #{wPassphrase} , "addresses": 1 }|] - , "Error in $.addresses: parsing [] failed, expected Array, but encountered Number" + , "Error in $.addresses: parsing NonEmpty failed, expected Array, but encountered Number" ) , ( [aesonQQ| { "passphrase": #{wPassphrase} diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs index f9190bd276e..e36ddfb6679 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs @@ -1345,10 +1345,12 @@ instance Arbitrary (ApiWalletMigrationPlanPostData n) where instance Arbitrary (Passphrase purpose) => Arbitrary (ApiWalletMigrationPostData n purpose) where arbitrary = do - n <- choose (1,255) pwd <- arbitrary - addr <- vector n - pure $ ApiWalletMigrationPostData pwd ((, Proxy @n) <$> addr) + addrCount <- choose (1, 255) + addrs <- (:|) + <$> arbitrary + <*> replicateM (addrCount - 1) arbitrary + pure $ ApiWalletMigrationPostData pwd ((, Proxy @n) <$> addrs) instance Arbitrary ApiWalletPassphrase where arbitrary = genericArbitrary From e295ca433354db0d56f55beb8d0f8aa31d6e5c73 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 3 May 2021 08:35:30 +0000 Subject: [PATCH 02/29] Add function `Wallet.migrationPlanToUnsignedTxs`. --- lib/core/src/Cardano/Wallet.hs | 72 ++++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index 130d91857ce..f4b023544e0 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -118,6 +118,7 @@ module Cardano.Wallet , ErrWithdrawalNotWorth (..) -- ** Migration + , migrationPlanToUnsignedTxs -- ** Delegation , PoolRetirementEpochInfo (..) @@ -276,6 +277,8 @@ import Cardano.Wallet.Primitive.CoinSelection.MA.RoundRobin , emptySkeleton , performSelection ) +import Cardano.Wallet.Primitive.Migration + ( MigrationPlan (..) ) import Cardano.Wallet.Primitive.Model ( Wallet , applyBlocks @@ -439,6 +442,8 @@ import Data.Time.Clock ( NominalDiffTime, UTCTime ) import Data.Type.Equality ( (:~:) (..), testEquality ) +import Data.Void + ( Void ) import Data.Word ( Word64 ) import Fmt @@ -459,6 +464,7 @@ import UnliftIO.MVar import qualified Cardano.Crypto.Wallet as CC import qualified Cardano.Wallet.Primitive.AddressDiscovery.Random as Rnd import qualified Cardano.Wallet.Primitive.AddressDiscovery.Sequential as Seq +import qualified Cardano.Wallet.Primitive.Migration as Migration import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Coin as Coin import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle @@ -1785,6 +1791,72 @@ getTransaction ctx wid tid = db & \DBLayer{..} -> do where db = ctx ^. dbLayer @IO @s @k +{------------------------------------------------------------------------------- + Migration +-------------------------------------------------------------------------------} + +migrationPlanToUnsignedTxs + :: forall s input inputUnqualified output noChange withdrawal unsignedTx. + ( IsOurs s Address + , input ~ (TxIn, TxOut, NonEmpty DerivationIndex) + , inputUnqualified ~ (TxIn, TxOut) + , output ~ TxOut + , noChange ~ Void + , withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex) + , unsignedTx ~ UnsignedTx input output noChange withdrawal + ) + => s + -> MigrationPlan + -> Withdrawal + -> NonEmpty Address + -> [unsignedTx] +migrationPlanToUnsignedTxs s plan rewardWithdrawal outputAddressesToCycle = + fst $ L.foldr + (accumulate) + ([], NE.toList $ NE.cycle outputAddressesToCycle) + (view #selections plan) + where + accumulate + :: Migration.Selection inputUnqualified + -> ([unsignedTx], [Address]) + -> ([unsignedTx], [Address]) + accumulate selection (unsignedTxs, outputAddresses) = + (unsignedTx : unsignedTxs, outputAddressesRemaining) + where + unsignedTx = s + -- Here we take a shortcut by reusing the functionality provided + -- for turning an ordinary coin selection into an unsigned tx: + & selectionToUnsignedTx selectionRewardWithdrawal ordinarySelection + -- Assert that the unsigned transaction does not have any change: + & voidChange + where + ordinarySelection = SelectionResult + { inputsSelected = view #inputIds selection + , outputsCovered = unsignedOutputs + , utxoRemaining = UTxOIndex.empty + , extraCoinSource = Nothing + , changeGenerated = [] + } + + voidChange + :: UnsignedTx input output anyChange withdrawal + -> UnsignedTx input output noChange withdrawal + voidChange tx = tx {unsignedChange = []} + + selectionRewardWithdrawal = + if (view #rewardWithdrawal selection) > Coin 0 + then rewardWithdrawal + else NoWithdrawal + + unsignedOutputs :: [TxOut] + unsignedOutputs = zipWith TxOut + (outputAddresses) + (NE.toList $ view #outputs selection) + + outputAddressesRemaining :: [Address] + outputAddressesRemaining = + drop (length $ view #outputs selection) outputAddresses + {------------------------------------------------------------------------------- Delegation -------------------------------------------------------------------------------} From 0d9493f14c2acd8a09e0e0322c6c8ae39ac12dde Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 6 May 2021 09:08:35 +0000 Subject: [PATCH 03/29] Add function `Wallet.createMigrationPlan`. --- lib/core/src/Cardano/Wallet.hs | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index f4b023544e0..513b7563c19 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -118,7 +118,9 @@ module Cardano.Wallet , ErrWithdrawalNotWorth (..) -- ** Migration + , createMigrationPlan , migrationPlanToUnsignedTxs + , ErrCreateMigrationPlan (..) -- ** Delegation , PoolRetirementEpochInfo (..) @@ -1795,6 +1797,30 @@ getTransaction ctx wid tid = db & \DBLayer{..} -> do Migration -------------------------------------------------------------------------------} +createMigrationPlan + :: forall ctx k s. + ( HasDBLayer IO s k ctx + , HasNetworkLayer IO ctx + , HasTransactionLayer k ctx + ) + => ctx + -> WalletId + -> Withdrawal + -> ExceptT ErrCreateMigrationPlan IO MigrationPlan +createMigrationPlan ctx wid rewardWithdrawal = do + (wallet, _, pending) <- withExceptT ErrCreateMigrationPlanNoSuchWallet $ + readWallet @ctx @s @k ctx wid + pp <- liftIO $ currentProtocolParameters nl + let txConstraints = view #constraints tl pp + let utxo = availableUTxO @s pending wallet + pure + $ Migration.createPlan txConstraints utxo + $ Migration.RewardWithdrawal + $ withdrawalToCoin rewardWithdrawal + where + nl = ctx ^. networkLayer + tl = ctx ^. transactionLayer @k + migrationPlanToUnsignedTxs :: forall s input inputUnqualified output noChange withdrawal unsignedTx. ( IsOurs s Address @@ -2383,6 +2409,11 @@ data ErrStartTimeLaterThanEndTime = ErrStartTimeLaterThanEndTime , errEndTime :: UTCTime } deriving (Show, Eq) +data ErrCreateMigrationPlan + = ErrCreateMigrationPlanEmpty + | ErrCreateMigrationPlanNoSuchWallet ErrNoSuchWallet + deriving (Generic, Eq, Show) + data ErrSelectAssets = ErrSelectAssetsCriteriaError ErrSelectionCriteria | ErrSelectAssetsNoSuchWallet ErrNoSuchWallet From da08c6d88e320b1914ce4feaee3bc064460cb7c7 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 6 May 2021 09:11:05 +0000 Subject: [PATCH 04/29] Implement function `Api.Server.createMigrationPlan`. --- lib/core/src/Cardano/Wallet/Api/Server.hs | 90 +++++++++++++++++++++-- 1 file changed, 85 insertions(+), 5 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index a3fcafa18ef..cf17ba35bea 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -125,6 +125,7 @@ import Cardano.Wallet , ErrCannotJoin (..) , ErrCannotQuit (..) , ErrConstructSharedWallet (..) + , ErrCreateMigrationPlan (..) , ErrCreateRandomAddress (..) , ErrDecodeSignedTx (..) , ErrDerivePublicKey (..) @@ -228,6 +229,7 @@ import Cardano.Wallet.Api.Types , ApiWalletDelegation (..) , ApiWalletDelegationNext (..) , ApiWalletDelegationStatus (..) + , ApiWalletMigrationBalance (..) , ApiWalletMigrationPlan (..) , ApiWalletMigrationPlanPostData (..) , ApiWalletMigrationPostData (..) @@ -331,6 +333,8 @@ import Cardano.Wallet.Primitive.CoinSelection.MA.RoundRobin , balanceMissing , selectionDelta ) +import Cardano.Wallet.Primitive.Migration + ( MigrationPlan (..) ) import Cardano.Wallet.Primitive.Model ( Wallet, availableBalance, currentTip, getState, totalBalance ) import Cardano.Wallet.Primitive.Slotting @@ -412,6 +416,8 @@ import Control.Arrow ( second ) import Control.DeepSeq ( NFData ) +import Control.Error.Util + ( failWith ) import Control.Monad ( forM, forever, join, unless, void, when, (>=>) ) import Control.Monad.IO.Class @@ -533,6 +539,7 @@ import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Coin as Coin import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle import qualified Cardano.Wallet.Primitive.Types.Tx as W +import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO import qualified Cardano.Wallet.Registry as Registry import qualified Data.Aeson as Aeson import qualified Data.ByteString as BS @@ -2015,15 +2022,81 @@ quitStakePool ctx (ApiT wid) body = do -------------------------------------------------------------------------------} createMigrationPlan - :: forall n s k. () - => ApiLayer s k - -- ^ Source wallet context + :: forall ctx n s k. + ( ctx ~ ApiLayer s k + , Bounded (Index (AddressIndexDerivationType k) 'AddressK) + , HardDerivation k + , IsOwned s k + , Typeable n + , Typeable s + , WalletKey k + ) + => ctx -> ApiT WalletId -- ^ Source wallet -> ApiWalletMigrationPlanPostData n + -- ^ Target addresses -> Handler (ApiWalletMigrationPlan n) -createMigrationPlan _ctx _wid _postData = do - liftHandler $ throwE ErrTemporarilyDisabled +createMigrationPlan ctx (ApiT wid) postData = do + (rewardWithdrawal, _) <- mkRewardAccountBuilder @_ @s @_ @n ctx wid Nothing + withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $ do + (wallet, _, _) <- withExceptT ErrCreateMigrationPlanNoSuchWallet $ + W.readWallet wrk wid + plan <- W.createMigrationPlan wrk wid rewardWithdrawal + failWith ErrCreateMigrationPlanEmpty $ mkApiWalletMigrationPlan + (getState wallet) + (view #addresses postData) + (rewardWithdrawal) + (plan) + +mkApiWalletMigrationPlan + :: forall n s. IsOurs s Address + => s + -> NonEmpty (ApiT Address, Proxy n) + -> Withdrawal + -> MigrationPlan + -> Maybe (ApiWalletMigrationPlan n) +mkApiWalletMigrationPlan s addresses rewardWithdrawal plan + | Just selections <- maybeSelections = + Just ApiWalletMigrationPlan + { selections + , totalFee + , balanceLeftover + , balanceSelected + } + | otherwise = + Nothing + where + maybeSelections :: Maybe (NonEmpty (ApiCoinSelection n)) + maybeSelections = NE.nonEmpty $ + mkApiCoinSelectionForMigration <$> unsignedTxs + + totalFee :: Quantity "lovelace" Natural + totalFee = coinToQuantity $ view #totalFee plan + + balanceLeftover :: ApiWalletMigrationBalance + balanceLeftover = plan + & view #unselected + & UTxO.balance + & mkApiWalletMigrationBalance + + balanceSelected :: ApiWalletMigrationBalance + balanceSelected = plan + & view #selections + & F.foldMap (view #inputBalance) + & mkApiWalletMigrationBalance + + unsignedTxs = W.migrationPlanToUnsignedTxs s plan rewardWithdrawal $ + getApiT . fst <$> addresses + + mkApiCoinSelectionForMigration unsignedTx = + mkApiCoinSelection [] Nothing Nothing (unsignedTx {unsignedChange = []}) + + mkApiWalletMigrationBalance :: TokenBundle -> ApiWalletMigrationBalance + mkApiWalletMigrationBalance b = ApiWalletMigrationBalance + { ada = coinToQuantity $ view #coin b + , assets = ApiT $ view #tokens b + } migrateWallet :: forall s k n p. () @@ -3207,6 +3280,13 @@ instance IsServerError ErrOutputTokenQuantityExceedsLimit where , "." ] +instance IsServerError ErrCreateMigrationPlan where + toServerError = \case + ErrCreateMigrationPlanEmpty -> + -- TODO: Provide a more useful error message: + apiError err403 NothingToMigrate "Nothing to migrate" + ErrCreateMigrationPlanNoSuchWallet e -> toServerError e + instance IsServerError ErrSelectAssets where toServerError = \case ErrSelectAssetsCriteriaError e -> toServerError e From 2354342cd3af6ceda39b60f4280357122f0d5008 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 7 May 2021 04:05:00 +0000 Subject: [PATCH 05/29] Decompose function `Wallet.migrationPlanToUnsignedTxs`. The responsibility for turning a `SelectionResult` and a `Withdrawal` into an `UnsignedTx` can be located outside of this function. In fact, it is advantageous to do so, since signing a transaction with `signTransaction` requires a `SelectionResult`, and not a `UnsignedTx`. --- lib/core/src/Cardano/Wallet.hs | 81 +++++++++-------------- lib/core/src/Cardano/Wallet/Api/Server.hs | 17 +++-- 2 files changed, 44 insertions(+), 54 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index 513b7563c19..03c0d825f03 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -17,6 +17,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- | -- Copyright: © 2018-2020 IOHK @@ -119,7 +120,7 @@ module Cardano.Wallet -- ** Migration , createMigrationPlan - , migrationPlanToUnsignedTxs + , migrationPlanToSelectionWithdrawals , ErrCreateMigrationPlan (..) -- ** Delegation @@ -1821,67 +1822,49 @@ createMigrationPlan ctx wid rewardWithdrawal = do nl = ctx ^. networkLayer tl = ctx ^. transactionLayer @k -migrationPlanToUnsignedTxs - :: forall s input inputUnqualified output noChange withdrawal unsignedTx. - ( IsOurs s Address - , input ~ (TxIn, TxOut, NonEmpty DerivationIndex) - , inputUnqualified ~ (TxIn, TxOut) - , output ~ TxOut - , noChange ~ Void - , withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex) - , unsignedTx ~ UnsignedTx input output noChange withdrawal - ) - => s - -> MigrationPlan +migrationPlanToSelectionWithdrawals + :: forall noChange. noChange ~ Void + => MigrationPlan -> Withdrawal -> NonEmpty Address - -> [unsignedTx] -migrationPlanToUnsignedTxs s plan rewardWithdrawal outputAddressesToCycle = - fst $ L.foldr + -> [(SelectionResult noChange, Withdrawal)] +migrationPlanToSelectionWithdrawals plan rewardWithdrawal outputAddressesToCycle + = fst + $ L.foldr (accumulate) ([], NE.toList $ NE.cycle outputAddressesToCycle) (view #selections plan) where accumulate - :: Migration.Selection inputUnqualified - -> ([unsignedTx], [Address]) - -> ([unsignedTx], [Address]) - accumulate selection (unsignedTxs, outputAddresses) = - (unsignedTx : unsignedTxs, outputAddressesRemaining) + :: Migration.Selection (TxIn, TxOut) + -> ([(SelectionResult noChange, Withdrawal)], [Address]) + -> ([(SelectionResult noChange, Withdrawal)], [Address]) + accumulate migrationSelection (selectionWithdrawals, outputAddresses) = + ( (selection, withdrawal) : selectionWithdrawals + , outputAddressesRemaining + ) where - unsignedTx = s - -- Here we take a shortcut by reusing the functionality provided - -- for turning an ordinary coin selection into an unsigned tx: - & selectionToUnsignedTx selectionRewardWithdrawal ordinarySelection - -- Assert that the unsigned transaction does not have any change: - & voidChange - where - ordinarySelection = SelectionResult - { inputsSelected = view #inputIds selection - , outputsCovered = unsignedOutputs - , utxoRemaining = UTxOIndex.empty - , extraCoinSource = Nothing - , changeGenerated = [] - } - - voidChange - :: UnsignedTx input output anyChange withdrawal - -> UnsignedTx input output noChange withdrawal - voidChange tx = tx {unsignedChange = []} + selection = SelectionResult + { inputsSelected = view #inputIds migrationSelection + , outputsCovered + , utxoRemaining = UTxOIndex.empty + , extraCoinSource = Nothing + , changeGenerated = [] + } - selectionRewardWithdrawal = - if (view #rewardWithdrawal selection) > Coin 0 - then rewardWithdrawal - else NoWithdrawal + withdrawal = + if (view #rewardWithdrawal migrationSelection) > Coin 0 + then rewardWithdrawal + else NoWithdrawal - unsignedOutputs :: [TxOut] - unsignedOutputs = zipWith TxOut - (outputAddresses) - (NE.toList $ view #outputs selection) + outputsCovered :: [TxOut] + outputsCovered = zipWith TxOut + (outputAddresses) + (NE.toList $ view #outputs migrationSelection) outputAddressesRemaining :: [Address] outputAddressesRemaining = - drop (length $ view #outputs selection) outputAddresses + drop (length $ view #outputs migrationSelection) outputAddresses {------------------------------------------------------------------------------- Delegation diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index cf17ba35bea..f4563527bda 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -328,7 +328,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.SharedState ) import Cardano.Wallet.Primitive.CoinSelection.MA.RoundRobin ( SelectionError (..) - , SelectionInsufficientError (..) + , SelectionResult (..) , UnableToConstructChangeError (..) , balanceMissing , selectionDelta @@ -472,6 +472,8 @@ import Data.Time ( UTCTime ) import Data.Type.Equality ( (:~:) (..), type (==), testEquality ) +import Data.Void + ( Void ) import Data.Word ( Word32 ) import Fmt @@ -2086,11 +2088,16 @@ mkApiWalletMigrationPlan s addresses rewardWithdrawal plan & F.foldMap (view #inputBalance) & mkApiWalletMigrationBalance - unsignedTxs = W.migrationPlanToUnsignedTxs s plan rewardWithdrawal $ - getApiT . fst <$> addresses + selectionWithdrawals :: [(SelectionResult Void, Withdrawal)] + selectionWithdrawals + = W.migrationPlanToSelectionWithdrawals plan rewardWithdrawal + $ getApiT . fst <$> addresses + + unsignedTxs = selectionWithdrawals <&> \(selection, withdrawal) -> + W.selectionToUnsignedTx withdrawal (selection {changeGenerated = []}) s mkApiCoinSelectionForMigration unsignedTx = - mkApiCoinSelection [] Nothing Nothing (unsignedTx {unsignedChange = []}) + mkApiCoinSelection [] Nothing Nothing unsignedTx mkApiWalletMigrationBalance :: TokenBundle -> ApiWalletMigrationBalance mkApiWalletMigrationBalance b = ApiWalletMigrationBalance @@ -3314,7 +3321,7 @@ instance IsServerError ErrSelectAssets where , "because I need to select additional inputs and " , "doing so will make the transaction too big. Try " , "sending a smaller amount. I had already selected " - , showT (length $ inputsSelected e), " inputs." + , showT (length $ view #inputsSelected e), " inputs." ] InsufficientMinCoinValues xs -> apiError err403 UtxoTooSmall $ mconcat From 66f901f041a1a1e4ccf2d8bf5eef941987bf9338 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 7 May 2021 10:14:09 +0000 Subject: [PATCH 06/29] Decompose function `Wallet.signTransaction`. This function had the dual responsibility of assigning change addresses and signing the resultant transaction. However, we sometimes need to sign transactions for which change addresses have already been assigned, or transactions without any change. In the second case, it's overly restrictive to require that callers provide a way of making change addresses. Therefore, it makes sense to decouple these two behaviours. This change extracts out a new function `assignChangeAddressesAndUpdateDb`, which handles the responsibility of assigning change addresses and updating the DB. --- lib/core/src/Cardano/Wallet.hs | 62 +++++++++++++++-------- lib/core/src/Cardano/Wallet/Api/Server.hs | 12 +++-- lib/core/test/unit/Cardano/WalletSpec.hs | 10 ++-- 3 files changed, 57 insertions(+), 27 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index 03c0d825f03..41539dcd8fe 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -111,6 +111,7 @@ module Cardano.Wallet , readWalletUTxOIndex , selectAssetsNoOutputs , assignChangeAddresses + , assignChangeAddressesAndUpdateDb , selectionToUnsignedTx , signTransaction , ErrSelectAssets(..) @@ -1201,7 +1202,7 @@ normalizeDelegationAddress s addr = do -- to change outputs to which new addresses have been assigned. This updates -- the wallet state as it needs to keep track of new pending change addresses. assignChangeAddresses - :: forall s. (GenChange s) + :: forall s. GenChange s => ArgGenChange s -> SelectionResult TokenBundle -> s @@ -1212,6 +1213,28 @@ assignChangeAddresses argGenChange sel = runState $ do pure $ TxOut addr bundle pure $ sel { changeGenerated = changeOuts } +assignChangeAddressesAndUpdateDb + :: forall ctx s k. + ( GenChange s + , HasDBLayer IO s k ctx + ) + => ctx + -> WalletId + -> ArgGenChange s + -> SelectionResult TokenBundle + -> ExceptT ErrSignPayment IO (SelectionResult TxOut) +assignChangeAddressesAndUpdateDb ctx wid generateChange selection = + db & \DBLayer{..} -> mapExceptT atomically $ do + cp <- withExceptT ErrSignPaymentNoSuchWallet $ + withNoSuchWallet wid $ readCheckpoint wid + let (selectionUpdated, stateUpdated) = + assignChangeAddresses generateChange selection (getState cp) + withExceptT ErrSignPaymentNoSuchWallet $ + putCheckpoint wid (updateState stateUpdated cp) + pure selectionUpdated + where + db = ctx ^. dbLayer @IO @s @k + selectionToUnsignedTx :: forall s input output change withdrawal. ( IsOurs s Address @@ -1441,46 +1464,45 @@ selectAssets ctx (utxo, cp, pending) tx outs transform = do hasWithdrawal :: Tx -> Bool hasWithdrawal = not . null . withdrawals --- | Produce witnesses and construct a transaction from a given --- selection. Requires the encryption passphrase in order to decrypt --- the root private key. Note that this doesn't broadcast the --- transaction to the network. In order to do so, use 'submitTx'. +-- | Produce witnesses and construct a transaction from a given selection. +-- +-- Requires the encryption passphrase in order to decrypt the root private key. +-- Note that this doesn't broadcast the transaction to the network. In order to +-- do so, use 'submitTx'. +-- signTransaction :: forall ctx s k. ( HasTransactionLayer k ctx , HasDBLayer IO s k ctx , HasNetworkLayer IO ctx , IsOwned s k - , GenChange s ) => ctx -> WalletId - -> ArgGenChange s - -> ((k 'RootK XPrv, Passphrase "encryption") -> (XPrv, Passphrase "encryption")) + -> ( (k 'RootK XPrv, Passphrase "encryption") -> + ( XPrv, Passphrase "encryption") + ) -- ^ Reward account derived from the root key (or somewhere else). -> Passphrase "raw" -> TransactionCtx - -> SelectionResult TokenBundle + -> SelectionResult TxOut -> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx) -signTransaction ctx wid argChange mkRwdAcct pwd txCtx sel = db & \DBLayer{..} -> do +signTransaction ctx wid mkRwdAcct pwd txCtx sel = + db & \DBLayer{..} -> do era <- liftIO $ currentNodeEra nl withRootKey @_ @s ctx wid pwd ErrSignPaymentWithRootKey $ \xprv scheme -> do let pwdP = preparePassphrase scheme pwd mapExceptT atomically $ do - cp <- withExceptT ErrSignPaymentNoSuchWallet $ withNoSuchWallet wid $ - readCheckpoint wid + cp <- withExceptT ErrSignPaymentNoSuchWallet + $ withNoSuchWallet wid + $ readCheckpoint wid pp <- liftIO $ currentProtocolParameters nl - let (sel', s') = assignChangeAddresses argChange sel (getState cp) - withExceptT ErrSignPaymentNoSuchWallet $ - putCheckpoint wid (updateState s' cp) - let keyFrom = isOwned (getState cp) (xprv, pwdP) let rewardAcnt = mkRwdAcct (xprv, pwdP) - (tx, sealedTx) <- withExceptT ErrSignPaymentMkTx $ ExceptT $ pure $ - mkTransaction tl era rewardAcnt keyFrom pp txCtx sel' - - (time, meta) <- liftIO $ mkTxMeta ti (currentTip cp) s' txCtx sel' + mkTransaction tl era rewardAcnt keyFrom pp txCtx sel + (time, meta) <- liftIO $ + mkTxMeta ti (currentTip cp) (getState cp) txCtx sel return (tx, meta, time, sealedTx) where db = ctx ^. dbLayer @IO @s @k diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index f4563527bda..b19128b3990 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -1755,8 +1755,10 @@ postTransaction ctx genChange (ApiT wid) body = do w <- liftHandler $ W.readWalletUTxOIndex @_ @s @k wrk wid sel <- liftHandler $ W.selectAssets @_ @s @k wrk w txCtx outs (const Prelude.id) + sel' <- liftHandler + $ W.assignChangeAddressesAndUpdateDb wrk wid genChange sel (tx, txMeta, txTime, sealedTx) <- liftHandler - $ W.signTransaction @_ @s @k wrk wid genChange mkRwdAcct pwd txCtx sel + $ W.signTransaction @_ @s @k wrk wid mkRwdAcct pwd txCtx sel' liftHandler $ W.submitTx @_ @s @k wrk wid (tx, txMeta, sealedTx) pure (sel, tx, txMeta, txTime) @@ -1913,8 +1915,10 @@ joinStakePool ctx knownPools getPoolStatus apiPoolId (ApiT wid) body = do sel <- liftHandler $ W.selectAssetsNoOutputs @_ @s @k wrk wid wal txCtx $ const Prelude.id + sel' <- liftHandler + $ W.assignChangeAddressesAndUpdateDb wrk wid genChange sel (tx, txMeta, txTime, sealedTx) <- liftHandler - $ W.signTransaction @_ @s @k wrk wid genChange mkRwdAcct pwd txCtx sel + $ W.signTransaction @_ @s @k wrk wid mkRwdAcct pwd txCtx sel' liftHandler $ W.submitTx @_ @s @k wrk wid (tx, txMeta, sealedTx) @@ -1996,8 +2000,10 @@ quitStakePool ctx (ApiT wid) body = do sel <- liftHandler $ W.selectAssetsNoOutputs @_ @s @k wrk wid wal txCtx $ const Prelude.id + sel' <- liftHandler + $ W.assignChangeAddressesAndUpdateDb wrk wid genChange sel (tx, txMeta, txTime, sealedTx) <- liftHandler - $ W.signTransaction @_ @s @k wrk wid genChange mkRwdAcct pwd txCtx sel + $ W.signTransaction @_ @s @k wrk wid mkRwdAcct pwd txCtx sel' liftHandler $ W.submitTx @_ @s @k wrk wid (tx, txMeta, sealedTx) diff --git a/lib/core/test/unit/Cardano/WalletSpec.hs b/lib/core/test/unit/Cardano/WalletSpec.hs index dcde1f57c5a..c31860cdaf4 100644 --- a/lib/core/test/unit/Cardano/WalletSpec.hs +++ b/lib/core/test/unit/Cardano/WalletSpec.hs @@ -587,11 +587,13 @@ walletKeyIsReencrypted (wid, wname) (xprv, pwd) newPwd = unsafeRunExceptT $ W.attachPrivateKeyFromPwd wl wid (xprv, pwd) let credentials (rootK, pwdP) = (getRawKey $ deriveRewardAccount pwdP rootK, pwdP) - (_,_,_,txOld) <- unsafeRunExceptT $ - W.signTransaction @_ @_ wl wid () credentials (coerce pwd) ctx selection + selection' <- unsafeRunExceptT $ + W.assignChangeAddressesAndUpdateDb wl wid () selection + (_,_,_,txOld) <- unsafeRunExceptT $ W.signTransaction + @_ @_ wl wid credentials (coerce pwd) ctx selection' unsafeRunExceptT $ W.updateWalletPassphrase wl wid (coerce pwd, newPwd) - (_,_,_,txNew) <- unsafeRunExceptT $ - W.signTransaction @_ @_ wl wid () credentials newPwd ctx selection + (_,_,_,txNew) <- unsafeRunExceptT $ W.signTransaction + @_ @_ wl wid credentials newPwd ctx selection' txOld `shouldBe` txNew where selection = SelectionResult From b1458b82d45c89ed929a35994e508f503ae19bb9 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 6 May 2021 11:19:17 +0000 Subject: [PATCH 07/29] Implement function `Api.Server.migrateWallet`. --- lib/core/src/Cardano/Wallet/Api/Server.hs | 51 ++++++++++++++++++++--- 1 file changed, 45 insertions(+), 6 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index b19128b3990..eee725ce361 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -2112,15 +2112,54 @@ mkApiWalletMigrationPlan s addresses rewardWithdrawal plan } migrateWallet - :: forall s k n p. () - => ApiLayer s k - -- ^ Source wallet context + :: forall ctx s k n p. + ( ctx ~ ApiLayer s k + , Bounded (Index (AddressIndexDerivationType k) 'AddressK) + , HardDerivation k + , HasNetworkLayer IO ctx + , IsOwned s k + , Typeable n + , Typeable s + , WalletKey k + ) + => ctx -> ApiT WalletId - -- ^ Source wallet -> ApiWalletMigrationPostData n p -> Handler [ApiTransaction n] -migrateWallet _ctx _wid _migrateData = do - liftHandler $ throwE ErrTemporarilyDisabled +migrateWallet ctx (ApiT wid) postData = do + (rewardWithdrawal, mkRewardAccount) <- + mkRewardAccountBuilder @_ @s @_ @n ctx wid Nothing + withWorkerCtx ctx wid liftE liftE $ \wrk -> do + plan <- liftHandler $ W.createMigrationPlan wrk wid rewardWithdrawal + txTimeToLive <- liftIO $ W.getTxExpiry ti Nothing + let selectionWithdrawals = W.migrationPlanToSelectionWithdrawals + plan rewardWithdrawal addresses + forM selectionWithdrawals $ \(selection, txWithdrawal) -> do + let txContext = defaultTransactionCtx + { txWithdrawal + , txTimeToLive + , txDelegationAction = Nothing + } + (tx, txMeta, txTime, sealedTx) <- liftHandler $ + W.signTransaction @_ @s @k wrk wid mkRewardAccount pwd txContext + (selection {changeGenerated = []}) + liftHandler $ + W.submitTx @_ @s @k wrk wid (tx, txMeta, sealedTx) + liftIO $ mkApiTransaction + (timeInterpreter (ctx ^. networkLayer)) + (txId tx) + (tx ^. #fee) + (NE.toList $ second Just <$> selection ^. #inputsSelected) + (tx ^. #outputs) + (tx ^. #withdrawals) + (txMeta, txTime) + (Nothing) + (#pendingSince) + where + addresses = getApiT . fst <$> view #addresses postData + pwd = coerce $ getApiT $ postData ^. #passphrase + ti :: TimeInterpreter (ExceptT PastHorizonException IO) + ti = timeInterpreter (ctx ^. networkLayer) {------------------------------------------------------------------------------- Network From 5e4f4f7deea94c7f2cf0ea13a125a463eb4da536 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 10 May 2021 04:52:20 +0000 Subject: [PATCH 08/29] Use correct response types for migration endpoints. The integration tests expect these to be 202 ACCEPTED. --- specifications/api/swagger.yaml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 566f8b2e4de..14621b33640 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -3686,8 +3686,8 @@ x-responsesCreateWalletMigrationPlan: &responsesCreateWalletMigrationPlan schema: *errNothingToMigrate <<: *responsesErr404WalletNotFound <<: *responsesErr406 - 200: - description: Ok + 202: + description: Accepted content: application/json: schema: *ApiWalletMigrationPlan @@ -3705,8 +3705,8 @@ x-responsesMigrateWallet: &responsesMigrateWallet <<: *responsesErr404WalletNotFound <<: *responsesErr406 <<: *responsesErr415UnsupportedMediaType - 200: - description: Ok + 202: + description: Accepted content: application/json: schema: From fa958d9b5c96f92cedf8b0432c6bf895a9ca3a5b Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 12 May 2021 04:31:14 +0000 Subject: [PATCH 09/29] Make `migrateWallet` endpoint return non-empty tx list. In the case where there really is nothing to migrate, we already return a 403 error. So there's no point in using types that make it possible to return an empty list of transactions as part of a successful response. --- lib/core/src/Cardano/Wallet.hs | 5 ++-- lib/core/src/Cardano/Wallet/Api.hs | 6 +++-- lib/core/src/Cardano/Wallet/Api/Server.hs | 28 +++++++++++++---------- specifications/api/swagger.yaml | 1 + 4 files changed, 24 insertions(+), 16 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index 41539dcd8fe..d1448b48d14 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -1849,9 +1849,10 @@ migrationPlanToSelectionWithdrawals => MigrationPlan -> Withdrawal -> NonEmpty Address - -> [(SelectionResult noChange, Withdrawal)] + -> Maybe (NonEmpty (SelectionResult noChange, Withdrawal)) migrationPlanToSelectionWithdrawals plan rewardWithdrawal outputAddressesToCycle - = fst + = NE.nonEmpty + $ fst $ L.foldr (accumulate) ([], NE.toList $ NE.cycle outputAddressesToCycle) diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs index d3105c6b12e..254eb379828 100644 --- a/lib/core/src/Cardano/Wallet/Api.hs +++ b/lib/core/src/Cardano/Wallet/Api.hs @@ -232,6 +232,8 @@ import Data.Generics.Product.Typed ( HasType, typed ) import Data.Kind ( Type ) +import Data.List.NonEmpty + ( NonEmpty ) import GHC.Generics ( Generic ) import Servant.API @@ -519,7 +521,7 @@ type MigrateShelleyWallet n = "wallets" :> Capture "walletId" (ApiT WalletId) :> "migrations" :> ReqBody '[JSON] (ApiWalletMigrationPostDataT n "raw") - :> PostAccepted '[JSON] [ApiTransactionT n] + :> PostAccepted '[JSON] (NonEmpty (ApiTransactionT n)) -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/createShelleyWalletMigrationPlan type CreateShelleyWalletMigrationPlan n = "wallets" @@ -803,7 +805,7 @@ type MigrateByronWallet n = "byron-wallets" :> Capture "walletId" (ApiT WalletId) :> "migrations" :> ReqBody '[JSON] (ApiWalletMigrationPostDataT n "lenient") - :> PostAccepted '[JSON] [ApiTransactionT n] + :> PostAccepted '[JSON] (NonEmpty (ApiTransactionT n)) -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/createByronWalletMigrationPlan type CreateByronWalletMigrationPlan n = "byron-wallets" diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index eee725ce361..2cfe04f945f 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -2076,8 +2076,18 @@ mkApiWalletMigrationPlan s addresses rewardWithdrawal plan Nothing where maybeSelections :: Maybe (NonEmpty (ApiCoinSelection n)) - maybeSelections = NE.nonEmpty $ - mkApiCoinSelectionForMigration <$> unsignedTxs + maybeSelections = fmap mkApiCoinSelectionForMigration <$> maybeUnsignedTxs + + maybeSelectionWithdrawals + :: Maybe (NonEmpty (SelectionResult Void, Withdrawal)) + maybeSelectionWithdrawals + = W.migrationPlanToSelectionWithdrawals plan rewardWithdrawal + $ getApiT . fst <$> addresses + + maybeUnsignedTxs = fmap mkUnsignedTx <$> maybeSelectionWithdrawals + where + mkUnsignedTx (selection, withdrawal) = W.selectionToUnsignedTx + withdrawal (selection {changeGenerated = []}) s totalFee :: Quantity "lovelace" Natural totalFee = coinToQuantity $ view #totalFee plan @@ -2094,14 +2104,6 @@ mkApiWalletMigrationPlan s addresses rewardWithdrawal plan & F.foldMap (view #inputBalance) & mkApiWalletMigrationBalance - selectionWithdrawals :: [(SelectionResult Void, Withdrawal)] - selectionWithdrawals - = W.migrationPlanToSelectionWithdrawals plan rewardWithdrawal - $ getApiT . fst <$> addresses - - unsignedTxs = selectionWithdrawals <&> \(selection, withdrawal) -> - W.selectionToUnsignedTx withdrawal (selection {changeGenerated = []}) s - mkApiCoinSelectionForMigration unsignedTx = mkApiCoinSelection [] Nothing Nothing unsignedTx @@ -2125,14 +2127,16 @@ migrateWallet => ctx -> ApiT WalletId -> ApiWalletMigrationPostData n p - -> Handler [ApiTransaction n] + -> Handler (NonEmpty (ApiTransaction n)) migrateWallet ctx (ApiT wid) postData = do (rewardWithdrawal, mkRewardAccount) <- mkRewardAccountBuilder @_ @s @_ @n ctx wid Nothing withWorkerCtx ctx wid liftE liftE $ \wrk -> do plan <- liftHandler $ W.createMigrationPlan wrk wid rewardWithdrawal txTimeToLive <- liftIO $ W.getTxExpiry ti Nothing - let selectionWithdrawals = W.migrationPlanToSelectionWithdrawals + selectionWithdrawals <- liftHandler + $ failWith ErrCreateMigrationPlanEmpty + $ W.migrationPlanToSelectionWithdrawals plan rewardWithdrawal addresses forM selectionWithdrawals $ \(selection, txWithdrawal) -> do let txContext = defaultTransactionCtx diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 14621b33640..d7a33718625 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -3712,6 +3712,7 @@ x-responsesMigrateWallet: &responsesMigrateWallet schema: type: array items: *ApiTransaction + minItems: 1 x-responsesDeleteWallet: &responsesDeleteWallet <<: *responsesErr400 From c2a174a3be51efb285c83ab6c5b6c4bf4a2178fd Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 10 May 2021 05:13:14 +0000 Subject: [PATCH 10/29] Resurrect test `CREATE_MIGRATION_PLAN_01`. --- .../Scenario/API/Byron/Migrations.hs | 31 +++++++++++++------ .../Scenario/API/Shelley/Migrations.hs | 31 +++++++++++++------ 2 files changed, 44 insertions(+), 18 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index 8bc79ec784f..873bf3bd3ea 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -48,6 +48,8 @@ import Control.Monad.IO.Class ( liftIO ) import Control.Monad.Trans.Resource ( runResourceT ) +import Data.Functor + ( (<&>) ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.Maybe @@ -115,18 +117,29 @@ spec :: forall n. , PaymentAddress n ByronKey ) => SpecWith Context spec = describe "BYRON_MIGRATIONS" $ do - it "BYRON_CALCULATE_01 - \ - \for non-empty wallet calculated fee is > zero." + + it "BYRON_CREATE_MIGRATION_PLAN_01 - \ + \Can create a migration plan." $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] $ \fixtureByronWallet -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - w <- fixtureByronWallet ctx - let ep = Link.createMigrationPlan @'Byron w - r <- request @(ApiWalletMigrationPlan n) ctx ep Default Empty - verify r - [ expectResponseCode HTTP.status200 + sourceWallet <- fixtureByronWallet ctx + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.createMigrationPlan @'Byron sourceWallet + response <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify response + [ expectResponseCode HTTP.status202 , expectField (#totalFee . #getQuantity) - (.> 0) + (`shouldBe` 334_200) + , expectField (#selections) + ((`shouldBe` 1) . length) + , expectField (#balanceSelected . #ada . #getQuantity) + (`shouldBe` 1_000_000_000_000) + , expectField (#balanceLeftover . #ada . #getQuantity) + (`shouldBe` 0) ] it "BYRON_CALCULATE_02 - \ diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index fabd2b1b8f6..4c5c7c55c87 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -47,6 +47,8 @@ import Control.Monad.IO.Class ( liftIO ) import Control.Monad.Trans.Resource ( runResourceT ) +import Data.Functor + ( (<&>) ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.Maybe @@ -114,17 +116,28 @@ spec :: forall n. , PaymentAddress n ByronKey ) => SpecWith Context spec = describe "SHELLEY_MIGRATIONS" $ do - it "SHELLEY_CALCULATE_01 - \ - \for non-empty wallet calculated fee is > zero." + + it "SHELLEY_CREATE_MIGRATION_PLAN_01 - \ + \Can create a migration plan." $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - w <- fixtureWallet ctx - let ep = Link.createMigrationPlan @'Shelley w - r <- request @(ApiWalletMigrationPlan n) ctx ep Default Empty - verify r - [ expectResponseCode HTTP.status200 + sourceWallet <- fixtureWallet ctx + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.createMigrationPlan @'Shelley sourceWallet + response <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify response + [ expectResponseCode HTTP.status202 , expectField (#totalFee . #getQuantity) - (.> 0) + (`shouldBe` 255_200) + , expectField (#selections) + ((`shouldBe` 1) . length) + , expectField (#balanceSelected . #ada . #getQuantity) + (`shouldBe` 1_000_000_000_000) + , expectField (#balanceLeftover . #ada . #getQuantity) + (`shouldBe` 0) ] it "SHELLEY_CALCULATE_02 - \ From 81485394d6a740d85946862aa59fa5878ced52c8 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 10 May 2021 05:24:13 +0000 Subject: [PATCH 11/29] Resurrect test `CREATE_MIGRATION_PLAN_02`. --- .../Test/Integration/Framework/TestData.hs | 6 ++---- .../Scenario/API/Byron/Migrations.hs | 21 ++++++++++++------- .../Scenario/API/Shelley/Migrations.hs | 21 ++++++++++++------- 3 files changed, 28 insertions(+), 20 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs index e92af78228f..b6695ba5112 100644 --- a/lib/core-integration/src/Test/Integration/Framework/TestData.hs +++ b/lib/core-integration/src/Test/Integration/Framework/TestData.hs @@ -353,10 +353,8 @@ errMsg400MinWithdrawalWrong = "The minimum withdrawal value must be at least \ \1 Lovelace." errMsg403NothingToMigrate :: Text -> String -errMsg403NothingToMigrate wid = - "I can't migrate the wallet with the given id: " ++ unpack wid ++ - ", because it's either empty or full of small coins which wouldn't be \ - \worth migrating." +errMsg403NothingToMigrate _wid = + "Nothing to migrate" errMsg404NoAsset :: String errMsg404NoAsset = "The requested asset is not associated with this wallet." diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index 873bf3bd3ea..51a111304a6 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -142,17 +142,22 @@ spec = describe "BYRON_MIGRATIONS" $ do (`shouldBe` 0) ] - it "BYRON_CALCULATE_02 - \ - \Cannot calculate fee for empty wallet." + it "BYRON_CREATE_MIGRATION_PLAN_02 - \ + \Cannot create plan for empty wallet." $ \ctx -> forM_ [emptyRandomWallet, emptyIcarusWallet] $ \emptyByronWallet -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - w <- emptyByronWallet ctx - let ep = Link.createMigrationPlan @'Byron w - r <- request @(ApiWalletMigrationPlan n) ctx ep Default Empty - verify r + sourceWallet <- emptyByronWallet ctx + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.createMigrationPlan @'Byron sourceWallet + response <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify response [ expectResponseCode HTTP.status403 - , expectErrorMessage (errMsg403NothingToMigrate $ w ^. walletId) + , expectErrorMessage + (errMsg403NothingToMigrate $ sourceWallet ^. walletId) ] it "BYRON_CALCULATE_02 - \ diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index 4c5c7c55c87..7cb07019fa4 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -140,16 +140,21 @@ spec = describe "SHELLEY_MIGRATIONS" $ do (`shouldBe` 0) ] - it "SHELLEY_CALCULATE_02 - \ - \Cannot calculate fee for empty wallet." + it "SHELLEY_CREATE_MIGRATION_PLAN_02 - \ + \Cannot create plan for empty wallet." $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - w <- emptyWallet ctx - let ep = Link.createMigrationPlan @'Shelley w - r <- request @(ApiWalletMigrationPlan n) ctx ep Default Empty - verify r + sourceWallet <- emptyWallet ctx + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.createMigrationPlan @'Shelley sourceWallet + response <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify response [ expectResponseCode HTTP.status403 - , expectErrorMessage (errMsg403NothingToMigrate $ w ^. walletId) + , expectErrorMessage + (errMsg403NothingToMigrate $ sourceWallet ^. walletId) ] describe "SHELLEY_CALCULATE_03 - \ From db065f110857073550cecddcf8205bcb720b6c3f Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 10 May 2021 06:31:55 +0000 Subject: [PATCH 12/29] Resurrect test `CREATE_MIGRATION_PLAN_03`. --- .../Scenario/API/Byron/Migrations.hs | 27 +++++++----- .../Scenario/API/Shelley/Migrations.hs | 41 ++++++++++++------- 2 files changed, 43 insertions(+), 25 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index 51a111304a6..dae61ff4eda 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -160,6 +160,23 @@ spec = describe "BYRON_MIGRATIONS" $ do (errMsg403NothingToMigrate $ sourceWallet ^. walletId) ] + it "BYRON_CREATE_MIGRATION_PLAN_03 - \ + \Cannot create plan for Shelley wallet using Byron endpoint." + $ \ctx -> runResourceT $ do + sourceWallet <- emptyWallet ctx + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.createMigrationPlan @'Byron sourceWallet + response <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify response + [ expectResponseCode HTTP.status404 + , expectErrorMessage + (errMsg404NoWallet $ sourceWallet ^. walletId) + ] + it "BYRON_CALCULATE_02 - \ \Cannot calculate fee for wallet with dust, that cannot be migrated." $ \ctx -> runResourceT $ do @@ -184,16 +201,6 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectErrorMessage (errMsg403NothingToMigrate $ w ^. walletId) ] - it "BYRON_CALCULATE_03 - \ - \Cannot estimate migration for Shelley wallet using Byron endpoint" - $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - w <- emptyWallet ctx - let ep = Link.createMigrationPlan @'Byron w - r <- request @(ApiWalletMigrationPlan n) ctx ep Default Empty - expectResponseCode HTTP.status404 r - expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r - describe "BYRON_MIGRATE_05 - I could migrate to any valid address" $ do forM_ [ ("Byron", emptyRandomWallet) , ("Icarus", emptyIcarusWallet) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index 7cb07019fa4..b99b200addd 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -157,21 +157,32 @@ spec = describe "SHELLEY_MIGRATIONS" $ do (errMsg403NothingToMigrate $ sourceWallet ^. walletId) ] - describe "SHELLEY_CALCULATE_03 - \ - \Cannot estimate migration for Byron wallet using Shelley endpoint" $ do - forM_ [ ("Byron", emptyRandomWallet) - , ("Icarus", emptyIcarusWallet) - ] $ \(walType, byronWallet) -> do - - it ("Cannot calculate Shelley migration using wallet: " ++ walType) - $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - w <- byronWallet ctx - let ep = Link.createMigrationPlan @'Shelley w - r <- request - @(ApiWalletMigrationPlan n) ctx ep Default Empty - expectResponseCode HTTP.status404 r - expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r + describe "SHELLEY_CREATE_MIGRATION_PLAN_03 - \ + \Cannot create plan for Byron wallet using Shelley endpoint." $ do + let sourceWallets = + [ ("Random", emptyRandomWallet) + , ("Icarus", emptyIcarusWallet) + ] + forM_ sourceWallets $ \(walletType, byronWallet) -> do + let title = mconcat + [ "Cannot calculate Shelley migration using wallet: " + , walletType + ] + it title $ \ctx -> runResourceT $ do + sourceWallet <- byronWallet ctx + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.createMigrationPlan @'Shelley sourceWallet + result <- request + @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify result + [ expectResponseCode HTTP.status404 + , expectErrorMessage + (errMsg404NoWallet $ sourceWallet ^. walletId) + ] describe "SHELLEY_MIGRATE_01 - \ \after a migration operation successfully completes, the correct \ From 267339d16f3f41673edda88b49ce6bbb82cb724d Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 10 May 2021 07:19:24 +0000 Subject: [PATCH 13/29] Resurrect test `CREATE_MIGRATION_PLAN_04`. --- .../src/Test/Integration/Faucet.hs | 4 ++ .../Scenario/API/Byron/Migrations.hs | 37 +++++++++++-------- .../Scenario/API/Shelley/Migrations.hs | 31 +++++++++++++++- 3 files changed, 55 insertions(+), 17 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Faucet.hs b/lib/core-integration/src/Test/Integration/Faucet.hs index f851e85fe4d..901a64d5768 100644 --- a/lib/core-integration/src/Test/Integration/Faucet.hs +++ b/lib/core-integration/src/Test/Integration/Faucet.hs @@ -20,6 +20,10 @@ module Test.Integration.Faucet , mirMnemonics , maMnemonics + -- * Dust wallets + , bigDustWallet + , onlyDustWallet + -- * Sea horses , seaHorseTokenName , seaHorsePolicyId diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index dae61ff4eda..afa25205c9b 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -177,28 +177,35 @@ spec = describe "BYRON_MIGRATIONS" $ do (errMsg404NoWallet $ sourceWallet ^. walletId) ] - it "BYRON_CALCULATE_02 - \ - \Cannot calculate fee for wallet with dust, that cannot be migrated." + it "BYRON_CREATE_MIGRATION_PLAN_04 - \ + \Cannot create a plan for a wallet that only contains dust." $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - -- NOTE - -- Special mnemonic for which wallet with dust - -- (5 utxo with 60 lovelace) - let mnemonics = - ["suffer", "decorate", "head", "opera", "yellow", "debate" - , "visa", "fire", "salute", "hybrid", "stone", "smart"] :: [Text] + -- NOTE: + -- Special mnemonic for wallet that has dust + -- (5 UTxOs with 60 lovelace each) + let mnemonicSentence = + [ "suffer", "decorate", "head", "opera", "yellow", "debate" + , "visa", "fire", "salute", "hybrid", "stone", "smart" + ] :: [Text] let payloadRestore = Json [json| { "name": "Dust Byron Wallet", - "mnemonic_sentence": #{mnemonics}, + "mnemonic_sentence": #{mnemonicSentence}, "passphrase": #{fixturePassphrase}, "style": "random" } |] - w <- unsafeResponse <$> postByronWallet ctx payloadRestore - let ep = Link.createMigrationPlan @'Byron w - r <- request @(ApiWalletMigrationPlan n) ctx ep Default Empty - verify r + sourceWallet <- unsafeResponse <$> + postByronWallet ctx payloadRestore + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.createMigrationPlan @'Byron sourceWallet + response <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify response [ expectResponseCode HTTP.status403 - , expectErrorMessage (errMsg403NothingToMigrate $ w ^. walletId) + , expectErrorMessage + (errMsg403NothingToMigrate $ sourceWallet ^. walletId) ] describe "BYRON_MIGRATE_05 - I could migrate to any valid address" $ do diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index b99b200addd..9b1c3a36ade 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -17,7 +17,7 @@ module Test.Integration.Scenario.API.Shelley.Migrations import Prelude import Cardano.Mnemonic - ( entropyToMnemonic, genEntropy ) + ( entropyToMnemonic, genEntropy, mnemonicToText ) import Cardano.Wallet.Api.Types ( ApiT (..) , ApiTransaction @@ -67,6 +67,8 @@ import Test.Hspec.Expectations.Lifted ( shouldBe, shouldSatisfy ) import Test.Hspec.Extra ( it ) +import Test.Integration.Faucet + ( onlyDustWallet ) import Test.Integration.Framework.DSL ( Context (..) , Headers (..) @@ -184,6 +186,31 @@ spec = describe "SHELLEY_MIGRATIONS" $ do (errMsg404NoWallet $ sourceWallet ^. walletId) ] + it "SHELLEY_CREATE_MIGRATION_PLAN_04 - \ + \Cannot create a plan for a wallet that only contains dust." + $ \ctx -> runResourceT $ do + liftIO $ pendingWith + "Disabled until a real dust wallet is available." + let payloadRestore = Json [json| { + "name": "Dust Shelley Wallet", + "mnemonic_sentence": #{mnemonicToText onlyDustWallet}, + "passphrase": #{fixturePassphrase}, + "style": "random" + } |] + sourceWallet <- unsafeResponse <$> postWallet ctx payloadRestore + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.createMigrationPlan @'Shelley sourceWallet + response <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify response + [ expectResponseCode HTTP.status403 + , expectErrorMessage + (errMsg403NothingToMigrate $ sourceWallet ^. walletId) + ] + describe "SHELLEY_MIGRATE_01 - \ \after a migration operation successfully completes, the correct \ \amount eventually becomes available in the target wallet for arbitrary \ @@ -193,7 +220,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do testAddressCycling 3 testAddressCycling 10 - Hspec.it "SHELLEY_MIGRATE_01_big_wallet - \ + it "SHELLEY_MIGRATE_01_big_wallet - \ \ migrate a big wallet requiring more than one tx" $ \ctx -> runResourceT @IO $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." From 65cbe79277dd9481c51a84e469f6b0c6d08b25e9 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 10 May 2021 07:41:32 +0000 Subject: [PATCH 14/29] Resurrect test `CREATE_MIGRATION_PLAN_05`. --- .../Scenario/API/Byron/Migrations.hs | 24 +++++++++++++++++++ .../Scenario/API/Shelley/Migrations.hs | 23 ++++++++++++++++++ 2 files changed, 47 insertions(+) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index afa25205c9b..59ca2edbfcc 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -208,6 +208,30 @@ spec = describe "BYRON_MIGRATIONS" $ do (errMsg403NothingToMigrate $ sourceWallet ^. walletId) ] + it "BYRON_CREATE_MIGRATION_PLAN_05 - \ + \Creating a plan is deterministic." + $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] + $ \fixtureByronWallet -> runResourceT $ do + sourceWallet <- fixtureByronWallet ctx + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.createMigrationPlan @'Byron sourceWallet + response1 <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + response2 <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + expectResponseCode HTTP.status202 response1 + expectResponseCode HTTP.status202 response2 + expectField (#selections) ((.> 0) . length) response1 + expectField (#selections) ((.> 0) . length) response2 + case (snd response1, snd response2) of + (Right plan1, Right plan2) -> + liftIO $ plan1 `shouldBe` plan2 + _ -> + error "Unable to compare plans." + describe "BYRON_MIGRATE_05 - I could migrate to any valid address" $ do forM_ [ ("Byron", emptyRandomWallet) , ("Icarus", emptyIcarusWallet) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index 9b1c3a36ade..15c2d396ab2 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -211,6 +211,29 @@ spec = describe "SHELLEY_MIGRATIONS" $ do (errMsg403NothingToMigrate $ sourceWallet ^. walletId) ] + it "SHELLEY_CREATE_MIGRATION_PLAN_05 - \ + \Creating a plan is deterministic." + $ \ctx -> runResourceT $ do + sourceWallet <- fixtureWallet ctx + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.createMigrationPlan @'Shelley sourceWallet + response1 <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + response2 <- request @(ApiWalletMigrationPlan n) ctx ep Default + (Json [json|{addresses: #{targetAddressIds}}|]) + expectResponseCode HTTP.status202 response1 + expectResponseCode HTTP.status202 response2 + expectField (#selections) ((.> 0) . length) response1 + expectField (#selections) ((.> 0) . length) response2 + case (snd response1, snd response2) of + (Right plan1, Right plan2) -> + plan1 `shouldBe` plan2 + _ -> + error "Unable to compare plans." + describe "SHELLEY_MIGRATE_01 - \ \after a migration operation successfully completes, the correct \ \amount eventually becomes available in the target wallet for arbitrary \ From 476edd1624f72afc26b89a5191fcb3e33757507e Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 11 May 2021 04:40:53 +0000 Subject: [PATCH 15/29] Resurrect test `MIGRATE_01`. --- .../Scenario/API/Byron/Migrations.hs | 98 ++++++++++--------- .../Scenario/API/Shelley/Migrations.hs | 91 +++++++++-------- 2 files changed, 102 insertions(+), 87 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index 59ca2edbfcc..f1b0dfc5788 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -232,6 +232,19 @@ spec = describe "BYRON_MIGRATIONS" $ do _ -> error "Unable to compare plans." + describe "BYRON_MIGRATE_01 - \ + \After a migration operation successfully completes, the correct \ + \amounts eventually become available in the target wallet for an \ + \arbitrary number of specified addresses, and the balance of the \ + \source wallet is completely depleted." + $ do + testAddressCycling "Random" fixtureRandomWallet 1 + testAddressCycling "Random" fixtureRandomWallet 3 + testAddressCycling "Random" fixtureRandomWallet 10 + testAddressCycling "Icarus" fixtureIcarusWallet 1 + testAddressCycling "Icarus" fixtureIcarusWallet 3 + testAddressCycling "Icarus" fixtureIcarusWallet 10 + describe "BYRON_MIGRATE_05 - I could migrate to any valid address" $ do forM_ [ ("Byron", emptyRandomWallet) , ("Icarus", emptyIcarusWallet) @@ -275,16 +288,7 @@ spec = describe "BYRON_MIGRATIONS" $ do expectResponseCode HTTP.status400 r expectErrorMessage errMsg400ParseError r - it "BYRON_MIGRATE_01 - \ - \after a migration operation successfully completes, the correct \ - \amount eventually becomes available in the target wallet for arbitrary \ - \ number of specified addresses." - $ \ctx -> runResourceT $ do - testAddressCycling ctx 1 - testAddressCycling ctx 3 - testAddressCycling ctx 10 - - Hspec.it "BYRON_MIGRATE_01 - \ + Hspec.it "BYRON_MIGRATE_XX_big_wallet - \ \ migrate a big wallet requiring more than one tx" $ \ctx -> runResourceT @IO $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." -- NOTE @@ -375,7 +379,7 @@ spec = describe "BYRON_MIGRATIONS" $ do ((`shouldBe` (Just 100)) . Map.lookup 10_000_000_000) ] - it "BYRON_MIGRATE_01 - \ + it "BYRON_MIGRATE_XX - \ \a migration operation removes all funds from the source wallet." $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] $ \fixtureByronWallet -> runResourceT $ do @@ -591,58 +595,64 @@ spec = describe "BYRON_MIGRATIONS" $ do | otherwise = pure () - testAddressCycling ctx addrNum = - forM_ [fixtureRandomWallet, fixtureIcarusWallet] - $ \fixtureByronWallet -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." + testAddressCycling sourceWalletType mkSourceWallet targetAddressCount = do + let title = mconcat + [ "Migration from " + , sourceWalletType + , " wallet to target address count: " + , show targetAddressCount + , "." + ] + it title $ \ctx -> runResourceT $ do + -- Restore a Byron wallet with funds, to act as a source wallet: - sourceWallet <- fixtureByronWallet ctx - let originalBalance = - view (#balance . #available . #getQuantity) sourceWallet + sourceWallet <- mkSourceWallet ctx + let sourceBalance = + view (#balance. #available . #getQuantity) sourceWallet -- Create an empty target wallet: targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addrIds = - map (\(ApiTypes.ApiAddress theid _ _) -> theid) $ - take addrNum addrs + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = take targetAddressCount targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) - -- Calculate the expected migration fee: - r0 <- request @(ApiWalletMigrationPlan n) ctx - (Link.createMigrationPlan @'Byron sourceWallet) Default Empty - verify r0 - [ expectResponseCode HTTP.status200 + -- Create a migration plan: + response0 <- request @(ApiWalletMigrationPlan n) ctx + (Link.createMigrationPlan @'Byron sourceWallet) Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify response0 + [ expectResponseCode HTTP.status202 , expectField #totalFee (.> Quantity 0) ] - let expectedFee = - getFromResponse (#totalFee . #getQuantity) r0 - let balanceLeftover = - getFromResponse (#balanceLeftover . #ada . #getQuantity) r0 + let expectedFee = getFromResponse + (#totalFee . #getQuantity) response0 + let balanceLeftover = getFromResponse + (#balanceLeftover . #ada . #getQuantity) response0 -- Perform a migration from the source wallet to the target wallet: - r1 <- request @[ApiTransaction n] ctx + response1 <- request @[ApiTransaction n] ctx (Link.migrateWallet @'Byron sourceWallet) Default (Json [json| { passphrase: #{fixturePassphrase} - , addresses: #{addrIds} + , addresses: #{targetAddressIds} }|]) - verify r1 + verify response1 [ expectResponseCode HTTP.status202 , expectField id (`shouldSatisfy` (not . null)) ] - -- Check that funds become available in the target wallet: - let expectedBalance = - originalBalance - expectedFee - balanceLeftover - eventually "Wallet has expectedBalance" $ do - r2 <- request @ApiWallet ctx + -- Check that funds have become available in the target wallet: + let expectedTargetBalance = + sourceBalance - expectedFee - balanceLeftover + eventually "Target wallet has expected balance." $ do + response2 <- request @ApiWallet ctx (Link.getWallet @'Shelley targetWallet) Default Empty - verify r2 + verify response2 [ expectField - (#balance . #available) - (`shouldBe` Quantity expectedBalance) + (#balance . #available) + (`shouldBe` Quantity expectedTargetBalance) , expectField - (#balance . #total) - (`shouldBe` Quantity expectedBalance) + (#balance . #total) + (`shouldBe` Quantity expectedTargetBalance) ] diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index 15c2d396ab2..ec5bd06736f 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -235,15 +235,16 @@ spec = describe "SHELLEY_MIGRATIONS" $ do error "Unable to compare plans." describe "SHELLEY_MIGRATE_01 - \ - \after a migration operation successfully completes, the correct \ - \amount eventually becomes available in the target wallet for arbitrary \ - \ number of specified addresses. Balance of source wallet = 0." + \After a migration operation successfully completes, the correct \ + \amounts eventually become available in the target wallet for an \ + \arbitrary number of specified addresses, and the balance of the \ + \source wallet is completely depleted." $ do - testAddressCycling 1 - testAddressCycling 3 - testAddressCycling 10 + testAddressCycling 1 + testAddressCycling 3 + testAddressCycling 10 - it "SHELLEY_MIGRATE_01_big_wallet - \ + it "SHELLEY_MIGRATE_XX_big_wallet - \ \ migrate a big wallet requiring more than one tx" $ \ctx -> runResourceT @IO $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." @@ -573,67 +574,71 @@ spec = describe "SHELLEY_MIGRATIONS" $ do | otherwise = pure () - testAddressCycling addrNum = - it ("Migration from Shelley wallet to " ++ show addrNum ++ " addresses") - $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." + testAddressCycling targetAddressCount = do + let title = mconcat + [ "Migration from Shelley wallet to target address count: " + , show targetAddressCount + , "." + ] + it title $ \ctx -> runResourceT $ do + -- Restore a Shelley wallet with funds, to act as a source wallet: sourceWallet <- fixtureWallet ctx - let originalBalance = - view (#balance. #available . #getQuantity) - sourceWallet + let sourceBalance = + view (#balance. #available . #getQuantity) sourceWallet -- Create an empty target wallet: targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addrIds = - map (\(ApiTypes.ApiAddress theid _ _) -> theid) $ - take addrNum addrs + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = take targetAddressCount targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) - -- Calculate the expected migration fee: - r0 <- request @(ApiWalletMigrationPlan n) ctx - (Link.createMigrationPlan @'Shelley sourceWallet) Default Empty - verify r0 - [ expectResponseCode HTTP.status200 + -- Create a migration plan: + response0 <- request @(ApiWalletMigrationPlan n) ctx + (Link.createMigrationPlan @'Shelley sourceWallet) Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify response0 + [ expectResponseCode HTTP.status202 , expectField #totalFee (.> Quantity 0) ] - let expectedFee = getFromResponse (#totalFee . #getQuantity) r0 + let expectedFee = + getFromResponse (#totalFee . #getQuantity) response0 -- Perform a migration from the source wallet to the target wallet: - r1 <- request @[ApiTransaction n] ctx + response1 <- request @[ApiTransaction n] ctx (Link.migrateWallet @'Shelley sourceWallet) Default (Json [json| { passphrase: #{fixturePassphrase} - , addresses: #{addrIds} + , addresses: #{targetAddressIds} }|]) - verify r1 + verify response1 [ expectResponseCode HTTP.status202 , expectField id (`shouldSatisfy` (not . null)) ] - -- Check that funds become available in the target wallet: - let expectedBalance = originalBalance - expectedFee - eventually "Wallet has expectedBalance" $ do - r2 <- request @ApiWallet ctx + -- Check that funds have become available in the target wallet: + let expectedTargetBalance = sourceBalance - expectedFee + eventually "Target wallet has expected balance." $ do + response2 <- request @ApiWallet ctx (Link.getWallet @'Shelley targetWallet) Default Empty - verify r2 + verify response2 [ expectField - (#balance . #available) - (`shouldBe` Quantity expectedBalance) + (#balance . #available) + (`shouldBe` Quantity expectedTargetBalance) , expectField - (#balance . #total) - (`shouldBe` Quantity expectedBalance) + (#balance . #total) + (`shouldBe` Quantity expectedTargetBalance) ] - -- Verify sourceWallet has balance 0 - r3 <- request @ApiWallet ctx + -- Check that the source wallet has a balance of zero: + response3 <- request @ApiWallet ctx (Link.getWallet @'Shelley sourceWallet) Default Empty - verify r3 + verify response3 [ expectField - (#balance . #available) - (`shouldBe` Quantity 0) + (#balance . #available) + (`shouldBe` Quantity 0) , expectField - (#balance . #total) - (`shouldBe` Quantity 0) + (#balance . #total) + (`shouldBe` Quantity 0) ] From b50f6a8a7d92c3c56aeaea3b5488222849784c67 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 11 May 2021 08:53:40 +0000 Subject: [PATCH 16/29] Resurrect test `MIGRATE_02`. --- .../Scenario/API/Byron/Migrations.hs | 234 ++++++++++-------- .../Scenario/API/Shelley/Migrations.hs | 189 +++++++------- 2 files changed, 225 insertions(+), 198 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index f1b0dfc5788..7d84916fbf5 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -245,6 +245,111 @@ spec = describe "BYRON_MIGRATIONS" $ do testAddressCycling "Icarus" fixtureIcarusWallet 3 testAddressCycling "Icarus" fixtureIcarusWallet 10 + it "BYRON_MIGRATE_02 - \ + \Can migrate a large wallet requiring more than one transaction." + $ \ctx -> runResourceT @IO $ do + + -- NOTE: + -- + -- Special mnemonic to which 200 legacy coins are attached in the + -- genesis file. + -- + -- Out of these 200 coins: + -- + -- - 100 coins are each worth 1 lovelace, and are expected to be + -- treated as dust. + -- - 100 coins are each worth 10,000,000,000 lovelace. + -- + let sourceWalletMnemonic = + ["collect", "fold", "file", "clown" + , "injury", "sun", "brass", "diet" + , "exist", "spike", "behave", "clip" + ] :: [Text] + sourceWallet <- unsafeResponse <$> postByronWallet ctx + (Json [json|{ + "name": "Big Byron Wallet", + "mnemonic_sentence": #{sourceWalletMnemonic}, + "passphrase": #{fixturePassphrase}, + "style": "random" + }|]) + sourceBalance <- eventually "Source wallet balance is correct." $ do + response <- request @ApiByronWallet ctx + (Link.getWallet @'Byron sourceWallet) Default Empty + verify response + [ expectField (#balance . #available . #getQuantity) + (`shouldBe` 1_000_000_000_100) + ] + return $ getFromResponse + (#balance . #available . #getQuantity) response + + -- Create an empty target wallet: + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + + -- Compute the expected migration plan: + responsePlan <- request @(ApiWalletMigrationPlan n) ctx + (Link.createMigrationPlan @'Byron sourceWallet) Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify responsePlan + [ expectResponseCode HTTP.status202 + , expectField + (#totalFee . #getQuantity) + (`shouldBe` 2_460_400) + , expectField + (#selections) + ((`shouldBe` 2) . length) + , expectField + (#balanceLeftover . #ada . #getQuantity) + (`shouldBe` 100) + , expectField + (#balanceSelected . #ada . #getQuantity) + (`shouldBe` 1_000_000_000_000) + ] + let expectedFee = getFromResponse + (#totalFee . #getQuantity) responsePlan + let balanceLeftover =getFromResponse + (#balanceLeftover . #ada . #getQuantity) responsePlan + + -- Perform a migration from the source wallet to the target wallet. + -- + -- This migration will involve more than one transaction, where each + -- transaction is sent one by one. It may happen that one of these + -- transactions is rolled back or simply discarded entirely. The wallet + -- doesn't currently have any retry mechanism, which means that + -- transactions must be manually retried by clients. + -- + -- The 'migrateWallet' function tries do exactly that: to make sure + -- that rolled-back transactions are cancelled and retried until the + -- migration is complete. + -- + liftIO $ migrateWallet ctx sourceWallet targetAddressIds + + -- Check that funds become available in the target wallet. + let expectedTargetBalance = + sourceBalance - balanceLeftover - expectedFee + eventually "Target wallet balance reaches expected balance" $ do + response <- request @ApiWallet ctx + (Link.getWallet @'Shelley targetWallet) Default Empty + verify response + [ expectField + (#balance . #available . #getQuantity) + (`shouldBe` expectedTargetBalance) + , expectField + (#balance . #total . #getQuantity) + (`shouldBe` expectedTargetBalance) + ] + + -- Analyse the target wallet's UTxO distribution: + responseStats <- request @ApiUtxoStatistics ctx + (Link.getUTxOsStatistics @'Shelley targetWallet) Default Empty + verify responseStats + [ expectField + (#distribution) + ((`shouldBe` (Just 2)) . Map.lookup 1_000_000_000_000) + ] + describe "BYRON_MIGRATE_05 - I could migrate to any valid address" $ do forM_ [ ("Byron", emptyRandomWallet) , ("Icarus", emptyIcarusWallet) @@ -288,97 +393,6 @@ spec = describe "BYRON_MIGRATIONS" $ do expectResponseCode HTTP.status400 r expectErrorMessage errMsg400ParseError r - Hspec.it "BYRON_MIGRATE_XX_big_wallet - \ - \ migrate a big wallet requiring more than one tx" $ \ctx -> runResourceT @IO $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - -- NOTE - -- Special mnemonic for which 200 legacy funds are attached to in the - -- genesis file. - -- - -- Out of these 200 coins, 100 of them are of 1 Lovelace and are - -- expected to be treated as dust. The rest are all worth: - -- 10,000,000,000 lovelace. - let mnemonics = - ["collect", "fold", "file", "clown" - , "injury", "sun", "brass", "diet" - , "exist", "spike", "behave", "clip" - ] :: [Text] - let payloadRestore = Json [json| { - "name": "Big Byron Wallet", - "mnemonic_sentence": #{mnemonics}, - "passphrase": #{fixturePassphrase}, - "style": "random" - } |] - wOld <- unsafeResponse <$> postByronWallet ctx payloadRestore - originalBalance <- eventually "wallet balance greater than 0" $ do - r <- request @ApiByronWallet ctx - (Link.getWallet @'Byron wOld) - Default - Empty - verify r - [ expectField (#balance . #available) (.> Quantity 0) - ] - return $ getFromResponse (#balance . #available . #getQuantity) r - - --Calculate the expected migration fee: - rFee <- request @(ApiWalletMigrationPlan n) ctx - (Link.createMigrationPlan @'Byron wOld) - Default - Empty - verify rFee - [ expectResponseCode HTTP.status200 - , expectField #totalFee (.> Quantity 0) - ] - let expectedFee = - getFromResponse (#totalFee . #getQuantity) rFee - let balanceLeftover = - getFromResponse (#balanceLeftover . #ada . #getQuantity) rFee - - -- Migrate to a new empty wallet - wNew <- emptyWallet ctx - addrs <- listAddresses @n ctx wNew - let addr1 = (addrs !! 1) ^. #id - - -- NOTE - -- The migration typically involves many transactions being sent one by - -- one. It may happen that one of these transaction is rolled back and - -- simply discarded entirely from mem pools. There's no retry mechanism - -- from the wallet _yet_, which means that such transactions must be - -- manually retried by clients. - -- - -- This 'migrateWallet' function does exactly this, and will try to make - -- sure that rolledback functions are canceled and retried up until the - -- full migration is done. - liftIO $ migrateWallet ctx wOld [addr1] - - -- Check that funds become available in the target wallet: Because - -- there's a bit of non-determinism in how the migration is really done, - -- we can expect the final balance with exactitude. Yet, we still expect - -- it to be not too far away from an ideal value. - let expectedMinBalance = - originalBalance - 2 * expectedFee - balanceLeftover - eventually "wallet balance ~ expectedBalance" $ do - request @ApiWallet ctx - (Link.getWallet @'Shelley wNew) - Default - Empty >>= flip verify - [ expectField - (#balance . #available) - (.> (Quantity expectedMinBalance)) - , expectField - (#balance . #total) - (.> (Quantity expectedMinBalance)) - ] - - -- Analyze the target wallet UTxO distribution - request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Shelley wNew) - Default - Empty >>= flip verify - [ expectField - #distribution - ((`shouldBe` (Just 100)) . Map.lookup 10_000_000_000) - ] - it "BYRON_MIGRATE_XX - \ \a migration operation removes all funds from the source wallet." $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] @@ -412,7 +426,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectField (#balance . #available) (`shouldBe` Quantity 0) ] - it "BYRON_MIGRATE_02 - \ + it "BYRON_MIGRATE_XX - \ \migrating an empty wallet should fail." $ \ctx -> forM_ [emptyRandomWallet, emptyIcarusWallet] $ \emptyByronWallet -> runResourceT $ do @@ -434,7 +448,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectErrorMessage (errMsg403NothingToMigrate srcId) ] - Hspec.it "BYRON_MIGRATE_02 - \ + Hspec.it "BYRON_MIGRATE_XX - \ \migrating wallet with dust should fail." $ \ctx -> runResourceT @IO $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." @@ -561,33 +575,41 @@ spec = describe "BYRON_MIGRATIONS" $ do -> [(ApiT Address, Proxy n)] -> IO () migrateWallet ctx src targets = do - (st, _) <- request - @(ApiWalletMigrationPlan n) ctx endpointInfo Default Empty - when (st == HTTP.status200) $ do -- returns '403 Nothing to Migrate' when done - -- 1/ Forget all pending transactions to unlock any locked UTxO - (_, txs) <- unsafeRequest @[ApiTransaction n] ctx endpointListTxs Empty + (status, _) <- request @(ApiWalletMigrationPlan n) ctx + endpointCreateMigrationPlan Default payloadCreateMigrationPlan + when (status == HTTP.status202) $ do + -- The above request returns '403 Nothing to Migrate' when done. + + -- 1. Forget all pending transactions to unlock any locked UTxO: + (_, txs) <- unsafeRequest + @[ApiTransaction n] ctx endpointListTxs Empty forM_ txs $ forgetTxIf ((== ApiT Pending) . view #status) - -- 2/ Attempt to migrate - _ <- request @[ApiTransaction n] ctx endpointMigration Default payload + -- 2. Attempt to migrate: + _ <- request @[ApiTransaction n] ctx endpointMigrateWallet Default + payloadMigrateWallet - -- 3/ Wait "long-enough" for transactions to have been inserted. + -- 3. Wait long enough for transactions to have been inserted: waitForTxImmutability ctx - -- 4/ Recurse, until the server tells us there's nothing left to migrate + -- 4. Recurse until the server tells us there's nothing left to + -- migrate: migrateWallet ctx src targets where - endpointInfo = + endpointCreateMigrationPlan = Link.createMigrationPlan @'Byron src - endpointMigration = + endpointMigrateWallet = Link.migrateWallet @'Byron src endpointListTxs = Link.listTransactions @'Byron src endpointForget = Link.deleteTransaction @'Byron src - payload = Json - [json|{"passphrase": #{fixturePassphrase}, "addresses": #{targets}}|] + payloadCreateMigrationPlan = Json [json|{"addresses": #{targets}}|] + payloadMigrateWallet = Json [json| + { "passphrase": #{fixturePassphrase} + , "addresses": #{targets} + }|] forgetTxIf predicate tx | predicate tx = diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index ec5bd06736f..904b9dea141 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -68,7 +68,7 @@ import Test.Hspec.Expectations.Lifted import Test.Hspec.Extra ( it ) import Test.Integration.Faucet - ( onlyDustWallet ) + ( bigDustWallet, onlyDustWallet ) import Test.Integration.Framework.DSL ( Context (..) , Headers (..) @@ -244,99 +244,96 @@ spec = describe "SHELLEY_MIGRATIONS" $ do testAddressCycling 3 testAddressCycling 10 - it "SHELLEY_MIGRATE_XX_big_wallet - \ - \ migrate a big wallet requiring more than one tx" $ \ctx -> runResourceT @IO $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." + it "SHELLEY_MIGRATE_02 - \ + \Can migrate a large wallet requiring more than one transaction." + $ \ctx -> runResourceT @IO $ do - -- NOTE - -- Special mnemonic for which 200 shelley funds are attached to in the - -- genesis file. - -- - -- Out of these 200 coins, 100 of them are of 1 ADA and are - -- expected to be treated as dust. The rest are all worth: - -- 10,000,000,000 lovelace. - let mnemonics = - ["radar", "scare", "sense", "winner", "little" - , "jeans", "blue", "spell", "mystery", "sketch" - , "omit", "time", "tiger", "leave", "load"] :: [Text] - let payloadRestore = Json [json| { + -- Create a large source wallet from which funds will be migrated: + sourceWallet <- unsafeResponse <$> postWallet ctx + (Json [json|{ "name": "Big Shelley Wallet", - "mnemonic_sentence": #{mnemonics}, + "mnemonic_sentence": #{mnemonicToText bigDustWallet}, "passphrase": #{fixturePassphrase} - } |] - wOld <- unsafeResponse <$> postWallet ctx payloadRestore - originalBalance <- eventually "wallet balance greater than 0" $ do - r <- request @ApiWallet ctx - (Link.getWallet @'Shelley wOld) - Default - Empty - verify r - [ expectField (#balance . #available) (.> Quantity 0) + }|]) + sourceBalance <- eventually "Source wallet balance is correct." $ do + response <- request @ApiWallet ctx + (Link.getWallet @'Shelley sourceWallet) Default Empty + verify response + [ expectField (#balance . #available . #getQuantity) + (`shouldBe` 10_000_100_000_000) ] return $ getFromResponse - (#balance . #available . #getQuantity) r + (#balance . #available . #getQuantity) response - -- Calculate the expected migration fee: - rFee <- request @(ApiWalletMigrationPlan n) ctx - (Link.createMigrationPlan @'Shelley wOld) - Default - Empty - verify rFee - [ expectResponseCode HTTP.status200 - , expectField #totalFee (.> Quantity 0) + -- Create an empty target wallet: + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + + -- Compute the expected migration plan: + responsePlan <- request @(ApiWalletMigrationPlan n) ctx + (Link.createMigrationPlan @'Shelley sourceWallet) Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify responsePlan + [ expectResponseCode HTTP.status202 + , expectField + (#totalFee . #getQuantity) + (`shouldBe` 3_120_400) + , expectField + (#selections) + ((`shouldBe` 2) . length) + , expectField + (#balanceLeftover . #ada . #getQuantity) + (`shouldBe` 0) + , expectField + (#balanceSelected . #ada . #getQuantity) + (`shouldBe` 10_000_100_000_000) ] - let expectedFee = - getFromResponse (#totalFee . #getQuantity) rFee - let balanceLeftover = - getFromResponse (#balanceLeftover . #ada . #getQuantity) rFee - - -- Migrate to a new empty wallet - wNew <- emptyWallet ctx - addrs <- listAddresses @n ctx wNew - let addr1 = (addrs !! 1) ^. #id - + let expectedFee = getFromResponse + (#totalFee . #getQuantity) responsePlan + let balanceLeftover = getFromResponse + (#balanceLeftover . #ada . #getQuantity) responsePlan - -- NOTE - -- The migration typically involves many transactions being sent one by - -- one. It may happen that one of these transaction is rolled back and - -- simply discarded entirely from mem pools. There's no retry mechanism - -- from the wallet _yet_, which means that such transactions must be - -- manually retried by clients. + -- Perform a migration from the source wallet to the target wallet. -- - -- This 'migrateWallet' function does exactly this, and will try to make - -- sure that rolledback functions are canceled and retried up until the - -- full migration is done. - liftIO $ migrateWallet ctx wOld [addr1] - - -- Check that funds become available in the target wallet: Because - -- there's a bit of non-determinism in how the migration is really done, - -- we can expect the final balance with exactitude. Yet, we still expect - -- it to be not too far away from an ideal value. - let expectedMinBalance = - originalBalance - 2 * expectedFee - balanceLeftover - eventually "wallet balance ~ expectedBalance" $ do - request @ApiWallet ctx - (Link.getWallet @'Shelley wNew) - Default - Empty >>= flip verify + -- This migration will involve more than one transaction, where each + -- transaction is sent one by one. It may happen that one of these + -- transactions is rolled back or simply discarded entirely. The wallet + -- doesn't currently have any retry mechanism, which means that + -- transactions must be manually retried by clients. + -- + -- The 'migrateWallet' function tries do exactly that: to make sure + -- that rolled-back transactions are cancelled and retried until the + -- migration is complete. + -- + liftIO $ migrateWallet ctx sourceWallet targetAddressIds + + -- Check that funds become available in the target wallet: + let expectedTargetBalance = + sourceBalance - balanceLeftover - expectedFee + eventually "Target wallet balance reaches expected balance" $ do + response <- request @ApiWallet ctx + (Link.getWallet @'Shelley targetWallet) Default Empty + verify response [ expectField - (#balance . #available) - (.> (Quantity expectedMinBalance)) + (#balance . #available . #getQuantity) + (`shouldBe` expectedTargetBalance) , expectField - (#balance . #total) - (.> (Quantity expectedMinBalance)) + (#balance . #total . #getQuantity) + (`shouldBe` expectedTargetBalance) ] - -- Analyze the target wallet UTxO distribution - request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Shelley wNew) - Default - Empty >>= flip verify + -- Analyse the target wallet's UTxO distribution: + responseStats <- request @ApiUtxoStatistics ctx + (Link.getUTxOsStatistics @'Shelley targetWallet) Default Empty + verify responseStats [ expectField - #distribution - ((`shouldBe` (Just 100)) . Map.lookup 100_000_000_000) + (#distribution) + ((`shouldBe` (Just 2)) . Map.lookup 10_000_000_000_000) ] - it "SHELLEY_MIGRATE_02 - \ + it "SHELLEY_MIGRATE_XX - \ \migrating an empty wallet should fail." $ \ctx -> runResourceT $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." @@ -357,7 +354,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do , expectErrorMessage (errMsg403NothingToMigrate srcId) ] - Hspec.it "SHELLEY_MIGRATE_02 - \ + Hspec.it "SHELLEY_MIGRATE_XX - \ \migrating wallet with 'dust' (that complies with minUTxOValue) should pass." $ \ctx -> runResourceT @IO $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." @@ -540,33 +537,41 @@ spec = describe "SHELLEY_MIGRATIONS" $ do -> [(ApiT Address, Proxy n)] -> IO () migrateWallet ctx src targets = do - (st, _) <- request - @(ApiWalletMigrationPlan n) ctx endpointInfo Default Empty - when (st == HTTP.status200) $ do -- returns '403 Nothing to Migrate' when done - -- 1/ Forget all pending transactions to unlock any locked UTxO - (_, txs) <- unsafeRequest @[ApiTransaction n] ctx endpointListTxs Empty + (status, _) <- request @(ApiWalletMigrationPlan n) ctx + endpointCreateMigrationPlan Default payloadCreateMigrationPlan + when (status == HTTP.status202) $ do + -- The above request returns '403 Nothing to Migrate' when done. + + -- 1. Forget all pending transactions to unlock any locked UTxO: + (_, txs) <- unsafeRequest + @[ApiTransaction n] ctx endpointListTxs Empty forM_ txs $ forgetTxIf ((== ApiT Pending) . view #status) - -- 2/ Attempt to migrate - _ <- request @[ApiTransaction n] ctx endpointMigration Default payload + -- 2. Attempt to migrate: + _ <- request @[ApiTransaction n] ctx endpointMigrateWallet Default + payloadMigrateWallet - -- 3/ Wait "long-enough" for transactions to have been inserted. + -- 3. Wait long enough for transactions to have been inserted: waitForTxImmutability ctx - -- 4/ Recurse, until the server tells us there's nothing left to migrate + -- 4. Recurse until the server tells us there's nothing left to + -- migrate: migrateWallet ctx src targets where - endpointInfo = + endpointCreateMigrationPlan = Link.createMigrationPlan @'Shelley src - endpointMigration = + endpointMigrateWallet = Link.migrateWallet @'Shelley src endpointListTxs = Link.listTransactions @'Shelley src endpointForget = Link.deleteTransaction @'Shelley src - payload = Json - [json|{"passphrase": #{fixturePassphrase}, "addresses": #{targets}}|] + payloadCreateMigrationPlan = Json [json|{"addresses": #{targets}}|] + payloadMigrateWallet = Json [json| + { "passphrase": #{fixturePassphrase} + , "addresses": #{targets} + }|] forgetTxIf predicate tx | predicate tx = From 00f4120af8aac30e2cb20101df905f9fd4f00cfa Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 12 May 2021 04:33:43 +0000 Subject: [PATCH 17/29] Resurrect test `MIGRATE_03`. --- .../Scenario/API/Byron/Migrations.hs | 45 +++++++++---------- .../Scenario/API/Shelley/Migrations.hs | 25 +++++------ 2 files changed, 34 insertions(+), 36 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index 7d84916fbf5..fdcffbe458a 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -350,6 +350,27 @@ spec = describe "BYRON_MIGRATIONS" $ do ((`shouldBe` (Just 2)) . Map.lookup 1_000_000_000_000) ] + it "BYRON_MIGRATE_03 - \ + \Migrating an empty wallet should fail." + $ \ctx -> forM_ [emptyRandomWallet, emptyIcarusWallet] + $ \emptyByronWallet -> runResourceT $ do + sourceWallet <- emptyByronWallet ctx + let sourceWalletId = sourceWallet ^. walletId + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.migrateWallet @'Byron sourceWallet + response <- request @[ApiTransaction n] ctx ep Default $ + Json [json| + { passphrase: #{fixturePassphrase} + , addresses: #{targetAddressIds} + }|] + verify response + [ expectResponseCode HTTP.status403 + , expectErrorMessage (errMsg403NothingToMigrate sourceWalletId) + ] + describe "BYRON_MIGRATE_05 - I could migrate to any valid address" $ do forM_ [ ("Byron", emptyRandomWallet) , ("Icarus", emptyIcarusWallet) @@ -426,28 +447,6 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectField (#balance . #available) (`shouldBe` Quantity 0) ] - it "BYRON_MIGRATE_XX - \ - \migrating an empty wallet should fail." - $ \ctx -> forM_ [emptyRandomWallet, emptyIcarusWallet] - $ \emptyByronWallet -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - sourceWallet <- emptyByronWallet ctx - targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addr1 = (addrs !! 1) ^. #id - let payload = - Json [json| - { passphrase: #{fixturePassphrase} - , addresses: [#{addr1}] - }|] - let ep = Link.migrateWallet @'Byron sourceWallet - r <- request @[ApiTransaction n] ctx ep Default payload - let srcId = sourceWallet ^. walletId - verify r - [ expectResponseCode HTTP.status403 - , expectErrorMessage (errMsg403NothingToMigrate srcId) - ] - Hspec.it "BYRON_MIGRATE_XX - \ \migrating wallet with dust should fail." $ \ctx -> runResourceT @IO $ do @@ -491,7 +490,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectErrorMessage (errMsg403NothingToMigrate srcId) ] - it "BYRON_MIGRATE_03 - \ + it "BYRON_MIGRATE_XX - \ \actual fee for migration is the same as the predicted fee." $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] $ \fixtureByronWallet -> runResourceT $ do diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index 904b9dea141..0f6cc260531 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -333,25 +333,24 @@ spec = describe "SHELLEY_MIGRATIONS" $ do ((`shouldBe` (Just 2)) . Map.lookup 10_000_000_000_000) ] - it "SHELLEY_MIGRATE_XX - \ - \migrating an empty wallet should fail." + it "SHELLEY_MIGRATE_03 - \ + \Migrating an empty wallet should fail." $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." sourceWallet <- emptyWallet ctx + let sourceWalletId = sourceWallet ^. walletId targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addr1 = (addrs !! 1) ^. #id - let payload = + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + let ep = Link.migrateWallet @'Shelley sourceWallet + response <- request @[ApiTransaction n] ctx ep Default $ Json [json| { passphrase: #{fixturePassphrase} - , addresses: [#{addr1}] + , addresses: #{targetAddressIds} }|] - let ep = Link.migrateWallet @'Shelley sourceWallet - r <- request @[ApiTransaction n] ctx ep Default payload - let srcId = sourceWallet ^. walletId - verify r + verify response [ expectResponseCode HTTP.status403 - , expectErrorMessage (errMsg403NothingToMigrate srcId) + , expectErrorMessage (errMsg403NothingToMigrate sourceWalletId) ] Hspec.it "SHELLEY_MIGRATE_XX - \ @@ -419,7 +418,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do ( `shouldBe` Quantity expectedBalance) ] - it "SHELLEY_MIGRATE_03 - \ + it "SHELLEY_MIGRATE_xx - \ \actual fee for migration is the same as the predicted fee." $ \ctx -> runResourceT $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." From b1c718c978c459bb545f091b0f8f32bfebea67b1 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 12 May 2021 05:45:18 +0000 Subject: [PATCH 18/29] Resurrect test `MIGRATE_04`. --- .../Scenario/API/Byron/Migrations.hs | 87 ++++++++++--------- .../Scenario/API/Shelley/Migrations.hs | 86 +++++++++--------- 2 files changed, 94 insertions(+), 79 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index fdcffbe458a..157dab5425a 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -371,6 +371,52 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectErrorMessage (errMsg403NothingToMigrate sourceWalletId) ] + it "BYRON_MIGRATE_04 - \ + \Actual fee for migration is identical to predicted fee." + $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] + $ \fixtureByronWallet -> runResourceT $ do + + let feeExpected = 334_200 + + -- Restore a source wallet with funds. + sourceWallet <- fixtureByronWallet ctx + + -- Create an empty target wallet: + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + + -- Create a migration plan: + let endpointPlan = (Link.createMigrationPlan @'Byron sourceWallet) + responsePlan <- request @(ApiWalletMigrationPlan n) + ctx endpointPlan Default $ + Json [json|{addresses: #{targetAddressIds}}|] + verify responsePlan + [ expectResponseCode HTTP.status202 + , expectField #totalFee (`shouldBe` Quantity feeExpected) + , expectField #selections ((`shouldBe` 1) . length) + ] + + -- Perform a migration: + let endpointMigrate = Link.migrateWallet @'Byron sourceWallet + responseMigrate <- + request @[ApiTransaction n] ctx endpointMigrate Default $ + Json [json| + { passphrase: #{fixturePassphrase} + , addresses: #{targetAddressIds} + }|] + -- Verify the fee is as expected: + verify responseMigrate + [ expectResponseCode HTTP.status202 + , expectField id ((`shouldBe` 1) . length) + , expectField id + $ (`shouldBe` feeExpected) + . fromIntegral + . sum + . fmap apiTransactionFee + ] + describe "BYRON_MIGRATE_05 - I could migrate to any valid address" $ do forM_ [ ("Byron", emptyRandomWallet) , ("Icarus", emptyIcarusWallet) @@ -490,46 +536,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectErrorMessage (errMsg403NothingToMigrate srcId) ] - it "BYRON_MIGRATE_XX - \ - \actual fee for migration is the same as the predicted fee." - $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] - $ \fixtureByronWallet -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - -- Restore a Byron wallet with funds. - sourceWallet <- fixtureByronWallet ctx - - -- Request a migration fee prediction. - let ep0 = (Link.createMigrationPlan @'Byron sourceWallet) - r0 <- request @(ApiWalletMigrationPlan n) ctx ep0 Default Empty - verify r0 - [ expectResponseCode HTTP.status200 - , expectField #totalFee (.> Quantity 0) - ] - - -- Perform the migration. - targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addr1 = (addrs !! 1) ^. #id - let payload = - Json [json| - { passphrase: #{fixturePassphrase} - , addresses: [#{addr1}] - }|] - let ep1 = Link.migrateWallet @'Byron sourceWallet - r1 <- request @[ApiTransaction n] ctx ep1 Default payload - verify r1 - [ expectResponseCode HTTP.status202 - , expectField id (`shouldSatisfy` (not . null)) - ] - - -- Verify that the fee prediction was correct. - let actualFee = fromIntegral $ sum $ apiTransactionFee - <$> getFromResponse id r1 - let predictedFee = - getFromResponse (#totalFee . #getQuantity) r0 - liftIO $ actualFee `shouldBe` predictedFee - - it "BYRON_MIGRATE_04 - migration fails with a wrong passphrase" + it "BYRON_MIGRATE_XX - migration fails with a wrong passphrase" $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] $ \fixtureByronWallet -> runResourceT $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index 0f6cc260531..215ba556dfa 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -353,6 +353,52 @@ spec = describe "SHELLEY_MIGRATIONS" $ do , expectErrorMessage (errMsg403NothingToMigrate sourceWalletId) ] + it "SHELLEY_MIGRATE_04 - \ + \Actual fee for migration is identical to predicted fee." + $ \ctx -> runResourceT $ do + + let feeExpected = 255_200 + + -- Restore a source wallet with funds: + sourceWallet <- fixtureWallet ctx + + -- Create an empty target wallet: + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + + -- Create a migration plan: + let endpointPlan = (Link.createMigrationPlan @'Shelley sourceWallet) + responsePlan <- request @(ApiWalletMigrationPlan n) + ctx endpointPlan Default $ + Json [json|{addresses: #{targetAddressIds}}|] + -- Verify the fee is as expected: + verify responsePlan + [ expectResponseCode HTTP.status202 + , expectField #totalFee (`shouldBe` Quantity feeExpected) + , expectField #selections ((`shouldBe` 1) . length) + ] + + -- Perform a migration: + let endpointMigrate = Link.migrateWallet @'Shelley sourceWallet + responseMigrate <- + request @[ApiTransaction n] ctx endpointMigrate Default $ + Json [json| + { passphrase: #{fixturePassphrase} + , addresses: #{targetAddressIds} + }|] + -- Verify the fee is as expected: + verify responseMigrate + [ expectResponseCode HTTP.status202 + , expectField id ((`shouldBe` 1) . length) + , expectField id + $ (`shouldBe` feeExpected) + . fromIntegral + . sum + . fmap apiTransactionFee + ] + Hspec.it "SHELLEY_MIGRATE_XX - \ \migrating wallet with 'dust' (that complies with minUTxOValue) should pass." $ \ctx -> runResourceT @IO $ do @@ -418,45 +464,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do ( `shouldBe` Quantity expectedBalance) ] - it "SHELLEY_MIGRATE_xx - \ - \actual fee for migration is the same as the predicted fee." - $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - -- Restore a Shelley wallet with funds. - sourceWallet <- fixtureWallet ctx - - -- Request a migration fee prediction. - let ep0 = (Link.createMigrationPlan @'Shelley sourceWallet) - r0 <- request @(ApiWalletMigrationPlan n) ctx ep0 Default Empty - verify r0 - [ expectResponseCode HTTP.status200 - , expectField #totalFee (.> Quantity 0) - ] - - -- Perform the migration. - targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addr1 = (addrs !! 1) ^. #id - let payload = - Json [json| - { passphrase: #{fixturePassphrase} - , addresses: [#{addr1}] - }|] - let ep1 = Link.migrateWallet @'Shelley sourceWallet - r1 <- request @[ApiTransaction n] ctx ep1 Default payload - verify r1 - [ expectResponseCode HTTP.status202 - , expectField id (`shouldSatisfy` (not . null)) - ] - - -- Verify that the fee prediction was correct. - let actualFee = fromIntegral $ sum $ apiTransactionFee - <$> getFromResponse id r1 - let predictedFee = - getFromResponse (#totalFee . #getQuantity) r0 - liftIO $ actualFee `shouldBe` predictedFee - - it "SHELLEY_MIGRATE_04 - migration fails with a wrong passphrase" $ \ctx -> runResourceT $ do + it "SHELLEY_MIGRATE_XX - migration fails with a wrong passphrase" $ \ctx -> runResourceT $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." -- Restore a Shelley wallet with funds, to act as a source wallet: sourceWallet <- fixtureWallet ctx From 1fbf614feb7008cb800c794d129c6f904c3009d8 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 12 May 2021 05:54:35 +0000 Subject: [PATCH 19/29] Resurrect test `MIGRATE_05`. --- .../Scenario/API/Byron/Migrations.hs | 53 ++++++++++--------- .../Scenario/API/Shelley/Migrations.hs | 50 +++++++++-------- 2 files changed, 55 insertions(+), 48 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index 157dab5425a..9512983e135 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -417,7 +417,34 @@ spec = describe "BYRON_MIGRATIONS" $ do . fmap apiTransactionFee ] - describe "BYRON_MIGRATE_05 - I could migrate to any valid address" $ do + it "BYRON_MIGRATE_05 - \ + \Migration fails if the wrong passphrase is supplied." + $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] + $ \fixtureByronWallet -> runResourceT $ do + + -- Restore a Byron wallet with funds, to act as a source wallet: + sourceWallet <- fixtureByronWallet ctx + + -- Create an empty target wallet: + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + + -- Attempt to perform a migration: + response <- request @[ApiTransaction n] ctx + (Link.migrateWallet @'Byron sourceWallet) + Default + (Json [json| + { passphrase: "not-the-right-passphrase" + , addresses: #{targetAddressIds} + }|]) + verify response + [ expectResponseCode HTTP.status403 + , expectErrorMessage errMsg403WrongPass + ] + + describe "BYRON_MIGRATE_XX - I could migrate to any valid address" $ do forM_ [ ("Byron", emptyRandomWallet) , ("Icarus", emptyIcarusWallet) ] $ \(walType, destWallet) -> do @@ -535,30 +562,6 @@ spec = describe "BYRON_MIGRATIONS" $ do [ expectResponseCode HTTP.status403 , expectErrorMessage (errMsg403NothingToMigrate srcId) ] - - it "BYRON_MIGRATE_XX - migration fails with a wrong passphrase" - $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] - $ \fixtureByronWallet -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - -- Restore a Byron wallet with funds, to act as a source wallet: - sourceWallet <- fixtureByronWallet ctx - - -- Perform a migration from the source wallet to a target wallet: - targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addr1 = (addrs !! 1) ^. #id - r0 <- request @[ApiTransaction n] ctx - (Link.migrateWallet @'Byron sourceWallet) - Default - (Json [json| - { passphrase: "not-the-right-passphrase" - , addresses: [#{addr1}] - }|]) - verify r0 - [ expectResponseCode HTTP.status403 - , expectErrorMessage errMsg403WrongPass - ] - where -- Compute the fee associated with an API transaction. apiTransactionFee :: ApiTransaction n -> Word64 diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index 215ba556dfa..a0ba9ad05ad 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -399,6 +399,32 @@ spec = describe "SHELLEY_MIGRATIONS" $ do . fmap apiTransactionFee ] + it "SHELLEY_MIGRATE_05 - \ + \Migration fails if the wrong passphrase is supplied." + $ \ctx -> runResourceT $ do + + -- Restore a Shelley wallet with funds, to act as a source wallet: + sourceWallet <- fixtureWallet ctx + + -- Create an empty target wallet: + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + + -- Attempt to perform a migration: + response <- request @[ApiTransaction n] ctx + (Link.migrateWallet @'Shelley sourceWallet) + Default + (Json [json| + { passphrase: "not-the-right-passphrase" + , addresses: #{targetAddressIds} + }|]) + verify response + [ expectResponseCode HTTP.status403 + , expectErrorMessage errMsg403WrongPass + ] + Hspec.it "SHELLEY_MIGRATE_XX - \ \migrating wallet with 'dust' (that complies with minUTxOValue) should pass." $ \ctx -> runResourceT @IO $ do @@ -464,29 +490,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do ( `shouldBe` Quantity expectedBalance) ] - it "SHELLEY_MIGRATE_XX - migration fails with a wrong passphrase" $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - -- Restore a Shelley wallet with funds, to act as a source wallet: - sourceWallet <- fixtureWallet ctx - - -- Perform a migration from the source wallet to a target wallet: - targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addr1 = (addrs !! 1) ^. #id - r0 <- request @[ApiTransaction n] ctx - (Link.migrateWallet @'Shelley sourceWallet) - Default - (Json [json| - { passphrase: "not-the-right-passphrase" - , addresses: [#{addr1}] - }|]) - verify r0 - [ expectResponseCode HTTP.status403 - , expectErrorMessage errMsg403WrongPass - ] - - - it "SHELLEY_MIGRATE_05 - I could migrate to any valid address" $ \ctx -> runResourceT $ do + it "SHELLEY_MIGRATE_XX - I could migrate to any valid address" $ \ctx -> runResourceT $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." --shelley address wShelley <- emptyWallet ctx From c220abb1a7abd707d3c78e18aa1404d3a67caebe Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 12 May 2021 09:05:00 +0000 Subject: [PATCH 20/29] Resurrect test `MIGRATE_06`. --- .../Scenario/API/Byron/Migrations.hs | 46 +++++++++----- .../Scenario/API/Shelley/Migrations.hs | 60 ++++++++++--------- 2 files changed, 63 insertions(+), 43 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index 9512983e135..b6bee304642 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -444,36 +444,50 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectErrorMessage errMsg403WrongPass ] - describe "BYRON_MIGRATE_XX - I could migrate to any valid address" $ do - forM_ [ ("Byron", emptyRandomWallet) + describe "BYRON_MIGRATE_06 - \ + \It's possible to migrate to any valid address." + $ forM_ + [ ("Random", emptyRandomWallet) , ("Icarus", emptyIcarusWallet) - ] $ \(walType, destWallet) -> do + ] $ \(walType, destWallet) -> it ("From wallet type: " ++ walType) $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - --shelley address + + -- Create a Shelley address: wShelley <- emptyWallet ctx addrs <- listAddresses @n ctx wShelley let addrShelley = (addrs !! 1) ^. #id - --icarus address - addrIcarus <- liftIO $ encodeAddress @n . head . icarusAddresses @n + + -- Create an Icarus address: + addrIcarus <- liftIO $ encodeAddress @n + . head + . icarusAddresses @n . entropyToMnemonic @15 <$> genEntropy - --byron address - addrByron <- liftIO $ encodeAddress @n . head . randomAddresses @n + + -- Create a Byron address: + addrByron <- liftIO $ encodeAddress @n + . head + . randomAddresses @n . entropyToMnemonic @12 <$> genEntropy - sWallet <- destWallet ctx - r <- request @[ApiTransaction n] ctx - (Link.migrateWallet @'Byron sWallet) - Default + -- Create a source wallet: + sourceWallet <- destWallet ctx + + -- Initiate a migration to all address types: + response <- request @[ApiTransaction n] ctx + (Link.migrateWallet @'Byron sourceWallet) Default (Json [json| { passphrase: #{fixturePassphrase} - , addresses: [#{addrShelley}, #{addrIcarus}, #{addrByron}] + , addresses: + [ #{addrShelley} + , #{addrIcarus} + , #{addrByron} + ] }|]) - verify r + verify response [ expectResponseCode HTTP.status403 , expectErrorMessage - (errMsg403NothingToMigrate (sWallet ^. walletId)) + (errMsg403NothingToMigrate (sourceWallet ^. walletId)) ] it "BYRON_MIGRATE_07 - invalid payload, parser error" $ \ctx -> runResourceT $ do diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index a0ba9ad05ad..020d8a2d8b3 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -425,6 +425,39 @@ spec = describe "SHELLEY_MIGRATIONS" $ do , expectErrorMessage errMsg403WrongPass ] + it "SHELLEY_MIGRATE_06 - \ + \It's possible to migrate to any valid address." + $ \ctx -> runResourceT $ do + + -- Create a Shelley address: + wShelley <- emptyWallet ctx + addrs <- listAddresses @n ctx wShelley + let addrShelley = (addrs !! 1) ^. #id + + -- Create an Icarus address: + addrIcarus <- liftIO $ encodeAddress @n . head . icarusAddresses @n + . entropyToMnemonic @15 <$> genEntropy + + -- Create a Byron address: + addrByron <- liftIO $ encodeAddress @n . head . randomAddresses @n + . entropyToMnemonic @12 <$> genEntropy + + -- Create a source wallet: + sourceWallet <- emptyWallet ctx + + -- Initiate a migration to all address types: + response <- request @[ApiTransaction n] ctx + (Link.migrateWallet @'Shelley sourceWallet) Default + (Json [json| + { passphrase: #{fixturePassphrase} + , addresses: [#{addrShelley}, #{addrIcarus}, #{addrByron}] + }|]) + verify response + [ expectResponseCode HTTP.status403 + , expectErrorMessage + (errMsg403NothingToMigrate (sourceWallet ^. walletId)) + ] + Hspec.it "SHELLEY_MIGRATE_XX - \ \migrating wallet with 'dust' (that complies with minUTxOValue) should pass." $ \ctx -> runResourceT @IO $ do @@ -490,33 +523,6 @@ spec = describe "SHELLEY_MIGRATIONS" $ do ( `shouldBe` Quantity expectedBalance) ] - it "SHELLEY_MIGRATE_XX - I could migrate to any valid address" $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - --shelley address - wShelley <- emptyWallet ctx - addrs <- listAddresses @n ctx wShelley - let addrShelley = (addrs !! 1) ^. #id - --icarus address - addrIcarus <- liftIO $ encodeAddress @n . head . icarusAddresses @n - . entropyToMnemonic @15 <$> genEntropy - --byron address - addrByron <- liftIO $ encodeAddress @n . head . randomAddresses @n - . entropyToMnemonic @12 <$> genEntropy - - sWallet <- emptyWallet ctx - r <- request @[ApiTransaction n] ctx - (Link.migrateWallet @'Shelley sWallet) - Default - (Json [json| - { passphrase: #{fixturePassphrase} - , addresses: [#{addrShelley}, #{addrIcarus}, #{addrByron}] - }|]) - verify r - [ expectResponseCode HTTP.status403 - , expectErrorMessage - (errMsg403NothingToMigrate (sWallet ^. walletId)) - ] - it "SHELLEY_MIGRATE_07 - invalid payload, parser error" $ \ctx -> runResourceT $ do liftIO $ pendingWith "Migration endpoints temporarily disabled." sourceWallet <- emptyWallet ctx From 2f9723ef5f16e08cea88bab7d737eecdc0438aa7 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 12 May 2021 09:13:48 +0000 Subject: [PATCH 21/29] Resurrect test `MIGRATE_07`. --- .../Scenario/API/Byron/Migrations.hs | 21 +++++++++--------- .../Scenario/API/Shelley/Migrations.hs | 22 ++++++++++--------- 2 files changed, 23 insertions(+), 20 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index b6bee304642..cf827c7a942 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -490,16 +490,17 @@ spec = describe "BYRON_MIGRATIONS" $ do (errMsg403NothingToMigrate (sourceWallet ^. walletId)) ] - it "BYRON_MIGRATE_07 - invalid payload, parser error" $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - sourceWallet <- emptyRandomWallet ctx - - r <- request @[ApiTransaction n] ctx - (Link.migrateWallet @'Byron sourceWallet) - Default - (NonJson "{passphrase:,}") - expectResponseCode HTTP.status400 r - expectErrorMessage errMsg400ParseError r + it "BYRON_MIGRATE_07 - \ + \Including an invalidly-formatted passphrase results in a parser error." + $ \ctx -> runResourceT $ do + sourceWallet <- emptyRandomWallet ctx + response <- request @[ApiTransaction n] ctx + (Link.migrateWallet @'Byron sourceWallet) Default + (NonJson "{passphrase:,}") + verify response + [ expectResponseCode HTTP.status400 + , expectErrorMessage errMsg400ParseError + ] it "BYRON_MIGRATE_XX - \ \a migration operation removes all funds from the source wallet." diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index 020d8a2d8b3..da5705a0030 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -458,6 +458,18 @@ spec = describe "SHELLEY_MIGRATIONS" $ do (errMsg403NothingToMigrate (sourceWallet ^. walletId)) ] + it "SHELLEY_MIGRATE_07 - \ + \Including an invalidly-formatted passphrase results in a parser error." + $ \ctx -> runResourceT $ do + sourceWallet <- emptyWallet ctx + response <- request @[ApiTransaction n] ctx + (Link.migrateWallet @'Shelley sourceWallet) Default + (NonJson "{passphrase:,}") + verify response + [ expectResponseCode HTTP.status400 + , expectErrorMessage errMsg400ParseError + ] + Hspec.it "SHELLEY_MIGRATE_XX - \ \migrating wallet with 'dust' (that complies with minUTxOValue) should pass." $ \ctx -> runResourceT @IO $ do @@ -522,16 +534,6 @@ spec = describe "SHELLEY_MIGRATIONS" $ do (#balance . #total) ( `shouldBe` Quantity expectedBalance) ] - - it "SHELLEY_MIGRATE_07 - invalid payload, parser error" $ \ctx -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - sourceWallet <- emptyWallet ctx - r <- request @[ApiTransaction n] ctx - (Link.migrateWallet @'Shelley sourceWallet) - Default - (NonJson "{passphrase:,}") - expectResponseCode HTTP.status400 r - expectErrorMessage errMsg400ParseError r where -- Compute the fee associated with an API transaction. apiTransactionFee :: ApiTransaction n -> Word64 From d6d2abc82c0a85090715b0e4e1ba2fa0c4c82b45 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 12 May 2021 09:44:04 +0000 Subject: [PATCH 22/29] Remove migration test that checks for depletion of source funds. This check is actually already performed in other integration tests. In addition, we can easily add this check to the end of tests that don't have it already. --- .../Scenario/API/Byron/Migrations.hs | 56 ++++++++----------- .../Scenario/API/Shelley/Migrations.hs | 15 ++++- 2 files changed, 36 insertions(+), 35 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index cf827c7a942..ef80c5a4985 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -350,6 +350,17 @@ spec = describe "BYRON_MIGRATIONS" $ do ((`shouldBe` (Just 2)) . Map.lookup 1_000_000_000_000) ] + -- Check that the source wallet has the expected leftover balance: + responseFinalSourceBalance <- request @ApiByronWallet ctx + (Link.getWallet @'Byron sourceWallet) Default Empty + verify responseFinalSourceBalance + [ expectResponseCode HTTP.status200 + , expectField (#balance . #available) + (`shouldBe` Quantity 100) + , expectField (#balance . #total) + (`shouldBe` Quantity 100) + ] + it "BYRON_MIGRATE_03 - \ \Migrating an empty wallet should fail." $ \ctx -> forM_ [emptyRandomWallet, emptyIcarusWallet] @@ -502,39 +513,6 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectErrorMessage errMsg400ParseError ] - it "BYRON_MIGRATE_XX - \ - \a migration operation removes all funds from the source wallet." - $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] - $ \fixtureByronWallet -> runResourceT $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - -- Restore a Byron wallet with funds, to act as a source wallet: - sourceWallet <- fixtureByronWallet ctx - - -- Perform a migration from the source wallet to a target wallet: - targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addr1 = (addrs !! 1) ^. #id - - r0 <- request @[ApiTransaction n] ctx - (Link.migrateWallet @'Byron sourceWallet) - Default - (Json [json| - { passphrase: #{fixturePassphrase} - , addresses: [#{addr1}] - }|]) - verify r0 - [ expectResponseCode HTTP.status202 - , expectField id (`shouldSatisfy` (not . null)) - ] - - -- Verify that the source wallet has no funds available: - r1 <- request @ApiByronWallet ctx - (Link.getWallet @'Byron sourceWallet) Default Empty - verify r1 - [ expectResponseCode HTTP.status200 - , expectField (#balance . #available) (`shouldBe` Quantity 0) - ] - Hspec.it "BYRON_MIGRATE_XX - \ \migrating wallet with dust should fail." $ \ctx -> runResourceT @IO $ do @@ -702,3 +680,15 @@ spec = describe "BYRON_MIGRATIONS" $ do (#balance . #total) (`shouldBe` Quantity expectedTargetBalance) ] + + -- Check that the source wallet has a balance of zero: + responseFinalSourceBalance <- request @ApiByronWallet ctx + (Link.getWallet @'Byron sourceWallet) Default Empty + verify responseFinalSourceBalance + [ expectField + (#balance . #available) + (`shouldBe` Quantity 0) + , expectField + (#balance . #total) + (`shouldBe` Quantity 0) + ] diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index da5705a0030..d60b465cf07 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -333,6 +333,17 @@ spec = describe "SHELLEY_MIGRATIONS" $ do ((`shouldBe` (Just 2)) . Map.lookup 10_000_000_000_000) ] + -- Check that the source wallet has the expected leftover balance: + responseFinalSourceBalance <- request @ApiWallet ctx + (Link.getWallet @'Shelley sourceWallet) Default Empty + verify responseFinalSourceBalance + [ expectResponseCode HTTP.status200 + , expectField (#balance . #available) + (`shouldBe` Quantity 0) + , expectField (#balance . #total) + (`shouldBe` Quantity 0) + ] + it "SHELLEY_MIGRATE_03 - \ \Migrating an empty wallet should fail." $ \ctx -> runResourceT $ do @@ -656,9 +667,9 @@ spec = describe "SHELLEY_MIGRATIONS" $ do ] -- Check that the source wallet has a balance of zero: - response3 <- request @ApiWallet ctx + responseFinalSourceBalance <- request @ApiWallet ctx (Link.getWallet @'Shelley sourceWallet) Default Empty - verify response3 + verify responseFinalSourceBalance [ expectField (#balance . #available) (`shouldBe` Quantity 0) From 33e056265f2043acadcd215998742759cec0e0ff Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 13 May 2021 05:37:18 +0000 Subject: [PATCH 23/29] Resurrect test `MIGRATE_08`. --- .../Scenario/API/Byron/Migrations.hs | 66 +++++---- .../Scenario/API/Shelley/Migrations.hs | 133 +++++++++++------- 2 files changed, 126 insertions(+), 73 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index ef80c5a4985..ef76750bab7 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -63,7 +63,7 @@ import Data.Text import Data.Word ( Word64 ) import Test.Hspec - ( SpecWith, describe, pendingWith, shouldBe, shouldSatisfy ) + ( SpecWith, describe, shouldBe, shouldSatisfy ) import Test.Hspec.Extra ( it ) import Test.Integration.Framework.DSL @@ -513,47 +513,63 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectErrorMessage errMsg400ParseError ] - Hspec.it "BYRON_MIGRATE_XX - \ - \migrating wallet with dust should fail." + Hspec.it "BYRON_MIGRATE_08 - \ + \It's not possible to migrate a wallet whose total balance is less \ + \than the minimum ada quantity for an output." $ \ctx -> runResourceT @IO $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - -- NOTE - -- Special mnemonic for which wallet with dust - -- (5 utxos with 60 lovelace in total) - let mnemonics = + + -- Create a source wallet with a small number of small quantities: + let mnemonicSentence = [ "suffer", "decorate", "head", "opera" , "yellow", "debate", "visa", "fire" , "salute", "hybrid", "stone", "smart" ] :: [Text] - let payloadRestore = Json [json| { + sourceWallet <- unsafeResponse <$> postByronWallet ctx + (Json [json|{ "name": "Dust Byron Wallet", - "mnemonic_sentence": #{mnemonics}, + "mnemonic_sentence": #{mnemonicSentence}, "passphrase": #{fixturePassphrase}, "style": "random" - } |] - sourceWallet <- unsafeResponse <$> postByronWallet ctx payloadRestore - eventually "wallet balance greater than 0" $ do + }|]) + eventually "Source wallet balance is correct." $ do request @ApiByronWallet ctx (Link.getWallet @'Byron sourceWallet) Default Empty >>= flip verify - [ expectField (#balance . #available) (.> Quantity 0) + [ expectField (#balance . #available) + (`shouldBe` Quantity 15) ] + let sourceWalletId = sourceWallet ^. walletId + -- Analyse the source wallet's UTxO distribution: + let expectedSourceDistribution = [(10, 5)] + responseSourceDistribution <- request @ApiUtxoStatistics ctx + (Link.getUTxOsStatistics @'Byron sourceWallet) Default Empty + verify responseSourceDistribution + [ expectField #distribution + ((`shouldBe` expectedSourceDistribution) + . Map.toList + . Map.filter (> 0) + ) + ] + + -- Create an empty target wallet: targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addr1 = (addrs !! 1) ^. #id - let payload = - Json [json| - { passphrase: #{fixturePassphrase} - , addresses: [#{addr1}] - }|] + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + + + -- Attempt a migration: let ep = Link.migrateWallet @'Byron sourceWallet - r <- request @[ApiTransaction n] ctx ep Default payload - let srcId = sourceWallet ^. walletId - verify r + responseMigrate <- request @[ApiTransaction n] ctx ep Default $ + Json [json| + { passphrase: #{fixturePassphrase} + , addresses: #{targetAddressIds} + }|] + verify responseMigrate [ expectResponseCode HTTP.status403 - , expectErrorMessage (errMsg403NothingToMigrate srcId) + , expectErrorMessage (errMsg403NothingToMigrate sourceWalletId) ] where -- Compute the fee associated with an API transaction. diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index d60b465cf07..f929d5db8c9 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -57,8 +57,6 @@ import Data.Proxy ( Proxy ) import Data.Quantity ( Quantity (..) ) -import Data.Text - ( Text ) import Data.Word ( Word64 ) import Test.Hspec @@ -481,70 +479,109 @@ spec = describe "SHELLEY_MIGRATIONS" $ do , expectErrorMessage errMsg400ParseError ] - Hspec.it "SHELLEY_MIGRATE_XX - \ - \migrating wallet with 'dust' (that complies with minUTxOValue) should pass." + Hspec.it "SHELLEY_MIGRATE_08 - \ + \It's possible to migrate a wallet with many small ada quantities, \ + \provided that the total balance is significantly greater than the \ + \minimum ada quantity for an output." $ \ctx -> runResourceT @IO $ do - liftIO $ pendingWith "Migration endpoints temporarily disabled." - -- NOTE - -- Special mnemonic for which wallet has dust - -- (10 utxo with 43 ADA) - let mnemonics = - ["either", "flip", "maple", "shift", "dismiss", "bridge" - , "sweet", "reveal", "green", "tornado", "need", "patient" - , "wall", "stamp", "pass"] :: [Text] - let payloadRestore = Json [json| { - "name": "Dust Shelley Wallet", - "mnemonic_sentence": #{mnemonics}, + + -- Create a source wallet with many small ada quantities: + sourceWallet <- unsafeResponse <$> postWallet ctx + (Json [json|{ + "name": "Shelley Wallet", + "mnemonic_sentence": #{mnemonicToText onlyDustWallet}, "passphrase": #{fixturePassphrase} - } |] - sourceWallet <- unsafeResponse <$> postWallet ctx payloadRestore - originalBalance <- eventually "wallet balance greater than 0" $ do - rg <- request @ApiWallet ctx - (Link.getWallet @'Shelley sourceWallet) - Default - Empty - verify rg - [ expectField (#balance . #available) (.> Quantity 0) + }|]) + sourceBalance <- eventually "Source wallet balance is correct." $ do + response <- request @ApiWallet ctx + (Link.getWallet @'Shelley sourceWallet) Default Empty + verify response + [ expectField (#balance . #available . #getQuantity) + (`shouldBe` 43_000_000) + , expectField (#balance . #total . #getQuantity) + (`shouldBe` 43_000_000) ] pure $ getFromResponse (#balance. #available . #getQuantity) - rg + response - -- Calculate the expected migration fee: - r0 <- request @(ApiWalletMigrationPlan n) ctx - (Link.createMigrationPlan @'Shelley sourceWallet) Default Empty - verify r0 - [ expectResponseCode HTTP.status200 - , expectField #totalFee (.> Quantity 0) + -- Analyse the source wallet's UTxO distribution: + let expectedSourceDistribution = + [ ( 1_000_000, 3) + , ( 10_000_000, 6) + , (100_000_000, 1) + ] + responseSourceDistribution <- request @ApiUtxoStatistics ctx + (Link.getUTxOsStatistics @'Shelley sourceWallet) Default Empty + verify responseSourceDistribution + [ expectField #distribution + ((`shouldBe` expectedSourceDistribution) + . Map.toList + . Map.filter (> 0) + ) ] - let expectedFee = getFromResponse (#totalFee . #getQuantity) r0 + -- Create an empty target wallet: targetWallet <- emptyWallet ctx - addrs <- listAddresses @n ctx targetWallet - let addr1 = (addrs !! 1) ^. #id - let payload = - Json [json| - { passphrase: #{fixturePassphrase} - , addresses: [#{addr1}] - }|] + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + + -- Compute the expected migration plan: + let feeExpected = 254_800 + responsePlan <- request @(ApiWalletMigrationPlan n) ctx + (Link.createMigrationPlan @'Shelley sourceWallet) Default + (Json [json|{addresses: #{targetAddressIds}}|]) + verify responsePlan + [ expectResponseCode HTTP.status202 + , expectField #totalFee (`shouldBe` Quantity feeExpected) + , expectField #selections ((`shouldBe` 1) . length) + ] + + -- Perform the migration: let ep = Link.migrateWallet @'Shelley sourceWallet - r <- request @[ApiTransaction n] ctx ep Default payload - verify r - [ expectResponseCode HTTP.status202 ] + responseMigrate <- request @[ApiTransaction n] ctx ep Default $ + Json [json| + { passphrase: #{fixturePassphrase} + , addresses: #{targetAddressIds} + }|] + + -- Verify the fee is as expected: + verify responseMigrate + [ expectResponseCode HTTP.status202 + , expectField id ((`shouldBe` 1) . length) + , expectField id + $ (`shouldBe` feeExpected) + . fromIntegral + . sum + . fmap apiTransactionFee + ] -- Check that funds become available in the target wallet: - let expectedBalance = originalBalance - expectedFee - eventually "targetWallet balance = expectedBalance" $ do + let expectedBalance = sourceBalance - feeExpected + eventually "Target wallet balance reaches the expected amount." $ do request @ApiWallet ctx (Link.getWallet @'Shelley targetWallet) Default Empty >>= flip verify [ expectField - (#balance . #available) - ( `shouldBe` Quantity expectedBalance) + (#balance . #available) + ( `shouldBe` Quantity expectedBalance) , expectField - (#balance . #total) - ( `shouldBe` Quantity expectedBalance) + (#balance . #total) + ( `shouldBe` Quantity expectedBalance) ] + + -- Analyse the target wallet's UTxO distribution: + let expectedTargetDistribution = [(100_000_000, 1)] + responseTargetDistribution <- request @ApiUtxoStatistics ctx + (Link.getUTxOsStatistics @'Shelley targetWallet) Default Empty + verify responseTargetDistribution + [ expectField #distribution + ((`shouldBe` expectedTargetDistribution) + . Map.toList + . Map.filter (> 0) + ) + ] where -- Compute the fee associated with an API transaction. apiTransactionFee :: ApiTransaction n -> Word64 From 5aabaa1025ca3d0950ecccf9ab3a3f2d3d7e110e Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 13 May 2021 06:33:09 +0000 Subject: [PATCH 24/29] Don't retry tests that deplete a fixture wallet's funds. If such a test fails when run the first time, it's more than likely that it'll fail when run a second time (as a fixture wallet's funds can only be spent once). In response to review feedback: https://github.com/input-output-hk/cardano-wallet/pull/2644#discussion_r630565046 --- .../src/Test/Integration/Scenario/API/Byron/Migrations.hs | 6 +++--- .../src/Test/Integration/Scenario/API/Shelley/Migrations.hs | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index ef76750bab7..0a9081f2c38 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -245,7 +245,7 @@ spec = describe "BYRON_MIGRATIONS" $ do testAddressCycling "Icarus" fixtureIcarusWallet 3 testAddressCycling "Icarus" fixtureIcarusWallet 10 - it "BYRON_MIGRATE_02 - \ + Hspec.it "BYRON_MIGRATE_02 - \ \Can migrate a large wallet requiring more than one transaction." $ \ctx -> runResourceT @IO $ do @@ -382,10 +382,10 @@ spec = describe "BYRON_MIGRATIONS" $ do , expectErrorMessage (errMsg403NothingToMigrate sourceWalletId) ] - it "BYRON_MIGRATE_04 - \ + Hspec.it "BYRON_MIGRATE_04 - \ \Actual fee for migration is identical to predicted fee." $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] - $ \fixtureByronWallet -> runResourceT $ do + $ \fixtureByronWallet -> runResourceT @IO $ do let feeExpected = 334_200 diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index f929d5db8c9..cd3532494eb 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -242,7 +242,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do testAddressCycling 3 testAddressCycling 10 - it "SHELLEY_MIGRATE_02 - \ + Hspec.it "SHELLEY_MIGRATE_02 - \ \Can migrate a large wallet requiring more than one transaction." $ \ctx -> runResourceT @IO $ do @@ -362,9 +362,9 @@ spec = describe "SHELLEY_MIGRATIONS" $ do , expectErrorMessage (errMsg403NothingToMigrate sourceWalletId) ] - it "SHELLEY_MIGRATE_04 - \ + Hspec.it "SHELLEY_MIGRATE_04 - \ \Actual fee for migration is identical to predicted fee." - $ \ctx -> runResourceT $ do + $ \ctx -> runResourceT @IO $ do let feeExpected = 255_200 From eb96557a1a329ab35876533c950e97ce87a7ac16 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 13 May 2021 08:45:57 +0000 Subject: [PATCH 25/29] Use more idiomatic style in `mkApiWalletMigrationPlan`. In response to review feedback: https://github.com/input-output-hk/cardano-wallet/pull/2644#discussion_r630743466 --- lib/core/src/Cardano/Wallet/Api/Server.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 2cfe04f945f..1f51ec8a1f5 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -2064,17 +2064,17 @@ mkApiWalletMigrationPlan -> Withdrawal -> MigrationPlan -> Maybe (ApiWalletMigrationPlan n) -mkApiWalletMigrationPlan s addresses rewardWithdrawal plan - | Just selections <- maybeSelections = - Just ApiWalletMigrationPlan - { selections - , totalFee - , balanceLeftover - , balanceSelected - } - | otherwise = - Nothing +mkApiWalletMigrationPlan s addresses rewardWithdrawal plan = + mkApiPlan <$> maybeSelections where + mkApiPlan :: NonEmpty (ApiCoinSelection n) -> ApiWalletMigrationPlan n + mkApiPlan selections = ApiWalletMigrationPlan + { selections + , totalFee + , balanceLeftover + , balanceSelected + } + maybeSelections :: Maybe (NonEmpty (ApiCoinSelection n)) maybeSelections = fmap mkApiCoinSelectionForMigration <$> maybeUnsignedTxs From a3d7deec8e95245d094b898c08b41c369bd32a97 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 13 May 2021 09:09:42 +0000 Subject: [PATCH 26/29] Provide a useful error message when there's nothing to migrate. In response to review feedback: https://github.com/input-output-hk/cardano-wallet/pull/2644#discussion_r631650180 --- .../src/Test/Integration/Framework/TestData.hs | 9 +++++++-- lib/core/src/Cardano/Wallet/Api/Server.hs | 9 +++++++-- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs index b6695ba5112..66614822215 100644 --- a/lib/core-integration/src/Test/Integration/Framework/TestData.hs +++ b/lib/core-integration/src/Test/Integration/Framework/TestData.hs @@ -353,8 +353,13 @@ errMsg400MinWithdrawalWrong = "The minimum withdrawal value must be at least \ \1 Lovelace." errMsg403NothingToMigrate :: Text -> String -errMsg403NothingToMigrate _wid = - "Nothing to migrate" +errMsg403NothingToMigrate _wid = mconcat + [ "I wasn't able to construct a migration plan. This could be " + , "because your wallet is empty, or it could be because the " + , "amount of ada in your wallet is insufficient to pay for " + , "any of the funds to be migrated. Try adding some ada to " + , "your wallet before trying again." + ] errMsg404NoAsset :: String errMsg404NoAsset = "The requested asset is not associated with this wallet." diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 1f51ec8a1f5..eef9b70cdbf 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -3339,8 +3339,13 @@ instance IsServerError ErrOutputTokenQuantityExceedsLimit where instance IsServerError ErrCreateMigrationPlan where toServerError = \case ErrCreateMigrationPlanEmpty -> - -- TODO: Provide a more useful error message: - apiError err403 NothingToMigrate "Nothing to migrate" + apiError err403 NothingToMigrate $ mconcat + [ "I wasn't able to construct a migration plan. This could be " + , "because your wallet is empty, or it could be because the " + , "amount of ada in your wallet is insufficient to pay for " + , "any of the funds to be migrated. Try adding some ada to " + , "your wallet before trying again." + ] ErrCreateMigrationPlanNoSuchWallet e -> toServerError e instance IsServerError ErrSelectAssets where From b0f1d828e015bc5e692abe714a7c0ab06a16c1eb Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 13 May 2021 09:18:58 +0000 Subject: [PATCH 27/29] Remove "disabled" warnings from migration endpoints. --- specifications/api/swagger.yaml | 8 -------- 1 file changed, 8 deletions(-) diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index d7a33718625..e4a93049b23 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -4657,10 +4657,6 @@ paths: tags: ["Migrations"] summary: Migrate description: | -

status: disabled

- ⚠️IMPORTANT⚠️ This endpoint has been temporarily disabled with the introduction of multi-assets UTxO. It will be enabled again soon. - -
Migrate the UTxO balance of this wallet to the given set of addresses. This operation will attempt to transfer as much of the wallet's balance @@ -4695,10 +4691,6 @@ paths: tags: ["Migrations"] summary: Create a migration plan description: | -

status: disabled

- ⚠️IMPORTANT⚠️ This endpoint has been temporarily disabled with the introduction of multi-assets UTxO. It will be enabled again soon. - -
Generate a plan for migrating the UTxO balance of this wallet to another wallet, without executing the plan. From 281998ffdf30b7d9d103bd5912b1a5329ed13591 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 14 May 2021 05:35:00 +0000 Subject: [PATCH 28/29] Add test `MIGRATE_MULTI_ASSET_01`. --- .../Scenario/API/Shelley/Migrations.hs | 150 ++++++++++++++++++ 1 file changed, 150 insertions(+) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index cd3532494eb..34917b10da8 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -39,6 +39,10 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( ShelleyKey ) import Cardano.Wallet.Primitive.Types.Address ( Address ) +import Cardano.Wallet.Primitive.Types.Coin + ( Coin (..) ) +import Cardano.Wallet.Primitive.Types.TokenBundle + ( TokenBundle (..) ) import Cardano.Wallet.Primitive.Types.Tx ( TxStatus (..) ) import Control.Monad @@ -47,6 +51,8 @@ import Control.Monad.IO.Class ( liftIO ) import Control.Monad.Trans.Resource ( runResourceT ) +import Data.Function + ( (&) ) import Data.Functor ( (<&>) ) import Data.Generics.Internal.VL.Lens @@ -59,6 +65,8 @@ import Data.Quantity ( Quantity (..) ) import Data.Word ( Word64 ) +import Numeric.Natural + ( Natural ) import Test.Hspec ( SpecWith, describe, pendingWith ) import Test.Hspec.Expectations.Lifted @@ -78,6 +86,7 @@ import Test.Integration.Framework.DSL , expectErrorMessage , expectField , expectResponseCode + , fixtureMultiAssetWallet , fixturePassphrase , fixtureWallet , getFromResponse @@ -103,7 +112,10 @@ import Test.Integration.Framework.TestData import qualified Cardano.Wallet.Api.Link as Link import qualified Cardano.Wallet.Api.Types as ApiTypes +import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap +import qualified Data.Foldable as F import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import qualified Network.HTTP.Types.Status as HTTP import qualified Test.Hspec as Hspec @@ -582,6 +594,129 @@ spec = describe "SHELLEY_MIGRATIONS" $ do . Map.filter (> 0) ) ] + + Hspec.it "SHELLEY_MIGRATE_MULTI_ASSET_01 - \ + \Can migrate a multi-asset wallet." + $ \ctx -> runResourceT @IO $ do + + -- Restore a source wallet with funds: + sourceWallet <- fixtureMultiAssetWallet ctx + + -- Wait for the source wallet balance to be correct: + let expectedAdaBalance = 40_000_000 + sourceBalance <- eventually "Source wallet balance is correct." $ do + response <- request @ApiWallet ctx + (Link.getWallet @'Shelley sourceWallet) Default Empty + verify response + [ expectField (#balance . #available . #getQuantity) + (`shouldBe` expectedAdaBalance) + , expectField (#balance . #total . #getQuantity) + (`shouldBe` expectedAdaBalance) + , expectField (#assets . #available . #getApiT) + ((`shouldBe` 8) . Set.size . TokenMap.getAssets) + , expectField (#assets . #total . #getApiT) + ((`shouldBe` 8) . Set.size . TokenMap.getAssets) + ] + let balanceAda = response + & getFromResponse (#balance . #available . #getQuantity) + & fromIntegral + & Coin + let balanceAssets = response + & getFromResponse (#assets . #available . #getApiT) + pure $ TokenBundle balanceAda balanceAssets + + -- Create an empty target wallet: + targetWallet <- emptyWallet ctx + targetAddresses <- listAddresses @n ctx targetWallet + let targetAddressIds = targetAddresses <&> + (\(ApiTypes.ApiAddress addrId _ _) -> addrId) + + -- Create a migration plan: + let endpointPlan = (Link.createMigrationPlan @'Shelley sourceWallet) + responsePlan <- request @(ApiWalletMigrationPlan n) + ctx endpointPlan Default $ + Json [json|{addresses: #{targetAddressIds}}|] + + -- Verify the plan is as expected: + let expectedFee = 191_100 + verify responsePlan + [ expectResponseCode HTTP.status202 + , expectField (#totalFee . #getQuantity) + (`shouldBe` expectedFee) + , expectField (#selections) + ((`shouldBe` 1) . length) + , expectField id + ((`shouldBe` 3) . apiPlanTotalInputCount) + , expectField id + ((`shouldBe` 1) . apiPlanTotalOutputCount) + , expectField (#balanceSelected . #ada) + (`shouldBe` coinToQuantity (view #coin sourceBalance)) + , expectField (#balanceLeftover . #ada . #getQuantity) + (`shouldBe` 0) + , expectField (#balanceSelected . #assets . #getApiT) + (`shouldBe` view #tokens sourceBalance) + , expectField (#balanceLeftover . #assets . #getApiT) + (`shouldSatisfy` TokenMap.isEmpty) + ] + + -- Perform a migration: + let endpointMigrate = Link.migrateWallet @'Shelley sourceWallet + responseMigrate <- + request @[ApiTransaction n] ctx endpointMigrate Default $ + Json [json| + { passphrase: #{fixturePassphrase} + , addresses: #{targetAddressIds} + }|] + + -- Verify the fee is as expected: + verify responseMigrate + [ expectResponseCode HTTP.status202 + , expectField id ((`shouldBe` 1) . length) + , expectField id + $ (`shouldBe` expectedFee) + . fromIntegral + . sum + . fmap apiTransactionFee + ] + + -- Check that funds become available in the target wallet: + let expectedTargetBalance = expectedAdaBalance - expectedFee + eventually "Target wallet balance reaches the expected amount." $ do + request @ApiWallet ctx + (Link.getWallet @'Shelley targetWallet) Default Empty + >>= flip verify + [ expectField + (#balance . #available) + (`shouldBe` Quantity expectedTargetBalance) + , expectField + (#balance . #total) + (`shouldBe` Quantity expectedTargetBalance) + , expectField + (#assets . #available . #getApiT) + (`shouldBe` view #tokens sourceBalance) + , expectField + (#assets . #total . #getApiT) + (`shouldBe` view #tokens sourceBalance) + ] + + -- Check that the source wallet has been depleted: + responseFinalSourceBalance <- request @ApiWallet ctx + (Link.getWallet @'Shelley sourceWallet) Default Empty + verify responseFinalSourceBalance + [ expectResponseCode HTTP.status200 + , expectField + (#balance . #available) + (`shouldBe` Quantity 0) + , expectField + (#balance . #total) + (`shouldBe` Quantity 0) + , expectField + (#assets . #available . #getApiT) + (`shouldSatisfy` TokenMap.isEmpty) + , expectField + (#assets . #total . #getApiT) + (`shouldSatisfy` TokenMap.isEmpty) + ] where -- Compute the fee associated with an API transaction. apiTransactionFee :: ApiTransaction n -> Word64 @@ -714,3 +849,18 @@ spec = describe "SHELLEY_MIGRATIONS" $ do (#balance . #total) (`shouldBe` Quantity 0) ] + +-------------------------------------------------------------------------------- +-- Utility functions +-------------------------------------------------------------------------------- + +apiPlanTotalInputCount :: ApiWalletMigrationPlan n -> Int +apiPlanTotalInputCount p = + F.sum (length . view #inputs <$> view #selections p) + +apiPlanTotalOutputCount :: ApiWalletMigrationPlan n -> Int +apiPlanTotalOutputCount p = + F.sum (length . view #outputs <$> view #selections p) + +coinToQuantity :: Coin -> Quantity "lovelace" Natural +coinToQuantity = Quantity . fromIntegral . unCoin From b9136673f1f69610b331a37f9dd50004d85571c7 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 14 May 2021 23:54:19 +0000 Subject: [PATCH 29/29] Use type synonym for selection results without change. This allows us to remove the module-wide `fno-warn-redundant-constraints`. In response to review feedback: https://github.com/input-output-hk/cardano-wallet/pull/2644#discussion_r632640582 --- lib/core/src/Cardano/Wallet.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index d1448b48d14..8dd4aaced4e 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -17,7 +17,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- | -- Copyright: © 2018-2020 IOHK @@ -1844,12 +1843,13 @@ createMigrationPlan ctx wid rewardWithdrawal = do nl = ctx ^. networkLayer tl = ctx ^. transactionLayer @k +type SelectionResultWithoutChange = SelectionResult Void + migrationPlanToSelectionWithdrawals - :: forall noChange. noChange ~ Void - => MigrationPlan + :: MigrationPlan -> Withdrawal -> NonEmpty Address - -> Maybe (NonEmpty (SelectionResult noChange, Withdrawal)) + -> Maybe (NonEmpty (SelectionResultWithoutChange, Withdrawal)) migrationPlanToSelectionWithdrawals plan rewardWithdrawal outputAddressesToCycle = NE.nonEmpty $ fst @@ -1860,8 +1860,8 @@ migrationPlanToSelectionWithdrawals plan rewardWithdrawal outputAddressesToCycle where accumulate :: Migration.Selection (TxIn, TxOut) - -> ([(SelectionResult noChange, Withdrawal)], [Address]) - -> ([(SelectionResult noChange, Withdrawal)], [Address]) + -> ([(SelectionResultWithoutChange, Withdrawal)], [Address]) + -> ([(SelectionResultWithoutChange, Withdrawal)], [Address]) accumulate migrationSelection (selectionWithdrawals, outputAddresses) = ( (selection, withdrawal) : selectionWithdrawals , outputAddressesRemaining