From 18bab9880be3cdb474ec92a44d961456771174dd Mon Sep 17 00:00:00 2001 From: KtorZ Date: Mon, 10 Sep 2018 17:13:52 +0200 Subject: [PATCH 01/14] Add Swagger combinator to drill into the file and modify operations - This is especially useful to add descriptions here and there without actually bloating the API type, making it hard to read as long as making the type errors much worse! - This combinator is quite unsafe an will throw when trying to generate the swagger schema if it was used on paths that aren't reachable -- This is most probably what we want. --- src/Cardano/Wallet/API/V1/Swagger.hs | 106 ++++++++++++++++++++++++++- 1 file changed, 102 insertions(+), 4 deletions(-) diff --git a/src/Cardano/Wallet/API/V1/Swagger.hs b/src/Cardano/Wallet/API/V1/Swagger.hs index f86249d6761..4c734900226 100644 --- a/src/Cardano/Wallet/API/V1/Swagger.hs +++ b/src/Cardano/Wallet/API/V1/Swagger.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} @@ -9,7 +10,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cardano.Wallet.API.V1.Swagger where -import Universum +import Universum hiding (get, put) import Cardano.Wallet.API.Indices (ParamNames) import Cardano.Wallet.API.Request.Filter @@ -29,16 +30,17 @@ import Pos.Util.CompileInfo (CompileTimeInfo, ctiGitRevision) import Pos.Util.Servant (CustomQueryFlag, LoggingApi) import Pos.Wallet.Web.Swagger.Instances.Schema () -import Control.Lens ((?~)) +import Control.Lens (At, Index, IxValue, at, (?~)) import Data.Aeson (encode) import Data.Aeson.Encode.Pretty import Data.Map (Map) -import Data.Swagger hiding (Example, Header) +import Data.Swagger hiding (Example) import Data.Typeable import Formatting (build, sformat) import GHC.TypeLits (KnownSymbol) import NeatInterpolation -import Servant (Handler, QueryFlag, ServantErr (..), Server) +import Servant (Handler, QueryFlag, ServantErr (..), Server, + StdMethod (..)) import Servant.API.Sub import Servant.Swagger import Servant.Swagger.UI (SwaggerSchemaUI') @@ -71,6 +73,102 @@ inlineCodeBlock txt = "
" <> replaceNewLines (replaceWhiteSpaces txt) <> " (StdMethod, FilePath)
+    -> (Operation -> Operation)
+    -> m
+    -> m
+alterOperation (verb, path) alter =
+    at path %~ (Just . unsafeAlterItem)
+  where
+    errUnreachableEndpoint :: Text
+    errUnreachableEndpoint =
+        "Unreachable endpoint: " <> show verb <> " " <> show path
+
+    errUnsupportedVerb :: Text
+    errUnsupportedVerb =
+        "Used unsupported verb to identify an endpoint: " <> show verb
+
+    unsafeAlterItem ::
+        ( HasGet item (Maybe Operation)
+        , HasPut item (Maybe Operation)
+        , HasPatch item (Maybe Operation)
+        , HasPost item (Maybe Operation)
+        , HasDelete item (Maybe Operation)
+        )
+        => Maybe item
+        -> item
+    unsafeAlterItem = maybe
+        (error errUnreachableEndpoint)
+        (unsafeLensFor verb %~ (Just . unsafeAlterOperation))
+
+    unsafeAlterOperation :: Maybe Operation -> Operation
+    unsafeAlterOperation = maybe
+        (error errUnreachableEndpoint)
+        alter
+
+    unsafeLensFor ::
+        ( Functor f
+        , HasGet item (Maybe Operation)
+        , HasPut item (Maybe Operation)
+        , HasPatch item (Maybe Operation)
+        , HasPost item (Maybe Operation)
+        , HasDelete item (Maybe Operation)
+        )
+        => StdMethod
+        -> (Maybe Operation -> f (Maybe Operation))
+        -> item
+        -> f item
+    unsafeLensFor = \case
+        GET    -> get
+        PUT    -> put
+        PATCH  -> patch
+        POST   -> post
+        DELETE -> delete
+        _      -> error errUnsupportedVerb
+
+
+-- | A combinator to modify the description of an operation, using
+-- 'alterOperation' under the hood.
+--
+--
+-- Example:
+--
+--     swagger
+--       & paths %~ (POST, "/api/v1/wallets") `setDescription` "foo"
+--       & paths %~ (GET, "/api/v1/wallets/{walletId}") `setDescription` "bar"
+setDescription
+    :: (IxValue m ~ PathItem, Index m ~ FilePath, At m)
+    => (StdMethod, FilePath)
+    -> Text
+    -> m
+    -> m
+setDescription endpoint str =
+    endpoint `alterOperation` (description ?~ str)
+
+
 --
 -- Instances
 --

From 0550c6f2ea94dfc2350b4e832d93ebcc4179f83b Mon Sep 17 00:00:00 2001
From: KtorZ 
Date: Mon, 10 Sep 2018 17:17:06 +0200
Subject: [PATCH 02/14] Add few examples of usage of this 'setDescription'
 combinator

---
 src/Cardano/Wallet/API/V1/Swagger.hs | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/src/Cardano/Wallet/API/V1/Swagger.hs b/src/Cardano/Wallet/API/V1/Swagger.hs
index 4c734900226..2c4d1c05e4c 100644
--- a/src/Cardano/Wallet/API/V1/Swagger.hs
+++ b/src/Cardano/Wallet/API/V1/Swagger.hs
@@ -1022,6 +1022,26 @@ swaggerSchemaUIServer =
   
 |]
 
+applyUpdateDescription :: Text
+applyUpdateDescription = [text|
+Apply the next available update proposal from the blockchain. Note that this
+will immediately shutdown the node and makes it unavailable for a short while.
+|]
+
+postponeUpdateDescription :: Text
+postponeUpdateDescription = [text|
+Discard the next available update from the node's local state. Yet, this doesn't
+reject the update which will still be applied as soon as the node is restarted.
+|]
+
+resetWalletStateDescription :: Text
+resetWalletStateDescription = [text|
+Wipe-out the node's local state entirely. The only intended use-case for this
+endpoint is during API integration testing. Note also that this will fail by
+default unless the node is running in debug mode.
+|]
+
+
 --
 -- The API
 --
@@ -1053,3 +1073,6 @@ api (compileInfo, curSoftwareVersion) walletAPI mkDescription = toSwagger wallet
     , deSoftwareVersion       = fromString $ show curSoftwareVersion
     }
   & info.license ?~ ("MIT" & url ?~ URL "https://raw.githubusercontent.com/input-output-hk/cardano-sl/develop/lib/LICENSE")
+  & paths %~ (POST, "/api/internal/apply-update") `setDescription` applyUpdateDescription
+  & paths %~ (POST, "/api/internal/postpone-update") `setDescription` postponeUpdateDescription
+  & paths %~ (DELETE, "/api/internal/reset-wallet-state") `setDescription` resetWalletStateDescription

From 01c4f59d36d56e8e8bd98f6ace4bb33869525412 Mon Sep 17 00:00:00 2001
From: Alfredo Di Napoli 
Date: Tue, 11 Sep 2018 17:02:54 +0200
Subject: [PATCH 03/14] [CBR-419] Enforce createHdRoot invariant

This commit threads a default account & address throughout the code deep
down the createHdRoot function, to ensure that atomically, in a single
acid-state transaction, we will always create a wallet with a companion
account & address.
---
 src/Cardano/Wallet/Kernel/Addresses.hs        | 32 +++++--
 src/Cardano/Wallet/Kernel/DB/AcidState.hs     | 40 +++++++--
 .../Wallet/Kernel/DB/HdWallet/Create.hs       | 33 +++++++-
 src/Cardano/Wallet/Kernel/Restore.hs          | 14 ++--
 src/Cardano/Wallet/Kernel/Wallets.hs          | 84 ++++++++++++++-----
 .../Wallet/WalletLayer/Kernel/Wallets.hs      | 28 ++-----
 6 files changed, 161 insertions(+), 70 deletions(-)

diff --git a/src/Cardano/Wallet/Kernel/Addresses.hs b/src/Cardano/Wallet/Kernel/Addresses.hs
index dd175682c27..7e127cb1153 100644
--- a/src/Cardano/Wallet/Kernel/Addresses.hs
+++ b/src/Cardano/Wallet/Kernel/Addresses.hs
@@ -1,5 +1,6 @@
 module Cardano.Wallet.Kernel.Addresses (
-    createAddress
+      createAddress
+    , newHdAddress
     -- * Errors
     , CreateAddressError(..)
     ) where
@@ -137,16 +138,10 @@ createHdRndAddress spendingPassword esk accId pw = do
         tryGenerateAddress gen collisions = do
             newIndex <- deriveIndex (flip uniformR gen) HdAddressIx HardDerivation
             let hdAddressId = HdAddressId accId newIndex
-                mbAddr = deriveLvl2KeyPair (IsBootstrapEraAddr True)
-                                           (ShouldCheckPassphrase True)
-                                           spendingPassword
-                                           esk
-                                           (accId ^. hdAccountIdIx . to getHdAccountIx)
-                                           (hdAddressId ^. hdAddressIdIx . to getHdAddressIx)
+                mbAddr = newHdAddress esk spendingPassword accId hdAddressId
             case mbAddr of
                  Nothing -> return (Left $ CreateAddressHdRndGenerationFailed accId)
-                 Just (newAddress, _) -> do
-                    let hdAddress  = initHdAddress hdAddressId newAddress
+                 Just hdAddress -> do
                     let db = pw ^. wallets
                     res <- update db (CreateHdAddress hdAddress)
                     case res of
@@ -159,3 +154,22 @@ createHdRndAddress spendingPassword esk accId pw = do
         -- The maximum number of allowed collisions.
         maxAllowedCollisions :: Word32
         maxAllowedCollisions = 1024
+
+
+-- | Generates a new 'HdAddress' by performing the HD crypto derivation
+-- underneath. Returns 'Nothing' if the cryptographic derivation fails.
+newHdAddress :: EncryptedSecretKey
+             -> PassPhrase
+             -> HdAccountId
+             -> HdAddressId
+             -> Maybe HdAddress
+newHdAddress esk spendingPassword accId hdAddressId =
+    let mbAddr = deriveLvl2KeyPair (IsBootstrapEraAddr True)
+                                   (ShouldCheckPassphrase True)
+                                   spendingPassword
+                                   esk
+                                   (accId ^. hdAccountIdIx . to getHdAccountIx)
+                                   (hdAddressId ^. hdAddressIdIx . to getHdAddressIx)
+    in case mbAddr of
+         Nothing              -> Nothing
+         Just (newAddress, _) -> Just $ initHdAddress hdAddressId newAddress
diff --git a/src/Cardano/Wallet/Kernel/DB/AcidState.hs b/src/Cardano/Wallet/Kernel/DB/AcidState.hs
index 00a88f4597b..3c842b5c2b9 100644
--- a/src/Cardano/Wallet/Kernel/DB/AcidState.hs
+++ b/src/Cardano/Wallet/Kernel/DB/AcidState.hs
@@ -432,12 +432,23 @@ observableRollbackUseInTestsOnly = runUpdateDiscardSnapshot $
 -- NOTE: We allow an initial set of accounts with associated addresses and
 -- balances /ONLY/ for testing purpose. Normally this should be empty; see
 -- 'createHdWallet'/'createWalletHdRnd' in "Cardano.Wallet.Kernel.Wallets".
+--
+-- INVARIANT: Creating a new wallet always come with a fresh HdAccount and
+-- a fresh 'HdAddress' attached to it, so we have to pass these two extra
+-- piece of into to the update function. We do @not@ build these inside the
+-- update function because derivation requires an 'EncryptedSecretKey' and
+-- definitely we do not want it to show up in our acid-state logs.
+--
 createHdWallet :: HdRoot
+               -> HdAccount
+               -- ^ The default HdAccount to go with this HdRoot
+               -> HdAddress
+               -- ^ The default HdAddress to go with this HdRoot
                -> Map HdAccountId (Utxo,[AddrWithId])
                -> Update DB (Either HD.CreateHdRootError ())
-createHdWallet newRoot utxoByAccount =
+createHdWallet newRoot defaultHdAccount defaultHdAddress utxoByAccount =
     runUpdateDiscardSnapshot . zoom dbHdWallets $ do
-      HD.createHdRoot newRoot
+      HD.createHdRoot newRoot defaultHdAccount defaultHdAddress
       updateAccounts_ $ map mkUpdate (Map.toList utxoByAccount)
   where
     mkUpdate :: (HdAccountId, (Utxo, [AddrWithId]))
@@ -451,13 +462,24 @@ createHdWallet newRoot utxoByAccount =
 
 -- | Begin restoration by creating an HdWallet with the given HdRoot,
 -- starting from the 'HdAccountOutsideK' state.
+--
+-- INVARIANT: Creating a new wallet always come with a fresh HdAccount and
+-- a fresh 'HdAddress' attached to it, so we have to pass these two extra
+-- piece of into to the update function. We do @not@ build these inside the
+-- update function because derivation requires an 'EncryptedSecretKey' and
+-- definitely we do not want it to show up in our acid-state logs.
+--
 restoreHdWallet :: HdRoot
+                -> HdAccount
+                -- ^ The default HdAccount to go with this HdRoot
+                -> HdAddress
+                -- ^ The default HdAddress to go with this HdRoot
                 -> Map HdAccountId (Utxo, Utxo, [AddrWithId])
                 -- ^ Current and genesis UTxO per account
                 -> Update DB (Either HD.CreateHdRootError ())
-restoreHdWallet newRoot utxoByAccount =
+restoreHdWallet newRoot defaultHdAccount defaultHdAddress utxoByAccount =
     runUpdateDiscardSnapshot . zoom dbHdWallets $ do
-      HD.createHdRoot newRoot
+      HD.createHdRoot newRoot defaultHdAccount defaultHdAddress
       updateAccounts_ $ map mkUpdate (Map.toList utxoByAccount)
   where
     mkUpdate :: (HdAccountId, (Utxo, Utxo, [AddrWithId]))
@@ -571,9 +593,13 @@ updateAccounts_ = mapM_ updateAccount
   Wrap HD C(R)UD operations
 -------------------------------------------------------------------------------}
 
-createHdRoot :: HdRoot -> Update DB (Either HD.CreateHdRootError ())
-createHdRoot hdRoot = runUpdateDiscardSnapshot . zoom dbHdWallets $
-    HD.createHdRoot hdRoot
+createHdRoot :: HdRoot
+             -> HdAccount
+             -> HdAddress
+             -> Update DB (Either HD.CreateHdRootError ())
+createHdRoot hdRoot defaultHdAccount defaultHdAddress =
+    runUpdateDiscardSnapshot . zoom dbHdWallets $
+        HD.createHdRoot hdRoot defaultHdAccount defaultHdAddress
 
 createHdAccount :: HdAccount -> Update DB (Either HD.CreateHdAccountError ())
 createHdAccount hdAccount = runUpdateDiscardSnapshot . zoom dbHdWallets $
diff --git a/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs b/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
index 2696c9e682f..8db9f19c626 100644
--- a/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
+++ b/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
@@ -41,6 +41,12 @@ import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 data CreateHdRootError =
     -- | We already have a wallet with the specified ID
     CreateHdRootExists HdRootId
+  | CreateHdRootDefaultAccountCreationFailed
+  -- ^ There is a serious bug in the logic, as creating a fresh account on
+  -- a fresh wallet should @never@ fail.
+  | CreateHdRootDefaultAddressCreationFailed
+  -- ^ There is a serious bug in the logic, as creating a fresh address on
+  -- a fresh wallet should @never@ fail.
 
 -- | Errors thrown by 'createHdAccount'
 data CreateHdAccountError =
@@ -67,13 +73,30 @@ deriveSafeCopy 1 'base ''CreateHdAddressError
   CREATE
 -------------------------------------------------------------------------------}
 
--- | Create a new wallet
-createHdRoot :: HdRoot -> Update' CreateHdRootError HdWallets ()
-createHdRoot hdRoot =
+-- | Create a new wallet.
+-- INVARIANT: Creating a new wallet always come with a fresh HdAccount and
+-- a fresh 'HdAddress' attached to it, so we have to pass these two extra
+-- piece of into to the update function. We do @not@ build these inside the
+-- update function because derivation requires an 'EncryptedSecretKey' and
+-- definitely we do not want it to show up in our acid-state logs.
+--
+createHdRoot :: HdRoot
+             -> HdAccount
+             -- ^ The default HdAccount to go with this HdRoot
+             -> HdAddress
+             -- ^ The default HdAddress to go with this HdRoot
+             -> Update' CreateHdRootError HdWallets ()
+createHdRoot hdRoot defaultHdAccount defaultHdAddress = do
     zoom hdWalletsRoots $ do
       exists <- gets $ IxSet.member rootId
       when exists $ throwError $ CreateHdRootExists rootId
       at rootId .= Just hdRoot
+
+    mapUpdateErrors (const CreateHdRootDefaultAccountCreationFailed) $
+        createHdAccount defaultHdAccount
+    mapUpdateErrors (const CreateHdRootDefaultAddressCreationFailed) $
+        createHdAddress defaultHdAddress
+
   where
     rootId = hdRoot ^. hdRootId
 
