Foundation for batch address import

KtorZ · KtorZ · commit 5de1f9262d42 · 2019-01-28T21:01:51.000+01:00
- Define top-level API
- First (untested) logic implementation for batch imports
diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Addresses.hs b/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] (APIResponse (BatchImportResult (V1 Address)))
       )
diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Handlers/Addresses.hs b/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 (APIResponse (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'
diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Types.hs b/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,47 @@ 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 Aeson.defaultOptions
+
+instance FromJSON a => FromJSON (BatchImportResult a) where
+    parseJSON = genericParseJSON Aeson.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
+
 
 -- | Create a new Address
 data NewAddress = NewAddress
diff --git a/wallet-new/src/Cardano/Wallet/Client.hs b/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 =
diff --git a/wallet-new/src/Cardano/Wallet/Client/Http.hs b/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
diff --git a/wallet-new/src/Cardano/Wallet/Kernel/Addresses.hs b/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
diff --git a/wallet-new/src/Cardano/Wallet/WalletLayer.hs b/wallet-new/src/Cardano/Wallet/WalletLayer.hs
@@ -15,6 +15,7 @@ module Cardano.Wallet.WalletLayer
     , RedeemAdaError(..)
     , CreateAddressError(..)
     , ValidateAddressError(..)
+    , ImportAddressError(..)
     , CreateAccountError(..)
     , GetAccountError(..)
     , GetAccountsError(..)
@@ -47,12 +48,12 @@ import           Cardano.Wallet.API.Request.Filter (FilterOperations (..))
 import           Cardano.Wallet.API.Request.Sort (SortOperations (..))
 import           Cardano.Wallet.API.Response (SliceOf (..), WalletResponse)
 import           Cardano.Wallet.API.V1.Types (Account, AccountBalance,
-                     AccountIndex, AccountUpdate, Address, ForceNtpCheck,
-                     NewAccount, NewAddress, NewWallet, NodeInfo, NodeSettings,
-                     PasswordUpdate, Payment, Redemption, SignedTransaction,
-                     SpendingPassword, Transaction, UnsignedTransaction,
-                     V1 (..), Wallet, WalletAddress, WalletId, WalletImport,
-                     WalletUpdate)
+                     AccountIndex, AccountUpdate, Address, BatchImportResult,
+                     ForceNtpCheck, NewAccount, NewAddress, NewWallet,
+                     NodeInfo, NodeSettings, PasswordUpdate, Payment,
+                     Redemption, SignedTransaction, SpendingPassword,
+                     Transaction, UnsignedTransaction, V1 (..), Wallet,
+                     WalletAddress, WalletId, WalletImport, WalletUpdate)
 import qualified Cardano.Wallet.Kernel.Accounts as Kernel
 import qualified Cardano.Wallet.Kernel.Addresses as Kernel
 import           Cardano.Wallet.Kernel.CoinSelection.FromGeneric
@@ -231,6 +232,31 @@ instance Buildable ValidateAddressError where
     build (ValidateAddressDecodingFailed rawText) =
         bprint ("ValidateAddressDecodingFailed " % build) rawText
 
+data ImportAddressError =
+      ImportAddressError Kernel.ImportAddressError
+    | ImportAddressAddressDecodingFailed Text
+    -- ^ Decoding the input 'Text' as an 'Address' failed.
+    deriving Eq
+
+-- | Unsound show instance needed for the 'Exception' instance.
+instance Show ImportAddressError where
+    show = formatToString build
+
+instance Exception ImportAddressError
+
+instance Arbitrary ImportAddressError where
+    arbitrary = oneof [ ImportAddressError <$> arbitrary
+                      , pure (ImportAddressAddressDecodingFailed "Ae2tdPwUPEZ18ZjTLnLVr9CEvUEUX4eW1LBHbxxx")
+                      ]
+
+instance Buildable ImportAddressError where
+    build (ImportAddressError kernelError) =
+        bprint ("ImportAddressError " % build) kernelError
+    build (ImportAddressAddressDecodingFailed txt) =
+        bprint ("ImportAddressAddressDecodingFailed " % build) txt
+
+
+
 ------------------------------------------------------------
 -- Errors when dealing with Accounts
 ------------------------------------------------------------
@@ -431,6 +457,10 @@ data PassiveWalletLayer m = PassiveWalletLayer
     , getAddresses         :: RequestParams -> m (SliceOf WalletAddress)
     , validateAddress      :: Text
                            -> m (Either ValidateAddressError WalletAddress)
+    , importAddresses      :: WalletId
+                           -> AccountIndex
+                           -> [V1 Address]
+                           -> m (Either ImportAddressError (BatchImportResult (V1 Address)))
 
     -- transactions
     , getTransactions      :: Maybe WalletId
diff --git a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel.hs b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel.hs
@@ -120,6 +120,7 @@ bracketPassiveWallet pm mode logFunction keystore node fInjects f = do
         , updateAccount        = Accounts.updateAccount       w
         , deleteAccount        = Accounts.deleteAccount       w
         , createAddress        = Addresses.createAddress      w
+        , importAddresses      = Addresses.importAddresses    w
         , addUpdate            = Internal.addUpdate           w
         , nextUpdate           = Internal.nextUpdate          w
         , applyUpdate          = Internal.applyUpdate         w
diff --git a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Addresses.hs b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Addresses.hs
@@ -1,8 +1,10 @@
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+
 module Cardano.Wallet.WalletLayer.Kernel.Addresses (
     createAddress
   , getAddresses
   , validateAddress
+  , importAddresses
   ) where
 
 import           Universum
@@ -28,7 +30,7 @@ import qualified Cardano.Wallet.Kernel.Internal as Kernel
 import qualified Cardano.Wallet.Kernel.Read as Kernel
 import           Cardano.Wallet.Kernel.Types (AccountId (..))
 import           Cardano.Wallet.WalletLayer (CreateAddressError (..),
-                     ValidateAddressError (..))
+                     ImportAddressError (..), ValidateAddressError (..))
 import           Cardano.Wallet.WalletLayer.Kernel.Conv
 
 createAddress :: MonadIO m
