diff --git a/.gitignore b/.gitignore index c17c6f21067..34b475713fc 100644 --- a/.gitignore +++ b/.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 diff --git a/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs index 79ed2e3367f..39fc3861f0b 100644 --- a/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs +++ b/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 diff --git a/lib/api/src/Cardano/Wallet/Api/Types.hs b/lib/api/src/Cardano/Wallet/Api/Types.hs index ba5ad9e94dc..5f2e469a2ba 100644 --- a/lib/api/src/Cardano/Wallet/Api/Types.hs +++ b/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) diff --git a/lib/exe/lib/Cardano/Wallet/Application/CLI.hs b/lib/exe/lib/Cardano/Wallet/Application/CLI.hs index 27e1b7bc778..410d416efc9 100644 --- a/lib/exe/lib/Cardano/Wallet/Application/CLI.hs +++ b/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 diff --git a/lib/integration/framework/Test/Integration/Framework/DSL/Wallet.hs b/lib/integration/framework/Test/Integration/Framework/DSL/Wallet.hs index 36e072c05ee..902b6571bd5 100644 --- a/lib/integration/framework/Test/Integration/Framework/DSL/Wallet.hs +++ b/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,10 +19,17 @@ 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 ) @@ -28,7 +37,9 @@ 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,6 +114,7 @@ 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 @@ -103,9 +122,28 @@ 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 diff --git a/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/Restoration.hs b/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/Restoration.hs index 27dfec0e39a..3890697df74 100644 --- a/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/Restoration.hs +++ b/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) diff --git a/lib/unit/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/unit/test/unit/Cardano/Wallet/Api/TypesSpec.hs index baf70e727a8..4e090c12d32 100644 --- a/lib/unit/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/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 diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index afdffd800a8..422b0bc5975 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -3107,6 +3107,7 @@ components: name: *walletName account_public_key: *walletAccountXPubkey address_pool_gap: *walletAddressPoolGap + restoration_mode: *restorationMode ApiWalletOrAccountPostData: &ApiWalletOrAccountPostData type: object