@@ -183,6 +206,10 @@ initHdAddress addrId address = HdAddress {
 instance Buildable CreateHdRootError where
     build (CreateHdRootExists rootId)
         = bprint ("CreateHdRootError::CreateHdRootExists "%build) rootId
+    build CreateHdRootDefaultAccountCreationFailed
+        = bprint "Invariant violation! CreateHdRootError::CreateHdRootDefaultAccountCreationFailed"
+    build CreateHdRootDefaultAddressCreationFailed
+        = bprint "Invariant violation! CreateHdRootError::CreateHdRootDefaultAddressCreationFailed"
 
 instance Buildable CreateHdAccountError where
     build (CreateHdAccountUnknownRoot (UnknownHdRoot rootId))
diff --git a/src/Cardano/Wallet/Kernel/Restore.hs b/src/Cardano/Wallet/Kernel/Restore.hs
index 641f13b63ee..9e08b839d1f 100644
--- a/src/Cardano/Wallet/Kernel/Restore.hs
+++ b/src/Cardano/Wallet/Kernel/Restore.hs
@@ -54,7 +54,7 @@ import           Pos.Chain.Txp (TxIn (..), TxOut (..), TxOutAux (..), Utxo,
 import           Pos.Core as Core (BlockCount (..), Coin, Config (..),
                      GenesisHash, SlotId, flattenSlotId, mkCoin,
                      unsafeIntegerToCoin)
-import           Pos.Crypto (EncryptedSecretKey)
+import           Pos.Crypto (EncryptedSecretKey, PassPhrase)
 import           Pos.DB.Block (getFirstGenesisBlockHash, getUndo,
                      resolveForwardLink)
 import           Pos.DB.Class (getBlock)
@@ -71,7 +71,7 @@ import           Pos.Util.Trace (Severity (Error))
 --
 -- Wallet initialization parameters match those of 'createWalletHdRnd'
 restoreWallet :: Kernel.PassiveWallet
-              -> Bool -- ^ Spending password
+              -> PassPhrase
               -> HD.WalletName
               -> HD.AssuranceLevel
               -> EncryptedSecretKey
@@ -82,13 +82,15 @@ restoreWallet pw spendingPass name assurance esk prefilter = do
     walletInitInfo <- withNodeState (pw ^. walletNode) $ getWalletInitInfo coreConfig wkey
     case walletInitInfo of
       WalletCreate utxos -> do
-        root <- createWalletHdRnd pw spendingPass name assurance esk $ \root ->
-                  Left $ CreateHdWallet root utxos
+        root <- createWalletHdRnd pw spendingPass name assurance esk $
+                \root defaultHdAccount defaultHdAddress ->
+                      Left $ CreateHdWallet root defaultHdAccount defaultHdAddress utxos
         return $ fmap (, mkCoin 0) root
       WalletRestore utxos (tgtTip, tgtSlot) -> do
         -- Create the wallet
-        mRoot <- createWalletHdRnd pw spendingPass name assurance esk $ \root ->
-                   Right $ RestoreHdWallet root utxos
+        mRoot <- createWalletHdRnd pw spendingPass name assurance esk $
+                 \root defaultHdAccount defaultHdAddress ->
+                       Right $ RestoreHdWallet root defaultHdAccount defaultHdAddress utxos
         case mRoot of
           Left  err  -> return (Left err)
           Right root -> do
diff --git a/src/Cardano/Wallet/Kernel/Wallets.hs b/src/Cardano/Wallet/Kernel/Wallets.hs
index 640d91dfae6..a72d0e6edfb 100644
--- a/src/Cardano/Wallet/Kernel/Wallets.hs
+++ b/src/Cardano/Wallet/Kernel/Wallets.hs
@@ -22,18 +22,23 @@ import           Data.Acid.Advanced (update')
 import           Pos.Core (Timestamp)
 import           Pos.Crypto (EncryptedSecretKey, PassPhrase,
                      changeEncPassphrase, checkPassMatches, emptyPassphrase,
-                     safeDeterministicKeyGen)
+                     firstHardened, safeDeterministicKeyGen)
 
+import           Cardano.Wallet.Kernel.Addresses (newHdAddress)
 import           Cardano.Wallet.Kernel.BIP39 (Mnemonic)
 import qualified Cardano.Wallet.Kernel.BIP39 as BIP39
 import           Cardano.Wallet.Kernel.DB.AcidState (CreateHdWallet (..),
                      DeleteHdRoot (..), RestoreHdWallet,
                      UpdateHdRootPassword (..), UpdateHdWallet (..))
-import           Cardano.Wallet.Kernel.DB.HdWallet (AssuranceLevel, HdRoot,
-                     WalletName, eskToHdRootId)
+import           Cardano.Wallet.Kernel.DB.HdWallet (AssuranceLevel, HdAccount,
+                     HdAccountId (..), HdAccountIx (..), HdAddress,
+                     HdAddressId (..), HdAddressIx (..), HdRoot, WalletName,
+                     eskToHdRootId)
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
 import qualified Cardano.Wallet.Kernel.DB.HdWallet.Create as HD
 import           Cardano.Wallet.Kernel.DB.InDb (InDb (..))
+import           Cardano.Wallet.Kernel.DB.Spec (Checkpoints (..),
+                     initCheckpoint)
 import           Cardano.Wallet.Kernel.Internal (PassiveWallet, walletKeystore,
                      wallets)
 import qualified Cardano.Wallet.Kernel.Keystore as Keystore
@@ -149,16 +154,21 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do
     -- STEP 3: Atomically generate the wallet and the initial internal structure in
     -- an acid-state transaction.
     res <- createWalletHdRnd pw
-                             (spendingPassword /= emptyPassphrase)
+                             spendingPassword
                              walletName
                              assuranceLevel
                              esk
                              -- Brand new wallets have no Utxo
                              -- See preconditon above.
-                             (\hdRoot -> Left $ CreateHdWallet hdRoot mempty)
+                             (\hdRoot defaultHdAccount defaultHdAddress ->
+                                 Left $ CreateHdWallet hdRoot
+                                                       defaultHdAccount
+                                                       defaultHdAddress
+                                                       mempty
+                             )
     case res of
-         -- NOTE(adinapoli): This is the @only@ error the DB can return, at
-         -- least for now, so we are pattern matching directly on it. In the
+         -- NOTE(adinapoli): This is the @only@ error the DB can return, (modulo
+         -- invariant violations), so we are pattern matching directly on it. In the
          -- case of more errors being added, carefully thinking would have to
          -- be put into whether or not we should remove the key from the keystore
          -- at this point. Surely we don't want to do this in the case the
@@ -167,6 +177,15 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do
          -- Fix properly as part of [CBR-404].
          Left e@(HD.CreateHdRootExists _) ->
              return . Left $ CreateWalletFailed e
+
+         -- The two errors below are invariant violations. We do want to clean
+         -- up the keystore, and abort.
+         Left e@HD.CreateHdRootDefaultAddressCreationFailed -> do
+             Keystore.delete (WalletIdHdRnd newRootId) (pw ^. walletKeystore)
+             return . Left $ CreateWalletFailed e
+         Left e@HD.CreateHdRootDefaultAccountCreationFailed -> do
+             Keystore.delete (WalletIdHdRnd newRootId) (pw ^. walletKeystore)
+             return . Left $ CreateWalletFailed e
          Right hdRoot -> return (Right hdRoot)
 
 
@@ -174,33 +193,54 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do
 -- via random index derivation.
 --
 -- Fails with CreateHdWalletError if the HdRootId already exists.
+--
+-- INVARIANT: Whenever we create an HdRoot, it @must@ come with a fresh
+-- account and address, both at 'firstHardened' index.
+--
 createWalletHdRnd :: PassiveWallet
-                  -> Bool
-                  -- ^ Whether or not this wallet has a spending password set.
+                  -> PassPhrase
                   -> HD.WalletName
                   -> AssuranceLevel
                   -> EncryptedSecretKey
-                  -> (HdRoot -> Either CreateHdWallet RestoreHdWallet)
+                  -> (  HdRoot
+                     -> HdAccount
+                     -> HdAddress
+                     -> Either CreateHdWallet RestoreHdWallet
+                     )
                   -> IO (Either HD.CreateHdRootError HdRoot)
-createWalletHdRnd pw hasSpendingPassword name assuranceLevel esk createWallet = do
+createWalletHdRnd pw spendingPassword name assuranceLevel esk createWallet = do
     created <- InDb <$> getCurrentTimestamp
-    let rootId  = eskToHdRootId esk
+    let hasSpendingPassword = spendingPassword /= emptyPassphrase
+        rootId  = eskToHdRootId esk
         newRoot = HD.initHdRoot rootId
                                 name
-                                (hdSpendingPassword created)
+                                (hdSpendingPassword hasSpendingPassword created)
                                 assuranceLevel
                                 created
-
-    res <- case createWallet newRoot of
-             Left  create  -> update' (pw ^. wallets) create
-             Right restore -> update' (pw ^. wallets) restore
-    return $ case res of
-                 Left err -> Left err
-                 Right () -> Right newRoot
+        hdAccountId = HdAccountId rootId (HdAccountIx firstHardened)
+        defaultHdAccount =
+            HD.initHdAccount hdAccountId initialAccountState &
+                HD.hdAccountName .~ (HD.AccountName "Default account")
+        hdAddressId = HdAddressId hdAccountId (HdAddressIx firstHardened)
+
+    case newHdAddress esk spendingPassword hdAccountId hdAddressId of
+         Nothing -> return (Left HD.CreateHdRootDefaultAddressCreationFailed)
+         Just defaultHdAddress -> do
+             -- We now have all the date we need to atomically generate a new
+             -- wallet with a default account & address.
+             res <- case createWallet newRoot defaultHdAccount defaultHdAddress of
+                 Left  create  -> update' (pw ^. wallets) create
+                 Right restore -> update' (pw ^. wallets) restore
+             return $ either Left (const (Right newRoot)) res
     where
 
-        hdSpendingPassword :: InDb Timestamp -> HD.HasSpendingPassword
-        hdSpendingPassword created =
+        initialAccountState :: HD.HdAccountState
+        initialAccountState = HD.HdAccountStateUpToDate HD.HdAccountUpToDate {
+              _hdUpToDateCheckpoints = Checkpoints . one $ initCheckpoint mempty
+            }
+
+        hdSpendingPassword :: Bool -> InDb Timestamp -> HD.HasSpendingPassword
+        hdSpendingPassword hasSpendingPassword created =
             if hasSpendingPassword then HD.HasSpendingPassword created
                                    else HD.NoSpendingPassword
 
diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs
index 38b41417afd..deed9127cad 100644
--- a/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs
+++ b/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs
@@ -20,7 +20,6 @@ import           Pos.Chain.Block (Blund, mainBlockSlot, undoTx)
 import           Pos.Chain.Txp (Utxo)
 import           Pos.Core (Config (..), mkCoin)
 import           Pos.Core.Slotting (Timestamp)
-import           Pos.Crypto.HD (firstHardened)
 import           Pos.Crypto.Signing
 
 import           Cardano.Wallet.API.V1.Types (V1 (..))
@@ -48,12 +47,10 @@ 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 (CreateAccount (..),
-                     CreateWallet (..), CreateWalletError (..),
-                     DeleteWalletError (..), GetUtxosError (..),
-                     GetWalletError (..), UpdateWalletError (..),
-                     UpdateWalletPasswordError (..))
-import qualified Cardano.Wallet.WalletLayer.Kernel.Accounts as Accounts
+import           Cardano.Wallet.WalletLayer (CreateWallet (..),
+                     CreateWalletError (..), DeleteWalletError (..),
+                     GetUtxosError (..), GetWalletError (..),
+                     UpdateWalletError (..), UpdateWalletPasswordError (..))
 import           Cardano.Wallet.WalletLayer.Kernel.Conv
 
 createWallet :: MonadIO m
@@ -82,16 +79,6 @@ createWallet wallet newWalletRequest = liftIO $ do
                                       (spendingPassword newwalSpendingPassword)
                                       (fromAssuranceLevel newwalAssuranceLevel)
                                       (HD.WalletName newwalName)
-      let rootId = root ^. HD.hdRootId
-      _ <- 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.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
@@ -131,7 +118,7 @@ createWallet wallet newWalletRequest = liftIO $ do
         (root, coins) <- withExceptT (CreateWalletError . Kernel.CreateWalletFailed) $ ExceptT $
             restoreWallet
               wallet
-              (pwd /= emptyPassphrase)
+              pwd
               (HD.WalletName walletName)
               hdAssuranceLevel
               esk
@@ -162,11 +149,6 @@ createWallet wallet newWalletRequest = liftIO $ do
         createdAt  = hdRoot ^. HD.hdRootCreatedAt . fromDb
         walletId   = toRootId $ hdRoot ^. HD.hdRootId
 
-               -- (V1.BackupPhrase mnemonic)
-               -- mbSpendingPassword
-               -- v1AssuranceLevel
-               -- v1WalletName
-               -- operation
     mnemonic (V1.NewWallet (V1.BackupPhrase m) _ _ _ _) = m
     spendingPassword = maybe emptyPassphrase coerce
 

From 64d6ad603e1f6a30ec62d185334dba49d1bc069b Mon Sep 17 00:00:00 2001
From: KtorZ 
Date: Tue, 11 Sep 2018 14:29:53 +0200
Subject: [PATCH 04/14] [CO-357] Factor-out code bits SscParam creation

This bits of code is used everywhere we need to start a node (auxx,
explorer, lib, node, tools) and will also get used in the integration
tests and demo soon enough. The underlying 'getNodeParams' function is
actually never used without the SscParams, so it makes sens to group
them together.
---
 server/Main.hs | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/server/Main.hs b/server/Main.hs
index 7004ff1e9c4..182bd9dc8d6 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -9,7 +9,6 @@ module Main where
 import           Universum
 
 import           Control.Concurrent.STM (newTQueueIO)
-import           Data.Maybe (fromJust)
 import           Ntp.Client (NtpConfiguration, NtpStatus, ntpClientSettings,
                      withNtpClient)
 import           Pos.Chain.Ssc (SscParams)
@@ -27,7 +26,6 @@ import           Pos.Launcher.Configuration (AssetLockPath (..),
                      ConfigurationOptions, HasConfigurations)
 import           Pos.Util (logException)
 import           Pos.Util.CompileInfo (HasCompileInfo, withCompileInfo)
-import           Pos.Util.UserSecret (usVss)
 import           Pos.Util.Wlog (LoggerName, Severity (..), logInfo, logMessage,
                      usingLoggerName)
 import           Pos.Wallet.Web (bracketWalletWS, bracketWalletWebDB,
@@ -227,12 +225,10 @@ startEdgeNode wso =
                   -> IO (SscParams, NodeParams)
     getParameters coreConfig txpConfig ntpConfig = do
 
-      currentParams <- CLI.getNodeParams defaultLoggerName
+      (currentParams, Just gtParams) <- CLI.getNodeParams defaultLoggerName
                                          (wsoNodeArgs wso)
                                          nodeArgs
                                          (configGeneratedSecrets coreConfig)
-      let vssSK = fromJust $ npUserSecret currentParams ^. usVss
-      let gtParams = CLI.gtSscParams (wsoNodeArgs wso) vssSK (npBehaviorConfig currentParams)
 
       CLI.printInfoOnStart (wsoNodeArgs wso)
                            (configGenesisData coreConfig)

From ff6109ad8ef9817c2a97aaae64aa3850e5dc111b Mon Sep 17 00:00:00 2001
From: Alfredo Di Napoli 
Date: Tue, 11 Sep 2018 18:18:15 +0200
Subject: [PATCH 05/14] Revert "[CBR-413] Ensure wallet creation yields
 predictable account index"

This reverts commit f136b56c9bc607133f3de7d09520806e24205207.

It also ensures that tests compiles again.
---
 .../Wallet/API/V1/Handlers/Accounts.hs        |   3 +-
 src/Cardano/Wallet/Kernel/Accounts.hs         | 138 ++++++------------
 src/Cardano/Wallet/Kernel/Addresses.hs        |  19 ++-
 src/Cardano/Wallet/Kernel/Transactions.hs     |  12 +-
 src/Cardano/Wallet/Kernel/Wallets.hs          |  55 ++++---
 src/Cardano/Wallet/WalletLayer.hs             |  21 +--
 .../Wallet/WalletLayer/Kernel/Accounts.hs     |  82 ++++-------
 .../Wallet/WalletLayer/Kernel/Addresses.hs    |   6 +-
 src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs |   3 +-
 test/unit/Test/Spec/Accounts.hs               |  23 ++-
 test/unit/Test/Spec/Addresses.hs              |   8 +-
 test/unit/Test/Spec/NewPayment.hs             |   9 +-
 test/unit/Wallet/Inductive/Cardano.hs         |  11 +-
 13 files changed, 161 insertions(+), 229 deletions(-)

diff --git a/src/Cardano/Wallet/API/V1/Handlers/Accounts.hs b/src/Cardano/Wallet/API/V1/Handlers/Accounts.hs
index c841ddc3adc..a7523fcfeb2 100644
--- a/src/Cardano/Wallet/API/V1/Handlers/Accounts.hs
+++ b/src/Cardano/Wallet/API/V1/Handlers/Accounts.hs
@@ -63,8 +63,7 @@ newAccount :: PassiveWalletLayer IO
            -> NewAccount
            -> Handler (WalletResponse Account)
 newAccount layer wId newAccountRequest = do
-    let req = WalletLayer.CreateHdAccountRandomIndex newAccountRequest
-    res <- liftIO $ WalletLayer.createAccount layer wId req
+    res <- liftIO $ WalletLayer.createAccount layer wId newAccountRequest
     case res of
          Left e        -> throwM e
          Right account -> return $ single account
diff --git a/src/Cardano/Wallet/Kernel/Accounts.hs b/src/Cardano/Wallet/Kernel/Accounts.hs
index b99622c4800..2f0e5ee76f6 100644
--- a/src/Cardano/Wallet/Kernel/Accounts.hs
+++ b/src/Cardano/Wallet/Kernel/Accounts.hs
@@ -1,6 +1,5 @@
 module Cardano.Wallet.Kernel.Accounts (
-      createHdRandomAccount
-    , createHdFixedAccount
+      createAccount
     , deleteAccount
     , updateAccount
     -- * Errors
@@ -17,6 +16,8 @@ import           System.Random.MWC (GenIO, createSystemRandom, uniformR)
 
 import           Data.Acid (update)
 
+import           Pos.Crypto (EncryptedSecretKey, PassPhrase)
+
 import           Cardano.Wallet.Kernel.DB.AcidState (CreateHdAccount (..), DB,
                      DeleteHdAccount (..), UpdateHdAccountName (..))
 import           Cardano.Wallet.Kernel.DB.HdWallet (AccountName (..),
@@ -43,9 +44,6 @@ data CreateAccountError =
     | CreateAccountKeystoreNotFound WalletId
       -- ^ When trying to create the 'Account', the 'Keystore' didn't have
       -- any secret associated with the input 'WalletId'.
-    | CreateAccountAlreadyExists HdRootId HdAccountIx
-      -- ^ When creating a certain account, the account already existed in
-      -- the database.
     | CreateAccountHdRndAccountSpaceSaturated HdRootId
       -- ^ The available number of HD accounts in use is such that trying
       -- to find another random index would be too expensive.
@@ -59,8 +57,6 @@ instance Buildable CreateAccountError where
         bprint ("CreateAccountUnknownHdRoot " % F.build) uRoot
     build (CreateAccountKeystoreNotFound accId) =
         bprint ("CreateAccountKeystoreNotFound " % F.build) accId
-    build (CreateAccountAlreadyExists rootId accId) =
-        bprint ("CreateAccountAlreadyExists " % F.build % F.build) rootId accId
     build (CreateAccountHdRndAccountSpaceSaturated hdAcc) =
         bprint ("CreateAccountHdRndAccountSpaceSaturated " % F.build) hdAcc
 
@@ -69,80 +65,42 @@ instance Show CreateAccountError where
 
 instance Exception CreateAccountError
 
-
-createHdRandomAccount :: AccountName
-                      -- ^ The name for this account.
-                      -> WalletId
-                      -- ^ An abstract notion of a 'Wallet identifier
-                      -> PassiveWallet
-                      -> IO (Either CreateAccountError HdAccount)
-createHdRandomAccount = createAccount newHdRndAccount
-
--- | Creates an 'HdAccount' from a @fixed@ index. Note how, despite tempting,
--- it's incorrect to call this @sequential generation@, as in such case the
--- index wouldn't be passed but merely an internal detail of such function.
--- @fixed@ here really means "externally provided".
-createHdFixedAccount :: HdAccountIx
-                     -- ^ The account index to target
-                     -> AccountName
-                     -- ^ The name for this account.
-                     -> WalletId
-                     -- ^ An abstract notion of a 'Wallet identifier
-                     -> PassiveWallet
-                     -> IO (Either CreateAccountError HdAccount)
-createHdFixedAccount newIndex = createAccount (newHdFixedAccount newIndex)
-
-
-type MkNewAccount = AccountName
-                  -> HdRootId
-                  -> PassiveWallet
-                  -> IO (Either CreateAccountError HdAccount)
-
 -- | Creates a new 'Account' for the input wallet.
 -- Note: @it does not@ generate a new 'Address' to go in tandem with this
--- 'Account'. This will be responsibility of the caller.
-createAccount :: MkNewAccount
-              -- ^ A function to create the account.
+-- 'Account'. This will be responsibility of the wallet layer.
+createAccount :: PassPhrase
+              -- ^ The 'Passphrase' (a.k.a the \"Spending Password\").
               -> AccountName
               -- ^ The name for this account.
               -> WalletId
               -- ^ An abstract notion of a 'Wallet identifier
               -> PassiveWallet
               -> IO (Either CreateAccountError HdAccount)
-createAccount creationFunction accountName walletId pw = do
+createAccount spendingPassword accountName walletId pw = do
     let keystore = pw ^. walletKeystore
     case walletId of
          WalletIdHdRnd hdRootId -> do
              mbEsk <- Keystore.lookup (WalletIdHdRnd hdRootId) keystore
              case mbEsk of
                   Nothing  -> return (Left $ CreateAccountKeystoreNotFound walletId)
-                  Just _   -> creationFunction accountName hdRootId pw
-
--- | Creates a new 'Account' using a fixed (given) index.
-newHdFixedAccount :: HdAccountIx
-                  -> AccountName
-                  -> HdRootId
-                  -> PassiveWallet
-                  -> IO (Either CreateAccountError HdAccount)
-newHdFixedAccount newIndex accountName rootId pw = do
-    let onFailure err = case err of
-         CreateHdAccountExists _ ->
-             -- Nothing we can do; we were asked to create a specific account
-             -- with a specific index, but there was a collision in the DB
-             return (Left $ CreateAccountAlreadyExists rootId newIndex)
-         CreateHdAccountUnknownRoot _ ->
-             return (Left $ CreateAccountUnknownHdRoot rootId)
-    tryGenerateAccount onFailure newIndex rootId accountName pw
+                  Just esk ->
+                      createHdRndAccount spendingPassword
+                                         accountName
+                                         esk
+                                         hdRootId
+                                         pw
 
 -- | Creates a new 'Account' using the random HD derivation under the hood.
 -- This code follows the same pattern of 'createHdRndAddress', but the two
 -- functions are "similarly different" enough to not make convenient generalise
 -- the code.
-newHdRndAccount :: AccountName
-                -> HdRootId
-                -> PassiveWallet
-                -> IO (Either CreateAccountError HdAccount)
-newHdRndAccount accountName rootId pw = do
+createHdRndAccount :: PassPhrase
+                   -> AccountName
+                   -> EncryptedSecretKey
+                   -> HdRootId
+                   -> PassiveWallet
+                   -> IO (Either CreateAccountError HdAccount)
+createHdRndAccount _spendingPassword accountName _esk rootId pw = do
     gen <- createSystemRandom
     go gen 0
     where
@@ -150,14 +108,25 @@ newHdRndAccount accountName rootId pw = do
         go gen collisions =
             case collisions >= maxAllowedCollisions of
                  True  -> return $ Left (CreateAccountHdRndAccountSpaceSaturated rootId)
-                 False -> do
-                     let onFailure err = case err of
-                           CreateHdAccountExists _ ->
-                               go gen (succ collisions)
-                           CreateHdAccountUnknownRoot _ ->
-                               return (Left $ CreateAccountUnknownHdRoot rootId)
-                     newIndex <- deriveIndex (flip uniformR gen) HdAccountIx HardDerivation
-                     tryGenerateAccount onFailure newIndex rootId accountName pw
+                 False -> tryGenerateAccount gen collisions
+
+        tryGenerateAccount :: GenIO
+                           -> Word32
+                           -- ^ The current number of collisions
+                           -> IO (Either CreateAccountError HdAccount)
+        tryGenerateAccount gen collisions = do
+            newIndex <- deriveIndex (flip uniformR gen) HdAccountIx HardDerivation
+            let hdAccountId = HdAccountId rootId newIndex
+                newAccount  = initHdAccount hdAccountId initState &
+                              hdAccountName .~ accountName
+                db = pw ^. wallets
+            res <- update db (CreateHdAccount newAccount)
+            case res of
+                 (Left (CreateHdAccountExists _)) ->
+                     go gen (succ collisions)
+                 (Left (CreateHdAccountUnknownRoot _)) ->
+                     return (Left $ CreateAccountUnknownHdRoot rootId)
+                 Right () -> return (Right newAccount)
 
         -- The maximum number of allowed collisions. This number was
         -- empirically calculated based on a [beta distribution](https://en.wikipedia.org/wiki/Beta_distribution).
@@ -169,30 +138,11 @@ newHdRndAccount accountName rootId pw = do
         maxAllowedCollisions :: Word32
         maxAllowedCollisions = 42
 
-tryGenerateAccount :: (CreateHdAccountError -> IO (Either CreateAccountError HdAccount))
-                   -- ^ An action to be run in case of errors
-                   -> HdAccountIx
-                   -> HdRootId
-                   -> AccountName
-                   -- ^ The requested index
-                   -> PassiveWallet
-                   -> IO (Either CreateAccountError HdAccount)
-tryGenerateAccount onFailure newIndex rootId accountName pw = do
-    let hdAccountId = HdAccountId rootId newIndex
-        newAccount  = initHdAccount hdAccountId initialAccountState &
-                      hdAccountName .~ accountName
-        db = pw ^. wallets
-    res <- update db (CreateHdAccount newAccount)
-    case res of
-         (Left e) -> onFailure e
-         Right () -> return (Right newAccount)
-  where
-    initialAccountState :: HdAccountState
-    initialAccountState = HdAccountStateUpToDate HdAccountUpToDate {
-          _hdUpToDateCheckpoints = Checkpoints . one $ initCheckpoint mempty
-        }
-
-
+        -- Initial account state
+        initState :: HdAccountState
+        initState = HdAccountStateUpToDate HdAccountUpToDate {
+              _hdUpToDateCheckpoints = Checkpoints . one $ initCheckpoint mempty
+            }
 
 -- | Deletes an HD 'Account' from the data storage.
 deleteAccount :: HdAccountId
diff --git a/src/Cardano/Wallet/Kernel/Addresses.hs b/src/Cardano/Wallet/Kernel/Addresses.hs
index 7e127cb1153..9fa819e334e 100644
--- a/src/Cardano/Wallet/Kernel/Addresses.hs
+++ b/src/Cardano/Wallet/Kernel/Addresses.hs
@@ -16,13 +16,13 @@ import           System.Random.MWC (GenIO, createSystemRandom, uniformR)
 
 import           Data.Acid (update)
 
-import           Pos.Core (IsBootstrapEraAddr (..), deriveLvl2KeyPair)
+import           Pos.Core (Address, IsBootstrapEraAddr (..), deriveLvl2KeyPair)
 import           Pos.Crypto (EncryptedSecretKey, PassPhrase,
                      ShouldCheckPassphrase (..))
 
 import           Cardano.Wallet.Kernel.DB.AcidState (CreateHdAddress (..))
 import           Cardano.Wallet.Kernel.DB.HdWallet (HdAccountId,
-                     HdAccountIx (..), HdAddress (..), HdAddressId (..),
+                     HdAccountIx (..), HdAddress, HdAddressId (..),
                      HdAddressIx (..), hdAccountIdIx, hdAccountIdParent,
                      hdAddressIdIx)
 import           Cardano.Wallet.Kernel.DB.HdWallet.Create
@@ -33,6 +33,7 @@ import           Cardano.Wallet.Kernel.Internal (PassiveWallet, walletKeystore,
                      wallets)
 import qualified Cardano.Wallet.Kernel.Keystore as Keystore
 import           Cardano.Wallet.Kernel.Types (AccountId (..), WalletId (..))
+import           Cardano.Wallet.WalletLayer.Kernel.Conv (toCardanoAddress)
 
 import           Test.QuickCheck (Arbitrary (..), oneof)
 
@@ -77,7 +78,7 @@ createAddress :: PassPhrase
               -> AccountId
               -- ^ An abstract notion of an 'Account' identifier
               -> PassiveWallet
-              -> IO (Either CreateAddressError HdAddress)
+              -> IO (Either CreateAddressError Address)
 createAddress spendingPassword accId pw = do
     let keystore = pw ^. walletKeystore
     case accId of
@@ -102,9 +103,7 @@ createAddress spendingPassword accId pw = do
                                       keystore
              case mbEsk of
                   Nothing  -> return (Left $ CreateAddressKeystoreNotFound accId)
-                  Just esk ->
-                      createHdRndAddress spendingPassword esk hdAccId pw
-
+                  Just esk -> createHdRndAddress spendingPassword esk hdAccId pw
 
 -- | Creates a new 'Address' using the random HD derivation under the hood.
 -- Being this an operation bound not only by the number of available derivation
@@ -120,12 +119,12 @@ createHdRndAddress :: PassPhrase
                    -> EncryptedSecretKey
                    -> HdAccountId
                    -> PassiveWallet
-                   -> IO (Either CreateAddressError HdAddress)
+                   -> IO (Either CreateAddressError Address)
 createHdRndAddress spendingPassword esk accId pw = do
     gen <- createSystemRandom
     go gen 0
     where
-        go :: GenIO -> Word32 -> IO (Either CreateAddressError HdAddress)
+        go :: GenIO -> Word32 -> IO (Either CreateAddressError Address)
         go gen collisions =
             case collisions >= maxAllowedCollisions of
                  True  -> return $ Left (CreateAddressHdRndAddressSpaceSaturated accId)
@@ -134,7 +133,7 @@ createHdRndAddress spendingPassword esk accId pw = do
         tryGenerateAddress :: GenIO
                            -> Word32
                            -- ^ The current number of collisions
-                           -> IO (Either CreateAddressError HdAddress)
+                           -> IO (Either CreateAddressError Address)
         tryGenerateAddress gen collisions = do
             newIndex <- deriveIndex (flip uniformR gen) HdAddressIx HardDerivation
             let hdAddressId = HdAddressId accId newIndex
@@ -149,7 +148,7 @@ createHdRndAddress spendingPassword esk accId pw = do
                              go gen (succ collisions)
                          (Left (CreateHdAddressUnknown _)) ->
                              return (Left $ CreateAddressUnknownHdAccount accId)
-                         Right () -> return . Right $ hdAddress
+                         Right () -> return (Right $ toCardanoAddress hdAddress)
 
         -- The maximum number of allowed collisions.
         maxAllowedCollisions :: Word32
diff --git a/src/Cardano/Wallet/Kernel/Transactions.hs b/src/Cardano/Wallet/Kernel/Transactions.hs
index c0a5db2ab99..834fbe912f3 100644
--- a/src/Cardano/Wallet/Kernel/Transactions.hs
+++ b/src/Cardano/Wallet/Kernel/Transactions.hs
@@ -68,8 +68,7 @@ import           Cardano.Wallet.Kernel.Types (AccountId (..),
                      RawResolvedTx (..), WalletId (..))
 import           Cardano.Wallet.Kernel.Util (shuffleNE)
 import           Cardano.Wallet.Kernel.Util.Core
-import           Cardano.Wallet.WalletLayer.Kernel.Conv (exceptT,
-                     toCardanoAddress)
+import           Cardano.Wallet.WalletLayer.Kernel.Conv (exceptT)
 
 {-------------------------------------------------------------------------------
   Generating payments and estimating fees
@@ -255,10 +254,9 @@ newTransaction ActiveWallet{..} spendingPassword options accountId payees = runE
     genChangeAddr :: MonadIO m
                   => ExceptT Kernel.CreateAddressError m Address
     genChangeAddr = ExceptT $ liftIO $
-        fmap toCardanoAddress <$>
-            Kernel.createAddress spendingPassword
-                                 (AccountIdHdRnd accountId)
-                                 walletPassive
+        Kernel.createAddress spendingPassword
+                             (AccountIdHdRnd accountId)
+                             walletPassive
 
 -- | This is called when we create a new Pending Transaction.
 -- This actually returns a function because we don`t know yet our outputs.
@@ -496,7 +494,7 @@ redeemAda w@ActiveWallet{..} accId pw rsk = runExceptT $ do
                       pw
                       (AccountIdHdRnd accId)
                       walletPassive
-    (tx, meta) <- mkTx (toCardanoAddress changeAddr)
+    (tx, meta) <- mkTx changeAddr
     withExceptT RedeemAdaNewForeignFailed $ ExceptT $ liftIO $
       newForeign
         w
diff --git a/src/Cardano/Wallet/Kernel/Wallets.hs b/src/Cardano/Wallet/Kernel/Wallets.hs
index a72d0e6edfb..2c50191735c 100644
--- a/src/Cardano/Wallet/Kernel/Wallets.hs
+++ b/src/Cardano/Wallet/Kernel/Wallets.hs
@@ -3,6 +3,8 @@ module Cardano.Wallet.Kernel.Wallets (
     , updateHdWallet
     , updatePassword
     , deleteHdWallet
+    , defaultHdAccount
+    , defaultHdAddress
       -- * Errors
     , CreateWalletError(..)
     , UpdateWalletPasswordError(..)
@@ -32,8 +34,8 @@ import           Cardano.Wallet.Kernel.DB.AcidState (CreateHdWallet (..),
                      UpdateHdRootPassword (..), UpdateHdWallet (..))
 import           Cardano.Wallet.Kernel.DB.HdWallet (AssuranceLevel, HdAccount,
                      HdAccountId (..), HdAccountIx (..), HdAddress,
-                     HdAddressId (..), HdAddressIx (..), HdRoot, WalletName,
-                     eskToHdRootId)
+                     HdAddressId (..), HdAddressIx (..), HdRoot, HdRootId,
+                     WalletName, eskToHdRootId)
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
 import qualified Cardano.Wallet.Kernel.DB.HdWallet.Create as HD
 import           Cardano.Wallet.Kernel.DB.InDb (InDb (..))
@@ -160,10 +162,10 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do
                              esk
                              -- Brand new wallets have no Utxo
                              -- See preconditon above.
-                             (\hdRoot defaultHdAccount defaultHdAddress ->
+                             (\hdRoot hdAccount hdAddress ->
                                  Left $ CreateHdWallet hdRoot
-                                                       defaultHdAccount
-                                                       defaultHdAddress
+                                                       hdAccount
+                                                       hdAddress
                                                        mempty
                              )
     case res of
@@ -217,33 +219,50 @@ createWalletHdRnd pw spendingPassword name assuranceLevel esk createWallet = do
                                 (hdSpendingPassword hasSpendingPassword created)
                                 assuranceLevel
                                 created
-        hdAccountId = HdAccountId rootId (HdAccountIx firstHardened)
-        defaultHdAccount =
-            HD.initHdAccount hdAccountId initialAccountState &
-                HD.hdAccountName .~ (HD.AccountName "Default account")
-        hdAddressId = HdAddressId hdAccountId (HdAddressIx firstHardened)
 
-    case newHdAddress esk spendingPassword hdAccountId hdAddressId of
+    case defaultHdAddress esk spendingPassword rootId of
          Nothing -> return (Left HD.CreateHdRootDefaultAddressCreationFailed)
-         Just defaultHdAddress -> do
+         Just hdAddress -> do
              -- We now have all the date we need to atomically generate a new
              -- wallet with a default account & address.
-             res <- case createWallet newRoot defaultHdAccount defaultHdAddress of
+             res <- case createWallet newRoot (defaultHdAccount rootId) hdAddress of
                  Left  create  -> update' (pw ^. wallets) create
                  Right restore -> update' (pw ^. wallets) restore
              return $ either Left (const (Right newRoot)) res
     where
 
-        initialAccountState :: HD.HdAccountState
-        initialAccountState = HD.HdAccountStateUpToDate HD.HdAccountUpToDate {
-              _hdUpToDateCheckpoints = Checkpoints . one $ initCheckpoint mempty
-            }
-
         hdSpendingPassword :: Bool -> InDb Timestamp -> HD.HasSpendingPassword
         hdSpendingPassword hasSpendingPassword created =
             if hasSpendingPassword then HD.HasSpendingPassword created
                                    else HD.NoSpendingPassword
 
+defaultHdAddress :: EncryptedSecretKey
+                 -> PassPhrase
+                 -> HD.HdRootId
+                 -> Maybe HdAddress
+defaultHdAddress esk spendingPassword rootId =
+    let hdAccountId = defaultHdAccountId rootId
+        hdAddressId = HdAddressId hdAccountId (HdAddressIx firstHardened)
+    in newHdAddress esk spendingPassword hdAccountId hdAddressId
+
+
+defaultHdAccountId :: HdRootId -> HdAccountId
+defaultHdAccountId rootId = HdAccountId rootId (HdAccountIx firstHardened)
+
+
+defaultHdAccount :: HdRootId -> HdAccount
+defaultHdAccount rootId =
+    let hdAccountId = defaultHdAccountId rootId
+    in HD.initHdAccount hdAccountId initialAccountState &
+           HD.hdAccountName .~ (HD.AccountName "Default account")
+  where
+    initialAccountState :: HD.HdAccountState
+    initialAccountState = HD.HdAccountStateUpToDate HD.HdAccountUpToDate {
+          _hdUpToDateCheckpoints = Checkpoints . one $ initCheckpoint mempty
+        }
+
+
+
 deleteHdWallet :: PassiveWallet
                -> HD.HdRootId
                -> IO (Either HD.UnknownHdRoot ())
diff --git a/src/Cardano/Wallet/WalletLayer.hs b/src/Cardano/Wallet/WalletLayer.hs
index d3af0065978..401a96ff088 100644
--- a/src/Cardano/Wallet/WalletLayer.hs
+++ b/src/Cardano/Wallet/WalletLayer.hs
@@ -3,7 +3,6 @@ module Cardano.Wallet.WalletLayer
     , ActiveWalletLayer (..)
     -- * Types
     , CreateWallet(..)
-    , CreateAccount(..)
     -- ** Errors
     , CreateWalletError(..)
     , GetWalletError(..)
@@ -73,7 +72,6 @@ data CreateWallet =
 
 data CreateWalletError =
       CreateWalletError Kernel.CreateWalletError
-    | CreateWalletFirstAccountCreationFailed CreateAccountError
 
 -- | Unsound show instance needed for the 'Exception' instance.
 instance Show CreateWalletError where
@@ -83,14 +81,11 @@ instance Exception CreateWalletError
 
 instance Arbitrary CreateWalletError where
     arbitrary = oneof [ CreateWalletError <$> arbitrary
-                      , CreateWalletFirstAccountCreationFailed <$> arbitrary
                       ]
 
 instance Buildable CreateWalletError where
     build (CreateWalletError kernelError) =
         bprint ("CreateWalletError " % build) kernelError
-    build (CreateWalletFirstAccountCreationFailed kernelError) =
-        bprint ("CreateWalletFirstAccountCreationFailed " % build) kernelError
 
 data GetWalletError =
       GetWalletError (V1 Kernel.UnknownHdRoot)
@@ -236,21 +231,10 @@ instance Buildable ValidateAddressError where
 -- Errors when dealing with Accounts
 ------------------------------------------------------------
 
-data CreateAccount =
-    CreateHdAccountFixedIndex Kernel.HdAccountIx NewAccount
-  -- ^ Creates a new HD 'Account' using as the account index
-  -- the supplied one.
-  | CreateHdAccountRandomIndex NewAccount
-  -- ^ Creates a new HD 'Account' using as the account index
-  -- a randomly-generated one.
-
 data CreateAccountError =
       CreateAccountError Kernel.CreateAccountError
     | CreateAccountWalletIdDecodingFailed Text
     -- ^ Decoding the parent's 'WalletId' from a raw 'Text' failed.
-    | CreateAccountFirstAddressGenerationFailed Kernel.CreateAddressError
-    -- ^ When trying to create the first 'Address' to go in tandem with this
-    -- 'Account', the generation failed.
     deriving Eq
 
 -- | Unsound show instance needed for the 'Exception' instance.
@@ -262,7 +246,6 @@ instance Exception CreateAccountError
 instance Arbitrary CreateAccountError where
     arbitrary = oneof [ CreateAccountError <$> arbitrary
                       , CreateAccountWalletIdDecodingFailed <$> arbitrary
-                      , CreateAccountFirstAddressGenerationFailed <$> arbitrary
                       ]
 
 instance Buildable CreateAccountError where
@@ -270,8 +253,6 @@ instance Buildable CreateAccountError where
         bprint ("CreateAccountError " % build) kernelError
     build (CreateAccountWalletIdDecodingFailed txt) =
         bprint ("CreateAccountWalletIdDecodingFailed " % build) txt
-    build (CreateAccountFirstAddressGenerationFailed kernelError) =
-        bprint ("CreateAccountFirstAddressGenerationFailed " % build) kernelError
 
 data GetAccountError =
       GetAccountError (V1 Kernel.UnknownHdAccount)
@@ -418,7 +399,7 @@ data PassiveWalletLayer m = PassiveWalletLayer
                            -> m (Either GetUtxosError [(Account, Utxo)])
     -- accounts
     , createAccount        :: WalletId
-                           -> CreateAccount
+                           -> NewAccount
                            -> m (Either CreateAccountError Account)
     , getAccounts          :: WalletId
                            -> m (Either GetAccountsError (IxSet Account))
diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs
index 727b53eb185..8373ae131ba 100644
--- a/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs
+++ b/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs
@@ -1,6 +1,5 @@
 module Cardano.Wallet.WalletLayer.Kernel.Accounts (
     createAccount
-  , createHdAccount
   , getAccount
   , getAccountBalance
   , getAccountAddresses
@@ -22,81 +21,56 @@ import           Cardano.Wallet.API.Response (WalletResponse, respondWith)
 import           Cardano.Wallet.API.V1.Types (V1 (..), WalletAddress)
 import qualified Cardano.Wallet.API.V1.Types as V1
 import qualified Cardano.Wallet.Kernel.Accounts as Kernel
-import qualified Cardano.Wallet.Kernel.Addresses as Kernel
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
+import           Cardano.Wallet.Kernel.DB.Read (addressesByAccountId)
 import           Cardano.Wallet.Kernel.DB.Util.IxSet (Indexed (..), IxSet)
 import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 import qualified Cardano.Wallet.Kernel.Internal as Kernel
 import qualified Cardano.Wallet.Kernel.Read as Kernel
-import           Cardano.Wallet.Kernel.Types (AccountId (..), WalletId (..))
-import           Cardano.Wallet.WalletLayer (CreateAccount (..),
-                     CreateAccountError (..), DeleteAccountError (..),
-                     GetAccountError (..), GetAccountsError (..),
-                     UpdateAccountError (..))
+import           Cardano.Wallet.Kernel.Types (WalletId (..))
+import           Cardano.Wallet.WalletLayer (CreateAccountError (..),
+                     DeleteAccountError (..), GetAccountError (..),
+                     GetAccountsError (..), UpdateAccountError (..))
 import           Cardano.Wallet.WalletLayer.Kernel.Conv
 
+-- | Creates a new account. It does @not@ create a default address to go
+-- alongside this wallet nor it should be, as the invariant applies only to
+-- new wallet being created/restored and is enforced elsewhere.
 createAccount :: MonadIO m
               => Kernel.PassiveWallet
               -> V1.WalletId
-              -> CreateAccount
+              -> V1.NewAccount
               -> m (Either CreateAccountError V1.Account)
-createAccount wallet wId createAccountRequest = liftIO $ do
-    either (Left . identity) (Right . uncurry mkAccount)
-      <$> createHdAccount wallet wId createAccountRequest
+createAccount wallet wId (V1.NewAccount mbSpendingPassword accountName) = liftIO $ runExceptT $  do
+    rootId <- withExceptT CreateAccountWalletIdDecodingFailed $
+                fromRootId wId
+    acc    <- withExceptT CreateAccountError $ ExceptT $ liftIO $
+                Kernel.createAccount passPhrase
+                                     (HD.AccountName accountName)
+                                     (WalletIdHdRnd rootId)
+                                     wallet
+    db <- liftIO (Kernel.getWalletSnapshot wallet)
+    let accId = acc ^. HD.hdAccountId
+    let accountAddresses = addressesByAccountId db accId
+    pure $ mkAccount acc (IxSet.toList accountAddresses)
   where
+    passPhrase = maybe mempty coerce mbSpendingPassword
+
     -- We cannot use the general 'fromAccount' function here since we lack
     -- a DB snapshot. We /could/ in principle ask for a snapshot and use that,
     -- but if meanwhile the account has already been changed that might lead
     -- to confusing results. Modifying the kernel code to do this atomically
     -- and return the (single) final snapshot might be possible but right now
     -- is more difficult than it appears (I've tried).
-    mkAccount :: HD.HdAccount -> HD.HdAddress -> V1.Account
-    mkAccount acc addr = V1.Account {
-        accIndex     = toAccountId (acc ^. HD.hdAccountId)
+    mkAccount :: HD.HdAccount -> [Indexed HD.HdAddress] -> V1.Account
+    mkAccount account addresses = V1.Account {
+        accIndex     = toAccountId (account ^. HD.hdAccountId)
       , accAmount    = V1.V1 (Core.mkCoin 0)
-      , accName      = V1.naccName (toNewAccountRq createAccountRequest)
+      , accName      = accountName
       , accWalletId  = wId
-      , accAddresses = [ toAddress acc addr ]
+      , accAddresses = map (toAddress account . view IxSet.ixedIndexed) addresses
       }
 
-createHdAccount :: MonadIO m
-                => Kernel.PassiveWallet
-                -> V1.WalletId
-                -> CreateAccount
-                -> m (Either CreateAccountError (HD.HdAccount, HD.HdAddress))
-createHdAccount wallet wId createAccountRequest = liftIO $ runExceptT $  do
-    let (V1.NewAccount mbSpendingPassword accountName) = toNewAccountRq createAccountRequest
-    rootId <- withExceptT CreateAccountWalletIdDecodingFailed $
-                fromRootId wId
-    acc    <- withExceptT CreateAccountError $ ExceptT $ liftIO $
-        case createAccountRequest of
-             CreateHdAccountRandomIndex _ ->
-                Kernel.createHdRandomAccount (HD.AccountName accountName)
-                                             (WalletIdHdRnd rootId)
-                                             wallet
-             CreateHdAccountFixedIndex newIndex _ ->
-                Kernel.createHdFixedAccount newIndex
-                                            (HD.AccountName accountName)
-                                            (WalletIdHdRnd rootId)
-                                            wallet
-    let accId = acc ^. HD.hdAccountId
-    -- Create a new address to go in tandem with this brand-new 'Account'.
-    fmap (acc,) $
-      withExceptT CreateAccountFirstAddressGenerationFailed $ ExceptT $ liftIO $
-        Kernel.createAddress (passPhrase mbSpendingPassword)
-                             (AccountIdHdRnd accId)
-                             wallet
-  where
-    passPhrase = maybe mempty coerce
-
-
-toNewAccountRq :: CreateAccount -> V1.NewAccount
-toNewAccountRq createAccountRequest =
-    case createAccountRequest of
-        CreateHdAccountFixedIndex _ rq -> rq
-        CreateHdAccountRandomIndex rq  -> rq
-
-
 -- | Retrieves a full set of accounts.
 getAccounts :: V1.WalletId
             -> Kernel.DB
diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Addresses.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Addresses.hs
index 1c5f8201e99..aa55ab4fa92 100644
--- a/src/Cardano/Wallet/WalletLayer/Kernel/Addresses.hs
+++ b/src/Cardano/Wallet/WalletLayer/Kernel/Addresses.hs
@@ -10,7 +10,7 @@ import           Universum
 import           Control.Monad.Trans.Except
 import           Data.Coerce (coerce)
 
-import           Pos.Core (decodeTextAddress)
+import           Pos.Core (Address, decodeTextAddress)
 
 import           Cardano.Wallet.API.Request (RequestParams (..))
 import           Cardano.Wallet.API.Request.Pagination (Page (..),
@@ -50,8 +50,8 @@ createAddress wallet
 
     -- | Creates a new 'WalletAddress'. As this is a brand new, fresh Address,
     -- it's fine to have 'False' for both 'isUsed' and 'isChange'.
-    mkAddress :: HD.HdAddress -> WalletAddress
-    mkAddress addr = WalletAddress (V1 $ toCardanoAddress addr) False False
+    mkAddress :: Address -> WalletAddress
+    mkAddress addr = WalletAddress (V1 addr) False False
 
 
 
diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs
index 331a99532b4..5d9876edc71 100644
--- a/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs
+++ b/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs
@@ -197,8 +197,9 @@ toAddress acc hdAddress =
     cardanoAddress = hdAddress ^. HD.hdAddressAddress . fromDb
     addressMeta    = acc ^. HD.hdAccountState . HD.hdAccountStateCurrent . cpAddressMeta cardanoAddress
 
+-- | Converts a Kernel 'HdAddress' into a Cardano 'Address'.
 toCardanoAddress :: HD.HdAddress -> Address
-toCardanoAddress hdAddress = hdAddress ^. HD.hdAddressAddress . fromDb
+toCardanoAddress hdAddr = hdAddr ^. HD.hdAddressAddress . fromDb
 
 {-------------------------------------------------------------------------------
   Custom errors
diff --git a/test/unit/Test/Spec/Accounts.hs b/test/unit/Test/Spec/Accounts.hs
index 35af9f5c6d5..c7ca4c78f4c 100644
--- a/test/unit/Test/Spec/Accounts.hs
+++ b/test/unit/Test/Spec/Accounts.hs
@@ -23,8 +23,7 @@ import qualified Cardano.Wallet.Kernel.DB.HdWallet as Kernel
 import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 import qualified Cardano.Wallet.Kernel.Internal as Internal
 import qualified Cardano.Wallet.Kernel.Keystore as Keystore
-import           Cardano.Wallet.WalletLayer (CreateAccount (..),
-                     PassiveWalletLayer)
+import           Cardano.Wallet.WalletLayer (PassiveWalletLayer)
 import qualified Cardano.Wallet.WalletLayer as WalletLayer
 import qualified Cardano.Wallet.WalletLayer.Kernel.Wallets as Wallets
 import           Control.Monad.Except (runExceptT)
@@ -81,7 +80,7 @@ spec = describe "Accounts" $ do
                 withFixture $ \_ layer _ Fixture{..} -> do
                     res <- WalletLayer.createAccount layer
                              (V1.walId fixtureV1Wallet)
-                             (CreateHdAccountRandomIndex fixtureNewAccountRq)
+                             fixtureNewAccountRq
                     (bimap STB STB res) `shouldSatisfy` isRight
 
         prop "fails if the parent wallet doesn't exists" $ withMaxSuccess 50 $ do
@@ -90,7 +89,7 @@ spec = describe "Accounts" $ do
                 pwd <- genSpendingPassword
                 request <- genNewAccountRq pwd
                 withLayer $ \layer _ -> do
-                    res <- WalletLayer.createAccount layer wId (CreateHdAccountRandomIndex request)
+                    res <- WalletLayer.createAccount layer wId request
                     case res of
                          Left (WalletLayer.CreateAccountError (CreateAccountKeystoreNotFound _)) ->
                              return ()
@@ -127,7 +126,7 @@ spec = describe "Accounts" $ do
                 withFixture $ \_ layer _ Fixture{..} -> do
                     let wId = V1.walId fixtureV1Wallet
                     (Right V1.Account{..}) <-
-                        WalletLayer.createAccount layer wId (CreateHdAccountRandomIndex fixtureNewAccountRq)
+                        WalletLayer.createAccount layer wId fixtureNewAccountRq
                     res <- WalletLayer.deleteAccount layer wId accIndex
                     (bimap STB STB res) `shouldSatisfy` isRight
 
@@ -220,7 +219,7 @@ spec = describe "Accounts" $ do
                 withFixture $ \_ layer _ Fixture{..} -> do
                     let wId = V1.walId fixtureV1Wallet
                     (Right V1.Account{..}) <-
-                        WalletLayer.createAccount layer wId (CreateHdAccountRandomIndex fixtureNewAccountRq)
+                        WalletLayer.createAccount layer wId fixtureNewAccountRq
                     let updateAccountRq = V1.AccountUpdate "My nice account"
                     res <- WalletLayer.updateAccount layer wId accIndex updateAccountRq
                     case res of
@@ -291,7 +290,7 @@ spec = describe "Accounts" $ do
                 withFixture $ \_ layer _ Fixture{..} -> do
                     (Right V1.Account{..}) <-
                         WalletLayer.createAccount layer (V1.walId fixtureV1Wallet)
-                                                        (CreateHdAccountRandomIndex fixtureNewAccountRq)
+                                                        fixtureNewAccountRq
                     res <- WalletLayer.getAccount layer (V1.walId fixtureV1Wallet)
                                                         accIndex
                     case res of
@@ -357,7 +356,7 @@ spec = describe "Accounts" $ do
                     -- by the 'createWallet' endpoint, for a total of 5.
                     forM_ [1..4] $ \(_i :: Int) ->
                         WalletLayer.createAccount layer (V1.walId fixtureV1Wallet)
-                                                        (CreateHdAccountRandomIndex fixtureNewAccountRq)
+                                                        fixtureNewAccountRq
                     res <- WalletLayer.getAccounts layer (V1.walId fixtureV1Wallet)
                     case res of
                          Left e     -> fail (show e)
@@ -428,7 +427,7 @@ spec = describe "Accounts" $ do
                     -- by the 'createWallet' endpoint, for a total of 5.
                     forM_ [1..4] $ \(_i :: Int) ->
                         WalletLayer.createAccount layer (V1.walId fixtureV1Wallet)
-                                                        (CreateHdAccountRandomIndex fixtureNewAccountRq)
+                                                        fixtureNewAccountRq
                     accounts <- WalletLayer.getAccounts layer (V1.walId fixtureV1Wallet)
                     let accountIndices =
                             case accounts of
@@ -480,7 +479,7 @@ spec = describe "Accounts" $ do
                     -- by the 'createWallet' endpoint, for a total of 5.
                     forM_ [1..4] $ \(_i :: Int) ->
                         WalletLayer.createAccount layer (V1.walId fixtureV1Wallet)
-                                                        (CreateHdAccountRandomIndex fixtureNewAccountRq)
+                                                        fixtureNewAccountRq
                     accountsBefore <- WalletLayer.getAccounts layer (V1.walId fixtureV1Wallet)
                     let accountIndices =
                             case accountsBefore of
@@ -508,7 +507,7 @@ spec = describe "Accounts" $ do
                     let zero = V1 (mkCoin 0)
                     (Right V1.Account{..}) <-
                         WalletLayer.createAccount layer (V1.walId fixtureV1Wallet)
-                                                        (CreateHdAccountRandomIndex fixtureNewAccountRq)
+                                                        fixtureNewAccountRq
                     res <- WalletLayer.getAccountBalance layer (V1.walId fixtureV1Wallet)
                                                                accIndex
                     case res of
@@ -544,7 +543,7 @@ spec = describe "Accounts" $ do
                     -- by the 'createWallet' endpoint, for a total of 5.
                     forM_ [1..4] $ \(_i :: Int) ->
                         WalletLayer.createAccount layer (V1.walId fixtureV1Wallet)
-                                                        (CreateHdAccountRandomIndex fixtureNewAccountRq)
+                                                        fixtureNewAccountRq
                     accounts <- WalletLayer.getAccounts layer (V1.walId fixtureV1Wallet)
                     let accountIndices =
                             case accounts of
diff --git a/test/unit/Test/Spec/Addresses.hs b/test/unit/Test/Spec/Addresses.hs
index 290c7595bc0..742ebd65c3b 100644
--- a/test/unit/Test/Spec/Addresses.hs
+++ b/test/unit/Test/Spec/Addresses.hs
@@ -16,7 +16,7 @@ import           Test.QuickCheck (arbitrary, choose, withMaxSuccess)
 import           Test.QuickCheck.Monadic (PropertyM, monadicIO, pick)
 
 import           Pos.Core (Address)
-import           Pos.Crypto (EncryptedSecretKey, firstHardened,
+import           Pos.Crypto (EncryptedSecretKey, emptyPassphrase, firstHardened,
                      safeDeterministicKeyGen)
 
 import           Cardano.Wallet.API.Request (RequestParams (..))
@@ -40,6 +40,7 @@ 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 qualified Cardano.Wallet.Kernel.Wallets as Kernel
 import           Cardano.Wallet.WalletLayer (PassiveWalletLayer)
 import qualified Cardano.Wallet.WalletLayer as WalletLayer
 import qualified Cardano.Wallet.WalletLayer.Kernel.Addresses as Addresses
@@ -78,8 +79,11 @@ prepareFixtures = do
                           <*> (InDb <$> pick arbitrary)
     newAccountId <- HdAccountId newRootId <$> deriveIndex (pick . choose) HdAccountIx HardDerivation
     let accounts = M.singleton newAccountId mempty
+        hdAccount        = Kernel.defaultHdAccount newRootId
+        (Just hdAddress) = Kernel.defaultHdAddress esk emptyPassphrase newRootId
+
     return $ \pw -> do
-        void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot accounts)
+        void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot hdAccount hdAddress accounts)
         return $ Fixture {
                            fixtureHdRootId = newRootId
                          , fixtureAccountId = AccountIdHdRnd newAccountId
diff --git a/test/unit/Test/Spec/NewPayment.hs b/test/unit/Test/Spec/NewPayment.hs
index e7facd81f12..f1d35026def 100644
--- a/test/unit/Test/Spec/NewPayment.hs
+++ b/test/unit/Test/Spec/NewPayment.hs
@@ -26,7 +26,7 @@ import           Pos.Chain.Txp (TxOut (..), TxOutAux (..))
 import           Pos.Core (Address, Coin (..), IsBootstrapEraAddr (..),
                      deriveLvl2KeyPair, mkCoin)
 import           Pos.Crypto (EncryptedSecretKey, ShouldCheckPassphrase (..),
-                     safeDeterministicKeyGen)
+                     emptyPassphrase, safeDeterministicKeyGen)
 
 import           Test.Spec.CoinSelection.Generators (InitialBalance (..),
                      Pay (..), genPayee, genUtxoWithAtLeast)
@@ -53,6 +53,7 @@ import qualified Cardano.Wallet.Kernel.NodeStateAdaptor as Node
 import qualified Cardano.Wallet.Kernel.PrefilterTx as Kernel
 import qualified Cardano.Wallet.Kernel.Transactions as Kernel
 import           Cardano.Wallet.Kernel.Types (AccountId (..), WalletId (..))
+import qualified Cardano.Wallet.Kernel.Wallets as Kernel
 import           Cardano.Wallet.WalletLayer (ActiveWalletLayer)
 import qualified Cardano.Wallet.WalletLayer as WalletLayer
 import qualified Cardano.Wallet.WalletLayer.Kernel.Conv as Kernel.Conv
@@ -110,9 +111,11 @@ prepareFixtures initialBalance toPay = do
         liftIO $ Keystore.insert (WalletIdHdRnd newRootId) esk keystore
         let pw = Kernel.walletPassive aw
 
-        let accounts = Kernel.prefilterUtxo newRootId esk utxo'
+        let accounts         = Kernel.prefilterUtxo newRootId esk utxo'
+            hdAccount        = Kernel.defaultHdAccount newRootId
+            (Just hdAddress) = Kernel.defaultHdAddress esk emptyPassphrase newRootId
 
-        void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot accounts)
+        void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot hdAccount hdAddress accounts)
         return $ Fixture {
                            fixtureHdRootId = newRootId
                          , fixtureAccountId = AccountIdHdRnd newAccountId
diff --git a/test/unit/Wallet/Inductive/Cardano.hs b/test/unit/Wallet/Inductive/Cardano.hs
index b15410d6f09..8430da6d74c 100644
--- a/test/unit/Wallet/Inductive/Cardano.hs
+++ b/test/unit/Wallet/Inductive/Cardano.hs
@@ -25,7 +25,7 @@ import qualified Formatting.Buildable
 import           Pos.Chain.Txp (Utxo, formatUtxo)
 import           Pos.Core (HasConfiguration, Timestamp (..))
 import           Pos.Core.Chrono
-import           Pos.Crypto (EncryptedSecretKey)
+import           Pos.Crypto (EncryptedSecretKey, emptyPassphrase)
 
 import qualified Cardano.Wallet.Kernel.BListener as Kernel
 import qualified Cardano.Wallet.Kernel.DB.AcidState as DB
@@ -220,11 +220,16 @@ equivalentT useWW activeWallet esk = \mkWallet w ->
         res <- liftIO $
           Kernel.createWalletHdRnd
             passiveWallet
-            False
+            emptyPassphrase
             walletName
             assuranceLevel
             esk
-            (\root -> Left $ DB.CreateHdWallet root (prefilterUtxo (root ^. HD.hdRootId) esk utxo))
+            (\root defaultAccount defaultAddress ->
+                Left $ DB.CreateHdWallet root
+                                         defaultAccount
+                                         defaultAddress
+                                         (prefilterUtxo (root ^. HD.hdRootId) esk utxo)
+            )
         case res of
              Left e -> createWalletErr (STB e)
              Right hdRoot -> do

From f88ab49199a5180004ec4b53d7f8ea6eb02ced58 Mon Sep 17 00:00:00 2001
From: Erik de Castro Lopo 
Date: Wed, 12 Sep 2018 11:40:15 +1000
Subject: [PATCH 06/14] Use individual LICENSE files

Symlinks are not correctlty handled by Github.
---
 LICENSE | 34 +++++++++++++++++-----------------
 1 file changed, 17 insertions(+), 17 deletions(-)

diff --git a/LICENSE b/LICENSE
index 74d83558329..367a48d9eac 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,20 +1,20 @@
-Copyright (c) 2017 IOHK
+Copyright (c) 2016 IOHK
 
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the
-"Software"), to deal in the Software without restriction, including
-without limitation the rights to use, copy, modify, merge, publish,
-distribute, sublicense, and/or sell copies of the Software, and to
-permit persons to whom the Software is furnished to do so, subject to
-the following conditions:
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to
+do so, subject to the following conditions:
 
-The above copyright notice and this permission notice shall be included
-in all copies or substantial portions of the Software.
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
 
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

From 3ff1369f3d25c0b19bb0fd3f70656d1cc682e21f Mon Sep 17 00:00:00 2001
From: Alfredo Di Napoli 
Date: Wed, 12 Sep 2018 11:23:43 +0200
Subject: [PATCH 07/14] [CBR-419] createAccount now returns the new DB snapshot

---
 src/Cardano/Wallet/Kernel/Accounts.hs           | 10 +++++-----
 src/Cardano/Wallet/Kernel/DB/AcidState.hs       |  4 ++--
 .../Wallet/WalletLayer/Kernel/Accounts.hs       | 17 +++++------------
 test/unit/Test/Spec/Accounts.hs                 |  7 +++++--
 4 files changed, 17 insertions(+), 21 deletions(-)

diff --git a/src/Cardano/Wallet/Kernel/Accounts.hs b/src/Cardano/Wallet/Kernel/Accounts.hs
index 2f0e5ee76f6..1426af025e4 100644
--- a/src/Cardano/Wallet/Kernel/Accounts.hs
+++ b/src/Cardano/Wallet/Kernel/Accounts.hs
@@ -75,7 +75,7 @@ createAccount :: PassPhrase
               -> WalletId
               -- ^ An abstract notion of a 'Wallet identifier
               -> PassiveWallet
-              -> IO (Either CreateAccountError HdAccount)
+              -> IO (Either CreateAccountError (DB, HdAccount))
 createAccount spendingPassword accountName walletId pw = do
     let keystore = pw ^. walletKeystore
     case walletId of
@@ -99,12 +99,12 @@ createHdRndAccount :: PassPhrase
                    -> EncryptedSecretKey
                    -> HdRootId
                    -> PassiveWallet
-                   -> IO (Either CreateAccountError HdAccount)
+                   -> IO (Either CreateAccountError (DB, HdAccount))
 createHdRndAccount _spendingPassword accountName _esk rootId pw = do
     gen <- createSystemRandom
     go gen 0
     where
-        go :: GenIO -> Word32 -> IO (Either CreateAccountError HdAccount)
+        go :: GenIO -> Word32 -> IO (Either CreateAccountError (DB, HdAccount))
         go gen collisions =
             case collisions >= maxAllowedCollisions of
                  True  -> return $ Left (CreateAccountHdRndAccountSpaceSaturated rootId)
@@ -113,7 +113,7 @@ createHdRndAccount _spendingPassword accountName _esk rootId pw = do
         tryGenerateAccount :: GenIO
                            -> Word32
                            -- ^ The current number of collisions
-                           -> IO (Either CreateAccountError HdAccount)
+                           -> IO (Either CreateAccountError (DB, HdAccount))
         tryGenerateAccount gen collisions = do
             newIndex <- deriveIndex (flip uniformR gen) HdAccountIx HardDerivation
             let hdAccountId = HdAccountId rootId newIndex
@@ -126,7 +126,7 @@ createHdRndAccount _spendingPassword accountName _esk rootId pw = do
                      go gen (succ collisions)
                  (Left (CreateHdAccountUnknownRoot _)) ->
                      return (Left $ CreateAccountUnknownHdRoot rootId)
-                 Right () -> return (Right newAccount)
+                 Right (db', ()) -> return (Right (db', newAccount))
 
         -- The maximum number of allowed collisions. This number was
         -- empirically calculated based on a [beta distribution](https://en.wikipedia.org/wiki/Beta_distribution).
diff --git a/src/Cardano/Wallet/Kernel/DB/AcidState.hs b/src/Cardano/Wallet/Kernel/DB/AcidState.hs
index 3c842b5c2b9..e0069a54055 100644
--- a/src/Cardano/Wallet/Kernel/DB/AcidState.hs
+++ b/src/Cardano/Wallet/Kernel/DB/AcidState.hs
@@ -601,8 +601,8 @@ createHdRoot hdRoot defaultHdAccount defaultHdAddress =
     runUpdateDiscardSnapshot . zoom dbHdWallets $
         HD.createHdRoot hdRoot defaultHdAccount defaultHdAddress
 
-createHdAccount :: HdAccount -> Update DB (Either HD.CreateHdAccountError ())
-createHdAccount hdAccount = runUpdateDiscardSnapshot . zoom dbHdWallets $
+createHdAccount :: HdAccount -> Update DB (Either HD.CreateHdAccountError (DB, ()))
+createHdAccount hdAccount = runUpdate' . zoom dbHdWallets $
     HD.createHdAccount hdAccount
 
 createHdAddress :: HdAddress -> Update DB (Either HD.CreateHdAddressError ())
diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs
index 8373ae131ba..6431e917df9 100644
--- a/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs
+++ b/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs
@@ -44,24 +44,17 @@ createAccount :: MonadIO m
 createAccount wallet wId (V1.NewAccount mbSpendingPassword accountName) = liftIO $ runExceptT $  do
     rootId <- withExceptT CreateAccountWalletIdDecodingFailed $
                 fromRootId wId
-    acc    <- withExceptT CreateAccountError $ ExceptT $ liftIO $
-                Kernel.createAccount passPhrase
-                                     (HD.AccountName accountName)
-                                     (WalletIdHdRnd rootId)
-                                     wallet
-    db <- liftIO (Kernel.getWalletSnapshot wallet)
+    (db, acc) <- withExceptT CreateAccountError $ ExceptT $ liftIO $
+                     Kernel.createAccount passPhrase
+                                          (HD.AccountName accountName)
+                                          (WalletIdHdRnd rootId)
+                                          wallet
     let accId = acc ^. HD.hdAccountId
     let accountAddresses = addressesByAccountId db accId
     pure $ mkAccount acc (IxSet.toList accountAddresses)
   where
     passPhrase = maybe mempty coerce mbSpendingPassword
 
-    -- We cannot use the general 'fromAccount' function here since we lack
-    -- a DB snapshot. We /could/ in principle ask for a snapshot and use that,
-    -- but if meanwhile the account has already been changed that might lead
-    -- to confusing results. Modifying the kernel code to do this atomically
-    -- and return the (single) final snapshot might be possible but right now
-    -- is more difficult than it appears (I've tried).
     mkAccount :: HD.HdAccount -> [Indexed HD.HdAddress] -> V1.Account
     mkAccount account addresses = V1.Account {
         accIndex     = toAccountId (account ^. HD.hdAccountId)
diff --git a/test/unit/Test/Spec/Accounts.hs b/test/unit/Test/Spec/Accounts.hs
index c7ca4c78f4c..f337f53cb4a 100644
--- a/test/unit/Test/Spec/Accounts.hs
+++ b/test/unit/Test/Spec/Accounts.hs
@@ -109,7 +109,10 @@ spec = describe "Accounts" $ do
                     res <- runExceptT . runHandler' $ hdl
                     (bimap identity STB res) `shouldSatisfy` isRight
 
-        prop "comes with 1 address by default" $ withMaxSuccess 50 $ do
+        prop "does NOT come with 1 address by default" $ withMaxSuccess 50 $ do
+            -- We expect newly created accounts to @not@ have any associated
+            -- addresses. Remember, it's only when we create a new HdRoot that
+            -- we enforce this invariant.
             monadicIO $ do
                 withFixture $ \_ layer _ Fixture{..} -> do
                     let hdl = Handlers.newAccount layer (V1.walId fixtureV1Wallet) fixtureNewAccountRq
@@ -117,7 +120,7 @@ spec = describe "Accounts" $ do
                     case res of
                          Left e -> throwM e
                          Right API.WalletResponse{..} ->
-                             length (V1.accAddresses wrData) `shouldBe` 1
+                             length (V1.accAddresses wrData) `shouldBe` 0
 
     describe "DeleteAccount" $ do
 

From 9b8409fe170cb130889f9409d8e90eebff4dec54 Mon Sep 17 00:00:00 2001
From: Pawel Jakubas 
Date: Mon, 10 Sep 2018 15:03:26 +0200
Subject: [PATCH 08/14] [CBR-417] adding pagination test

[CBR-417] adding === and reducing max number of elements

[CBR-417] simplifying further test
---
 test/unit/Test/Spec/Addresses.hs | 22 +++++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

diff --git a/test/unit/Test/Spec/Addresses.hs b/test/unit/Test/Spec/Addresses.hs
index 290c7595bc0..311010c466c 100644
--- a/test/unit/Test/Spec/Addresses.hs
+++ b/test/unit/Test/Spec/Addresses.hs
@@ -12,7 +12,8 @@ import           Servant.Server
 
 import           Test.Hspec (Spec, describe, shouldBe, shouldSatisfy)
 import           Test.Hspec.QuickCheck (prop)
-import           Test.QuickCheck (arbitrary, choose, withMaxSuccess)
+import           Test.QuickCheck (arbitrary, choose, elements, withMaxSuccess,
+                     (===))
 import           Test.QuickCheck.Monadic (PropertyM, monadicIO, pick)
 
 import           Pos.Core (Address)
@@ -324,6 +325,25 @@ spec = describe "Addresses" $ do
                                     -> pure ()
                            _ -> fail ("Got " ++ show res)
 
+            prop "arbitrary number of addresses, pages and per page" $ withMaxSuccess 500 $ do
+                monadicIO $ do
+                    (rNumOfAddresses :: Int) <- pick $ elements [0..15]
+                    (rNumOfPages :: Int) <- pick $ elements [0..15]
+                    (rNumPerPage :: Int) <- pick $ elements [0..15]
+                    withAddressFixtures rNumOfAddresses $ \_ layer _ fixtureAddresses -> do
+                        let (!>) = drop . (subtract 1)
+                        let ( xs  res
+                        let correctAddresses = pure $ map addressFixtureAddress $
+                                               slice rNumOfPages rNumPerPage fixtureAddresses
+                        pure (toBeCheckedAddresses === correctAddresses)
+
     describe "ValidateAddress" $ do
         describe "Address validation (wallet layer)" $ do
 

From efde829d53a32093e19fe6203f55a033ebada31e Mon Sep 17 00:00:00 2001
From: Alfredo Di Napoli 
Date: Wed, 12 Sep 2018 15:07:18 +0200
Subject: [PATCH 09/14] [CBR-419] Fix logic but in createHdWallet

Previously in createHdWallet we were passing a map
{HdAccountId,(Utxo,[Addr]} to be used to populate the hierarchy of the
new HdRoot. However, with the introduction of the invariant what was
happing was that this function was overriding the stake set for a
particular account, making the tests fail.
---
 src/Cardano/Wallet/Kernel/DB/AcidState.hs     | 61 ++++++++++++-------
 .../Wallet/Kernel/DB/HdWallet/Create.hs       | 26 +-------
 src/Cardano/Wallet/Kernel/Wallets.hs          | 29 ++-------
 test/unit/Test/Spec/Addresses.hs              |  4 +-
 test/unit/Test/Spec/NewPayment.hs             |  4 +-
 5 files changed, 52 insertions(+), 72 deletions(-)

diff --git a/src/Cardano/Wallet/Kernel/DB/AcidState.hs b/src/Cardano/Wallet/Kernel/DB/AcidState.hs
index e0069a54055..68def0a632f 100644
--- a/src/Cardano/Wallet/Kernel/DB/AcidState.hs
+++ b/src/Cardano/Wallet/Kernel/DB/AcidState.hs
@@ -66,7 +66,7 @@ import           Cardano.Wallet.Kernel.DB.HdWallet
 import qualified Cardano.Wallet.Kernel.DB.HdWallet.Create as HD
 import qualified Cardano.Wallet.Kernel.DB.HdWallet.Delete as HD
 import qualified Cardano.Wallet.Kernel.DB.HdWallet.Update as HD
-import           Cardano.Wallet.Kernel.DB.InDb (InDb (InDb))
+import           Cardano.Wallet.Kernel.DB.InDb (InDb (InDb), fromDb)
 import           Cardano.Wallet.Kernel.DB.Spec
 import           Cardano.Wallet.Kernel.DB.Spec.Pending (Pending)
 import qualified Cardano.Wallet.Kernel.DB.Spec.Update as Spec
@@ -440,16 +440,18 @@ observableRollbackUseInTestsOnly = runUpdateDiscardSnapshot $
 -- definitely we do not want it to show up in our acid-state logs.
 --
 createHdWallet :: HdRoot
-               -> HdAccount
-               -- ^ The default HdAccount to go with this HdRoot
+               -> HdAccountId
+               -- ^ The default HdAccountId to go with this HdRoot. This
+               -- function will take responsibility of creating the associated
+               -- 'HdAccount'.
                -> HdAddress
-               -- ^ The default HdAddress to go with this HdRoot
+               -- ^ The default HdAddress to go with this HdRoot.
                -> Map HdAccountId (Utxo,[AddrWithId])
                -> Update DB (Either HD.CreateHdRootError ())
-createHdWallet newRoot defaultHdAccount defaultHdAddress utxoByAccount =
+createHdWallet newRoot defaultHdAccountId defaultHdAddress utxoByAccount =
     runUpdateDiscardSnapshot . zoom dbHdWallets $ do
-      HD.createHdRoot newRoot defaultHdAccount defaultHdAddress
-      updateAccounts_ $ map mkUpdate (Map.toList utxoByAccount)
+      HD.createHdRoot newRoot
+      updateAccounts_ $ map mkUpdate (Map.toList (insertDefault utxoByAccount))
   where
     mkUpdate :: (HdAccountId, (Utxo, [AddrWithId]))
              -> AccountUpdate HD.CreateHdRootError ()
@@ -460,6 +462,18 @@ createHdWallet newRoot defaultHdAccount defaultHdAddress utxoByAccount =
         , accountUpdate      = return () -- just need to create it, no more
         }
 
+    insertDefault :: Map HdAccountId (Utxo, [AddrWithId])
+                  -> Map HdAccountId (Utxo, [AddrWithId])
+    insertDefault m =
+        let defaultAddr = ( defaultHdAddress ^. hdAddressId
+                          , defaultHdAddress ^. hdAddressAddress . fromDb
+                          )
+        in case Map.lookup defaultHdAccountId m of
+               Just (utxo, addrs) ->
+                   Map.insert defaultHdAccountId (utxo, defaultAddr : addrs) m
+               Nothing ->
+                   Map.insert defaultHdAccountId (mempty, [defaultAddr]) m
+
 -- | Begin restoration by creating an HdWallet with the given HdRoot,
 -- starting from the 'HdAccountOutsideK' state.
 --
@@ -470,17 +484,19 @@ createHdWallet newRoot defaultHdAccount defaultHdAddress utxoByAccount =
 -- definitely we do not want it to show up in our acid-state logs.
 --
 restoreHdWallet :: HdRoot
-                -> HdAccount
-                -- ^ The default HdAccount to go with this HdRoot
+                -> HdAccountId
+                -- ^ The default HdAccountId to go with this HdRoot. This
+                -- function will take responsibility of creating the associated
+                -- 'HdAccount'.
                 -> HdAddress
                 -- ^ The default HdAddress to go with this HdRoot
                 -> Map HdAccountId (Utxo, Utxo, [AddrWithId])
                 -- ^ Current and genesis UTxO per account
                 -> Update DB (Either HD.CreateHdRootError ())
-restoreHdWallet newRoot defaultHdAccount defaultHdAddress utxoByAccount =
+restoreHdWallet newRoot defaultHdAccountId defaultHdAddress utxoByAccount =
     runUpdateDiscardSnapshot . zoom dbHdWallets $ do
-      HD.createHdRoot newRoot defaultHdAccount defaultHdAddress
-      updateAccounts_ $ map mkUpdate (Map.toList utxoByAccount)
+      HD.createHdRoot newRoot
+      updateAccounts_ $ map mkUpdate (Map.toList (insertDefault utxoByAccount))
   where
     mkUpdate :: (HdAccountId, (Utxo, Utxo, [AddrWithId]))
              -> AccountUpdate HD.CreateHdRootError ()
@@ -491,6 +507,18 @@ restoreHdWallet newRoot defaultHdAccount defaultHdAddress utxoByAccount =
         , accountUpdate      = return () -- Create it only
         }
 
+    insertDefault :: Map HdAccountId (Utxo, Utxo, [AddrWithId])
+                  -> Map HdAccountId (Utxo, Utxo, [AddrWithId])
+    insertDefault m =
+        let defaultAddr = ( defaultHdAddress ^. hdAddressId
+                          , defaultHdAddress ^. hdAddressAddress . fromDb
+                          )
+        in case Map.lookup defaultHdAccountId m of
+               Just (utxo, utxo', addrs) ->
+                   Map.insert defaultHdAccountId (utxo, utxo', defaultAddr : addrs) m
+               Nothing ->
+                   Map.insert defaultHdAccountId (mempty, mempty, [defaultAddr]) m
+
 {-------------------------------------------------------------------------------
   Internal: support for updating accounts
 -------------------------------------------------------------------------------}
@@ -593,14 +621,6 @@ updateAccounts_ = mapM_ updateAccount
   Wrap HD C(R)UD operations
 -------------------------------------------------------------------------------}
 
-createHdRoot :: HdRoot
-             -> HdAccount
-             -> HdAddress
-             -> Update DB (Either HD.CreateHdRootError ())
-createHdRoot hdRoot defaultHdAccount defaultHdAddress =
-    runUpdateDiscardSnapshot . zoom dbHdWallets $
-        HD.createHdRoot hdRoot defaultHdAccount defaultHdAddress
-
 createHdAccount :: HdAccount -> Update DB (Either HD.CreateHdAccountError (DB, ()))
 createHdAccount hdAccount = runUpdate' . zoom dbHdWallets $
     HD.createHdAccount hdAccount
@@ -688,7 +708,6 @@ makeAcidic ''DB [
     , 'applyHistoricalBlock
     , 'restorationComplete
       -- Updates on HD wallets
-    , 'createHdRoot
     , 'createHdAddress
     , 'createHdAccount
     , 'createHdWallet
diff --git a/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs b/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
index 8db9f19c626..08098a7e168 100644
--- a/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
+++ b/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
@@ -41,9 +41,6 @@ import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 data CreateHdRootError =
     -- | We already have a wallet with the specified ID
     CreateHdRootExists HdRootId
-  | CreateHdRootDefaultAccountCreationFailed
-  -- ^ There is a serious bug in the logic, as creating a fresh account on
-  -- a fresh wallet should @never@ fail.
   | CreateHdRootDefaultAddressCreationFailed
   -- ^ There is a serious bug in the logic, as creating a fresh address on
   -- a fresh wallet should @never@ fail.
@@ -74,29 +71,12 @@ deriveSafeCopy 1 'base ''CreateHdAddressError
 -------------------------------------------------------------------------------}
 
 -- | Create a new wallet.
--- INVARIANT: Creating a new wallet always come with a fresh HdAccount and
--- a fresh 'HdAddress' attached to it, so we have to pass these two extra
--- piece of into to the update function. We do @not@ build these inside the
--- update function because derivation requires an 'EncryptedSecretKey' and
--- definitely we do not want it to show up in our acid-state logs.
---
-createHdRoot :: HdRoot
-             -> HdAccount
-             -- ^ The default HdAccount to go with this HdRoot
-             -> HdAddress
-             -- ^ The default HdAddress to go with this HdRoot
-             -> Update' CreateHdRootError HdWallets ()
-createHdRoot hdRoot defaultHdAccount defaultHdAddress = do
+createHdRoot :: HdRoot -> Update' CreateHdRootError HdWallets ()
+createHdRoot hdRoot = do
     zoom hdWalletsRoots $ do
       exists <- gets $ IxSet.member rootId
       when exists $ throwError $ CreateHdRootExists rootId
       at rootId .= Just hdRoot
-
-    mapUpdateErrors (const CreateHdRootDefaultAccountCreationFailed) $
-        createHdAccount defaultHdAccount
-    mapUpdateErrors (const CreateHdRootDefaultAddressCreationFailed) $
-        createHdAddress defaultHdAddress
-
   where
     rootId = hdRoot ^. hdRootId
 
@@ -206,8 +186,6 @@ initHdAddress addrId address = HdAddress {
 instance Buildable CreateHdRootError where
     build (CreateHdRootExists rootId)
         = bprint ("CreateHdRootError::CreateHdRootExists "%build) rootId
-    build CreateHdRootDefaultAccountCreationFailed
-        = bprint "Invariant violation! CreateHdRootError::CreateHdRootDefaultAccountCreationFailed"
     build CreateHdRootDefaultAddressCreationFailed
         = bprint "Invariant violation! CreateHdRootError::CreateHdRootDefaultAddressCreationFailed"
 
diff --git a/src/Cardano/Wallet/Kernel/Wallets.hs b/src/Cardano/Wallet/Kernel/Wallets.hs
index 2c50191735c..5ddfc4a52f9 100644
--- a/src/Cardano/Wallet/Kernel/Wallets.hs
+++ b/src/Cardano/Wallet/Kernel/Wallets.hs
@@ -3,7 +3,7 @@ module Cardano.Wallet.Kernel.Wallets (
     , updateHdWallet
     , updatePassword
     , deleteHdWallet
-    , defaultHdAccount
+    , defaultHdAccountId
     , defaultHdAddress
       -- * Errors
     , CreateWalletError(..)
@@ -32,15 +32,13 @@ import qualified Cardano.Wallet.Kernel.BIP39 as BIP39
 import           Cardano.Wallet.Kernel.DB.AcidState (CreateHdWallet (..),
                      DeleteHdRoot (..), RestoreHdWallet,
                      UpdateHdRootPassword (..), UpdateHdWallet (..))
-import           Cardano.Wallet.Kernel.DB.HdWallet (AssuranceLevel, HdAccount,
+import           Cardano.Wallet.Kernel.DB.HdWallet (AssuranceLevel,
                      HdAccountId (..), HdAccountIx (..), HdAddress,
                      HdAddressId (..), HdAddressIx (..), HdRoot, HdRootId,
                      WalletName, eskToHdRootId)
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
 import qualified Cardano.Wallet.Kernel.DB.HdWallet.Create as HD
 import           Cardano.Wallet.Kernel.DB.InDb (InDb (..))
-import           Cardano.Wallet.Kernel.DB.Spec (Checkpoints (..),
-                     initCheckpoint)
 import           Cardano.Wallet.Kernel.Internal (PassiveWallet, walletKeystore,
                      wallets)
 import qualified Cardano.Wallet.Kernel.Keystore as Keystore
@@ -162,9 +160,9 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do
                              esk
                              -- Brand new wallets have no Utxo
                              -- See preconditon above.
-                             (\hdRoot hdAccount hdAddress ->
+                             (\hdRoot hdAccountId hdAddress ->
                                  Left $ CreateHdWallet hdRoot
-                                                       hdAccount
+                                                       hdAccountId
                                                        hdAddress
                                                        mempty
                              )
@@ -185,9 +183,6 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do
          Left e@HD.CreateHdRootDefaultAddressCreationFailed -> do
              Keystore.delete (WalletIdHdRnd newRootId) (pw ^. walletKeystore)
              return . Left $ CreateWalletFailed e
-         Left e@HD.CreateHdRootDefaultAccountCreationFailed -> do
-             Keystore.delete (WalletIdHdRnd newRootId) (pw ^. walletKeystore)
-             return . Left $ CreateWalletFailed e
          Right hdRoot -> return (Right hdRoot)
 
 
@@ -205,7 +200,7 @@ createWalletHdRnd :: PassiveWallet
                   -> AssuranceLevel
                   -> EncryptedSecretKey
                   -> (  HdRoot
-                     -> HdAccount
+                     -> HdAccountId
                      -> HdAddress
                      -> Either CreateHdWallet RestoreHdWallet
                      )
@@ -225,7 +220,7 @@ createWalletHdRnd pw spendingPassword name assuranceLevel esk createWallet = do
          Just hdAddress -> do
              -- We now have all the date we need to atomically generate a new
              -- wallet with a default account & address.
-             res <- case createWallet newRoot (defaultHdAccount rootId) hdAddress of
+             res <- case createWallet newRoot (defaultHdAccountId rootId) hdAddress of
                  Left  create  -> update' (pw ^. wallets) create
                  Right restore -> update' (pw ^. wallets) restore
              return $ either Left (const (Right newRoot)) res
@@ -250,18 +245,6 @@ defaultHdAccountId :: HdRootId -> HdAccountId
 defaultHdAccountId rootId = HdAccountId rootId (HdAccountIx firstHardened)
 
 
-defaultHdAccount :: HdRootId -> HdAccount
-defaultHdAccount rootId =
-    let hdAccountId = defaultHdAccountId rootId
-    in HD.initHdAccount hdAccountId initialAccountState &
-           HD.hdAccountName .~ (HD.AccountName "Default account")
-  where
-    initialAccountState :: HD.HdAccountState
-    initialAccountState = HD.HdAccountStateUpToDate HD.HdAccountUpToDate {
-          _hdUpToDateCheckpoints = Checkpoints . one $ initCheckpoint mempty
-        }
-
-
 
 deleteHdWallet :: PassiveWallet
                -> HD.HdRootId
diff --git a/test/unit/Test/Spec/Addresses.hs b/test/unit/Test/Spec/Addresses.hs
index 742ebd65c3b..2a509ac707a 100644
--- a/test/unit/Test/Spec/Addresses.hs
+++ b/test/unit/Test/Spec/Addresses.hs
@@ -79,11 +79,11 @@ prepareFixtures = do
                           <*> (InDb <$> pick arbitrary)
     newAccountId <- HdAccountId newRootId <$> deriveIndex (pick . choose) HdAccountIx HardDerivation
     let accounts = M.singleton newAccountId mempty
-        hdAccount        = Kernel.defaultHdAccount newRootId
+        hdAccountId      = Kernel.defaultHdAccountId newRootId
         (Just hdAddress) = Kernel.defaultHdAddress esk emptyPassphrase newRootId
 
     return $ \pw -> do
-        void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot hdAccount hdAddress accounts)
+        void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot hdAccountId hdAddress accounts)
         return $ Fixture {
                            fixtureHdRootId = newRootId
                          , fixtureAccountId = AccountIdHdRnd newAccountId
diff --git a/test/unit/Test/Spec/NewPayment.hs b/test/unit/Test/Spec/NewPayment.hs
index f1d35026def..f79116c6b83 100644
--- a/test/unit/Test/Spec/NewPayment.hs
+++ b/test/unit/Test/Spec/NewPayment.hs
@@ -112,10 +112,10 @@ prepareFixtures initialBalance toPay = do
         let pw = Kernel.walletPassive aw
 
         let accounts         = Kernel.prefilterUtxo newRootId esk utxo'
-            hdAccount        = Kernel.defaultHdAccount newRootId
+            hdAccountId      = Kernel.defaultHdAccountId newRootId
             (Just hdAddress) = Kernel.defaultHdAddress esk emptyPassphrase newRootId
 
-        void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot hdAccount hdAddress accounts)
+        void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot hdAccountId hdAddress accounts)
         return $ Fixture {
                            fixtureHdRootId = newRootId
                          , fixtureAccountId = AccountIdHdRnd newAccountId

From bacff82a57f5afdb12d8a8eb6d0190c343cfc209 Mon Sep 17 00:00:00 2001
From: Alfredo Di Napoli 
Date: Wed, 12 Sep 2018 16:39:42 +0200
Subject: [PATCH 10/14] [CBR-419] Address review comments

This commit partially restore (no pun intended) and extend the
'restoreWallet' signature to not take a PassPhrase anymore (which we
won't have during a migration) but take a Cardano Address which will be
used in the companion HdAddress when we create the wallet.
---
 .../Wallet/Kernel/DB/HdWallet/Create.hs       |   5 -
 src/Cardano/Wallet/Kernel/Restore.hs          |  23 +++-
 src/Cardano/Wallet/Kernel/Wallets.hs          | 129 +++++++++++-------
 .../Wallet/WalletLayer/Kernel/Wallets.hs      |  32 +++--
 test/unit/Wallet/Inductive/Cardano.hs         |  14 +-
 5 files changed, 127 insertions(+), 76 deletions(-)

diff --git a/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs b/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
index 08098a7e168..9a05500ad02 100644
--- a/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
+++ b/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
@@ -41,9 +41,6 @@ import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 data CreateHdRootError =
     -- | We already have a wallet with the specified ID
     CreateHdRootExists HdRootId
-  | CreateHdRootDefaultAddressCreationFailed
-  -- ^ There is a serious bug in the logic, as creating a fresh address on
-  -- a fresh wallet should @never@ fail.
 
 -- | Errors thrown by 'createHdAccount'
 data CreateHdAccountError =
@@ -186,8 +183,6 @@ initHdAddress addrId address = HdAddress {
 instance Buildable CreateHdRootError where
     build (CreateHdRootExists rootId)
         = bprint ("CreateHdRootError::CreateHdRootExists "%build) rootId
-    build CreateHdRootDefaultAddressCreationFailed
-        = bprint "Invariant violation! CreateHdRootError::CreateHdRootDefaultAddressCreationFailed"
 
 instance Buildable CreateHdAccountError where
     build (CreateHdAccountUnknownRoot (UnknownHdRoot rootId))
diff --git a/src/Cardano/Wallet/Kernel/Restore.hs b/src/Cardano/Wallet/Kernel/Restore.hs
index 9e08b839d1f..f66053343ab 100644
--- a/src/Cardano/Wallet/Kernel/Restore.hs
+++ b/src/Cardano/Wallet/Kernel/Restore.hs
@@ -51,10 +51,10 @@ import           Pos.Chain.Block (Block, Blund, HeaderHash, MainBlock, Undo,
                      headerHash, mainBlockSlot)
 import           Pos.Chain.Txp (TxIn (..), TxOut (..), TxOutAux (..), Utxo,
                      genesisUtxo)
-import           Pos.Core as Core (BlockCount (..), Coin, Config (..),
+import           Pos.Core as Core (Address, BlockCount (..), Coin, Config (..),
                      GenesisHash, SlotId, flattenSlotId, mkCoin,
                      unsafeIntegerToCoin)
-import           Pos.Crypto (EncryptedSecretKey, PassPhrase)
+import           Pos.Crypto (EncryptedSecretKey)
 import           Pos.DB.Block (getFirstGenesisBlockHash, getUndo,
                      resolveForwardLink)
 import           Pos.DB.Class (getBlock)
@@ -70,25 +70,36 @@ import           Pos.Util.Trace (Severity (Error))
 -- background thread that will asynchronously restore the wallet history.
 --
 -- Wallet initialization parameters match those of 'createWalletHdRnd'
+-- NOTE: We pass in a fresh 'Address' which will be used to initialise the
+-- companion 'HdAccount' this wallet will be created with. The reason why
+-- we do this is that, if we were to use the 'PassPhrase' directly, it would
+-- have been impossible for upstream code dealing with migrations to call
+-- this function, as during migration time you don't have access to the
+-- users' spending passwords.
+-- During migration, instead, you can pick one of the @existing@ addresses
+-- in the legacy wallet layer, and use it as input.
 restoreWallet :: Kernel.PassiveWallet
-              -> PassPhrase
+              -> Bool
+              -- ^ Did this wallet have a spending password set?
+              -> Address
+              -- ^ The stock address to use for the companion 'HdAccount'.
               -> HD.WalletName
               -> HD.AssuranceLevel
               -> EncryptedSecretKey
               -> (Blund -> IO (Map HD.HdAccountId PrefilteredBlock, [TxMeta]))
               -> IO (Either CreateHdRootError (HD.HdRoot, Coin))
-restoreWallet pw spendingPass name assurance esk prefilter = do
+restoreWallet pw hasSpendingPassword defaultCardanoAddress name assurance esk prefilter = do
     coreConfig <- getCoreConfig (pw ^. walletNode)
     walletInitInfo <- withNodeState (pw ^. walletNode) $ getWalletInitInfo coreConfig wkey
     case walletInitInfo of
       WalletCreate utxos -> do
-        root <- createWalletHdRnd pw spendingPass name assurance esk $
+        root <- createWalletHdRnd pw hasSpendingPassword defaultCardanoAddress name assurance esk $
                 \root defaultHdAccount defaultHdAddress ->
                       Left $ CreateHdWallet root defaultHdAccount defaultHdAddress utxos
         return $ fmap (, mkCoin 0) root
       WalletRestore utxos (tgtTip, tgtSlot) -> do
         -- Create the wallet
-        mRoot <- createWalletHdRnd pw spendingPass name assurance esk $
+        mRoot <- createWalletHdRnd pw hasSpendingPassword defaultCardanoAddress name assurance esk $
                  \root defaultHdAccount defaultHdAddress ->
                        Right $ RestoreHdWallet root defaultHdAccount defaultHdAddress utxos
         case mRoot of
diff --git a/src/Cardano/Wallet/Kernel/Wallets.hs b/src/Cardano/Wallet/Kernel/Wallets.hs
index 5ddfc4a52f9..e79b20d82de 100644
--- a/src/Cardano/Wallet/Kernel/Wallets.hs
+++ b/src/Cardano/Wallet/Kernel/Wallets.hs
@@ -4,6 +4,7 @@ module Cardano.Wallet.Kernel.Wallets (
     , updatePassword
     , deleteHdWallet
     , defaultHdAccountId
+    , defaultHdAddressId
     , defaultHdAddress
       -- * Errors
     , CreateWalletError(..)
@@ -21,7 +22,7 @@ import qualified Formatting.Buildable
 
 import           Data.Acid.Advanced (update')
 
-import           Pos.Core (Timestamp)
+import           Pos.Core (Address, Timestamp)
 import           Pos.Crypto (EncryptedSecretKey, PassPhrase,
                      changeEncPassphrase, checkPassMatches, emptyPassphrase,
                      firstHardened, safeDeterministicKeyGen)
@@ -38,7 +39,7 @@ import           Cardano.Wallet.Kernel.DB.HdWallet (AssuranceLevel,
                      WalletName, eskToHdRootId)
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
 import qualified Cardano.Wallet.Kernel.DB.HdWallet.Create as HD
-import           Cardano.Wallet.Kernel.DB.InDb (InDb (..))
+import           Cardano.Wallet.Kernel.DB.InDb (InDb (..), fromDb)
 import           Cardano.Wallet.Kernel.Internal (PassiveWallet, walletKeystore,
                      wallets)
 import qualified Cardano.Wallet.Kernel.Keystore as Keystore
@@ -55,6 +56,9 @@ import           Test.QuickCheck (Arbitrary (..), oneof)
 data CreateWalletError =
       CreateWalletFailed HD.CreateHdRootError
       -- ^ When trying to create the 'Wallet', the DB operation failed.
+    | CreateWalletDefaultAddressDerivationFailed
+    -- ^ When generating the default address for the companion 'HdAddress',
+    -- the derivation failed
 
 instance Arbitrary CreateWalletError where
     arbitrary = oneof []
@@ -62,6 +66,8 @@ instance Arbitrary CreateWalletError where
 instance Buildable CreateWalletError where
     build (CreateWalletFailed dbOperation) =
         bprint ("CreateWalletUnknownHdAccount " % F.build) dbOperation
+    build CreateWalletDefaultAddressDerivationFailed =
+        bprint "CreateWalletDefaultAddressDerivationFailed"
 
 instance Show CreateWalletError where
     show = formatToString build
@@ -151,39 +157,47 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do
     let newRootId = eskToHdRootId esk
     Keystore.insert (WalletIdHdRnd newRootId) esk (pw ^. walletKeystore)
 
-    -- STEP 3: Atomically generate the wallet and the initial internal structure in
-    -- an acid-state transaction.
-    res <- createWalletHdRnd pw
-                             spendingPassword
-                             walletName
-                             assuranceLevel
-                             esk
-                             -- Brand new wallets have no Utxo
-                             -- See preconditon above.
-                             (\hdRoot hdAccountId hdAddress ->
-                                 Left $ CreateHdWallet hdRoot
-                                                       hdAccountId
-                                                       hdAddress
-                                                       mempty
-                             )
-    case res of
-         -- NOTE(adinapoli): This is the @only@ error the DB can return, (modulo
-         -- invariant violations), so we are pattern matching directly on it. In the
-         -- case of more errors being added, carefully thinking would have to
-         -- be put into whether or not we should remove the key from the keystore
-         -- at this point. Surely we don't want to do this in the case the
-         -- wallet already exists, or we would end up deleting the key of the
-         -- existing wallet!
-         -- Fix properly as part of [CBR-404].
-         Left e@(HD.CreateHdRootExists _) ->
-             return . Left $ CreateWalletFailed e
-
-         -- The two errors below are invariant violations. We do want to clean
-         -- up the keystore, and abort.
-         Left e@HD.CreateHdRootDefaultAddressCreationFailed -> do
-             Keystore.delete (WalletIdHdRnd newRootId) (pw ^. walletKeystore)
-             return . Left $ CreateWalletFailed e
-         Right hdRoot -> return (Right hdRoot)
+    -- STEP 2.5: Generate the fresh Cardano Address which will be used for the
+    -- companion 'HdAddress'
+    let mbHdAddress =
+            newHdAddress esk
+                         spendingPassword
+                         (defaultHdAccountId newRootId)
+                         (defaultHdAddressId newRootId)
+    case mbHdAddress of
+        Nothing -> do
+            Keystore.delete (WalletIdHdRnd newRootId) (pw ^. walletKeystore)
+            return $ Left CreateWalletDefaultAddressDerivationFailed
+        Just hdAddress -> do
+            -- STEP 3: Atomically generate the wallet and the initial internal structure in
+            -- an acid-state transaction.
+            res <- createWalletHdRnd pw
+                                     (spendingPassword /= emptyPassphrase)
+                                     (hdAddress ^. HD.hdAddressAddress . fromDb)
+                                     walletName
+                                     assuranceLevel
+                                     esk
+                                     -- Brand new wallets have no Utxo
+                                     -- See preconditon above.
+                                     (\hdRoot hdAccountId hdAddr ->
+                                         Left $ CreateHdWallet hdRoot
+                                                               hdAccountId
+                                                               hdAddr
+                                                               mempty
+                                     )
+            case res of
+                 -- NOTE(adinapoli): This is the @only@ error the DB can return,
+                 -- so we are pattern matching directly on it. In the
+                 -- case of more errors being added, carefully thinking would have to
+                 -- be put into whether or not we should remove the key from the keystore
+                 -- at this point. Surely we don't want to do this in the case the
+                 -- wallet already exists, or we would end up deleting the key of the
+                 -- existing wallet!
+                 -- Fix properly as part of [CBR-404].
+                 Left e@(HD.CreateHdRootExists _) ->
+                     return . Left $ CreateWalletFailed e
+
+                 Right hdRoot -> return (Right hdRoot)
 
 
 -- | Creates an HD wallet where new accounts and addresses are generated
@@ -195,7 +209,10 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do
 -- account and address, both at 'firstHardened' index.
 --
 createWalletHdRnd :: PassiveWallet
-                  -> PassPhrase
+                  -> Bool
+                  -- Does this wallet have a spending password?
+                  -> Address
+                  -- The 'Address' to use for the companion 'HdAddress'.
                   -> HD.WalletName
                   -> AssuranceLevel
                   -> EncryptedSecretKey
@@ -205,32 +222,32 @@ createWalletHdRnd :: PassiveWallet
                      -> Either CreateHdWallet RestoreHdWallet
                      )
                   -> IO (Either HD.CreateHdRootError HdRoot)
-createWalletHdRnd pw spendingPassword name assuranceLevel esk createWallet = do
+createWalletHdRnd pw hasSpendingPassword defaultCardanoAddress name assuranceLevel esk createWallet = do
     created <- InDb <$> getCurrentTimestamp
-    let hasSpendingPassword = spendingPassword /= emptyPassphrase
-        rootId  = eskToHdRootId esk
+    let rootId  = eskToHdRootId esk
         newRoot = HD.initHdRoot rootId
                                 name
-                                (hdSpendingPassword hasSpendingPassword created)
+                                (hdSpendingPassword created)
                                 assuranceLevel
                                 created
 
-    case defaultHdAddress esk spendingPassword rootId of
-         Nothing -> return (Left HD.CreateHdRootDefaultAddressCreationFailed)
-         Just hdAddress -> do
-             -- We now have all the date we need to atomically generate a new
-             -- wallet with a default account & address.
-             res <- case createWallet newRoot (defaultHdAccountId rootId) hdAddress of
-                 Left  create  -> update' (pw ^. wallets) create
-                 Right restore -> update' (pw ^. wallets) restore
-             return $ either Left (const (Right newRoot)) res
+        hdAddress = defaultHdAddressWith rootId defaultCardanoAddress
+
+    -- We now have all the date we need to atomically generate a new
+    -- wallet with a default account & address.
+    res <- case createWallet newRoot (defaultHdAccountId rootId) hdAddress of
+        Left  create  -> update' (pw ^. wallets) create
+        Right restore -> update' (pw ^. wallets) restore
+    return $ either Left (const (Right newRoot)) res
     where
 
-        hdSpendingPassword :: Bool -> InDb Timestamp -> HD.HasSpendingPassword
-        hdSpendingPassword hasSpendingPassword created =
+        hdSpendingPassword :: InDb Timestamp -> HD.HasSpendingPassword
+        hdSpendingPassword created =
             if hasSpendingPassword then HD.HasSpendingPassword created
                                    else HD.NoSpendingPassword
 
+-- | Creates a default 'HdAddress' at a fixed derivation path. This is
+-- useful for tests, but otherwise you may want to use 'defaultHdAddressWith'.
 defaultHdAddress :: EncryptedSecretKey
                  -> PassPhrase
                  -> HD.HdRootId
@@ -240,10 +257,20 @@ defaultHdAddress esk spendingPassword rootId =
         hdAddressId = HdAddressId hdAccountId (HdAddressIx firstHardened)
     in newHdAddress esk spendingPassword hdAccountId hdAddressId
 
+-- | Given a Cardano 'Address', it returns a default 'HdAddress' at a fixed
+-- and predictable generation path.
+defaultHdAddressWith :: HD.HdRootId -> Address -> HdAddress
+defaultHdAddressWith rootId cardanoAddress =
+    let hdAccountId = defaultHdAccountId rootId
+        hdAddressId = HdAddressId hdAccountId (HdAddressIx firstHardened)
+    in HD.HdAddress hdAddressId (InDb cardanoAddress)
 
 defaultHdAccountId :: HdRootId -> HdAccountId
 defaultHdAccountId rootId = HdAccountId rootId (HdAccountIx firstHardened)
 
+defaultHdAddressId :: HdRootId -> HdAddressId
+defaultHdAddressId rootId =
+    HdAddressId (defaultHdAccountId rootId) (HdAddressIx firstHardened)
 
 
 deleteHdWallet :: PassiveWallet
diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs
index deed9127cad..e1b7511cd5c 100644
--- a/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs
+++ b/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs
@@ -12,6 +12,7 @@ module Cardano.Wallet.WalletLayer.Kernel.Wallets (
 
 import           Universum
 
+import           Control.Monad.Except (throwError)
 import           Data.Coerce (coerce)
 import qualified Data.Map as M
 import           Data.Maybe (fromJust)
@@ -24,6 +25,7 @@ import           Pos.Crypto.Signing
 
 import           Cardano.Wallet.API.V1.Types (V1 (..))
 import qualified Cardano.Wallet.API.V1.Types as V1
+import           Cardano.Wallet.Kernel.Addresses (newHdAddress)
 import qualified Cardano.Wallet.Kernel.BIP39 as BIP39
 import           Cardano.Wallet.Kernel.DB.AcidState (dbHdWallets)
 import           Cardano.Wallet.Kernel.DB.BlockContext
@@ -115,18 +117,26 @@ createWallet wallet newWalletRequest = liftIO $ do
                     Nothing -> (M.empty, [])
                     Just rb -> prefilterBlock rb wId esk
 
-        (root, coins) <- withExceptT (CreateWalletError . Kernel.CreateWalletFailed) $ ExceptT $
-            restoreWallet
-              wallet
-              pwd
-              (HD.WalletName walletName)
-              hdAssuranceLevel
-              esk
-              prefilter
+            mbHdAddress = newHdAddress esk
+                                       pwd
+                                       (Kernel.defaultHdAccountId rootId)
+                                       (Kernel.defaultHdAddressId rootId)
+        case mbHdAddress of
+            Nothing -> throwError (CreateWalletError Kernel.CreateWalletDefaultAddressDerivationFailed)
+            Just hdAddress -> do
+                (root, coins) <- withExceptT (CreateWalletError . Kernel.CreateWalletFailed) $ ExceptT $
+                    restoreWallet
+                      wallet
+                      (pwd /= emptyPassphrase)
+                      (hdAddress ^. HD.hdAddressAddress . fromDb)
+                      (HD.WalletName walletName)
+                      hdAssuranceLevel
+                      esk
+                      prefilter
 
-        -- Return the wallet information, with an updated balance.
-        let root' = mkRoot walletName (toAssuranceLevel hdAssuranceLevel) now root
-        updateSyncState wallet wId (root' { V1.walBalance = V1 coins })
+                -- Return the wallet information, with an updated balance.
+                let root' = mkRoot walletName (toAssuranceLevel hdAssuranceLevel) now root
+                updateSyncState wallet wId (root' { V1.walBalance = V1 coins })
 
     mkRoot :: Text -> V1.AssuranceLevel -> Timestamp -> HD.HdRoot -> V1.Wallet
     mkRoot v1WalletName v1AssuranceLevel now hdRoot = V1.Wallet {
diff --git a/test/unit/Wallet/Inductive/Cardano.hs b/test/unit/Wallet/Inductive/Cardano.hs
index 8430da6d74c..1462a8355bf 100644
--- a/test/unit/Wallet/Inductive/Cardano.hs
+++ b/test/unit/Wallet/Inductive/Cardano.hs
@@ -27,9 +27,11 @@ import           Pos.Core (HasConfiguration, Timestamp (..))
 import           Pos.Core.Chrono
 import           Pos.Crypto (EncryptedSecretKey, emptyPassphrase)
 
+import qualified Cardano.Wallet.Kernel.Addresses as Kernel
 import qualified Cardano.Wallet.Kernel.BListener as Kernel
 import qualified Cardano.Wallet.Kernel.DB.AcidState as DB
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
+import           Cardano.Wallet.Kernel.DB.InDb (fromDb)
 import qualified Cardano.Wallet.Kernel.Internal as Internal
 import           Cardano.Wallet.Kernel.Invariants as Kernel
 import qualified Cardano.Wallet.Kernel.Keystore as Keystore
@@ -217,17 +219,23 @@ equivalentT useWW activeWallet esk = \mkWallet w ->
                 -> Utxo
                 -> TranslateT EquivalenceViolation m HD.HdAccountId
     walletBootT ctxt utxo = do
+        let newRootId = HD.eskToHdRootId esk
+        let (Just defaultAddress) = Kernel.newHdAddress esk
+                                                        emptyPassphrase
+                                                        (Kernel.defaultHdAccountId newRootId)
+                                                        (Kernel.defaultHdAddressId newRootId)
         res <- liftIO $
           Kernel.createWalletHdRnd
             passiveWallet
-            emptyPassphrase
+            False
+            (defaultAddress ^. HD.hdAddressAddress . fromDb)
             walletName
             assuranceLevel
             esk
-            (\root defaultAccount defaultAddress ->
+            (\root defaultAccount defAddress ->
                 Left $ DB.CreateHdWallet root
                                          defaultAccount
-                                         defaultAddress
+                                         defAddress
                                          (prefilterUtxo (root ^. HD.hdRootId) esk utxo)
             )
         case res of

From fd9ba33b40b1fc854c92e440f745ecb9801f0284 Mon Sep 17 00:00:00 2001
From: Alfredo Di Napoli 
Date: Wed, 12 Sep 2018 17:22:24 +0200
Subject: [PATCH 11/14] [CBR-419] Remove a call to Keystore.delete

---
 src/Cardano/Wallet/Kernel/Wallets.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/src/Cardano/Wallet/Kernel/Wallets.hs b/src/Cardano/Wallet/Kernel/Wallets.hs
index e79b20d82de..a0b692453dc 100644
--- a/src/Cardano/Wallet/Kernel/Wallets.hs
+++ b/src/Cardano/Wallet/Kernel/Wallets.hs
@@ -166,7 +166,15 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do
                          (defaultHdAddressId newRootId)
     case mbHdAddress of
         Nothing -> do
-            Keystore.delete (WalletIdHdRnd newRootId) (pw ^. walletKeystore)
+            -- Here, ideally, we would like to do some cleanup and call
+            -- >>> Keystore.delete (WalletIdHdRnd newRootId) (pw ^. walletKeystore)
+            -- However, this wouldn't be correct in case, for example, the user
+            -- is trying to create the same wallet twice. In that case we would
+            -- wipe a pre-existing, perfectly valid key!
+            -- The solution to this and other problems will be provided with [CBR-404].
+            -- For the moment, the less evil solution is to simply allow dangling
+            -- keys in the keystore. Being 'Keystore.insert' idempotent, doing so
+            -- won't compromise using the wallet.
             return $ Left CreateWalletDefaultAddressDerivationFailed
         Just hdAddress -> do
             -- STEP 3: Atomically generate the wallet and the initial internal structure in

From 97d9ebba41f5b8077abc1ba9d060ef9255b483b6 Mon Sep 17 00:00:00 2001
From: Rupert Horlick 
Date: Wed, 5 Sep 2018 09:33:34 -0400
Subject: [PATCH 12/14] [CDEC-509] Remove HasCoreConfiguration and
 dbSerializeVersion

---
 server/Main.hs                                | 52 +++++++++----------
 .../Wallet/API/Internal/LegacyHandlers.hs     |  3 +-
 .../Wallet/API/V1/LegacyHandlers/Accounts.hs  |  4 +-
 .../Wallet/API/V1/LegacyHandlers/Info.hs      |  4 +-
 .../Wallet/API/V1/LegacyHandlers/Wallets.hs   |  3 +-
 src/Cardano/Wallet/API/V1/Migration.hs        |  2 -
 src/Cardano/Wallet/API/WIP/LegacyHandlers.hs  |  6 +--
 src/Cardano/Wallet/Kernel/Mode.hs             | 11 ++--
 src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs |  4 +-
 src/Cardano/Wallet/Server/LegacyPlugins.hs    |  4 +-
 test/unit/UTxO/Interpreter.hs                 |  7 ++-
 test/unit/UTxO/Translate.hs                   |  7 +--
 test/unit/Wallet/Inductive/Cardano.hs         |  6 +--
 13 files changed, 47 insertions(+), 66 deletions(-)

diff --git a/server/Main.hs b/server/Main.hs
index 182bd9dc8d6..3f0e5e2b78c 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -200,44 +200,42 @@ actionWithWallet coreConfig txpConfig sscParams nodeParams ntpConfig params =
 -- | Runs an edge node plus its wallet backend API.
 startEdgeNode :: HasCompileInfo => WalletStartupOptions -> IO ()
 startEdgeNode wso =
-    withConfigurations blPath conf $ \coreConfig txpConfig ntpConfig -> do
-        (sscParams, nodeParams) <- getParameters coreConfig txpConfig ntpConfig
-        case wsoWalletBackendParams wso of
-            WalletLegacy legacyParams -> actionWithLegacyWallet
-                coreConfig
-                txpConfig
-                sscParams
-                nodeParams
-                ntpConfig
-                legacyParams
-            WalletNew newParams -> actionWithWallet
-                coreConfig
-                txpConfig
-                sscParams
-                nodeParams
-                ntpConfig
-                newParams
+    withConfigurations blPath dumpGenesisPath dumpConfiguration conf
+        $ \coreConfig txpConfig ntpConfig -> do
+              (sscParams, nodeParams) <- getParameters coreConfig
+              case wsoWalletBackendParams wso of
+                  WalletLegacy legacyParams -> actionWithLegacyWallet
+                      coreConfig
+                      txpConfig
+                      sscParams
+                      nodeParams
+                      ntpConfig
+                      legacyParams
+                  WalletNew newParams -> actionWithWallet coreConfig
+                                                          txpConfig
+                                                          sscParams
+                                                          nodeParams
+                                                          ntpConfig
+                                                          newParams
   where
-    getParameters :: HasConfigurations
-                  => Core.Config
-                  -> TxpConfiguration
-                  -> NtpConfiguration
-                  -> IO (SscParams, NodeParams)
-    getParameters coreConfig txpConfig ntpConfig = do
+    getParameters :: Core.Config -> IO (SscParams, NodeParams)
+    getParameters coreConfig = do
 
       (currentParams, Just gtParams) <- CLI.getNodeParams defaultLoggerName
                                          (wsoNodeArgs wso)
                                          nodeArgs
                                          (configGeneratedSecrets coreConfig)
 
-      CLI.printInfoOnStart (wsoNodeArgs wso)
-                           (configGenesisData coreConfig)
-                           ntpConfig
-                           txpConfig
       logInfo "Wallet is enabled!"
 
       return (gtParams, currentParams)
 
+    dumpGenesisPath :: Maybe FilePath
+    dumpGenesisPath = CLI.cnaDumpGenesisDataPath (wsoNodeArgs wso)
+
+    dumpConfiguration :: Bool
+    dumpConfiguration = CLI.cnaDumpConfiguration (wsoNodeArgs wso)
+
     conf :: ConfigurationOptions
     conf = CLI.configurationOptions $ CLI.commonArgs (wsoNodeArgs wso)
 
diff --git a/src/Cardano/Wallet/API/Internal/LegacyHandlers.hs b/src/Cardano/Wallet/API/Internal/LegacyHandlers.hs
index b2cde6ec140..35ead1a0be8 100644
--- a/src/Cardano/Wallet/API/Internal/LegacyHandlers.hs
+++ b/src/Cardano/Wallet/API/Internal/LegacyHandlers.hs
@@ -36,7 +36,7 @@ import           Cardano.Wallet.Server.CLI (RunMode (..), isDebugMode)
 -- | Until we depend from V0 logic to implement the each 'Handler' we
 -- still need the natural transformation here.
 handlers
-    :: (HasConfiguration, HasUpdateConfiguration)
+    :: HasUpdateConfiguration
     => (forall a. MonadV1 a -> Handler a)
     -> Core.Config
     -> RunMode
@@ -53,7 +53,6 @@ handlers naturalTransformation coreConfig runMode =
         hoistServer (Proxy @Internal.API) naturalTransformation handlers'
 
 nextUpdate :: ( MonadIO m
-              , HasConfiguration
               , MonadThrow m
               , V0.WalletDbReader ctx m
               , HasUpdateConfiguration
diff --git a/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs b/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs
index 1e34185fa78..fca09339662 100644
--- a/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs
+++ b/src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs
@@ -19,9 +19,7 @@ import           Cardano.Wallet.API.V1.Migration
 import           Cardano.Wallet.API.V1.Types
 import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 
-handlers
-    :: HasConfigurations
-    => ServerT Accounts.API MonadV1
+handlers :: ServerT Accounts.API MonadV1
 handlers =
          deleteAccount
     :<|> getAccount
diff --git a/src/Cardano/Wallet/API/V1/LegacyHandlers/Info.hs b/src/Cardano/Wallet/API/V1/LegacyHandlers/Info.hs
index 05a27fb75be..3a85bf04145 100644
--- a/src/Cardano/Wallet/API/V1/LegacyHandlers/Info.hs
+++ b/src/Cardano/Wallet/API/V1/LegacyHandlers/Info.hs
@@ -21,9 +21,7 @@ import qualified Pos.Wallet.Web.ClientTypes.Types as V0
 import qualified Pos.Wallet.Web.Methods.Misc as V0
 
 -- | All the @Servant@ handlers for settings-specific operations.
-handlers :: ( HasConfigurations
-            )
-         => Diffusion MonadV1
+handlers :: Diffusion MonadV1
          -> TVar NtpStatus
          -> ServerT Info.API MonadV1
 handlers = getInfo
diff --git a/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs b/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs
index a56159e1ad3..d626019ff6d 100644
--- a/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs
+++ b/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs
@@ -34,8 +34,7 @@ import           Servant
 
 
 -- | All the @Servant@ handlers for wallet-specific operations.
-handlers :: HasConfigurations
-         => Core.Config -> ServerT Wallets.API MonadV1
+handlers :: Core.Config -> ServerT Wallets.API MonadV1
 handlers coreConfig = newWallet coreConfig
     :<|> listWallets
     :<|> updatePassword
diff --git a/src/Cardano/Wallet/API/V1/Migration.hs b/src/Cardano/Wallet/API/V1/Migration.hs
index b99457f7056..2030d644f7a 100644
--- a/src/Cardano/Wallet/API/V1/Migration.hs
+++ b/src/Cardano/Wallet/API/V1/Migration.hs
@@ -5,7 +5,6 @@ module Cardano.Wallet.API.V1.Migration (
     -- * Configuration re-exports
     , HasCompileInfo
     , HasConfigurations
-    , HasConfiguration
     , HasSscConfiguration
     , HasUpdateConfiguration
     , HasNodeConfiguration
@@ -17,6 +16,5 @@ import           Cardano.Wallet.API.V1.Migration.Types as Exports
 import           Pos.Chain.Ssc (HasSscConfiguration)
 import           Pos.Chain.Update (HasUpdateConfiguration)
 import           Pos.Configuration (HasNodeConfiguration)
-import           Pos.Core.Configuration (HasConfiguration)
 import           Pos.Launcher.Configuration (HasConfigurations)
 import           Pos.Util.CompileInfo (HasCompileInfo)
diff --git a/src/Cardano/Wallet/API/WIP/LegacyHandlers.hs b/src/Cardano/Wallet/API/WIP/LegacyHandlers.hs
index 4556b7953ba..1df07fb11b6 100644
--- a/src/Cardano/Wallet/API/WIP/LegacyHandlers.hs
+++ b/src/Cardano/Wallet/API/WIP/LegacyHandlers.hs
@@ -37,8 +37,7 @@ import           Pos.Wallet.Web.Tracking.Types (SyncQueue)
 import           Pos.Wallet.Web.Util (getWalletAccountIds)
 import           Servant
 
-handlers :: HasConfigurations
-            => (forall a. MonadV1 a -> Handler a)
+handlers :: (forall a. MonadV1 a -> Handler a)
             -> Core.Config
             -> TxpConfiguration
             -> Diffusion MonadV1
@@ -55,8 +54,7 @@ handlers naturalTransformation coreConfig txpConfig diffusion =
     submitTx = sendTx diffusion
 
 -- | All the @Servant@ handlers for wallet-specific operations.
-handlersPlain :: HasConfigurations
-         => Core.Config
+handlersPlain :: Core.Config
          -> TxpConfiguration
          -> (TxAux -> MonadV1 Bool)
          -> ServerT WIP.API MonadV1
diff --git a/src/Cardano/Wallet/Kernel/Mode.hs b/src/Cardano/Wallet/Kernel/Mode.hs
index 08713648675..b2be64b99c5 100644
--- a/src/Cardano/Wallet/Kernel/Mode.hs
+++ b/src/Cardano/Wallet/Kernel/Mode.hs
@@ -14,7 +14,7 @@ import           Universum
 import           Pos.Chain.Block
 import           Pos.Chain.Txp
 import           Pos.Context
-import           Pos.Core as Core (Config, HasConfiguration)
+import           Pos.Core as Core (Config)
 import           Pos.Core.Chrono
 import           Pos.Core.JsonLog (CanJsonLog (..))
 import           Pos.Core.Reporting (HasMisbehaviorMetrics (..))
@@ -164,14 +164,14 @@ instance {-# OVERLAPPABLE #-}
 
 type instance MempoolExt WalletMode = EmptyMempoolExt
 
-instance HasConfiguration => MonadDBRead WalletMode where
+instance MonadDBRead WalletMode where
   dbGet         = dbGetDefault
   dbIterSource  = dbIterSourceDefault
   dbGetSerBlock = dbGetSerBlockRealDefault
   dbGetSerUndo  = dbGetSerUndoRealDefault
   dbGetSerBlund  = dbGetSerBlundRealDefault
 
-instance HasConfiguration => MonadDB WalletMode where
+instance MonadDB WalletMode where
   dbPut         = dbPutDefault
   dbWriteBatch  = dbWriteBatchDefault
   dbDelete      = dbDeleteDefault
@@ -183,14 +183,13 @@ instance MonadSlotsData ctx WalletMode => MonadSlots ctx WalletMode where
   getCurrentSlotInaccurate = getCurrentSlotInaccurateSimple
   currentTimeSlotting      = currentTimeSlottingSimple
 
-instance HasConfiguration => MonadGState WalletMode where
+instance MonadGState WalletMode where
   gsAdoptedBVData = gsAdoptedBVDataDefault
 
 instance {-# OVERLAPPING #-} CanJsonLog WalletMode where
   jsonLog = jsonLogDefault
 
-instance HasConfiguration
-      => MonadTxpLocal WalletMode where
+instance MonadTxpLocal WalletMode where
   txpNormalize = txNormalize
   txpProcessTx = txProcessTransaction
 
diff --git a/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs b/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs
index b202e3bbe4c..c36ab7ad2f0 100644
--- a/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs
+++ b/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs
@@ -75,7 +75,6 @@ import           Pos.Core as Core (BlockCount, Config (..), GenesisHash (..),
                      SlotCount, Timestamp (..), TxFeePolicy,
                      configBlockVersionData, configEpochSlots, configK,
                      difficultyL, getChainDifficulty)
-import           Pos.Core.Configuration (HasConfiguration)
 import           Pos.Core.Slotting (EpochIndex (..), HasSlottingVar (..),
                      LocalSlotIndex (..), MonadSlots (..), SlotId (..))
 import qualified Pos.DB.Block as DB
@@ -170,8 +169,7 @@ type Lock m = forall a. LockContext -> (HeaderHash -> m a) -> m a
 -- Using 'NodeConstraints' in such functions isolates these functions from
 -- changes to the type classes used in the underlying node.
 type NodeConstraints = (
-      HasConfiguration
-    , HasUpdateConfiguration
+      HasUpdateConfiguration
     , HasCompileInfo
     )
 
diff --git a/src/Cardano/Wallet/Server/LegacyPlugins.hs b/src/Cardano/Wallet/Server/LegacyPlugins.hs
index 62a2d832344..7c71e0e8bea 100644
--- a/src/Cardano/Wallet/Server/LegacyPlugins.hs
+++ b/src/Cardano/Wallet/Server/LegacyPlugins.hs
@@ -202,11 +202,11 @@ resubmitterPlugin coreConfig txpConfig = [\diffusion -> askWalletDB >>= \db ->
                         startPendingTxsResubmitter coreConfig txpConfig db (sendTx diffusion)]
 
 -- | A @Plugin@ to notify frontend via websockets.
-notifierPlugin :: HasConfigurations => Plugin WalletWebMode
+notifierPlugin :: Plugin WalletWebMode
 notifierPlugin = [const V0.notifierPlugin]
 
 -- | The @Plugin@ responsible for the restoration & syncing of a wallet.
-syncWalletWorker :: HasConfigurations => Core.Config -> Plugin WalletWebMode
+syncWalletWorker :: Core.Config -> Plugin WalletWebMode
 syncWalletWorker coreConfig = pure $ const $
     modifyLoggerName (const "syncWalletWorker") $
     (view (lensOf @SyncQueue) >>= processSyncRequest coreConfig)
diff --git a/test/unit/UTxO/Interpreter.hs b/test/unit/UTxO/Interpreter.hs
index b97f98069ba..9019d65fe04 100644
--- a/test/unit/UTxO/Interpreter.hs
+++ b/test/unit/UTxO/Interpreter.hs
@@ -289,8 +289,7 @@ runIntBoot' boot = mapTranslateErrors mustBeLeft . runIntBoot boot
 
 -- | Convenience function to list actions in the 'Translate' monad
 liftTranslateInt :: Monad m
-                 => (   (HasConfiguration, HasUpdateConfiguration)
-                     => TranslateT IntException m a)
+                 => (HasUpdateConfiguration => TranslateT IntException m a)
                  -> IntT h e m a
 liftTranslateInt ta =  IntT $ lift $ mapTranslateErrors Left $ withConfig $ ta
 
@@ -353,7 +352,7 @@ popIntCheckpoint = do
 -- The function runs in the underlying 'Translate' monad so that it is not tempted
 -- to use state it shouldn't.
 pushCheckpoint :: Monad m
-                => (    (HasConfiguration, HasUpdateConfiguration)
+                => (    HasUpdateConfiguration
                      => IntCheckpoint
                      -> SlotId
                      -> TranslateT IntException m (IntCheckpoint, a))
@@ -399,7 +398,7 @@ updateStakes :: forall m. MonadError IntException m
              -> ResolvedBlock
              -> StakesMap -> m StakesMap
 updateStakes gs (ResolvedBlock txs _ _) =
-    foldr (>=>) return $ map go txs
+    foldr ((>=>) . go) return txs
   where
     go :: ResolvedTx -> StakesMap -> m StakesMap
     go (ResolvedTx ins outs _) =
diff --git a/test/unit/UTxO/Translate.hs b/test/unit/UTxO/Translate.hs
index c06a787e7f4..2a7809612e2 100644
--- a/test/unit/UTxO/Translate.hs
+++ b/test/unit/UTxO/Translate.hs
@@ -67,7 +67,6 @@ import           Test.Pos.Configuration (withDefConfiguration,
 -- 'CardanoContext' instead.
 data TranslateEnv = TranslateEnv {
       teContext :: TransCtxt
-    , teConfig  :: Dict HasConfiguration
     , teUpdate  :: Dict HasUpdateConfiguration
     }
 
@@ -108,7 +107,6 @@ runTranslateT (TranslateT ta) =
       let env :: TranslateEnv
           env = TranslateEnv {
                     teContext = initContext (initCardanoContext coreConfig)
-                  , teConfig  = Dict
                   , teUpdate  = Dict
                   }
       in do ma <- runReaderT (runExceptT ta) env
@@ -130,10 +128,9 @@ runTranslateNoErrors = runTranslate
 
 -- | Lift functions that want the configuration as type class constraints
 withConfig :: Monad m
-           => ((HasConfiguration, HasUpdateConfiguration) => TranslateT e m a)
+           => (HasUpdateConfiguration => TranslateT e m a)
            -> TranslateT e m a
 withConfig f = do
-    Dict <- TranslateT $ asks teConfig
     Dict <- TranslateT $ asks teUpdate
     f
 
@@ -185,7 +182,7 @@ translateGenesisHeader = view gbHeader <$> asks (ccBlock0 . tcCardano)
 
 -- | Run the verifier
 verify :: Monad m
-       => (HasConfiguration => Verify e a)
+       => Verify e a
        -> TranslateT e' m (Validated e (a, Utxo))
 verify ma = withConfig $ do
     utxo <- asks (ccUtxo . tcCardano)
diff --git a/test/unit/Wallet/Inductive/Cardano.hs b/test/unit/Wallet/Inductive/Cardano.hs
index 1462a8355bf..407155c03ae 100644
--- a/test/unit/Wallet/Inductive/Cardano.hs
+++ b/test/unit/Wallet/Inductive/Cardano.hs
@@ -23,7 +23,7 @@ import           Formatting (bprint, build, formatToString, sformat, (%))
 import qualified Formatting.Buildable
 
 import           Pos.Chain.Txp (Utxo, formatUtxo)
-import           Pos.Core (HasConfiguration, Timestamp (..))
+import           Pos.Core (Timestamp (..))
 import           Pos.Core.Chrono
 import           Pos.Crypto (EncryptedSecretKey, emptyPassphrase)
 
@@ -66,10 +66,10 @@ data EventCallbacks h m = EventCallbacks {
       -- The callback is given the translated UTxO of the bootstrap
       -- transaction (we cannot give it the translated transaction because
       -- we cannot translate the bootstrap transaction).
-      walletBootT :: HasConfiguration => InductiveCtxt h -> Utxo -> m HD.HdAccountId
+      walletBootT :: InductiveCtxt h -> Utxo -> m HD.HdAccountId
 
       -- | Apply a block
-    , walletApplyBlockT :: HasConfiguration => InductiveCtxt h -> HD.HdAccountId -> RawResolvedBlock -> m ()
+    , walletApplyBlockT :: InductiveCtxt h -> HD.HdAccountId -> RawResolvedBlock -> m ()
 
       -- | Insert new pending transaction
     , walletNewPendingT :: InductiveCtxt h -> HD.HdAccountId -> RawResolvedTx -> m ()

From 803023a860d7897da37c9bdc129bff4d3608a0a3 Mon Sep 17 00:00:00 2001
From: KtorZ 
Date: Thu, 13 Sep 2018 07:07:32 +0200
Subject: [PATCH 13/14] [CBR-427] Make NtpCheck non-blocking unless explicitly
 forced

When implementing the new data-layer 'node-info' handler, we've made the
choice to have the underlying check for NtpStatus blocking /
synchronous. This choices is usually fine as the check normally takes
around ~100ms. However, when running on CI, we do not connect to the
Internet and therefore, will always timeout for those check.  This could
be the cause for the integration tests bootstrap not syncing properly
(not telling us about it).
---
 src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs | 62 ++++++++++++++-----
 1 file changed, 47 insertions(+), 15 deletions(-)

diff --git a/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs b/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs
index b202e3bbe4c..04d17e882ab 100644
--- a/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs
+++ b/src/Cardano/Wallet/Kernel/NodeStateAdaptor.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE ConstraintKinds            #-}
 {-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE RankNTypes                 #-}
 
 module Cardano.Wallet.Kernel.NodeStateAdaptor (
@@ -488,28 +489,59 @@ waitForUpdate = liftIO . takeMVar =<< asks l
     l :: Res -> MVar ConfirmedProposalState
     l = ucDownloadedUpdate . view lensOf'
 
+
 -- | Get the difference between NTP time and local system time, nothing if the
 -- NTP server couldn't be reached in the last 30min.
 --
 -- Note that one can force a new query to the NTP server in which case, it may
 -- take up to 30s to resolve.
-defaultGetNtpDrift :: MonadIO m => TVar NtpStatus -> V1.ForceNtpCheck -> m V1.TimeInfo
-defaultGetNtpDrift tvar ntpCheckBehavior = liftIO $ do
-    when (ntpCheckBehavior == V1.ForceNtpCheck) $
-        atomically $ writeTVar tvar NtpSyncPending
-    mkTimeInfo <$> waitForNtpStatus
+defaultGetNtpDrift
+    :: MonadIO m
+    => TVar NtpStatus
+    -> V1.ForceNtpCheck
+    -> m V1.TimeInfo
+defaultGetNtpDrift tvar ntpCheckBehavior = liftIO $ mkTimeInfo <$>
+    if (ntpCheckBehavior == V1.ForceNtpCheck) then
+        forceNtpCheck >> getNtpOffset blockingLookupNtpOffset
+    else
+        getNtpOffset nonBlockingLookupNtpOffset
   where
+    forceNtpCheck :: MonadIO m => m ()
+    forceNtpCheck =
+        atomically $ writeTVar tvar NtpSyncPending
+
+    getNtpOffset :: MonadIO m => (NtpStatus -> STM (Maybe NtpOffset)) -> m (Maybe NtpOffset)
+    getNtpOffset lookupNtpOffset =
+        atomically $ (readTVar tvar >>= lookupNtpOffset)
+
     mkTimeInfo :: Maybe NtpOffset -> V1.TimeInfo
-    mkTimeInfo = V1.TimeInfo . fmap (V1.mkLocalTimeDifference . toMicroseconds)
-
-    -- NOTE This usually takes ~100-300ms and at most 30s
-    waitForNtpStatus :: MonadIO m => m (Maybe NtpOffset)
-    waitForNtpStatus = atomically $ do
-        status <- readTVar tvar
-        case status of
-            NtpSyncPending     -> retry
-            NtpDrift offset    -> pure (Just offset)
-            NtpSyncUnavailable -> pure Nothing
+    mkTimeInfo =
+        V1.TimeInfo . fmap (V1.mkLocalTimeDifference . toMicroseconds)
+
+
+-- Lookup NtpOffset from an NTPStatus in a non-blocking manner
+--
+-- i.e. Returns immediately with 'Nothing' if the NtpSync is pending.
+nonBlockingLookupNtpOffset
+    :: NtpStatus
+    -> STM (Maybe NtpOffset)
+nonBlockingLookupNtpOffset = \case
+    NtpSyncPending     -> pure Nothing
+    NtpDrift offset    -> pure (Just offset)
+    NtpSyncUnavailable -> pure Nothing
+
+
+-- Lookup NtpOffset from an NTPStatus in a blocking manner, this usually
+-- take ~100ms
+--
+-- i.e. Wait (at most 30s) for the NtpSync to resolve if pending
+blockingLookupNtpOffset
+    :: NtpStatus
+    -> STM (Maybe NtpOffset)
+blockingLookupNtpOffset = \case
+    NtpSyncPending     -> retry
+    NtpDrift offset    -> pure (Just offset)
+    NtpSyncUnavailable -> pure Nothing
 
 
 -- | Get the most recent main block starting at the specified header

From 19b41ce22d89349e1cbcce983116bee08824861e Mon Sep 17 00:00:00 2001
From: Alfredo Di Napoli 
Date: Thu, 13 Sep 2018 13:26:38 +0200
Subject: [PATCH 14/14] [CBR-419] Enforce invariant on defaultHdAddressWith

This commit enforces that when we build a new 'HdAddress' out of an
Address, we decrypt the HD payload contained within and we use it to
retrieve the derivation path for both the newly-generated 'HdAddress'
and the parent 'HdAccount'.
---
 .../Wallet/Kernel/DB/HdWallet/Create.hs       |  3 ++
 src/Cardano/Wallet/Kernel/Decrypt.hs          | 20 +++++++++
 src/Cardano/Wallet/Kernel/Wallets.hs          | 41 ++++++++++++-------
 3 files changed, 50 insertions(+), 14 deletions(-)

diff --git a/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs b/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
index 9a05500ad02..e33973a2f78 100644
--- a/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
+++ b/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs
@@ -41,6 +41,7 @@ import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 data CreateHdRootError =
     -- | We already have a wallet with the specified ID
     CreateHdRootExists HdRootId
+  | CreateHdRootDefaultAddressDerivationFailed
 
 -- | Errors thrown by 'createHdAccount'
 data CreateHdAccountError =
@@ -183,6 +184,8 @@ initHdAddress addrId address = HdAddress {
 instance Buildable CreateHdRootError where
     build (CreateHdRootExists rootId)
         = bprint ("CreateHdRootError::CreateHdRootExists "%build) rootId
+    build CreateHdRootDefaultAddressDerivationFailed
+        = bprint "CreateHdRootError::CreateHdRootDefaultAddressDerivationFailed"
 
 instance Buildable CreateHdAccountError where
     build (CreateHdAccountUnknownRoot (UnknownHdRoot rootId))
diff --git a/src/Cardano/Wallet/Kernel/Decrypt.hs b/src/Cardano/Wallet/Kernel/Decrypt.hs
index e13c97a809d..1905a65b716 100644
--- a/src/Cardano/Wallet/Kernel/Decrypt.hs
+++ b/src/Cardano/Wallet/Kernel/Decrypt.hs
@@ -1,8 +1,28 @@
 module Cardano.Wallet.Kernel.Decrypt
     ( decryptAddress
+    , decryptHdLvl2DerivationPath
     , keyToWalletDecrCredentials
     , WalletDecrCredentials
     , WalletDecrCredentialsKey(..)
     ) where
 
+import           Universum
+
+import           Data.List ((!!))
+
 import           Pos.Wallet.Web.Tracking.Decrypt
+
+import           Cardano.Wallet.Kernel.DB.HdWallet (HdAccountIx (..),
+                     HdAddressIx (..))
+import           Pos.Core (Address, aaPkDerivationPath, addrAttributesUnwrapped)
+import           Pos.Crypto (HDPassphrase, unpackHDAddressAttr)
+
+
+decryptHdLvl2DerivationPath :: HDPassphrase
+                            -> Address
+                            -> Maybe (HdAccountIx, HdAddressIx)
+decryptHdLvl2DerivationPath hdPass addr = do
+    hdPayload <- aaPkDerivationPath $ addrAttributesUnwrapped addr
+    derPath <- unpackHDAddressAttr hdPass hdPayload
+    guard $ length derPath == 2
+    pure (HdAccountIx (derPath !! 0), HdAddressIx (derPath !! 1))
diff --git a/src/Cardano/Wallet/Kernel/Wallets.hs b/src/Cardano/Wallet/Kernel/Wallets.hs
index a0b692453dc..c15e85d99b3 100644
--- a/src/Cardano/Wallet/Kernel/Wallets.hs
+++ b/src/Cardano/Wallet/Kernel/Wallets.hs
@@ -23,7 +23,7 @@ import qualified Formatting.Buildable
 import           Data.Acid.Advanced (update')
 
 import           Pos.Core (Address, Timestamp)
-import           Pos.Crypto (EncryptedSecretKey, PassPhrase,
+import           Pos.Crypto (EncryptedSecretKey, HDPassphrase, PassPhrase,
                      changeEncPassphrase, checkPassMatches, emptyPassphrase,
                      firstHardened, safeDeterministicKeyGen)
 
@@ -40,6 +40,8 @@ import           Cardano.Wallet.Kernel.DB.HdWallet (AssuranceLevel,
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
 import qualified Cardano.Wallet.Kernel.DB.HdWallet.Create as HD
 import           Cardano.Wallet.Kernel.DB.InDb (InDb (..), fromDb)
+import           Cardano.Wallet.Kernel.Decrypt (WalletDecrCredentialsKey (..),
+                     decryptHdLvl2DerivationPath, keyToWalletDecrCredentials)
 import           Cardano.Wallet.Kernel.Internal (PassiveWallet, walletKeystore,
                      wallets)
 import qualified Cardano.Wallet.Kernel.Keystore as Keystore
@@ -204,6 +206,8 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do
                  -- Fix properly as part of [CBR-404].
                  Left e@(HD.CreateHdRootExists _) ->
                      return . Left $ CreateWalletFailed e
+                 Left e@(HD.CreateHdRootDefaultAddressDerivationFailed) ->
+                     return . Left $ CreateWalletFailed e
 
                  Right hdRoot -> return (Right hdRoot)
 
@@ -239,14 +243,18 @@ createWalletHdRnd pw hasSpendingPassword defaultCardanoAddress name assuranceLev
                                 assuranceLevel
                                 created
 
-        hdAddress = defaultHdAddressWith rootId defaultCardanoAddress
-
-    -- We now have all the date we need to atomically generate a new
-    -- wallet with a default account & address.
-    res <- case createWallet newRoot (defaultHdAccountId rootId) hdAddress of
-        Left  create  -> update' (pw ^. wallets) create
-        Right restore -> update' (pw ^. wallets) restore
-    return $ either Left (const (Right newRoot)) res
+        hdPass    = fst $ keyToWalletDecrCredentials (KeyForRegular esk)
+        hdAddress = defaultHdAddressWith hdPass rootId defaultCardanoAddress
+
+    case hdAddress of
+        Nothing -> return (Left HD.CreateHdRootDefaultAddressDerivationFailed)
+        Just addr -> do
+            -- We now have all the date we need to atomically generate a new
+            -- wallet with a default account & address.
+            res <- case createWallet newRoot (defaultHdAccountId rootId) addr of
+                Left  create  -> update' (pw ^. wallets) create
+                Right restore -> update' (pw ^. wallets) restore
+            return $ either Left (const (Right newRoot)) res
     where
 
         hdSpendingPassword :: InDb Timestamp -> HD.HasSpendingPassword
@@ -267,11 +275,16 @@ defaultHdAddress esk spendingPassword rootId =
 
 -- | Given a Cardano 'Address', it returns a default 'HdAddress' at a fixed
 -- and predictable generation path.
-defaultHdAddressWith :: HD.HdRootId -> Address -> HdAddress
-defaultHdAddressWith rootId cardanoAddress =
-    let hdAccountId = defaultHdAccountId rootId
-        hdAddressId = HdAddressId hdAccountId (HdAddressIx firstHardened)
-    in HD.HdAddress hdAddressId (InDb cardanoAddress)
+-- module Cardano.Wallet.Kernel.Decrypt
+defaultHdAddressWith :: HDPassphrase
+                     -> HD.HdRootId
+                     -> Address
+                     -> Maybe HdAddress
+defaultHdAddressWith hdPass rootId cardanoAddress = do
+    (hdAccountIx, hdAddressIx) <- decryptHdLvl2DerivationPath hdPass cardanoAddress
+    let hdAccountId = HdAccountId rootId hdAccountIx
+        hdAddressId = HdAddressId hdAccountId hdAddressIx
+    pure $ HD.HdAddress hdAddressId (InDb cardanoAddress)
 
 defaultHdAccountId :: HdRootId -> HdAccountId
 defaultHdAccountId rootId = HdAccountId rootId (HdAccountIx firstHardened)