Merge #4041

4041: Batch Import Addresses  to  1.4.2 r=disassembler a=KtorZ

## Description

<!--- A brief description of this PR and the problem is trying to solve -->

Backporting cardano-foundation/cardano-wallet#259 to 1.4.2

## Linked issue

<!--- Put here the relevant issue from YouTrack -->



Co-authored-by: KtorZ <[email protected]>

Author: iohk-bors[bot]

CHANGELOG.md

@@ -1,5 +1,11 @@
 # CHANGELOG
 
+## Cardano SL 2.0.2
+
+### Features
+
+- Support for (unused) addresses batch import ([CO-448](https://iohk.myjetbrains.com/youtrack/issue/CO-448) [#4041](https://github.com/input-output-hk/cardano-sl/pull/4041))
+
 ## Cardano SL 2.0.1
 
 ### Fixes

wallet-new/src/Cardano/Wallet/API/V1/Addresses.hs

@@ -19,4 +19,8 @@ type API = Tags '["Addresses"] :>
       :<|> "addresses" :> Capture "address" Text
                        :> Summary "Returns interesting information about an address, if available and valid."
                        :> Get '[ValidJSON] (WalletResponse WalletAddress)
+      :<|> "wallets" :> CaptureWalletId :> "accounts" :> CaptureAccountId :> "addresses"
+        :> Summary "Batch import existing addresses"
+        :> ReqBody '[ValidJSON] [V1 Address]
+        :> Post '[ValidJSON] (WalletResponse (BatchImportResult (V1 Address)))
       )

wallet-new/src/Cardano/Wallet/API/V1/Handlers/Addresses.hs

@@ -20,6 +20,7 @@ handlers :: PassiveWalletLayer IO -> ServerT Addresses.API Handler
 handlers w =  listAddresses w
          :<|> newAddress w
          :<|> getAddress w
+         :<|> importAddresses w
 
 listAddresses :: PassiveWalletLayer IO
               -> RequestParams -> Handler (WalletResponse [WalletAddress])
@@ -49,3 +50,16 @@ getAddress pwl addressRaw = do
     case res of
          Left err   -> throwM err
          Right addr -> return $ single addr
+
+
+importAddresses
+    :: PassiveWalletLayer IO
+    -> WalletId
+    -> AccountIndex
+    -> [V1 Address]
+    -> Handler (WalletResponse (BatchImportResult (V1 Address)))
+importAddresses pwl walId accIx addrs = do
+    res <- liftIO $ WalletLayer.importAddresses pwl walId accIx addrs
+    case res of
+        Left err   -> throwM err
+        Right res' -> return $ single res'

wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Addresses.hs

@@ -46,6 +46,7 @@ handlers
 handlers nm = listAddresses nm
        :<|> newAddress nm
        :<|> getAddress nm
+       :<|> importAddresses nm
 
 -- | This is quite slow. What happens when we have 50k addresses?
 -- TODO(ks): One idea I have is to persist the length of the
@@ -133,3 +134,11 @@ getAddress nm addrText = do
             accMod <- V0.txMempoolToModifier ws mps . keyToWalletDecrCredentials nm =<< V0.findKey nm accId
             let caddr = V0.getWAddress ws accMod adiWAddressMeta
             single <$> migrate caddr
+
+importAddresses
+    :: NetworkMagic
+    -> WalletId
+    -> AccountIndex
+    -> [V1 Address]
+    -> m (WalletResponse (BatchImportResult (V1 Address)))
+importAddresses _ _ _ _ = error "Not Implemented."

wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs

@@ -964,6 +964,7 @@ Getting Utxo statistics
 
 You can get Utxo statistics of a given wallet using
  [`GET /api/v1/wallets/{{walletId}}/statistics/utxos`](#tag/Accounts%2Fpaths%2F~1api~1v1~1wallets~1{walletId}~1statistics~1utxos%2Fget)
+
 ```
 curl -X GET \
   https://127.0.0.1:8090/api/v1/wallets/Ae2tdPwUPE...8V3AVTnqGZ/statistics/utxos \
@@ -975,9 +976,53 @@ curl -X GET \
 ```json
 $readUtxoStatistics
 ```
-
 Make sure to carefully read the section about [Pagination](#section/Pagination) to fully
 leverage the API capabilities.
+
+
+Importing (Unused) Addresses From a Previous Node (or Version)
+--------------------------------------------------------------
+
+When restoring a wallet, only the information available on the blockchain can
+be retrieved. Some pieces of information aren't stored on
+the blockchain and are only defined as _Metadata_ of the wallet backend. This
+includes:
+
+- The wallet's name
+- The wallet's assurance level
+- The wallet's spending password
+- The wallet's unused addresses
+
+Unused addresses are not recorded on the blockchain and, in the case of random
+derivation, it is unlikely that the same addresses will be generated on two
+different node instances. However, some API users may wish to preserve unused
+addresses between different instances of the wallet backend.
+
+To enable this, the wallet backend provides an endpoint ([`POST /api/v1/wallets/{{walletId}}/accounts/{{accountId}/addresses`](#tag/Addresses%2Fpaths%2F~1api~1v1~1wallets~1{walletId}~1accounts~1{accountId}~1addresses%2Fpost))
+to import a list of addresses into a given account. Note that this endpoint is
+quite lenient when it comes to errors: it tries to import all provided addresses
+one by one, and ignores any that can't be imported for whatever reason. The
+server will respond with the total number of successes and, if any, a list of
+addresses that failed to be imported. Trying to import an address that is already
+present will behave as a no-op.
+
+For example:
+
+```
+curl -X POST \
+  https://127.0.0.1:8090/api/v1/wallets/Ae2tdPwUPE...8V3AVTnqGZ/accounts/2147483648/addresses \
+  -H 'Accept: application/json;charset=utf-8' \
+  --cacert ./scripts/tls-files/ca.crt \
+  --cert ./scripts/tls-files/client.pem \
+  -d '[
+    "Ae2tdPwUPE...8V3AVTnqGZ",
+    "Ae2odDwvbA...b6V104CTV8"
+  ]'
+```
+
+> **IMPORTANT**: This feature is experimental and performance is
+> not guaranteed. Users are advised to import small batches only.
+
 |]
   where
     createAccount        = decodeUtf8 $ encodePretty $ genExample @(WalletResponse Account)

wallet-new/src/Cardano/Wallet/API/V1/Types.hs

@@ -72,6 +72,7 @@ module Cardano.Wallet.API.V1.Types (
   , word32ToAddressLevel
   , IsChangeAddress (..)
   , mkAddressPathBIP44
+  , BatchImportResult(..)
   -- * Payments
   , Payment (..)
   , PaymentSource (..)
@@ -395,9 +396,9 @@ instance Arbitrary (V1 Core.Address) where
 
 instance ToSchema (V1 Core.Address) where
     declareNamedSchema _ =
-        pure $ NamedSchema (Just "V1Address") $ mempty
+        pure $ NamedSchema (Just "Address") $ mempty
             & type_ .~ SwaggerString
-            -- TODO: any other constraints we can have here?
+            & format ?~ "base58"
 
 instance FromHttpApiData (V1 Core.Address) where
     parseQueryParam = fmap (fmap V1) Core.decodeTextAddress
@@ -1483,6 +1484,48 @@ instance BuildableSafeGen WalletAddress where
 instance Buildable [WalletAddress] where
     build = bprint listJson
 
+instance Buildable [V1 Core.Address] where
+    build = bprint listJson
+
+data BatchImportResult a = BatchImportResult
+    { aimTotalSuccess :: !Natural
+    , aimFailures     :: ![a]
+    } deriving (Show, Ord, Eq, Generic)
+
+instance Buildable (BatchImportResult a) where
+    build res = bprint
+        ("BatchImportResult (success:"%int%", failures:"%int%")")
+        (aimTotalSuccess res)
+        (length $ aimFailures res)
+
+instance ToJSON a => ToJSON (BatchImportResult a) where
+    toJSON = genericToJSON Serokell.defaultOptions
+
+instance FromJSON a => FromJSON (BatchImportResult a) where
+    parseJSON = genericParseJSON Serokell.defaultOptions
+
+instance (ToJSON a, ToSchema a, Arbitrary a) => ToSchema (BatchImportResult a) where
+    declareNamedSchema =
+        genericSchemaDroppingPrefix "aim" (\(--^) props -> props
+            & ("totalSuccess" --^ "Total number of entities successfully imported")
+            & ("failures" --^ "Entities failed to be imported, if any")
+        )
+
+instance Arbitrary a => Arbitrary (BatchImportResult a) where
+    arbitrary = BatchImportResult
+        <$> arbitrary
+        <*> scale (`mod` 3) arbitrary -- NOTE Small list
+
+instance Arbitrary a => Example (BatchImportResult a)
+
+instance Semigroup (BatchImportResult a) where
+    (BatchImportResult a0 b0) <> (BatchImportResult a1 b1) =
+        BatchImportResult (a0 + a1) (b0 <> b1)
+
+instance Monoid (BatchImportResult a) where
+    mempty = BatchImportResult 0 mempty
+    mappend = (<>)
+
 
 -- | Create a new Address
 data NewAddress = NewAddress

wallet-new/src/Cardano/Wallet/Client.hs

@@ -76,6 +76,11 @@ data WalletClient m
          :: NewAddress -> Resp m WalletAddress
     , getAddress
          :: Text -> Resp m WalletAddress
+    , importAddresses
+        :: WalletId
+        -> AccountIndex
+        -> [V1 Address]
+        -> Resp m (BatchImportResult (V1 Address))
     -- wallets endpoints
     , postWallet
          :: New Wallet -> Resp m Wallet
@@ -232,6 +237,8 @@ natMapClient phi f wc = WalletClient
         f . phi . postAddress wc
     , getAddress =
         f . phi . getAddress wc
+    , importAddresses =
+        \x y -> f . phi . importAddresses wc x y
     , postWallet =
         f . phi . postWallet wc
     , getWalletIndexFilterSorts =

wallet-new/src/Cardano/Wallet/Client/Http.hs

@@ -97,6 +97,8 @@ mkHttpClient baseUrl manager = WalletClient
         = run . postAddressR
     , getAddress
         = run . getAddressR
+    , importAddresses
+        = \x y -> run . importAddressesR x y
     -- wallets endpoints
     , postWallet
         = run . postWalletR
@@ -192,6 +194,7 @@ mkHttpClient baseUrl manager = WalletClient
     getAddressIndexR
         :<|> postAddressR
         :<|> getAddressR
+        :<|> importAddressesR
         = addressesAPI
 
     postWalletR

wallet-new/src/Cardano/Wallet/Kernel/Addresses.hs

@@ -1,14 +1,19 @@
+{-# LANGUAGE LambdaCase #-}
+
 module Cardano.Wallet.Kernel.Addresses (
       createAddress
     , newHdAddress
+    , importAddresses
     -- * Errors
     , CreateAddressError(..)
+    , ImportAddressError(..)
     ) where
 
 import qualified Prelude
 import           Universum
 
 import           Control.Lens (to)
+import           Control.Monad.Except (throwError)
 import           Formatting (bprint, build, formatToString, (%))
 import qualified Formatting as F
 import qualified Formatting.Buildable
@@ -24,8 +29,8 @@ import           Pos.Crypto (EncryptedSecretKey, PassPhrase,
 import           Cardano.Wallet.Kernel.DB.AcidState (CreateHdAddress (..))
 import           Cardano.Wallet.Kernel.DB.HdWallet (HdAccountId,
                      HdAccountIx (..), HdAddress, HdAddressId (..),
-                     HdAddressIx (..), hdAccountIdIx, hdAccountIdParent,
-                     hdAddressIdIx)
+                     HdAddressIx (..), HdRootId (..), IsOurs (..),
+                     hdAccountIdIx, hdAccountIdParent, hdAddressIdIx)
 import           Cardano.Wallet.Kernel.DB.HdWallet.Create
                      (CreateHdAddressError (..), initHdAddress)
 import           Cardano.Wallet.Kernel.DB.HdWallet.Derivation
@@ -176,3 +181,63 @@ newHdAddress nm esk spendingPassword accId hdAddressId =
     in case mbAddr of
          Nothing              -> Nothing
          Just (newAddress, _) -> Just $ initHdAddress hdAddressId newAddress
+
+
+data ImportAddressError
+    = ImportAddressKeystoreNotFound HdAccountId
+    -- ^ When trying to create the 'Address', the parent 'Account' was not there.
+    deriving Eq
+
+instance Arbitrary ImportAddressError where
+    arbitrary = oneof
+        [ ImportAddressKeystoreNotFound <$> arbitrary
+        ]
+
+instance Buildable ImportAddressError where
+    build = \case
+        ImportAddressKeystoreNotFound uAccount ->
+            bprint ("ImportAddressError" % F.build) uAccount
+
+instance Show ImportAddressError where
+    show = formatToString build
+
+
+-- | Import already existing addresses into the DB. A typical use-case for that
+-- is backend migration, where users (e.g. exchanges) want to import unused
+-- addresses they've generated in the past (and likely communicated to their
+-- users). Because Addresses in the old scheme are generated randomly, there's
+-- no guarantee that addresses would be generated in the same order on a new
+-- node (they better not actually!).
+importAddresses
+    :: HdAccountId
+    -- ^ An abstract notion of an 'Account' identifier
+    -> [Address]
+    -> PassiveWallet
+    -> IO (Either ImportAddressError [Either Address ()])
+importAddresses accId addrs pw = runExceptT $ do
+    let rootId = accId ^. hdAccountIdParent
+    esk <- lookupSecretKey rootId
+    lift $ forM addrs (flip importOneAddress [(rootId, esk)])
+  where
+    lookupSecretKey
+        :: HdRootId
+        -> ExceptT ImportAddressError IO EncryptedSecretKey
+    lookupSecretKey rootId = do
+        let nm = makeNetworkMagic (pw ^. walletProtocolMagic)
+        let keystore = pw ^. walletKeystore
+        lift (Keystore.lookup nm (WalletIdHdRnd rootId) keystore) >>= \case
+            Nothing  -> throwError (ImportAddressKeystoreNotFound accId)
+            Just esk -> return esk
+
+    importOneAddress
+        :: Address
+        -> [(HdRootId, EncryptedSecretKey)]
+        -> IO (Either Address ())
+    importOneAddress addr = evalStateT $ do
+        let updateLifted = fmap Just .  lift . update (pw ^. wallets)
+        res <- state (isOurs addr) >>= \case
+            Nothing     -> return Nothing
+            Just hdAddr -> updateLifted $ CreateHdAddress hdAddr
+        return $ case res of
+            Just (Right _) -> Right ()
+            _              -> Left addr