From e9ca97d3c2ef8bc756e988eca622d0d72e4fdb4b Mon Sep 17 00:00:00 2001 From: Alfredo Di Napoli Date: Fri, 7 Sep 2018 15:28:20 +0200 Subject: [PATCH 01/11] [CBR-377] Replace `--new-wallet` flag This commit replaces the `--new-wallet` flag in favour of a `--legacy-wallet` variant. Now the new data layer is enabled by default. --- src/Cardano/Wallet/Server/CLI.hs | 8 ++++---- src/Cardano/Wallet/Server/LegacyPlugins.hs | 4 +++- 2 files changed, 7 insertions(+), 5 deletions(-) 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 131e9c44e22..62a2d832344 100644 --- a/src/Cardano/Wallet/Server/LegacyPlugins.hs +++ b/src/Cardano/Wallet/Server/LegacyPlugins.hs @@ -48,7 +48,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, @@ -115,6 +116,7 @@ legacyWalletBackend :: (HasConfigurations, HasCompileInfo) -> Plugin WalletWebMode legacyWalletBackend coreConfig 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) From 88cc6627fe139c20f7c7b05ed00180ffcf309759 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Sat, 8 Sep 2018 14:55:09 +0200 Subject: [PATCH 02/11] [CBR-377] Wire-up updateNotifier in the new data-layer The main difference from the old one is that is doesn't notify clients via websockets since websockets are currently not supported by the new kernel. Should they be? Note that clients can still know about available update by polling the API on the "GET /api/internal/next-update" endpoint. Co-authored-by: Alfredo Di Napoli --- server/Main.hs | 4 ++-- src/Cardano/Wallet/Server/Plugins.hs | 21 ++++++++++++------- src/Cardano/Wallet/WalletLayer.hs | 5 +++++ src/Cardano/Wallet/WalletLayer/Kernel.hs | 2 ++ .../Wallet/WalletLayer/Kernel/Internal.hs | 20 ++++++++++++++++-- test/Cardano/Wallet/WalletLayer/QuickCheck.hs | 11 ++++++++++ 6 files changed, 51 insertions(+), 12 deletions(-) diff --git a/server/Main.hs b/server/Main.hs index 353df04486a..7004ff1e9c4 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -183,8 +183,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/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..a9656174fb6 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) @@ -463,6 +464,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/test/Cardano/Wallet/WalletLayer/QuickCheck.hs b/test/Cardano/Wallet/WalletLayer/QuickCheck.hs index b17c7773c7c..e0a606c51fe 100644 --- a/test/Cardano/Wallet/WalletLayer/QuickCheck.hs +++ b/test/Cardano/Wallet/WalletLayer/QuickCheck.hs @@ -21,6 +21,7 @@ import Cardano.Wallet.WalletLayer (ActiveWalletLayer (..), 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 +72,9 @@ bracketPassiveWallet = , postponeUpdate = liftedGen , resetWalletState = liftedGen , importWallet = \_ -> liftedGen + + , waitForUpdate = liftedGen + , addUpdate = \_ -> liftedGen } -- | A utility function. @@ -163,3 +167,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 [] From 0fee3d0b560de1fc8708b79c5ad7c2a72c5c3199 Mon Sep 17 00:00:00 2001 From: Alfredo Di Napoli Date: Mon, 10 Sep 2018 10:49:28 +0200 Subject: [PATCH 03/11] [CBR-413] Add a test to showcase the bug. --- test/unit/Test/Spec/Wallets.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) 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 From adc5bccaae150bc6ef64fa6afb8c94190f75b9f0 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Fri, 31 Aug 2018 09:05:32 +0200 Subject: [PATCH 04/11] [CBR-398] Adding integration test for redeemADA functionality --- integration/AccountSpecs.hs | 58 +++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) diff --git a/integration/AccountSpecs.hs b/integration/AccountSpecs.hs index 0f22c96dbec..4c1659155d3 100644 --- a/integration/AccountSpecs.hs +++ b/integration/AccountSpecs.hs @@ -98,6 +98,64 @@ accountSpecs wRef wc = map (AccountBalance . accAmount) accsUpdated `shouldBe` balancesPartialUpdated + + it "redeeming avvv key gives rise to the corresponding increase of balance of wallet'account - mnemonic not used" $ do + + newWallet <- randomWallet CreateWallet + Wallet{..} <- createWalletCheck wc newWallet + + --adding new account + rAcc <- generate arbitrary :: IO NewAccount + newAcctResp <- postAccount wc walId rAcc + newAcct <- wrData <$> newAcctResp `shouldPrism` _Right + + balancePartialRespB <- getAccountBalance wc walId (accIndex newAcct) + balancesPartialB <- wrData <$> balancePartialRespB `shouldPrism` _Right + let zeroBalance = AccountBalance $ V1 (Core.mkCoin 0) + balancesPartialB `shouldBe` zeroBalance + + -- state-demo/genesis-keys/keys-fakeavvm/fake-9.seed + let avvmKey = "QBYOctbb6fJT/dBDLwg4je+SAvEzEhRxA7wpLdEFhnY=" + --password is set to Nothing + passPhrase <- generate (pure mempty) :: IO SpendingPassword + let redemption = Redemption + { redemptionRedemptionCode = ShieldedRedemptionCode avvmKey + , redemptionMnemonic = Nothing + , redemptionSpendingPassword = passPhrase + , redemptionWalletId = walId + , redemptionAccountIndex = accIndex newAcct + } + + etxn <- redeemAda wc redemption + + txn <- fmap wrData etxn `shouldPrism` _Right + + threadDelay 180000000 + + --checking if redemption give rise to transaction indexing + eresp <- getTransactionIndex + wc + (Just walId) + (Just (accIndex newAcct)) + Nothing + resp <- fmap wrData eresp `shouldPrism` _Right + map txId resp `shouldContain` [txId txn] + + --balance for the previously zero-balance account should increase by 100000 + balancePartialResp <- getAccountBalance wc walId (accIndex newAcct) + balancesPartial <- wrData <$> balancePartialResp `shouldPrism` _Right + let nonzeroBalance = AccountBalance $ V1 (Core.mkCoin 100000) + balancesPartial `shouldBe` nonzeroBalance + + --redeemAda for the same redeem address should result in error + etxnAgain <- redeemAda wc redemption + + clientError <- etxnAgain `shouldPrism` _Left + clientError + `shouldBe` + ClientWalletError (UnknownError "Request error (Cannot send redemption transaction: Redemption address balance is 0)") + + where filterByAddress :: WalletAddress -> FilterOperations '[V1 Address] WalletAddress filterByAddress addr = From f624de058a8601924bc091464fc891ceec665a03 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Fri, 31 Aug 2018 10:52:55 +0200 Subject: [PATCH 05/11] [CBR-398] Taking account for nonempty spendingpassword if randomWallet ever use it in the future --- integration/AccountSpecs.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/integration/AccountSpecs.hs b/integration/AccountSpecs.hs index 4c1659155d3..449b316c76f 100644 --- a/integration/AccountSpecs.hs +++ b/integration/AccountSpecs.hs @@ -45,7 +45,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 @@ -99,6 +99,7 @@ accountSpecs wRef wc = map (AccountBalance . accAmount) accsUpdated `shouldBe` balancesPartialUpdated + it "redeeming avvv key gives rise to the corresponding increase of balance of wallet'account - mnemonic not used" $ do newWallet <- randomWallet CreateWallet @@ -121,7 +122,9 @@ accountSpecs wRef wc = let redemption = Redemption { redemptionRedemptionCode = ShieldedRedemptionCode avvmKey , redemptionMnemonic = Nothing - , redemptionSpendingPassword = passPhrase + , redemptionSpendingPassword = case newwalSpendingPassword newWallet of + Just spPassw -> spPassw + Nothing -> passPhrase , redemptionWalletId = walId , redemptionAccountIndex = accIndex newAcct } From 07b59df8ac1f644f05e8ca40817cc34cb82a6f15 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Mon, 3 Sep 2018 12:04:25 +0200 Subject: [PATCH 06/11] [CBR-398] complying with reviews and small fix to passphrase --- integration/AccountSpecs.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/integration/AccountSpecs.hs b/integration/AccountSpecs.hs index 449b316c76f..a5407a976b2 100644 --- a/integration/AccountSpecs.hs +++ b/integration/AccountSpecs.hs @@ -100,7 +100,7 @@ accountSpecs wRef wc = - it "redeeming avvv key gives rise to the corresponding increase of balance of wallet'account - mnemonic not used" $ do + it "redeeming avvm key gives rise to the corresponding increase of balance of wallet'account - mnemonic not used" $ do newWallet <- randomWallet CreateWallet Wallet{..} <- createWalletCheck wc newWallet @@ -118,7 +118,8 @@ accountSpecs wRef wc = -- state-demo/genesis-keys/keys-fakeavvm/fake-9.seed let avvmKey = "QBYOctbb6fJT/dBDLwg4je+SAvEzEhRxA7wpLdEFhnY=" --password is set to Nothing - passPhrase <- generate (pure mempty) :: IO SpendingPassword + --passPhrase <- generate (pure mempty) :: IO SpendingPassword + passPhrase <- pure mempty :: IO SpendingPassword let redemption = Redemption { redemptionRedemptionCode = ShieldedRedemptionCode avvmKey , redemptionMnemonic = Nothing @@ -133,7 +134,7 @@ accountSpecs wRef wc = txn <- fmap wrData etxn `shouldPrism` _Right - threadDelay 180000000 + threadDelay 90000000 --checking if redemption give rise to transaction indexing eresp <- getTransactionIndex From ba1daa62e1359de7669dcea1242dc44e94608790 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Mon, 3 Sep 2018 21:22:50 +0200 Subject: [PATCH 07/11] [CBR-398] Clarifying rationale behind redemptionSpendingPassword in the comment --- integration/AccountSpecs.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/integration/AccountSpecs.hs b/integration/AccountSpecs.hs index a5407a976b2..a71e6b368f7 100644 --- a/integration/AccountSpecs.hs +++ b/integration/AccountSpecs.hs @@ -117,8 +117,9 @@ accountSpecs wRef wc = -- state-demo/genesis-keys/keys-fakeavvm/fake-9.seed let avvmKey = "QBYOctbb6fJT/dBDLwg4je+SAvEzEhRxA7wpLdEFhnY=" - --password is set to Nothing - --passPhrase <- generate (pure mempty) :: IO SpendingPassword + + --password is set to Nothing in the current implementation of randomWallet + --when it changes redemptionSpendingPassword handles it, otherwise passPhare addresses it passPhrase <- pure mempty :: IO SpendingPassword let redemption = Redemption { redemptionRedemptionCode = ShieldedRedemptionCode avvmKey From 5ef71952a84818f011143bb5e49dfd68456769db Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Mon, 10 Sep 2018 11:15:32 +0200 Subject: [PATCH 08/11] [CBR-398] Refactoring to prop/monadicIO/pick/run --- integration/AccountSpecs.hs | 51 +++++++++++++++++++------------------ 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/integration/AccountSpecs.hs b/integration/AccountSpecs.hs index a71e6b368f7..b5620b939f7 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 @@ -99,28 +101,28 @@ accountSpecs wRef wc = map (AccountBalance . accAmount) accsUpdated `shouldBe` balancesPartialUpdated + pick "redeeming avvm key gives rise to the corresponding increase of balance of wallet'account - mnemonic not used" $ withMaxSuccess 1 $ + monadicIO $ do - it "redeeming avvm key gives rise to the corresponding increase of balance of wallet'account - mnemonic not used" $ do - - newWallet <- randomWallet CreateWallet - Wallet{..} <- createWalletCheck wc newWallet + newWallet <- run $ randomWallet CreateWallet + Wallet{..} <- run $ createWalletCheck wc newWallet --adding new account - rAcc <- generate arbitrary :: IO NewAccount - newAcctResp <- postAccount wc walId rAcc - newAcct <- wrData <$> newAcctResp `shouldPrism` _Right + rAcc <- pick arbitrary :: PropertyM IO NewAccount + newAcctResp <- run $ postAccount wc walId rAcc + newAcct <- run $ wrData <$> newAcctResp `shouldPrism` _Right - balancePartialRespB <- getAccountBalance wc walId (accIndex newAcct) - balancesPartialB <- wrData <$> balancePartialRespB `shouldPrism` _Right + balancePartialRespB <- run $ getAccountBalance wc walId (accIndex newAcct) + balancesPartialB <- run $ wrData <$> balancePartialRespB `shouldPrism` _Right let zeroBalance = AccountBalance $ V1 (Core.mkCoin 0) - balancesPartialB `shouldBe` zeroBalance + 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 :: IO SpendingPassword + passPhrase <- pure mempty :: PropertyM IO SpendingPassword let redemption = Redemption { redemptionRedemptionCode = ShieldedRedemptionCode avvmKey , redemptionMnemonic = Nothing @@ -131,36 +133,35 @@ accountSpecs wRef wc = , redemptionAccountIndex = accIndex newAcct } - etxn <- redeemAda wc redemption + etxn <- run $ redeemAda wc redemption - txn <- fmap wrData etxn `shouldPrism` _Right + txn <- run $ fmap wrData etxn `shouldPrism` _Right - threadDelay 90000000 + liftIO $ threadDelay 90000000 --checking if redemption give rise to transaction indexing - eresp <- getTransactionIndex + eresp <- run $ getTransactionIndex wc (Just walId) (Just (accIndex newAcct)) Nothing - resp <- fmap wrData eresp `shouldPrism` _Right - map txId resp `shouldContain` [txId txn] + 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 <- getAccountBalance wc walId (accIndex newAcct) - balancesPartial <- wrData <$> balancePartialResp `shouldPrism` _Right + balancePartialResp <- run $ getAccountBalance wc walId (accIndex newAcct) + balancesPartial <- run $ wrData <$> balancePartialResp `shouldPrism` _Right let nonzeroBalance = AccountBalance $ V1 (Core.mkCoin 100000) - balancesPartial `shouldBe` nonzeroBalance + liftIO $ balancesPartial `shouldBe` nonzeroBalance --redeemAda for the same redeem address should result in error - etxnAgain <- redeemAda wc redemption + etxnAgain <- run $ redeemAda wc redemption - clientError <- etxnAgain `shouldPrism` _Left - clientError + 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 = From 31b4569de515ea0baaa5f906c13d11822189e7cd Mon Sep 17 00:00:00 2001 From: Alfredo Di Napoli Date: Mon, 10 Sep 2018 11:21:07 +0200 Subject: [PATCH 09/11] [CBR-413] Reuse the WalletLayer.createHdAccount machinery This commit reuse the 'WalletLayer.createHdAccount' machinery in the Wallet creation/restoration process to ensure that newly-created wallets have always a fresh account and a fresh address. --- src/Cardano/Wallet/WalletLayer.hs | 8 ++++++- .../Wallet/WalletLayer/Kernel/Wallets.hs | 23 ++++++++++--------- 2 files changed, 19 insertions(+), 12 deletions(-) diff --git a/src/Cardano/Wallet/WalletLayer.hs b/src/Cardano/Wallet/WalletLayer.hs index 992a4714088..5e5dfd202f9 100644 --- a/src/Cardano/Wallet/WalletLayer.hs +++ b/src/Cardano/Wallet/WalletLayer.hs @@ -72,7 +72,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 +258,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 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 From cd16e1d9df68810c94bc24e31a70b2020dc50970 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Mon, 10 Sep 2018 11:39:57 +0200 Subject: [PATCH 10/11] [CBR-398] build fix --- integration/AccountSpecs.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/AccountSpecs.hs b/integration/AccountSpecs.hs index b5620b939f7..ecf7dbb3726 100644 --- a/integration/AccountSpecs.hs +++ b/integration/AccountSpecs.hs @@ -101,7 +101,7 @@ accountSpecs wRef wc = map (AccountBalance . accAmount) accsUpdated `shouldBe` balancesPartialUpdated - pick "redeeming avvm key gives rise to the corresponding increase of balance of wallet'account - mnemonic not used" $ withMaxSuccess 1 $ + 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 From 7d1d84cda6ab6d9e831b9b577fdb3fe16bc490dd Mon Sep 17 00:00:00 2001 From: Alfredo Di Napoli Date: Mon, 10 Sep 2018 14:55:39 +0200 Subject: [PATCH 11/11] [CBR-413] Fix test fallout This commit fixes some fallout in the tests which tested pagination. Due to the fact now each wallet creates a fresh new address, pagination tests needed to be amended to take that into account. --- test/Cardano/Wallet/WalletLayer/QuickCheck.hs | 19 +++----- test/unit/Test/Spec/Addresses.hs | 46 ++++++++++++------- 2 files changed, 35 insertions(+), 30 deletions(-) diff --git a/test/Cardano/Wallet/WalletLayer/QuickCheck.hs b/test/Cardano/Wallet/WalletLayer/QuickCheck.hs index b17c7773c7c..3749f93394b 100644 --- a/test/Cardano/Wallet/WalletLayer/QuickCheck.hs +++ b/test/Cardano/Wallet/WalletLayer/QuickCheck.hs @@ -11,13 +11,12 @@ 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 (..)) @@ -106,12 +105,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 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 $