@@ -186,3 +188,26 @@ validateAddress rawText db = runExcept $ do
           , addrChangeAddress = False
           , addrOwnership     = (V1 V1.AddressAmbiguousOwnership)
           }
+
+
+importAddresses
+    :: (MonadIO m)
+    => Kernel.PassiveWallet
+    -> V1.WalletId
+    -> V1.AccountIndex
+    -> [V1.V1 V1.Address]
+    -> m (Either ImportAddressError (V1.BatchImportResult (V1.V1 V1.Address)))
+importAddresses wallet wId accIx addrs = runExceptT $ do
+    accId <- withExceptT ImportAddressAddressDecodingFailed $
+        fromAccountId wId accIx
+    res <- withExceptT ImportAddressError $ ExceptT $ liftIO $
+        Kernel.importAddresses accId (V1.unV1 <$> addrs) wallet
+    return $ foldImportResults V1.V1 res
+  where
+    foldImportResults
+        :: (a -> b)
+        -> [Either a ()]
+        -> V1.BatchImportResult b
+    foldImportResults f = flip foldl' mempty $ \b -> \case
+        Left a  -> b <> V1.BatchImportResult 0 [f a]
+        Right _ -> b <> V1.BatchImportResult 1 []

Original file line number	Diff line number	Diff line change
`@@ -19,4 +19,8 @@ type API = Tags '["Addresses"] :>`
`19`	`19`	`:<\|> "addresses" :> Capture "address" Text`
`20`	`20`	`:> Summary "Returns interesting information about an address, if available and valid."`
`21`	`21`	`:> Get '[ValidJSON] (WalletResponse WalletAddress)`
	`22`	`+ :<\|> "wallets" :> CaptureWalletId :> "accounts" :> CaptureAccountId :> "addresses"`
	`23`	`+ :> Summary "Batch import existing addresses"`
	`24`	`+ :> ReqBody '[ValidJSON] [V1 Address]`
	`25`	`+ :> Post '[ValidJSON] (APIResponse (BatchImportResult (V1 Address)))`
`22`	`26`	`)`