From bc406dddbbe213a24afa275a7d3fc17aa9a1974f Mon Sep 17 00:00:00 2001 From: KtorZ Date: Tue, 6 Oct 2020 17:59:44 +0200 Subject: [PATCH] store seq-state derivation prefix in the database. That prefixes tells us which account corresponds to which state and also, which purpose so can distinguish between Icarus and Shelley wallets. This will require a database migration which I'll add in a later commit. --- lib/core/src/Cardano/Wallet.hs | 4 +- lib/core/src/Cardano/Wallet/Api/Server.hs | 5 +- lib/core/src/Cardano/Wallet/DB/Sqlite.hs | 5 +- lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs | 11 +- .../src/Cardano/Wallet/DB/Sqlite/Types.hs | 16 ++- .../Primitive/AddressDerivation/Icarus.hs | 33 +---- .../AddressDerivation/Jormungandr.hs | 35 +----- .../Primitive/AddressDerivation/Shelley.hs | 35 +----- .../Primitive/AddressDiscovery/Sequential.hs | 117 ++++++++++++++---- 9 files changed, 131 insertions(+), 130 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index 6db7cfd7d15..614b64fde10 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -248,6 +248,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential , defaultAddressPoolGap , mkSeqStateFromRootXPrv , mkUnboundedAddressPoolGap + , purposeBIP44 , shrinkPool ) import Cardano.Wallet.Primitive.CoinSelection @@ -604,7 +605,7 @@ createIcarusWallet -> (k 'RootK XPrv, Passphrase "encryption") -> ExceptT ErrWalletAlreadyExists IO WalletId createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do - let s = mkSeqStateFromRootXPrv @n credentials $ + let s = mkSeqStateFromRootXPrv @n credentials purposeBIP44 $ mkUnboundedAddressPoolGap 10000 let (hist, cp) = initWallet block0 gp s let addrs = map address . concatMap (view #outputs . fst) $ hist @@ -614,6 +615,7 @@ createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do (shrinkPool @n (liftPaymentAddress @n) addrs g (Seq.externalPool s)) (Seq.pendingChangeIxs s) (Seq.rewardAccountKey s) + (Seq.derivationPrefix s) now <- lift getCurrentTime let meta = WalletMetadata { name = wname diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 825a27cd1e2..b561dff0b45 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -257,6 +257,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential , defaultAddressPoolGap , mkSeqStateFromAccountXPub , mkSeqStateFromRootXPrv + , purposeCIP1852 ) import Cardano.Wallet.Primitive.CoinSelection ( CoinSelection (..), changeBalance, inputBalance ) @@ -598,7 +599,7 @@ postShelleyWallet -> WalletPostData -> Handler ApiWallet postShelleyWallet ctx generateKey body = do - let state = mkSeqStateFromRootXPrv (rootXPrv, pwd) g + let state = mkSeqStateFromRootXPrv (rootXPrv, pwd) purposeCIP1852 g void $ liftHandler $ initWorker @_ @s @k ctx wid (\wrk -> W.createWallet @(WorkerCtx ctx) @s @k wrk wid wName state) (\wrk -> W.restoreWallet @(WorkerCtx ctx) @s @t @k wrk wid) @@ -634,7 +635,7 @@ postAccountWallet -> AccountPostData -> Handler w postAccountWallet ctx mkWallet liftKey coworker body = do - let state = mkSeqStateFromAccountXPub (liftKey accXPub) g + let state = mkSeqStateFromAccountXPub (liftKey accXPub) purposeCIP1852 g void $ liftHandler $ initWorker @_ @s @k ctx wid (\wrk -> W.createWallet @(WorkerCtx ctx) @s @k wrk wid wName state) (\wrk -> W.restoreWallet @(WorkerCtx ctx) @s @t @k wrk wid) diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs index bcb0edbfec3..6a143106d0c 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs @@ -1577,6 +1577,7 @@ instance , seqStateInternalGap = iGap , seqStateAccountXPub = serializeXPub accountXPub , seqStateRewardXPub = serializeXPub (Seq.rewardAccountKey st) + , seqStateDerivationPrefix = Seq.derivationPrefix st } insertAddressPool @n wid sl intPool insertAddressPool @n wid sl extPool @@ -1587,13 +1588,13 @@ instance selectState (wid, sl) = runMaybeT $ do st <- MaybeT $ selectFirst [SeqStateWalletId ==. wid] [] - let SeqState _ eGap iGap accountBytes rewardBytes = entityVal st + let SeqState _ eGap iGap accountBytes rewardBytes prefix = entityVal st let accountXPub = unsafeDeserializeXPub accountBytes let rewardXPub = unsafeDeserializeXPub rewardBytes intPool <- lift $ selectAddressPool @n wid sl iGap accountXPub extPool <- lift $ selectAddressPool @n wid sl eGap accountXPub pendingChangeIxs <- lift $ selectSeqStatePendingIxs wid - pure $ Seq.SeqState intPool extPool pendingChangeIxs rewardXPub + pure $ Seq.SeqState intPool extPool pendingChangeIxs rewardXPub prefix insertAddressPool :: forall n k c. (PaymentAddress n k, Typeable c) diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs index 968d9c78e38..dbfaae17d84 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs @@ -227,11 +227,12 @@ UTxO sql=utxo -- Sequential scheme address discovery state -- which does not belong to a particular checkpoint. SeqState - seqStateWalletId W.WalletId sql=wallet_id - seqStateExternalGap W.AddressPoolGap sql=external_gap - seqStateInternalGap W.AddressPoolGap sql=internal_gap - seqStateAccountXPub B8.ByteString sql=account_xpub - seqStateRewardXPub B8.ByteString sql=reward_xpub + seqStateWalletId W.WalletId sql=wallet_id + seqStateExternalGap W.AddressPoolGap sql=external_gap + seqStateInternalGap W.AddressPoolGap sql=internal_gap + seqStateAccountXPub B8.ByteString sql=account_xpub + seqStateRewardXPub B8.ByteString sql=reward_xpub + seqStateDerivationPrefix W.DerivationPrefix sql=derivation_prefix Primary seqStateWalletId Foreign Wallet seq_state seqStateWalletId ! ON DELETE CASCADE diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs index c0bc75f4fd9..df582dd6f63 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs @@ -29,7 +29,11 @@ import Cardano.Slotting.Slot import Cardano.Wallet.Primitive.AddressDerivation ( AccountingStyle (..), Passphrase (..), PassphraseScheme (..) ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential - ( AddressPoolGap (..), getAddressPoolGap, mkAddressPoolGap ) + ( AddressPoolGap (..) + , DerivationPrefix + , getAddressPoolGap + , mkAddressPoolGap + ) import Cardano.Wallet.Primitive.Types ( Address (..) , AddressState (..) @@ -631,3 +635,13 @@ instance PersistField AddressState where instance PersistFieldSql AddressState where sqlType _ = sqlType (Proxy @Text) + +---------------------------------------------------------------------------- +-- DerivationPrefix + +instance PersistField DerivationPrefix where + toPersistValue = toPersistValue . toText + fromPersistValue = fromPersistValueFromText + +instance PersistFieldSql DerivationPrefix where + sqlType _ = sqlType (Proxy @Text) diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs index 77ad518df94..a427b9f6a40 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs @@ -69,7 +69,7 @@ import Cardano.Wallet.Primitive.AddressDerivation import Cardano.Wallet.Primitive.AddressDiscovery ( IsOurs (..) ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential - ( SeqState ) + ( SeqState, coinTypeAda, purposeBIP44 ) import Cardano.Wallet.Primitive.Types ( Address (..), Hash (..), invariant, testnetMagic ) import Control.Arrow @@ -102,8 +102,6 @@ import Data.Proxy ( Proxy (..) ) import Data.Void ( Void ) -import Data.Word - ( Word32 ) import GHC.Generics ( Generic ) import GHC.TypeLits @@ -132,31 +130,6 @@ newtype IcarusKey (depth :: Depth) key = instance (NFData key) => NFData (IcarusKey depth key) --- | Purpose is a constant set to 44' (or 0x8000002C) following the original --- BIP-44 specification. --- --- It indicates that the subtree of this node is used according to this --- specification. --- --- Hardened derivation is used at this level. -purposeIndex :: Word32 -purposeIndex = 0x8000002C - --- | One master node (seed) can be used for unlimited number of independent --- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the --- same space for various cryptocoins has some disadvantages. --- --- This level creates a separate subtree for every cryptocoin, avoiding reusing --- addresses across cryptocoins and improving privacy issues. --- --- Coin type is a constant, set for each cryptocoin. For Cardano this constant --- is set to 1815' (or 0x80000717). 1815 is the birthyear of our beloved Ada --- Lovelace. --- --- Hardened derivation is used at this level. -coinTypeIndex :: Word32 -coinTypeIndex = 0x80000717 - -- | The minimum seed length for 'generateKeyFromSeed' and 'unsafeGenerateKeyFromSeed'. minSeedLengthBytes :: Int minSeedLengthBytes = 16 @@ -324,9 +297,9 @@ instance HardDerivation IcarusKey where (Passphrase pwd) (IcarusKey rootXPrv) (Index accIx) = let purposeXPrv = -- lvl1 derivation; hardened derivation of purpose' - deriveXPrv DerivationScheme2 pwd rootXPrv purposeIndex + deriveXPrv DerivationScheme2 pwd rootXPrv (getIndex purposeBIP44) coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type' - deriveXPrv DerivationScheme2 pwd purposeXPrv coinTypeIndex + deriveXPrv DerivationScheme2 pwd purposeXPrv (getIndex coinTypeAda) acctXPrv = -- lvl3 derivation; hardened derivation of account' index deriveXPrv DerivationScheme2 pwd coinTypeXPrv accIx in diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Jormungandr.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Jormungandr.hs index 5d603887ca6..aa1fb27aad6 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Jormungandr.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Jormungandr.hs @@ -83,7 +83,7 @@ import Cardano.Wallet.Primitive.AddressDerivation import Cardano.Wallet.Primitive.AddressDiscovery ( IsOurs (..) ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential - ( SeqState, rewardAccountKey ) + ( SeqState, coinTypeAda, purposeCIP1852, rewardAccountKey ) import Cardano.Wallet.Primitive.Types ( Address (..), Hash (..), invariant ) import Control.DeepSeq @@ -103,7 +103,7 @@ import Data.Proxy import Data.Text.Class ( TextDecodingError (..) ) import Data.Word - ( Word32, Word8 ) + ( Word8 ) import GHC.Generics ( Generic ) import GHC.Stack @@ -143,33 +143,6 @@ addrSingleSize = 1 + publicKeySize addrGroupedSize :: Int addrGroupedSize = addrSingleSize + publicKeySize --- | Purpose is a constant set to 1852' (or 0x8000073c) following the BIP-44 --- extension for Cardano: --- --- https://github.com/input-output-hk/implementation-decisions/blob/e2d1bed5e617f0907bc5e12cf1c3f3302a4a7c42/text/1852-hd-chimeric.md --- --- It indicates that the subtree of this node is used according to this --- specification. --- --- Hardened derivation is used at this level. -purposeIndex :: Word32 -purposeIndex = 0x8000073c - --- | One master node (seed) can be used for unlimited number of independent --- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the --- same space for various cryptocoins has some disadvantages. --- --- This level creates a separate subtree for every cryptocoin, avoiding reusing --- addresses across cryptocoins and improving privacy issues. --- --- Coin type is a constant, set for each cryptocoin. For Cardano this constant --- is set to 1815' (or 0x80000717). 1815 is the birthyear of our beloved Ada --- Lovelace. --- --- Hardened derivation is used at this level. -coinTypeIndex :: Word32 -coinTypeIndex = 0x80000717 - -- | The minimum seed length for 'generateKeyFromSeed' and -- 'unsafeGenerateKeyFromSeed'. minSeedLengthBytes :: Int @@ -211,9 +184,9 @@ instance HardDerivation JormungandrKey where (Passphrase pwd) (JormungandrKey rootXPrv) (Index accIx) = let purposeXPrv = -- lvl1 derivation; hardened derivation of purpose' - deriveXPrv DerivationScheme2 pwd rootXPrv purposeIndex + deriveXPrv DerivationScheme2 pwd rootXPrv (getIndex purposeCIP1852) coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type' - deriveXPrv DerivationScheme2 pwd purposeXPrv coinTypeIndex + deriveXPrv DerivationScheme2 pwd purposeXPrv (getIndex coinTypeAda) acctXPrv = -- lvl3 derivation; hardened derivation of account' index deriveXPrv DerivationScheme2 pwd coinTypeXPrv accIx in diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs index 2d386ac8cd6..23791dbbbb3 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs @@ -79,7 +79,7 @@ import Cardano.Wallet.Primitive.AddressDerivation import Cardano.Wallet.Primitive.AddressDiscovery ( IsOurs (..) ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential - ( SeqState, rewardAccountKey ) + ( SeqState, coinTypeAda, purposeCIP1852, rewardAccountKey ) import Cardano.Wallet.Primitive.Types ( Address (..), Hash (..), invariant ) import Control.DeepSeq @@ -104,8 +104,6 @@ import Data.Proxy ( Proxy (..) ) import Data.Text.Class ( TextDecodingError (..) ) -import Data.Word - ( Word32 ) import GHC.Generics ( Generic ) @@ -131,33 +129,6 @@ newtype ShelleyKey (depth :: Depth) key = instance (NFData key) => NFData (ShelleyKey depth key) --- | Purpose is a constant set to 1852' (or 0x8000073c) following the BIP-44 --- extension for Cardano: --- --- https://github.com/input-output-hk/implementation-decisions/blob/e2d1bed5e617f0907bc5e12cf1c3f3302a4a7c42/text/1852-hd-chimeric.md --- --- It indicates that the subtree of this node is used according to this --- specification. --- --- Hardened derivation is used at this level. -purposeIndex :: Word32 -purposeIndex = 0x8000073c - --- | One master node (seed) can be used for unlimited number of independent --- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the --- same space for various cryptocoins has some disadvantages. --- --- This level creates a separate subtree for every cryptocoin, avoiding reusing --- addresses across cryptocoins and improving privacy issues. --- --- Coin type is a constant, set for each cryptocoin. For Cardano this constant --- is set to 1815' (or 0x80000717). 1815 is the birthyear of our beloved Ada --- Lovelace. --- --- Hardened derivation is used at this level. -coinTypeIndex :: Word32 -coinTypeIndex = 0x80000717 - -- | The minimum seed length for 'generateKeyFromSeed' and -- 'unsafeGenerateKeyFromSeed'. minSeedLengthBytes :: Int @@ -198,9 +169,9 @@ instance HardDerivation ShelleyKey where (Passphrase pwd) (ShelleyKey rootXPrv) (Index accIx) = let purposeXPrv = -- lvl1 derivation; hardened derivation of purpose' - deriveXPrv DerivationScheme2 pwd rootXPrv purposeIndex + deriveXPrv DerivationScheme2 pwd rootXPrv (getIndex purposeCIP1852) coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type' - deriveXPrv DerivationScheme2 pwd purposeXPrv coinTypeIndex + deriveXPrv DerivationScheme2 pwd purposeXPrv (getIndex coinTypeAda) acctXPrv = -- lvl3 derivation; hardened derivation of account' index deriveXPrv DerivationScheme2 pwd coinTypeXPrv accIx in diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs index 4ca74dbc8d6..bcca4c8ef76 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs @@ -55,6 +55,10 @@ module Cardano.Wallet.Primitive.AddressDiscovery.Sequential -- ** State , SeqState (..) + , DerivationPrefix (..) + , purposeBIP44 + , purposeCIP1852 + , coinTypeAda , mkSeqStateFromRootXPrv , mkSeqStateFromAccountXPub @@ -72,7 +76,7 @@ import Cardano.Wallet.Primitive.AddressDerivation , Depth (..) , DerivationType (..) , HardDerivation (..) - , Index + , Index (..) , KeyFingerprint (..) , MkKeyFingerprint (..) , NetworkDiscriminant (..) @@ -551,13 +555,8 @@ data SeqState (n :: NetworkDiscriminant) k = SeqState -- (cf: 'PendingIxs') , rewardAccountKey :: k 'AddressK XPub -- ^ Reward account public key associated with this wallet --- , derivationPath :: --- ( Index 'Hardened 'PurposeK --- , Index 'Hardened 'CoinTypeK --- , Index 'Hardened 'AccountK --- ) --- -- ^ Derivation path from a root key up to the internal account --- + , derivationPrefix :: DerivationPrefix + -- ^ Derivation path prefix from a root key up to the internal account } deriving stock (Generic) @@ -575,13 +574,76 @@ instance => NFData (SeqState n k) instance PersistPublicKey (k 'AccountK) => Buildable (SeqState n k) where - build (SeqState intP extP chgs _) = "SeqState:\n" + build (SeqState intP extP chgs _ path) = "SeqState:\n" + <> indentF 4 ("Derivation prefix: " <> build (toText path)) <> indentF 4 (build intP) <> indentF 4 (build extP) <> indentF 4 ("Change indexes: " <> indentF 4 chgsF) where chgsF = blockListF' "-" build (pendingIxsToList chgs) +newtype DerivationPrefix = DerivationPrefix + ( Index 'Hardened 'PurposeK + , Index 'Hardened 'CoinTypeK + , Index 'Hardened 'AccountK + ) deriving (Show, Generic) + +instance NFData DerivationPrefix + +instance ToText DerivationPrefix where + toText (DerivationPrefix (purpose, coinType, account)) + = T.intercalate "/" + $ map (T.pack . show) + [getIndex purpose, getIndex coinType, getIndex account] + +instance FromText DerivationPrefix where + fromText txt = + DerivationPrefix <$> case T.splitOn "/" txt of + [purposeT, coinTypeT, accountT] -> (,,) + <$> fromText purposeT + <*> fromText coinTypeT + <*> fromText accountT + _ -> + Left $ TextDecodingError "expected exactly 3 derivation paths" + + +-- | Purpose is a constant set to 44' (or 0x8000002C) following the original +-- BIP-44 specification. +-- +-- It indicates that the subtree of this node is used according to this +-- specification. +-- +-- Hardened derivation is used at this level. +purposeBIP44 :: Index 'Hardened 'PurposeK +purposeBIP44 = toEnum 0x8000002C + +-- | Purpose is a constant set to 1852' (or 0x8000073c) following the BIP-44 +-- extension for Cardano: +-- +-- https://github.com/input-output-hk/implementation-decisions/blob/e2d1bed5e617f0907bc5e12cf1c3f3302a4a7c42/text/1852-hd-chimeric.md +-- +-- It indicates that the subtree of this node is used according to this +-- specification. +-- +-- Hardened derivation is used at this level. +purposeCIP1852 :: Index 'Hardened 'PurposeK +purposeCIP1852 = toEnum 0x8000073c + +-- | One master node (seed) can be used for unlimited number of independent +-- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the +-- same space for various cryptocoins has some disadvantages. +-- +-- This level creates a separate subtree for every cryptocoin, avoiding reusing +-- addresses across cryptocoins and improving privacy issues. +-- +-- Coin type is a constant, set for each cryptocoin. For Cardano this constant +-- is set to 1815' (or 0x80000717). 1815 is the birthyear of our beloved Ada +-- Lovelace. +-- +-- Hardened derivation is used at this level. +coinTypeAda :: Index 'Hardened 'CoinTypeK +coinTypeAda = toEnum 0x80000717 + -- | Construct a Sequential state for a wallet from root private key and password. mkSeqStateFromRootXPrv :: forall n k. @@ -592,9 +654,10 @@ mkSeqStateFromRootXPrv , Bounded (Index (AddressIndexDerivationType k) 'AddressK) ) => (k 'RootK XPrv, Passphrase "encryption") + -> Index 'Hardened 'PurposeK -> AddressPoolGap -> SeqState n k -mkSeqStateFromRootXPrv (rootXPrv, pwd) g = +mkSeqStateFromRootXPrv (rootXPrv, pwd) purpose g = let accXPrv = deriveAccountPrivateKey pwd rootXPrv minBound @@ -604,8 +667,10 @@ mkSeqStateFromRootXPrv (rootXPrv, pwd) g = mkAddressPool @n (publicKey accXPrv) g [] intPool = mkAddressPool @n (publicKey accXPrv) g [] + prefix = + DerivationPrefix ( purpose, coinTypeAda, minBound ) in - SeqState intPool extPool emptyPendingIxs rewardXPub + SeqState intPool extPool emptyPendingIxs rewardXPub prefix -- | Construct a Sequential state for a wallet from public account key. mkSeqStateFromAccountXPub @@ -615,9 +680,10 @@ mkSeqStateFromAccountXPub , MkKeyFingerprint k Address ) => k 'AccountK XPub + -> Index 'Hardened 'PurposeK -> AddressPoolGap -> SeqState n k -mkSeqStateFromAccountXPub accXPub g = +mkSeqStateFromAccountXPub accXPub purpose g = let -- This matches the reward address for "normal wallets". The accountXPub -- is the first account, minBound being the first Soft index @@ -627,8 +693,10 @@ mkSeqStateFromAccountXPub accXPub g = mkAddressPool @n accXPub g [] intPool = mkAddressPool @n accXPub g [] + prefix = + DerivationPrefix ( purpose, coinTypeAda, minBound ) in - SeqState intPool extPool emptyPendingIxs rewardXPub + SeqState intPool extPool emptyPendingIxs rewardXPub prefix -- NOTE -- We have to scan both the internal and external chain. Note that, the @@ -648,13 +716,9 @@ instance , Index 'Soft 'RoleK , Index 'Soft 'AddressK ) - isOurs addr (SeqState !s1 !s2 !ixs !rpk) = + isOurs addr (SeqState !s1 !s2 !ixs !rpk !prefix) = let - purpose :: Index 'Hardened 'PurposeK - coinType :: Index 'Hardened 'CoinTypeK - accountIx :: Index 'Hardened 'AccountK - (purpose, coinType, accountIx) = undefined -- TODO: have this in the seq state - + DerivationPrefix (purpose, coinType, accountIx) = prefix (internal, !s1') = lookupAddress @n (const Used) addr s1 (external, !s2') = lookupAddress @n (const Used) addr s2 @@ -671,7 +735,7 @@ instance _ -> Nothing in - (ixs' `deepseq` ours `deepseq` ours, SeqState s1' s2' ixs' rpk) + (ixs' `deepseq` ours `deepseq` ours, SeqState s1' s2' ixs' rpk prefix) instance ( SoftDerivation k @@ -685,14 +749,14 @@ instance type ArgGenChange (SeqState n k) = (k 'AddressK XPub -> k 'AddressK XPub -> Address) - genChange mkAddress (SeqState intPool extPool pending rpk) = + genChange mkAddress (SeqState intPool extPool pending rpk path) = let (ix, pending') = nextChangeIndex intPool pending accountXPub = accountPubKey intPool addressXPub = deriveAddressPublicKey accountXPub UTxOInternal ix addr = mkAddress addressXPub rpk in - (addr, SeqState intPool extPool pending' rpk) + (addr, SeqState intPool extPool pending' rpk path) instance ( IsOurs (SeqState n k) Address @@ -702,7 +766,7 @@ instance , AddressIndexDerivationType k ~ 'Soft ) => IsOwned (SeqState n k) k where - isOwned (SeqState !s1 !s2 _ _) (rootPrv, pwd) addr = + isOwned (SeqState !s1 !s2 _ _ _) (rootPrv, pwd) addr = let xPrv1 = lookupAndDeriveXPrv s1 xPrv2 = lookupAndDeriveXPrv s2 @@ -728,7 +792,7 @@ instance , MkKeyFingerprint k Address , SoftDerivation k ) => CompareDiscovery (SeqState n k) where - compareDiscovery (SeqState !s1 !s2 _ _) a1 a2 = + compareDiscovery (SeqState !s1 !s2 _ _ _) a1 a2 = case (ix a1 s1 <|> ix a1 s2, ix a2 s1 <|> ix a2 s2) of (Nothing, Nothing) -> EQ (Nothing, Just _) -> GT @@ -803,10 +867,11 @@ mkSeqAnyState , Bounded (Index (AddressIndexDerivationType k) 'AddressK) ) => (k 'RootK XPrv, Passphrase "encryption") + -> Index 'Hardened 'PurposeK -> AddressPoolGap -> SeqAnyState n k p -mkSeqAnyState credentials poolGap = SeqAnyState - { innerState = mkSeqStateFromRootXPrv credentials poolGap +mkSeqAnyState credentials purpose poolGap = SeqAnyState + { innerState = mkSeqStateFromRootXPrv credentials purpose poolGap } instance