Add restoration point option on post account wallet end point (#4984)

### Changes

- Add restoration point option in post account wallet end point

### Issues 

fix #4967

Author: paolino

.gitignore

@@ -39,7 +39,7 @@ cabal.project.diff
 ### Direnv ###
 .envrc-local
 .envrc-override
-.direnv/flake-profile*
+.direnv
 
 ### auto-generated faulty JSON golden tests ###
 *.faulty.json

lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs

@@ -751,7 +751,8 @@ import Data.Generics.Internal.VL.Lens
 import Data.Generics.Labels
     ()
 import Data.Generics.Product
-    ( typed
+    ( HasField'
+    , typed
     )
 import Data.IntCast
     ( intCastMaybe
@@ -955,6 +956,24 @@ postWallet ctx generateKey liftKey (WalletOrAccountPostData body) = case body of
 
         in postAccountWallet ctx mkShelleyWallet liftKey action body'
 
+computeRestorationPoint
+    :: forall ctx s body
+     . ( ctx ~ ApiLayer s
+       , HasField' "restorationMode" body (Maybe (ApiT RestorationMode))
+       )
+    => ctx
+    -> NetworkParameters
+    -> body
+    -> Handler RestorationPoint
+computeRestorationPoint ctx networkParams body =
+    liftHandler
+        $ withExceptT ErrCreateWalletRestorationFromABlockFailed
+        $ ExceptT
+        $ getRestorationPoint
+            (genesisParameters networkParams)
+            (maybe RestoreFromGenesis getApiT $ body ^. #restorationMode)
+            (ctx ^. networkLayer)
+
 postShelleyWallet
     :: forall ctx s k n.
         ( s ~ SeqState n k
@@ -975,12 +994,7 @@ postShelleyWallet ctx generateKey body = do
     let state = mkSeqStateFromRootXPrv
             (keyFlavorFromState @s) (RootCredentials rootXPrv pwdP)
             purposeCIP1852 g changeAddrMode
-    restorationPoint <- liftHandler
-        $ withExceptT ErrCreateWalletRestorationFromABlockFailed
-        $ ExceptT $ getRestorationPoint
-            (genesisParameters networkParams)
-            (maybe RestoreFromGenesis getApiT $ restorationMode body)
-            (ctx ^. networkLayer)
+    restorationPoint <- computeRestorationPoint ctx networkParams body
     let initialState = InitialState state genesisBlock restorationPoint
     void $ liftHandler $ createWalletWorker @_ @s ctx wid
         (W.createWallet @s networkParams wid wName initialState)
@@ -1025,9 +1039,10 @@ postAccountWallet
     -> AccountPostData
     -> Handler w
 postAccountWallet ctx mkWallet liftKey coworker body = do
+    restorationPoint <- computeRestorationPoint ctx networkParams body
     let state = mkSeqStateFromAccountXPub
             (liftKey accXPub) Nothing purposeCIP1852 g IncreasingChangeAddresses
-        initialState = InitialState state genesisBlock RestorationPointAtGenesis
+        initialState = InitialState state genesisBlock restorationPoint
     void $ liftHandler $ createWalletWorker @_ @s ctx wid
         (W.createWallet @s networkParams wid wName initialState)
         coworker

lib/api/src/Cardano/Wallet/Api/Types.hs

@@ -1134,6 +1134,7 @@ data AccountPostData = AccountPostData
     { name :: !(ApiT WalletName)
     , accountPublicKey :: !ApiAccountPublicKey
     , addressPoolGap :: !(Maybe (ApiT AddressPoolGap))
+    , restorationMode :: Maybe ApiRestorationMode
     }
     deriving (FromJSON, ToJSON) via DefaultRecord AccountPostData
     deriving (Eq, Generic, Show)

lib/exe/lib/Cardano/Wallet/Application/CLI.hs

@@ -751,6 +751,7 @@ cmdWalletCreateFromPublicKey mkClient =
                 (ApiT wName)
                 wAccPubKey
                 (Just $ ApiT wGap)
+                Nothing
 
 -- | Arguments for 'wallet get' command
 data WalletGetArgs = WalletGetArgs

lib/integration/framework/Test/Integration/Framework/DSL/Wallet.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Test.Integration.Framework.DSL.Wallet
     ( createARandomWalletWithMnemonics
@@ -17,18 +19,27 @@ module Test.Integration.Framework.DSL.Wallet
     , named
     , fundWallet
     , withApiWallet
+    , xPubOfMnemonics
+    , createWalletFromXPub
+    , withRestorationMode
     ) where
 
 import Prelude
 
+import Cardano.Address.Derivation
+    ( XPub
+    , toXPub
+    )
 import Cardano.Mnemonic
     ( SomeMnemonic
     )
 import Cardano.Wallet.Api.Clients.Testnet.Id
     ( Testnet42
     )
 import Cardano.Wallet.Api.Types
-    ( AddressAmount (..)
+    ( AccountPostData (..)
+    , AddressAmount (..)
+    , ApiAccountPublicKey (..)
     , ApiMnemonicT (..)
     , ApiT (..)
     , ApiTxId (..)
@@ -46,11 +57,15 @@ import Cardano.Wallet.Api.Types.WalletAssets
 import Cardano.Wallet.Faucet
     ( Faucet (nextShelleyMnemonic)
     )
+import Cardano.Wallet.Network.RestorationMode
+    ( RestorationMode
+    )
 import Cardano.Wallet.Primitive.SyncProgress
     ( SyncProgress (..)
     )
 import Cardano.Wallet.Primitive.Types
     ( WalletId
+    , WalletName
     )
 import Cardano.Wallet.Primitive.Types.Tx.TxMeta
     ( TxStatus (InLedger)
@@ -72,6 +87,9 @@ import Data.Generics.Internal.VL
     ( (.~)
     , (^.)
     )
+import Data.Generics.Product
+    ( HasField
+    )
 import Data.Text
     ( Text
     )
@@ -96,16 +114,36 @@ import Test.Integration.Framework.DSL.TestM
     , request
     )
 
+import qualified Cardano.Address.Style.Shelley as Address
 import qualified Cardano.Faucet.Mnemonics as Mnemonics
 import qualified Cardano.Wallet.Api.Clients.Testnet.Shelley as C
 
 type AWallet = ApiT WalletId
 
 type Patch a = a -> a
 
+createWalletFromXPub
+    :: XPub
+    -> Patch AccountPostData
+    -> TestM (Either ClientError AWallet)
+createWalletFromXPub xpub refine = do
+    apiWallet' <-
+        request
+            $ C.postWallet
+            $ WalletOrAccountPostData
+            $ Right
+            $ refine
+            $ AccountPostData
+                { name = ApiT $ unsafeFromText "Wallet from mnemonic"
+                , accountPublicKey = ApiAccountPublicKey $ ApiT xpub
+                , addressPoolGap = Nothing
+                , restorationMode = Nothing
+                }
+    pure $ fmap (view #id) apiWallet'
+
 createWalletFromMnemonics
     :: SomeMnemonic
-    -> (WalletPostData -> WalletPostData)
+    -> Patch WalletPostData
     -> TestM (Either ClientError AWallet)
 createWalletFromMnemonics m15 refine = do
     apiWallet' <-
@@ -125,9 +163,16 @@ createWalletFromMnemonics m15 refine = do
                 }
     pure $ fmap (view #id) apiWallet'
 
-createARandomWallet :: Patch WalletPostData -> TestM (Either ClientError AWallet)
+createARandomWallet
+    :: Patch WalletPostData -> TestM (Either ClientError AWallet)
 createARandomWallet refine = fmap fst <$> createARandomWalletWithMnemonics refine
 
+xPubOfMnemonics :: SomeMnemonic -> XPub
+xPubOfMnemonics mnemonic =
+    let rootKey = Address.genMasterKeyFromMnemonic mnemonic mempty
+        accKey = Address.deriveAccountPrivateKey rootKey minBound
+    in  toXPub $ Address.getKey accKey
+
 createARandomWalletWithMnemonics
     :: Patch WalletPostData
     -- ^ Refine the wallet data
@@ -155,14 +200,24 @@ statusIs :: SyncProgress -> Over ApiWallet ()
 statusIs expected = check
     $ \w -> w ^. #state . #getApiT `shouldBe` expected
 
-named :: Text -> Patch WalletPostData
-named name' = #name .~ ApiT (unsafeFromText name')
+named
+    :: HasField "name" a a b (ApiT WalletName)
+    => Text
+    -> Patch a
+named name' = #name .~ ApiT (unsafeFromText @WalletName name')
+
+withRestorationMode
+    :: HasField "restorationMode" a a b (Maybe (ApiT RestorationMode))
+    => RestorationMode
+    -> Patch a
+withRestorationMode rm = #restorationMode .~ Just (ApiT rm)
 
 aFaucetWallet :: TestM AWallet
 aFaucetWallet = do
     faucet <- asks _faucet
     faucetMnemonic <- liftIO $ nextShelleyMnemonic faucet
-    Partial faucetWalletId <- createWalletFromMnemonics faucetMnemonic $ named "Faucet wallet"
+    Partial faucetWalletId <-
+        createWalletFromMnemonics faucetMnemonic $ named "Faucet wallet"
     over faucetWalletId waitUntilStateIsReady
     pure faucetWalletId
 

lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/Restoration.hs

@@ -14,7 +14,6 @@ import Prelude
 
 import Cardano.Wallet.Api.Types
     ( ApiT (..)
-    , WalletPostData (..)
     )
 import Cardano.Wallet.Api.Types.BlockHeader
     ( ApiBlockHeader (..)
@@ -28,6 +27,9 @@ import Cardano.Wallet.Primitive.Types.Hash
 import Cardano.Wallet.Unsafe
     ( unsafeFromText
     )
+import Data.Generics.Product
+    ( HasField
+    )
 import Data.Quantity
     ( Quantity (..)
     )
@@ -58,11 +60,14 @@ import Test.Integration.Framework.DSL.Wallet
     , createARandomWallet
     , createARandomWalletWithMnemonics
     , createWalletFromMnemonics
+    , createWalletFromXPub
     , deleteWallet
     , fundWallet
     , named
     , waitUntilStateIsReady
     , withApiWallet
+    , withRestorationMode
+    , xPubOfMnemonics
     )
 
 import qualified Cardano.Wallet.Api.Clients.Network as C
@@ -71,7 +76,8 @@ import qualified Cardano.Wallet.Read as Read
 spec :: SpecWith Context
 spec = describe "restoration of wallets" $ do
     itM "WALLET_RESTORE_0.1 create a wallet restoring from tip" $ do
-        Partial w <- createARandomWallet $ named "Wallet from tip" . restoringFromTip
+        Partial w <-
+            createARandomWallet $ named "Wallet from tip" . restoringFromTip
         over w $ do
             waitUntilStateIsReady
             withApiWallet $ balanceIs 0
@@ -182,7 +188,9 @@ spec = describe "restoration of wallets" $ do
                     ApiBlockHeader
                         { slotNo = Quantity 0
                         , blockHeight = Quantity 0
-                        , headerHash = unsafeFromText "39d89a1e837e968ba35370be47cdfcbfd193cd992fdeed557b77c49b77ee59cf"
+                        , headerHash =
+                            unsafeFromText
+                                "39d89a1e837e968ba35370be47cdfcbfd193cd992fdeed557b77c49b77ee59cf"
                         }
             w <- createARandomWallet (restoringFromCheckpoint cp)
             clientError w $ do
@@ -193,21 +201,83 @@ spec = describe "restoration of wallets" $ do
                                   \The block at slot number 0 \
                                   \and hash 39d89a1e837e968ba35370be47cdfcbfd193cd992fdeed557b77c49b77ee59cf \
                                   \does not exist."
+    itM
+        "WALLET_RESTORE_0.9 create an account wallet from the tip \
+        \ignores past transactions"
+        $ do
+            Partial (genesisClone, mnemonics) <-
+                createARandomWalletWithMnemonics
+                    $ named "Account from genesis" . restoringFromTip
+            let xpub = xPubOfMnemonics mnemonics
+            over genesisClone $ do
+                waitUntilStateIsReady
+                fundWallet 42_000_000
+                withApiWallet $ balanceIs 42_000_000
+                deleteWallet
+            Partial tipClone <-
+                createWalletFromXPub xpub
+                    $ named "Account from tip" . restoringFromTip
+            over tipClone $ do
+                waitUntilStateIsReady
+                withApiWallet $ balanceIs 0
+    itM
+        "WALLET_RESTORE_0.10 create an account wallet from the genesis \
+        \capture the past transactions"
+        $ do
+            Partial (genesisClone, mnemonics) <-
+                createARandomWalletWithMnemonics
+                    $ named "Account from genesis" . restoringFromTip
+            let xpub = xPubOfMnemonics mnemonics
+            over genesisClone $ do
+                waitUntilStateIsReady
+                fundWallet 42_000_000
+                withApiWallet $ balanceIs 42_000_000
+                deleteWallet
+            Partial tipClone <-
+                createWalletFromXPub xpub
+                    $ named "Account from genesis second take" . restoringFromGenesis
+            over tipClone $ do
+                waitUntilStateIsReady
+                withApiWallet $ balanceIs 42_000_000
+    itM
+        "WALLET_RESTORE_0.11 create an account wallet from checkpoint \
+        \capture the past transactions"
+        $ do
+            Partial (genesisClone, mnemonics) <-
+                createARandomWalletWithMnemonics
+                    $ named "Account from genesis" . restoringFromTip
+            let xpub = xPubOfMnemonics mnemonics
+            over genesisClone $ do
+                waitUntilStateIsReady
+            Partial cp <- request C.blocksLatestHeader
+            waitSomeEpochs 2
+            over genesisClone $ do
+                fundWallet 42_000_000
+                withApiWallet $ balanceIs 42_000_000
+                deleteWallet
+            Partial tipClone <-
+                createWalletFromXPub xpub
+                    $ named "Account from a block" . restoringFromCheckpoint cp
+            over tipClone $ do
+                waitUntilStateIsReady
+                withApiWallet $ balanceIs 42_000_000
 
-setRestorationMode :: RestorationMode -> Patch WalletPostData
-setRestorationMode rm wd = wd{restorationMode = Just $ ApiT rm}
-
-restoringFromTip :: Patch WalletPostData
-restoringFromTip = setRestorationMode RestoreFromTip
+restoringFromTip
+    :: HasField "restorationMode" a a b (Maybe (ApiT RestorationMode))
+    => Patch a
+restoringFromTip = withRestorationMode RestoreFromTip
 
-restoringFromGenesis :: Patch WalletPostData
-restoringFromGenesis = setRestorationMode RestoreFromGenesis
+restoringFromGenesis
+    :: HasField "restorationMode" a a b (Maybe (ApiT RestorationMode))
+    => Patch a
+restoringFromGenesis = withRestorationMode RestoreFromGenesis
 
 restoringFromCheckpoint
-    :: ApiBlockHeader
-    -> Patch WalletPostData
+    :: HasField "restorationMode" a a b (Maybe (ApiT RestorationMode))
+    => ApiBlockHeader
+    -> Patch a
 restoringFromCheckpoint cp =
-    setRestorationMode
+    withRestorationMode
         $ RestoreFromBlock
             (Read.SlotNo $ fromIntegral $ getQuantity $ slotNo cp)
             (toRawHeaderHash $ headerHash cp)

lib/unit/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -1584,7 +1584,7 @@ instance Arbitrary AccountPostData where
     arbitrary = do
         wName <- ApiT <$> arbitrary
         accXPub <- arbitrary
-        pure $ AccountPostData wName accXPub Nothing
+        pure $ AccountPostData wName accXPub Nothing Nothing
 
 instance Arbitrary WalletPostData where
     arbitrary = genericArbitrary