diff --git a/integration/AccountSpecs.hs b/integration/AccountSpecs.hs index 0f22c96dbec..ecf7dbb3726 100644 --- a/integration/AccountSpecs.hs +++ b/integration/AccountSpecs.hs @@ -11,7 +11,9 @@ import Control.Concurrent (threadDelay) import Control.Lens import Pos.Core.Common (mkCoin) import Test.Hspec -import Test.QuickCheck (arbitrary, generate, shuffle) +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck (arbitrary, generate, shuffle, withMaxSuccess) +import Test.QuickCheck.Monadic (PropertyM, monadicIO, pick, run) import Util import qualified Pos.Core as Core @@ -45,7 +47,7 @@ accountSpecs wRef wc = forM_ tests $ \PaginationTest{..} -> do eresp <- getAccountAddresses wc walId accIndex page perPage filters expectations . acaAddresses . wrData =<< eresp `shouldPrism` _Right - it "can retrieve initial and updated balances of several account from getAccountBalances that are equivalent to what is obtained from getAccount" $ do + it "can retrieve initial and updated balances of several accounts from getAccountBalances that are equivalent to what is obtained from getAccounts" $ do genesis <- genesisWallet wc (fromAcct, _) <- firstAccountAndId wc genesis @@ -98,6 +100,68 @@ accountSpecs wRef wc = map (AccountBalance . accAmount) accsUpdated `shouldBe` balancesPartialUpdated + + prop "redeeming avvm key gives rise to the corresponding increase of balance of wallet'account - mnemonic not used" $ withMaxSuccess 1 $ + monadicIO $ do + + newWallet <- run $ randomWallet CreateWallet + Wallet{..} <- run $ createWalletCheck wc newWallet + + --adding new account + rAcc <- pick arbitrary :: PropertyM IO NewAccount + newAcctResp <- run $ postAccount wc walId rAcc + newAcct <- run $ wrData <$> newAcctResp `shouldPrism` _Right + + balancePartialRespB <- run $ getAccountBalance wc walId (accIndex newAcct) + balancesPartialB <- run $ wrData <$> balancePartialRespB `shouldPrism` _Right + let zeroBalance = AccountBalance $ V1 (Core.mkCoin 0) + liftIO $ balancesPartialB `shouldBe` zeroBalance + + -- state-demo/genesis-keys/keys-fakeavvm/fake-9.seed + let avvmKey = "QBYOctbb6fJT/dBDLwg4je+SAvEzEhRxA7wpLdEFhnY=" + + --password is set to Nothing in the current implementation of randomWallet + --when it changes redemptionSpendingPassword handles it, otherwise passPhare addresses it + passPhrase <- pure mempty :: PropertyM IO SpendingPassword + let redemption = Redemption + { redemptionRedemptionCode = ShieldedRedemptionCode avvmKey + , redemptionMnemonic = Nothing + , redemptionSpendingPassword = case newwalSpendingPassword newWallet of + Just spPassw -> spPassw + Nothing -> passPhrase + , redemptionWalletId = walId + , redemptionAccountIndex = accIndex newAcct + } + + etxn <- run $ redeemAda wc redemption + + txn <- run $ fmap wrData etxn `shouldPrism` _Right + + liftIO $ threadDelay 90000000 + + --checking if redemption give rise to transaction indexing + eresp <- run $ getTransactionIndex + wc + (Just walId) + (Just (accIndex newAcct)) + Nothing + resp <- run $ fmap wrData eresp `shouldPrism` _Right + liftIO $ map txId resp `shouldContain` [txId txn] + + --balance for the previously zero-balance account should increase by 100000 + balancePartialResp <- run $ getAccountBalance wc walId (accIndex newAcct) + balancesPartial <- run $ wrData <$> balancePartialResp `shouldPrism` _Right + let nonzeroBalance = AccountBalance $ V1 (Core.mkCoin 100000) + liftIO $ balancesPartial `shouldBe` nonzeroBalance + + --redeemAda for the same redeem address should result in error + etxnAgain <- run $ redeemAda wc redemption + + clientError <- run $ etxnAgain `shouldPrism` _Left + liftIO $ clientError + `shouldBe` + ClientWalletError (UnknownError "Request error (Cannot send redemption transaction: Redemption address balance is 0)") + where filterByAddress :: WalletAddress -> FilterOperations '[V1 Address] WalletAddress filterByAddress addr = diff --git a/server/Main.hs b/server/Main.hs index a52f2442ff9..52dfea1a242 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -185,8 +185,8 @@ actionWithWallet coreConfig txpConfig sscParams nodeParams ntpConfig params = -- Periodically compact & snapshot the acid-state database. , Plugins.acidStateSnapshots (view Kernel.Internal.wallets (snd w)) params dbMode - -- | A @Plugin@ to notify frontend via websockets. - , Plugins.updateNotifier + -- | A @Plugin@ to watch and store incoming update proposals + , Plugins.updateWatcher ] -- Extract the logger name from node parameters diff --git a/src/Cardano/Wallet/Server/CLI.hs b/src/Cardano/Wallet/Server/CLI.hs index f8829fb5bbf..47c5fa9f8be 100644 --- a/src/Cardano/Wallet/Server/CLI.hs +++ b/src/Cardano/Wallet/Server/CLI.hs @@ -123,12 +123,12 @@ chooseWalletBackendParser :: Parser ChooseWalletBackend chooseWalletBackendParser = choose <$> walletBackendParamsParser <*> (switch $ mconcat [ - long "new-wallet" - , help "Use the new wallet implementation (NOT FOR PRODUCTION USE)" + long "legacy-wallet" + , help "Use the legacy wallet implementation (NOT RECOMMENDED)" ]) where - choose opts False = WalletLegacy $ opts - choose opts True = WalletNew $ NewWalletBackendParams opts + choose opts True = WalletLegacy $ opts + choose opts False = WalletNew $ NewWalletBackendParams opts -- | The @Parser@ for the @WalletBackendParams@. walletBackendParamsParser :: Parser WalletBackendParams diff --git a/src/Cardano/Wallet/Server/LegacyPlugins.hs b/src/Cardano/Wallet/Server/LegacyPlugins.hs index 6f0e50e76b4..d21710407c9 100644 --- a/src/Cardano/Wallet/Server/LegacyPlugins.hs +++ b/src/Cardano/Wallet/Server/LegacyPlugins.hs @@ -49,7 +49,8 @@ import qualified Servant import Pos.Context (HasNodeContext) import Pos.Core as Core (Config) import Pos.Util (lensOf) -import Pos.Util.Wlog (logInfo, modifyLoggerName, usingLoggerName) +import Pos.Util.Wlog (logInfo, logWarning, modifyLoggerName, + usingLoggerName) import Cardano.NodeIPC (startNodeJsIPC) import Pos.Configuration (walletProductionApi, @@ -118,6 +119,7 @@ legacyWalletBackend :: (HasConfigurations, HasCompileInfo) -> Plugin WalletWebMode legacyWalletBackend coreConfig walletConfig txpConfig WalletBackendParams {..} ntpStatus = pure $ \diffusion -> do modifyLoggerName (const "legacyServantBackend") $ do + logWarning $ sformat "RUNNING THE OLD LEGACY DATA LAYER IS NOT RECOMMENDED!" logInfo $ sformat ("Production mode for API: "%build) walletProductionApi logInfo $ sformat ("Transaction submission disabled: "%build) diff --git a/src/Cardano/Wallet/Server/Plugins.hs b/src/Cardano/Wallet/Server/Plugins.hs index e44cbf5357f..2e57b1e59e2 100644 --- a/src/Cardano/Wallet/Server/Plugins.hs +++ b/src/Cardano/Wallet/Server/Plugins.hs @@ -9,7 +9,7 @@ module Cardano.Wallet.Server.Plugins , docServer , monitoringServer , acidStateSnapshots - , updateNotifier + , updateWatcher ) where import Universum @@ -30,14 +30,14 @@ import Cardano.Wallet.Server.CLI (NewWalletBackendParams (..), isDebugMode, walletAcidInterval) import Cardano.Wallet.WalletLayer (ActiveWalletLayer, PassiveWalletLayer) +import Pos.Chain.Update (cpsSoftwareVersion) import Pos.Crypto (ProtocolMagic) import Pos.Infra.Diffusion.Types (Diffusion (..)) import Pos.Infra.Shutdown (HasShutdownContext (shutdownContext), ShutdownContext) import Pos.Launcher.Configuration (HasConfigurations) import Pos.Util.CompileInfo (HasCompileInfo) -import Pos.Util.Wlog (logError, logInfo, modifyLoggerName, - usingLoggerName) +import Pos.Util.Wlog (logInfo, modifyLoggerName, usingLoggerName) import Pos.Web (serveDocImpl, serveImpl) import qualified Pos.Web.Server @@ -46,6 +46,7 @@ import qualified Cardano.Wallet.Kernel.Mode as Kernel import qualified Cardano.Wallet.Server as Server import Cardano.Wallet.Server.Plugins.AcidState (createAndArchiveCheckpoints) +import qualified Cardano.Wallet.WalletLayer as WalletLayer import qualified Cardano.Wallet.WalletLayer.Kernel as WalletLayer.Kernel import qualified Data.ByteString.Char8 as BS8 import qualified Servant @@ -158,8 +159,12 @@ acidStateSnapshots dbRef params dbMode = pure $ \_diffusion -> do (walletAcidInterval opts) dbMode --- | A @Plugin@ to notify frontend via websockets. -updateNotifier :: Plugin Kernel.WalletMode -updateNotifier = [ - \_diffusion -> logError "Not Implemented: updateNotifier [CBR-374]" - ] +-- | A @Plugin@ to store updates proposal received from the blockchain +updateWatcher :: Plugin Kernel.WalletMode +updateWatcher = pure $ \_diffusion -> do + modifyLoggerName (const "update-watcher-plugin") $ do + w <- Kernel.getWallet + forever $ liftIO $ do + newUpdate <- WalletLayer.waitForUpdate w + logInfo "A new update was found!" + WalletLayer.addUpdate w . cpsSoftwareVersion $ newUpdate diff --git a/src/Cardano/Wallet/WalletLayer.hs b/src/Cardano/Wallet/WalletLayer.hs index 992a4714088..d3af0065978 100644 --- a/src/Cardano/Wallet/WalletLayer.hs +++ b/src/Cardano/Wallet/WalletLayer.hs @@ -34,6 +34,7 @@ import Test.QuickCheck (Arbitrary (..), oneof) import Pos.Chain.Block (Blund) import Pos.Chain.Txp (Tx, TxId, Utxo) +import Pos.Chain.Update (ConfirmedProposalState) import Pos.Core (Coin, Timestamp) import Pos.Core.Chrono (NE, NewestFirst (..), OldestFirst (..)) import Pos.Core.Update (SoftwareVersion) @@ -72,7 +73,7 @@ data CreateWallet = data CreateWalletError = CreateWalletError Kernel.CreateWalletError - | CreateWalletFirstAccountCreationFailed Kernel.CreateAccountError + | CreateWalletFirstAccountCreationFailed CreateAccountError -- | Unsound show instance needed for the 'Exception' instance. instance Show CreateWalletError where @@ -258,6 +259,12 @@ instance Show CreateAccountError where instance Exception CreateAccountError +instance Arbitrary CreateAccountError where + arbitrary = oneof [ CreateAccountError <$> arbitrary + , CreateAccountWalletIdDecodingFailed <$> arbitrary + , CreateAccountFirstAddressGenerationFailed <$> arbitrary + ] + instance Buildable CreateAccountError where build (CreateAccountError kernelError) = bprint ("CreateAccountError " % build) kernelError @@ -463,6 +470,10 @@ data PassiveWalletLayer m = PassiveWalletLayer , postponeUpdate :: m () , resetWalletState :: m () , importWallet :: WalletImport -> m (Either ImportWalletError Wallet) + + -- updates + , waitForUpdate :: m ConfirmedProposalState + , addUpdate :: SoftwareVersion -> m () } ------------------------------------------------------------ diff --git a/src/Cardano/Wallet/WalletLayer/Kernel.hs b/src/Cardano/Wallet/WalletLayer/Kernel.hs index 9dcdebbd4b5..6c83b97994d 100644 --- a/src/Cardano/Wallet/WalletLayer/Kernel.hs +++ b/src/Cardano/Wallet/WalletLayer/Kernel.hs @@ -71,9 +71,11 @@ bracketPassiveWallet mode logFunction keystore node f = do , updateAccount = Accounts.updateAccount w , deleteAccount = Accounts.deleteAccount w , createAddress = Addresses.createAddress w + , addUpdate = Internal.addUpdate w , nextUpdate = Internal.nextUpdate w , applyUpdate = Internal.applyUpdate w , postponeUpdate = Internal.postponeUpdate w + , waitForUpdate = Internal.waitForUpdate w , resetWalletState = Internal.resetWalletState w , importWallet = Internal.importWallet w , applyBlocks = invokeIO . Actions.ApplyBlocks diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Internal.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Internal.hs index 7bfec96b98f..b9e73d64732 100644 --- a/src/Cardano/Wallet/WalletLayer/Kernel/Internal.hs +++ b/src/Cardano/Wallet/WalletLayer/Kernel/Internal.hs @@ -4,6 +4,9 @@ module Cardano.Wallet.WalletLayer.Kernel.Internal ( , postponeUpdate , resetWalletState , importWallet + + , waitForUpdate + , addUpdate ) where import Universum @@ -12,12 +15,13 @@ import Control.Concurrent.MVar (modifyMVar_) import Data.Acid.Advanced (update') import System.IO.Error (isDoesNotExistError) +import Pos.Chain.Update (ConfirmedProposalState) import Pos.Core.Update (SoftwareVersion) import Cardano.Wallet.API.V1.Types (V1 (..), Wallet, WalletImport (..)) -import Cardano.Wallet.Kernel.DB.AcidState (ClearDB (..), - GetNextUpdate (..), RemoveNextUpdate (..)) +import Cardano.Wallet.Kernel.DB.AcidState (AddUpdate (..), + ClearDB (..), GetNextUpdate (..), RemoveNextUpdate (..)) import Cardano.Wallet.Kernel.DB.InDb import Cardano.Wallet.Kernel.DB.TxMeta import qualified Cardano.Wallet.Kernel.Internal as Kernel @@ -67,6 +71,18 @@ applyUpdate w = liftIO $ do postponeUpdate :: MonadIO m => Kernel.PassiveWallet -> m () postponeUpdate w = update' (w ^. Kernel.wallets) $ RemoveNextUpdate +-- | Wait for an update notification +waitForUpdate :: MonadIO m => Kernel.PassiveWallet -> m ConfirmedProposalState +waitForUpdate w = liftIO $ + Node.withNodeState (w ^. Kernel.walletNode) $ \_lock -> + Node.waitForUpdate + +-- | Add an update in the DB, this is triggered by the notifier once getting +-- a new proposal from the blockchain +addUpdate :: MonadIO m => Kernel.PassiveWallet -> SoftwareVersion -> m () +addUpdate w v = liftIO $ + update' (w ^. Kernel.wallets) $ AddUpdate (InDb v) + -- | Reset wallet state resetWalletState :: MonadIO m => Kernel.PassiveWallet -> m () resetWalletState w = liftIO $ do diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs index d83d1faaaf7..38b41417afd 100644 --- a/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs +++ b/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs @@ -25,7 +25,6 @@ import Pos.Crypto.Signing import Cardano.Wallet.API.V1.Types (V1 (..)) import qualified Cardano.Wallet.API.V1.Types as V1 -import qualified Cardano.Wallet.Kernel.Accounts as Kernel import qualified Cardano.Wallet.Kernel.BIP39 as BIP39 import Cardano.Wallet.Kernel.DB.AcidState (dbHdWallets) import Cardano.Wallet.Kernel.DB.BlockContext @@ -49,10 +48,12 @@ import Cardano.Wallet.Kernel.Types (RawResolvedBlock (..), WalletId (..), fromRawResolvedBlock) import Cardano.Wallet.Kernel.Util.Core (getCurrentTimestamp) import qualified Cardano.Wallet.Kernel.Wallets as Kernel -import Cardano.Wallet.WalletLayer (CreateWallet (..), - CreateWalletError (..), DeleteWalletError (..), - GetUtxosError (..), GetWalletError (..), - UpdateWalletError (..), UpdateWalletPasswordError (..)) +import Cardano.Wallet.WalletLayer (CreateAccount (..), + CreateWallet (..), CreateWalletError (..), + DeleteWalletError (..), GetUtxosError (..), + GetWalletError (..), UpdateWalletError (..), + UpdateWalletPasswordError (..)) +import qualified Cardano.Wallet.WalletLayer.Kernel.Accounts as Accounts import Cardano.Wallet.WalletLayer.Kernel.Conv createWallet :: MonadIO m @@ -85,12 +86,12 @@ createWallet wallet newWalletRequest = liftIO $ do _ <- withExceptT CreateWalletFirstAccountCreationFailed $ ExceptT $ do -- When we create a new wallet, we want to create a new account -- with a predictable, fixed seed, in compliance with the old - -- schema. - Kernel.createHdFixedAccount - (HD.HdAccountIx firstHardened) - (HD.AccountName "Default account") - (WalletIdHdRnd rootId) - wallet + -- schema.We offload this to the WalletLayer so that we can be + -- sure it will also create a fresh address and we won't + -- duplicate work. + let newAccount = V1.NewAccount newwalSpendingPassword "Default account" + let rq = CreateHdAccountFixedIndex (HD.HdAccountIx firstHardened) newAccount + Accounts.createHdAccount wallet (toRootId rootId) rq return (mkRoot newwalName newwalAssuranceLevel now root) restore :: V1.NewWallet diff --git a/test/Cardano/Wallet/WalletLayer/QuickCheck.hs b/test/Cardano/Wallet/WalletLayer/QuickCheck.hs index b17c7773c7c..122af87d3a3 100644 --- a/test/Cardano/Wallet/WalletLayer/QuickCheck.hs +++ b/test/Cardano/Wallet/WalletLayer/QuickCheck.hs @@ -11,16 +11,16 @@ import Universum import Cardano.Wallet.Kernel.Diffusion (WalletDiffusion (..)) import Cardano.Wallet.Orphans.Arbitrary () import Cardano.Wallet.WalletLayer (ActiveWalletLayer (..), - CreateAccountError (..), DeleteAccountError (..), - DeleteWalletError (..), GetAccountError (..), - GetAccountsError (..), GetUtxosError (..), - GetWalletError (..), ImportWalletError (..), - PassiveWalletLayer (..), UpdateAccountError (..), - UpdateWalletError (..), UpdateWalletPasswordError (..), - ValidateAddressError (..)) + DeleteAccountError (..), DeleteWalletError (..), + GetAccountError (..), GetAccountsError (..), + GetUtxosError (..), GetWalletError (..), + ImportWalletError (..), PassiveWalletLayer (..), + UpdateAccountError (..), UpdateWalletError (..), + UpdateWalletPasswordError (..), ValidateAddressError (..)) import Cardano.Wallet.API.V1.Types (V1 (..)) +import Pos.Chain.Update (ConfirmedProposalState) import Pos.Core () import Test.Pos.Chain.Txp.Arbitrary () import Test.QuickCheck (Arbitrary (..), arbitrary, generate, oneof) @@ -71,6 +71,9 @@ bracketPassiveWallet = , postponeUpdate = liftedGen , resetWalletState = liftedGen , importWallet = \_ -> liftedGen + + , waitForUpdate = liftedGen + , addUpdate = \_ -> liftedGen } -- | A utility function. @@ -106,12 +109,6 @@ bracketActiveWallet walletPassiveLayer _walletDiffusion = anywhere. ------------------------------------------------------------------------------} -instance Arbitrary CreateAccountError where - arbitrary = oneof [ CreateAccountError <$> arbitrary - , pure (CreateAccountWalletIdDecodingFailed "foobar") - , CreateAccountFirstAddressGenerationFailed <$> arbitrary - ] - instance Arbitrary GetAccountError where arbitrary = oneof [ GetAccountError . V1 <$> arbitrary , GetAccountWalletIdDecodingFailed <$> arbitrary @@ -163,3 +160,10 @@ instance Arbitrary ImportWalletError where , ImportWalletNoWalletFoundInBackup <$> arbitrary , ImportWalletCreationFailed <$> arbitrary ] + +-- This is obviously not a valid 'Arbitrary' instance, but one will be provided +-- when we will be start using this 'WalletLayer' implementation. Note how the +-- core layer already provides one, it's just a matter of exposing it to other +-- components and use it. +instance Arbitrary ConfirmedProposalState where + arbitrary = oneof [] diff --git a/test/unit/Test/Spec/Addresses.hs b/test/unit/Test/Spec/Addresses.hs index 9ed30949af5..290c7595bc0 100644 --- a/test/unit/Test/Spec/Addresses.hs +++ b/test/unit/Test/Spec/Addresses.hs @@ -16,12 +16,14 @@ import Test.QuickCheck (arbitrary, choose, withMaxSuccess) import Test.QuickCheck.Monadic (PropertyM, monadicIO, pick) import Pos.Core (Address) -import Pos.Crypto (EncryptedSecretKey, safeDeterministicKeyGen) +import Pos.Crypto (EncryptedSecretKey, firstHardened, + safeDeterministicKeyGen) import Cardano.Wallet.API.Request (RequestParams (..)) import Cardano.Wallet.API.Request.Pagination (Page (..), PaginationParams (..), PerPage (..)) -import Cardano.Wallet.API.Response (WalletResponse (wrData)) +import Cardano.Wallet.API.Response (SliceOf (..), + WalletResponse (wrData)) import Cardano.Wallet.API.V1.Handlers.Addresses as Handlers import qualified Cardano.Wallet.API.V1.Types as V1 import qualified Cardano.Wallet.Kernel.Addresses as Kernel @@ -34,14 +36,12 @@ import Cardano.Wallet.Kernel.DB.HdWallet.Create (initHdRoot) import Cardano.Wallet.Kernel.DB.HdWallet.Derivation (HardeningMode (..), deriveIndex) import Cardano.Wallet.Kernel.DB.InDb (InDb (..), fromDb) -import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet import Cardano.Wallet.Kernel.Internal (PassiveWallet, wallets) import qualified Cardano.Wallet.Kernel.Keystore as Keystore import qualified Cardano.Wallet.Kernel.Read as Kernel import Cardano.Wallet.Kernel.Types (AccountId (..), WalletId (..)) import Cardano.Wallet.WalletLayer (PassiveWalletLayer) import qualified Cardano.Wallet.WalletLayer as WalletLayer -import qualified Cardano.Wallet.WalletLayer.Kernel.Accounts as Accounts import qualified Cardano.Wallet.WalletLayer.Kernel.Addresses as Addresses import qualified Cardano.Wallet.WalletLayer.Kernel.Conv as Kernel.Conv import qualified Cardano.Wallet.WalletLayer.Kernel.Wallets as Wallets @@ -62,7 +62,7 @@ data Fixture = Fixture { data AddressFixture = AddressFixture { addressFixtureAddress :: V1.WalletAddress - } + } deriving (Eq, Ord) -- | Prepare some fixtures using the 'PropertyM' context to prepare the data, -- and execute the 'acid-state' update once the 'PassiveWallet' gets into @@ -95,15 +95,28 @@ prepareAddressFixture n = do newWalletRq <- WalletLayer.CreateWallet <$> Wallets.genNewWalletRq spendingPassword return $ \pw -> do Right v1Wallet <- Wallets.createWallet pw newWalletRq - -- Get all the available accounts - db <- Kernel.getWalletSnapshot pw - let Right accs = Accounts.getAccounts (V1.walId v1Wallet) db - let (acc : _) = IxSet.toList accs - let newAddressRq = V1.NewAddress spendingPassword (V1.accIndex acc) (V1.walId v1Wallet) - res <- replicateM n (Addresses.createAddress pw newAddressRq) + -- Create new accounts under the first, automatically-generated + -- account for this wallet, placed at 'firstHardened'. + let newAddressRq = + V1.NewAddress spendingPassword + (V1.unsafeMkAccountIndex firstHardened) + (V1.walId v1Wallet) + + -- We create one address less of which is requested by the caller, as + -- by default each fresh account gets a new address. + res <- replicateM (max 0 (n -1)) (Addresses.createAddress pw newAddressRq) case sequence res of - Left e -> error (show e) - Right addr -> return (map AddressFixture addr) + Left e -> error (show e) + Right _addrs -> do + db' <- Kernel.getWalletSnapshot pw + -- Low & behold here lies an hack: in order to produce the data + -- in the same order in which it will be consumed by the + -- pagination tests, we need to call 'listAddresses', which + -- obviously doesn't list _just_ the addresses for a single + -- account, but it works as our fixture creates only one. + let pp = PaginationParams (Page 1) (PerPage 100) + let SliceOf{..} = Addresses.getAddresses (RequestParams pp) db' + return . map AddressFixture $ paginatedSlice withFixture :: ( Keystore.Keystore -> PassiveWalletLayer IO @@ -255,10 +268,9 @@ spec = describe "Addresses" $ do res <- runExceptT $ runHandler' $ do Handlers.listAddresses layer (RequestParams pp) case res of - Right wr | [wa0'] <- wrData wr - , wa0' == addressFixtureAddress wa0 - -> pure () - _ -> fail ("Got " ++ show res) + Right wr -> + wrData wr `shouldBe` [addressFixtureAddress wa0] + _ -> fail ("Got " ++ show res) prop "3 addresses, page 1, per page 2" $ do monadicIO $ diff --git a/test/unit/Test/Spec/Wallets.hs b/test/unit/Test/Spec/Wallets.hs index ef4b3475258..f9a12065572 100644 --- a/test/unit/Test/Spec/Wallets.hs +++ b/test/unit/Test/Spec/Wallets.hs @@ -192,6 +192,22 @@ spec = describe "Wallets" $ do fetchAccount (V1.walId wrData) (bimap identity STB res) `shouldSatisfy` isRight + prop "comes by default with 1 address at the default account" $ withMaxSuccess 50 $ do + monadicIO $ do + pwd <- genSpendingPassword + rq <- genNewWalletRq pwd + withLayer $ \layer _ -> do + liftIO $ do + let fetchAccount wId = + Handlers.getAccount layer wId (V1.unsafeMkAccountIndex firstHardened) + res <- runExceptT . runHandler' $ do + V1.WalletResponse{..} <- Handlers.newWallet layer rq + fetchAccount (V1.walId wrData) + case res of + Left e -> throwM e + Right V1.WalletResponse{..} -> + length (V1.accAddresses wrData) `shouldBe` 1 + describe "DeleteWallet" $ do describe "Wallet deletion (wallet layer)" $ do