From d87fc55ce542c3b1d074dcbc2cbc7694d9fc0c65 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 2 May 2019 14:21:41 +0200 Subject: [PATCH] review isOurs & AddressScheme abstractions to be more granular (+review location) --- src/Cardano/Wallet.hs | 10 +- .../Wallet/Primitive/AddressDerivation.hs | 1 - .../Wallet/Primitive/AddressDiscovery.hs | 143 +++++++++++------- src/Cardano/Wallet/Primitive/Model.hs | 3 +- src/Cardano/Wallet/Primitive/Signing.hs | 69 ++++----- src/Cardano/Wallet/Primitive/Types.hs | 19 --- .../Wallet/Primitive/AddressDiscovery/Any.hs | 16 +- test/bench/Main.hs | 7 +- test/unit/Cardano/Wallet/DB/MVarSpec.hs | 3 +- .../Wallet/Primitive/AddressDiscoverySpec.hs | 22 +-- .../Cardano/Wallet/Primitive/ModelSpec.hs | 3 +- .../Cardano/Wallet/Primitive/SigningSpec.hs | 21 +-- test/unit/Cardano/WalletSpec.hs | 12 +- 13 files changed, 167 insertions(+), 162 deletions(-) diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs index 44c59a21617..dc41caa51e5 100644 --- a/src/Cardano/Wallet.hs +++ b/src/Cardano/Wallet.hs @@ -65,7 +65,7 @@ import Cardano.Wallet.Primitive.AddressDerivation , encryptPassphrase ) import Cardano.Wallet.Primitive.AddressDiscovery - ( AddressScheme (..) ) + ( GenChange (..), IsOwned (..) ) import Cardano.Wallet.Primitive.Model ( Wallet , applyBlocks @@ -82,7 +82,6 @@ import Cardano.Wallet.Primitive.Types ( Block (..) , Coin (..) , Direction (..) - , IsOurs (..) , SignedTx (..) , SlotId (..) , Tx @@ -234,7 +233,7 @@ data ErrSubmitTx -- | Create a new instance of the wallet layer. mkWalletLayer - :: forall s. (IsOurs s, AddressScheme s, NFData s, Show s) + :: forall s. (IsOwned s, GenChange s, NFData s, Show s) => DBLayer IO s -> NetworkLayer IO -> WalletLayer s @@ -291,11 +290,12 @@ mkWalletLayer db network = WalletLayer , signTx = \wid pwd (CoinSelection ins outs chgs) -> DB.withLock db $ do (w, _) <- withExceptT ErrSignTxNoSuchWallet $ _readWallet wid let (changeOuts, s') = flip runState (getState w) $ forM chgs $ \c -> do - addr <- state nextChangeAddress + addr <- state genChange return $ TxOut addr c allShuffledOuts <- liftIO $ shuffle (outs ++ changeOuts) withRootKey wid pwd ErrSignTxWrongPassphrase $ \xprv -> do - case mkStdTx (getState w) (xprv, pwd) ins allShuffledOuts of + let keyFrom = isOwned (getState w) (xprv, pwd) + case mkStdTx keyFrom ins allShuffledOuts of Right (tx, wit) -> do -- Safe because we have a lock and we already fetched the -- wallet within this context. diff --git a/src/Cardano/Wallet/Primitive/AddressDerivation.hs b/src/Cardano/Wallet/Primitive/AddressDerivation.hs index 7ec87189b3d..980acbc0746 100644 --- a/src/Cardano/Wallet/Primitive/AddressDerivation.hs +++ b/src/Cardano/Wallet/Primitive/AddressDerivation.hs @@ -573,7 +573,6 @@ keyToAddress (Key xpub) = emptyAttributes = CBOR.encodeMapLen 0 - -- $use -- 'Key' and 'Index' allow for representing public keys, private keys, hardened -- indexes and soft (non-hardened) indexes for various level in a non-ambiguous diff --git a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs index 9cc37fcca23..8250d91f067 100644 --- a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs +++ b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs @@ -7,6 +7,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} -- | @@ -20,10 +21,14 @@ module Cardano.Wallet.Primitive.AddressDiscovery ( - -- * Sequential Derivation + -- * Abstractions + IsOurs(..) + , IsOwned(..) + , GenChange(..) + -- * Sequential Derivation -- ** Address Pool Gap - AddressPoolGap + , AddressPoolGap , MkAddressPoolGapError (..) , defaultAddressPoolGap , getAddressPoolGap @@ -45,7 +50,6 @@ module Cardano.Wallet.Primitive.AddressDiscovery -- ** State , SeqState (..) , mkSeqState - , AddressScheme (..) ) where import Prelude @@ -66,7 +70,7 @@ import Cardano.Wallet.Primitive.AddressDerivation , publicKey ) import Cardano.Wallet.Primitive.Types - ( Address, IsOurs (..), invariant ) + ( Address, invariant ) import Control.Applicative ( (<|>) ) import Control.DeepSeq @@ -96,6 +100,60 @@ import qualified Data.List as L import qualified Data.Map.Strict as Map import qualified Data.Text as T +-- | This abstraction exists to give us the ability to keep the wallet business +-- logic agnostic to the address derivation and discovery mechanisms. +-- +-- This is needed because two different address schemes lives on Cardano: +-- +-- - A hierarchical random scheme: +-- rather 'custom' made, with several flaws; this is the original and now +-- legacy address scheme. +-- +-- - A hierarchical sequential scheme: +-- a new scheme based on the BIP-0044 specification, which is better suited +-- for our present needs. +-- +-- In practice, we will need a wallet that can support both, even if not at the +-- same time, and this little abstraction can buy us this without introducing +-- too much overhead. +class IsOurs s where + isOurs + :: Address + -> s + -> (Bool, s) + -- ^ Checks whether an address is ours or not. + +-- | More powerful than 'isOurs', this abstractions offer the underlying state +-- the ability to find / compute the address private key corresponding to a +-- given known address. +-- +-- Requiring 'IsOwned' as a constraint supposed that there is a way to recover +-- the root private key of a particular wallet. This isn't true for externally +-- owned wallet which would delegate its key management to a third party (like +-- a hardware Ledger or Trezor). +class IsOurs s => IsOwned s where + isOwned + :: s + -> (Key 'RootK XPrv, Passphrase "encryption") + -> Address + -> Maybe (Key 'AddressK XPrv, Passphrase "encryption") + -- ^ Derive the private key corresponding to an address. Careful, this + -- operation can be costly. Note that the state is discarded from this + -- function as we do not intend to discover any addresses from this + -- operation; This is merely a lookup from known addresses. + +-- | Abstracting over change address generation. In theory, this is only needed +-- for sending transactions on a wallet following a particular scheme. This +-- abstractions allows for defining an heuristic to pick new change address. For +-- instance, in BIP-44, change addresses belong to a particular change chain +-- (also called "Internal Chain"). +class GenChange s where + genChange + :: s + -> (Address, s) + -- ^ Generate a new change address for the given scheme. The rules for + -- generating a new change address depends on the underlying scheme. + {------------------------------------------------------------------------------- Sequential Derivation @@ -380,51 +438,41 @@ mkSeqState (rootXPrv, pwd) g = -- in theory, there's nothing forcing a wallet to generate change -- addresses on the internal chain anywhere in the available range. instance IsOurs SeqState where - isOurs addr (SeqState !s1 !s2 !ixs) = - let - (internal, !s1') = lookupAddress addr s1 - (external, !s2') = lookupAddress addr s2 - !ixs' = case internal of + isOurs addr (SeqState !s1 !s2 !ixs) = + let + (internal, !s1') = lookupAddress addr s1 + (external, !s2') = lookupAddress addr s2 + !ixs' = case internal of Nothing -> ixs Just ix -> updatePendingIxs ix ixs - ours = isJust (internal <|> external) - in - (ixs' `deepseq` ours `deepseq` ours, SeqState s1' s2' ixs') - --- TODO: We might want to move this abstraction / there is more work to be --- done here. --- --- It would maybe be nice to derive IsOurs from AddressScheme automatically --- A /possible/ way to do that would be to return --- Maybe ((Key 'RootK XPrv, Passphrase "encryption") -> Key 'AddressK XPrv) --- instead, such that we can use @isJust@ without knowing the rootKey and pwd. -class AddressScheme s where - keyFrom - :: Address - -> (Key 'RootK XPrv, Passphrase "encryption") - -> s - -> Maybe (Key 'AddressK XPrv) - -- ^ Derive the private key corresponding to an address. Careful, this - -- operation can be costly. Note that the state is discarded from this - -- function as we do not intend to discover any addresses from this - -- operation; This is merely a lookup from known addresses. + ours = isJust (internal <|> external) + in + (ixs' `deepseq` ours `deepseq` ours, SeqState s1' s2' ixs') - nextChangeAddress - :: s - -> (Address, s) - -- ^ Picks the first non-used known change address and use it. - -- We keep track of pending indexes in the state. In case there's no - -- more unused change address available, we pick an already existing - -- one. +instance GenChange SeqState where + -- | We pick indexes in sequence from the first known available index (i.e. + -- @length addrs - gap@) but we do not generate _new change addresses_. As a + -- result, we can't generate more than @gap@ _pending_ change addresses and + -- therefore, rotate the change addresses when we need extra change outputs. + -- + -- See also: 'nextChangeIndex' + genChange (SeqState intPool extPool pending) = + let + (ix, pending') = nextChangeIndex intPool pending + accountXPub = accountPubKey intPool + addressXPub = deriveAddressPublicKey accountXPub InternalChain ix + addr = keyToAddress addressXPub + in + (addr, SeqState intPool extPool pending') -instance AddressScheme SeqState where - keyFrom addr (rootPrv, pwd) (SeqState !s1 !s2 _) = +instance IsOwned SeqState where + isOwned (SeqState !s1 !s2 _) (rootPrv, pwd) addr = let xPrv1 = lookupAndDeriveXPrv s1 xPrv2 = lookupAndDeriveXPrv s2 xPrv = xPrv1 <|> xPrv2 in - xPrv + (,pwd) <$> xPrv where lookupAndDeriveXPrv :: forall chain. Typeable chain @@ -438,18 +486,3 @@ instance AddressScheme SeqState where cc = changeChain @chain in deriveAddressPrivateKey pwd accountPrv cc <$> addrIx - - -- | We pick indexes in sequence from the first known available index (i.e. - -- @length addrs - gap@) but we do not generate _new change addresses_. As a - -- result, we can't generate more than @gap@ _pending_ change addresses and - -- therefore, rotate the change addresses when we need extra change outputs. - -- - -- See also: 'nextChangeIndex' - nextChangeAddress (SeqState intPool extPool pending) = - let - (ix, pending') = nextChangeIndex intPool pending - accountXPub = accountPubKey intPool - addressXPub = deriveAddressPublicKey accountXPub InternalChain ix - addr = keyToAddress addressXPub - in - (addr, SeqState intPool extPool pending') diff --git a/src/Cardano/Wallet/Primitive/Model.hs b/src/Cardano/Wallet/Primitive/Model.hs index 28279876290..26c7855dcf1 100644 --- a/src/Cardano/Wallet/Primitive/Model.hs +++ b/src/Cardano/Wallet/Primitive/Model.hs @@ -50,12 +50,13 @@ import Prelude import Cardano.Wallet.Binary ( txId ) +import Cardano.Wallet.Primitive.AddressDiscovery + ( IsOurs (..) ) import Cardano.Wallet.Primitive.Types ( Block (..) , Direction (..) , Dom (..) , Hash (..) - , IsOurs (..) , SlotId (..) , Tx (..) , TxIn (..) diff --git a/src/Cardano/Wallet/Primitive/Signing.hs b/src/Cardano/Wallet/Primitive/Signing.hs index 018704a8b60..82e6667646c 100644 --- a/src/Cardano/Wallet/Primitive/Signing.hs +++ b/src/Cardano/Wallet/Primitive/Signing.hs @@ -26,16 +26,7 @@ import Cardano.Environment import Cardano.Wallet.Binary ( TxWitness (..), encodeTx, toByteString ) import Cardano.Wallet.Primitive.AddressDerivation - ( Depth (AddressK, RootK) - , Key - , Passphrase (..) - , XPrv - , XPub - , getKey - , publicKey - ) -import Cardano.Wallet.Primitive.AddressDiscovery - ( AddressScheme (keyFrom) ) + ( Depth (AddressK), Key, Passphrase (..), XPrv, XPub, getKey, publicKey ) import Cardano.Wallet.Primitive.Types ( Address, Hash (..), Tx (..), TxIn, TxOut (..) ) import Control.Monad @@ -60,58 +51,60 @@ newtype SignTxError -- " Standard " here refers to the fact that we do not deal with redemption, -- multisignature transactions, etc. mkStdTx - :: AddressScheme s - => s + :: (Address -> Maybe (Key 'AddressK XPrv, Passphrase "encryption")) -- ^ A 'state' from which an address private key can be looked up - -> (Key 'RootK XPrv, Passphrase "encryption") - -- ^ Credentials associated with this address -> [(TxIn, TxOut)] -- ^ Selected inputs -> [TxOut] -- ^ Selected outputs (including change) -> Either SignTxError (Tx, [TxWitness]) -mkStdTx s creds@(_, pwd) ownedIns outs = do - let ins = (fmap fst ownedIns) +mkStdTx keyFrom inps outs = do + let ins = (fmap fst inps) let tx = Tx ins outs let txSigData = hashTx tx - txWitnesses <- forM ownedIns $ \(_in, TxOut addr _c) -> mkWitness txSigData - <$> withEither (KeyNotFoundForAddress addr) (keyFrom addr creds s) + txWitnesses <- forM inps $ \(_in, TxOut addr _c) -> mkWitness txSigData + <$> withEither (KeyNotFoundForAddress addr) (keyFrom addr) return (tx, txWitnesses) where withEither :: e -> Maybe a -> Either e a withEither e = maybe (Left e) Right + hashTx :: Tx -> Hash "tx" hashTx txSigData = Hash $ BA.convert $ (hash @_ @Blake2b_256) $ toByteString $ encodeTx txSigData - mkWitness :: Hash "tx" -> Key 'AddressK XPrv -> TxWitness - mkWitness tx xPrv = PublicKeyWitness + + mkWitness + :: Hash "tx" + -> (Key 'AddressK XPrv, Passphrase "encryption") + -> TxWitness + mkWitness tx (xPrv, pwd) = PublicKeyWitness (encodeXPub $ publicKey xPrv) (sign (SignTx tx) (xPrv, pwd)) + encodeXPub :: (Key level XPub) -> ByteString encodeXPub = CC.unXPub . getKey --- | Used for signing transactions -sign - :: SignTag - -> (Key 'AddressK XPrv, Passphrase "encryption") - -> Hash "signature" -sign tag (key, (Passphrase pwd)) = - Hash . CC.unXSignature $ CC.sign pwd (getKey key) (signTag tag) - where - -- | Encode magic bytes & the contents of a @SignTag@. Magic bytes are - -- guaranteed to be different (and begin with a different byte) for different - -- tags. - signTag :: SignTag -> ByteString - signTag = \case - SignTx (Hash payload) -> - "\x01" <> pm <> toByteString (CBOR.encodeBytes payload) + sign + :: SignTag + -> (Key 'AddressK XPrv, Passphrase "encryption") + -> Hash "signature" + sign tag (key, (Passphrase pwd)) = + Hash . CC.unXSignature $ CC.sign pwd (getKey key) (signTag tag) where - pm = - let ProtocolMagic x = protocolMagic network - in toByteString . CBOR.encodeInt32 $ x + -- | Encode magic bytes & the contents of a @SignTag@. Magic bytes are + -- guaranteed to be different (and begin with a different byte) for different + -- tags. + signTag :: SignTag -> ByteString + signTag = \case + SignTx (Hash payload) -> + "\x01" <> pm <> toByteString (CBOR.encodeBytes payload) + where + pm = + let ProtocolMagic x = protocolMagic network + in toByteString . CBOR.encodeInt32 $ x -- | To protect agains replay attacks (i.e. when an attacker intercepts a -- signed piece of data and later sends it again), we add a tag to all data diff --git a/src/Cardano/Wallet/Primitive/Types.hs b/src/Cardano/Wallet/Primitive/Types.hs index 183e794c4fb..b5ca099a070 100644 --- a/src/Cardano/Wallet/Primitive/Types.hs +++ b/src/Cardano/Wallet/Primitive/Types.hs @@ -42,7 +42,6 @@ module Cardano.Wallet.Primitive.Types , txIns -- * Address - , IsOurs(..) , Address (..) , AddressState (..) @@ -405,24 +404,6 @@ data TxWitness Address -------------------------------------------------------------------------------} --- | This abstraction exists to give us the ability to keep the wallet business --- logic agnostic to the address derivation and discovery mechanisms. --- --- This is needed because two different address schemes lives on Cardano: --- - A hierarchical random scheme: --- rather 'custom' made, with several flaws; this is the original and now --- legacy address scheme. --- --- - A hierarchical sequential scheme: --- a new scheme based on the BIP-0044 specification, which is better suited --- for our present needs. --- --- In practice, we will need a wallet that can support both, even if not at the --- same time, and this little abstraction can buy us this without introducing --- too much overhead. -class IsOurs s where - isOurs :: Address -> s -> (Bool, s) - newtype Address = Address { getAddress :: ByteString } deriving (Show, Generic, Eq, Ord) diff --git a/test/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs b/test/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs index 457d080cc19..fdd6c6d69d1 100644 --- a/test/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs +++ b/test/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs @@ -18,9 +18,9 @@ module Cardano.Wallet.Primitive.AddressDiscovery.Any import Prelude import Cardano.Wallet.Primitive.AddressDiscovery - ( AddressScheme (..) ) + ( GenChange (..), IsOurs (..), IsOwned (..) ) import Cardano.Wallet.Primitive.Types - ( Address (..), IsOurs (..), WalletId (..), WalletName (..) ) + ( Address (..), WalletId (..), WalletName (..) ) import Control.DeepSeq ( NFData ) import Crypto.Hash @@ -52,12 +52,14 @@ instance NFData AnyAddressState instance IsOurs AnyAddressState where isOurs (Address addr) s@(AnyAddressState p) = (crc32 addr < p', s) where - p' = floor (fromIntegral (maxBound :: Word32) * p) + p' = floor (fromIntegral (maxBound :: Word32) * p) -instance AddressScheme AnyAddressState where - keyFrom _ _ _ = Nothing - nextChangeAddress _ = error - "AddressScheme.nextChangeAddress: trying to generate change for \ +instance IsOwned AnyAddressState where + isOwned _ _ _ = Nothing + +instance GenChange AnyAddressState where + genChange _ = error + "GenChange.genChange: trying to generate change for \ \an incompatible scheme 'AnyAddressState'. Please don't." initAnyState :: Text -> Double -> (WalletId, WalletName, AnyAddressState) diff --git a/test/bench/Main.hs b/test/bench/Main.hs index c4515054666..66f9472969c 100644 --- a/test/bench/Main.hs +++ b/test/bench/Main.hs @@ -18,14 +18,13 @@ import Cardano.Wallet.Network.HttpBridge import Cardano.Wallet.Primitive.AddressDerivation ( Passphrase (..), digest, generateKeyFromSeed, publicKey ) import Cardano.Wallet.Primitive.AddressDiscovery - ( AddressScheme (..), SeqState, defaultAddressPoolGap, mkSeqState ) + ( GenChange, IsOwned, SeqState, defaultAddressPoolGap, mkSeqState ) import Cardano.Wallet.Primitive.AddressDiscovery.Any ( AnyAddressState, initAnyState ) import Cardano.Wallet.Primitive.Model ( totalBalance, totalUTxO ) import Cardano.Wallet.Primitive.Types - ( IsOurs (..) - , SlotId (..) + ( SlotId (..) , UTxO (..) , WalletId (..) , WalletName (..) @@ -145,7 +144,7 @@ overrideEnvironment _ = {-# ANN bench_restoration ("HLint: ignore Use camelCase" :: String) #-} bench_restoration - :: (IsOurs s, AddressScheme s, NFData s, Show s) + :: (IsOwned s, GenChange s, NFData s, Show s) => (WalletId, WalletName, s) -> IO () bench_restoration (wid, wname, s) = withHttpBridge $ \port -> do diff --git a/test/unit/Cardano/Wallet/DB/MVarSpec.hs b/test/unit/Cardano/Wallet/DB/MVarSpec.hs index 7cef9289c24..4e1ae383a4b 100644 --- a/test/unit/Cardano/Wallet/DB/MVarSpec.hs +++ b/test/unit/Cardano/Wallet/DB/MVarSpec.hs @@ -29,12 +29,13 @@ import Cardano.Wallet.DB.MVar ( newDBLayer ) import Cardano.Wallet.Primitive.AddressDerivation ( Depth (..), Key, Passphrase (..), XPrv, generateKeyFromSeed ) +import Cardano.Wallet.Primitive.AddressDiscovery + ( IsOurs (..) ) import Cardano.Wallet.Primitive.Model ( Wallet, initWallet ) import Cardano.Wallet.Primitive.Types ( Direction (..) , Hash (..) - , IsOurs (..) , SlotId (..) , Tx (..) , TxMeta (..) diff --git a/test/unit/Cardano/Wallet/Primitive/AddressDiscoverySpec.hs b/test/unit/Cardano/Wallet/Primitive/AddressDiscoverySpec.hs index 40e6bdb0976..f8ed6134f9e 100644 --- a/test/unit/Cardano/Wallet/Primitive/AddressDiscoverySpec.hs +++ b/test/unit/Cardano/Wallet/Primitive/AddressDiscoverySpec.hs @@ -26,7 +26,9 @@ import Cardano.Wallet.Primitive.AddressDerivation import Cardano.Wallet.Primitive.AddressDiscovery ( AddressPool , AddressPoolGap - , AddressScheme (..) + , GenChange (..) + , IsOurs (..) + , IsOwned (..) , MkAddressPoolGapError (..) , SeqState (..) , accountPubKey @@ -35,14 +37,14 @@ import Cardano.Wallet.Primitive.AddressDiscovery , defaultAddressPoolGap , emptyPendingIxs , gap + , genChange , lookupAddress , mkAddressPool , mkAddressPoolGap , mkSeqState - , nextChangeAddress ) import Cardano.Wallet.Primitive.Types - ( Address, IsOurs (..), ShowFmt (..) ) + ( Address, ShowFmt (..) ) import Control.Monad ( forM, unless ) import Control.Monad.IO.Class @@ -141,13 +143,15 @@ spec = do it "fail fromText @AddressPoolGap \"raczej nie\"" $ fromText @AddressPoolGap "raczej nie" === Left (TextDecodingError err) - describe "PendingIxs & AddressScheme" $ do + describe "PendingIxs & GenChange" $ do it "Can always generate exactly `gap` different change addresses" - (property prop_nextChangeAddressGap) + (property prop_genChangeGap) it "After `gap` change addresses, the same one are yield in reverse order" (property prop_changeAddressRotation) it "Can generate new change addresses after discovering a pending one" (property prop_changeNoLock) + + describe "IsOwned" $ do it "Any discovered address has a corresponding private key!" $ do (property prop_lookupDiscovered) @@ -255,10 +259,10 @@ prop_poolEventuallyDiscoverOurs (g, addr) = -- | We can always generate at exactly `gap` change addresses (on the internal -- chain) -prop_nextChangeAddressGap +prop_genChangeGap :: AddressPoolGap -> Property -prop_nextChangeAddressGap g = +prop_genChangeGap g = property prop where key = unsafeGenerateKeyFromSeed (mempty, mempty) mempty @@ -296,7 +300,7 @@ prop_lookupDiscovered (s0, addr) = where key = unsafeGenerateKeyFromSeed (mempty, mempty) mempty prop s = monadicIO $ liftIO $ do - unless (isJust $ keyFrom addr (key, mempty) s) $ do + unless (isJust $ isOwned s (key, mempty) addr) $ do expectationFailure "couldn't find private key corresponding to addr" @@ -321,7 +325,7 @@ changeAddresses -> SeqState -> ([Address], SeqState) changeAddresses as s = - let (a, s') = nextChangeAddress s + let (a, s') = genChange s in if a `elem` as then (as, s) else changeAddresses (a:as) s' instance Arbitrary AddressPoolGap where diff --git a/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs b/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs index 7043d257d9c..220eb239ede 100644 --- a/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs +++ b/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs @@ -12,6 +12,8 @@ import Prelude import Cardano.Wallet.Binary ( txId ) +import Cardano.Wallet.Primitive.AddressDiscovery + ( IsOurs (..) ) import Cardano.Wallet.Primitive.Model ( applyBlock , applyBlocks @@ -30,7 +32,6 @@ import Cardano.Wallet.Primitive.Types , Direction (..) , Dom (..) , Hash (..) - , IsOurs (..) , ShowFmt (..) , SlotId (..) , Tx (..) diff --git a/test/unit/Cardano/Wallet/Primitive/SigningSpec.hs b/test/unit/Cardano/Wallet/Primitive/SigningSpec.hs index 52e2fe39bea..ab333a11628 100644 --- a/test/unit/Cardano/Wallet/Primitive/SigningSpec.hs +++ b/test/unit/Cardano/Wallet/Primitive/SigningSpec.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -22,8 +23,6 @@ import Cardano.Wallet.Primitive.AddressDerivation , publicKey , unsafeGenerateKeyFromSeed ) -import Cardano.Wallet.Primitive.AddressDiscovery - ( AddressScheme (..) ) import Cardano.Wallet.Primitive.Signing ( SignTxError (..), mkStdTx ) import Cardano.Wallet.Primitive.Types @@ -34,8 +33,6 @@ import Data.ByteArray.Encoding ( Base (..), convertFromBase, convertToBase ) import Data.ByteString ( ByteString ) -import Data.Map - ( Map ) import Data.Word ( Word32 ) import Test.Hspec @@ -49,10 +46,9 @@ spec = do describe "mkStdTx" $ do it "Unknown input address yields an error" $ do let addr = keyToAddress $ publicKey $ xprv "addr" - let res = mkStdTx s creds inps outs + let res = mkStdTx keyFrom inps outs where - s = mempty :: Map Address (Key 'AddressK XPrv) - creds = (xprv "arbitrary", mempty) + keyFrom = const Nothing inps = [ ( TxIn (Hash "arbitrary") 0 , TxOut addr (Coin 0) @@ -612,9 +608,10 @@ goldenTestSignedTx goldenTestSignedTx nOuts xprvs expected = it title $ do let addrs = first (keyToAddress . publicKey) <$> xprvs let s = Map.fromList (zip (fst <$> addrs) (fst <$> xprvs)) + let keyFrom a = (,mempty) <$> Map.lookup a s let inps = mkInput <$> zip addrs [0..] let outs = take nOuts $ mkOutput <$> cycle addrs - let res = mkStdTx s (rootXPrv, mempty) inps outs + let res = mkStdTx keyFrom inps outs case res of Left e -> fail (show e) Right tx -> do @@ -648,14 +645,6 @@ goldenTestSignedTx nOuts xprvs expected = it title $ do faucetTx = either (\e -> error $ "faucetTx: " <> e) Hash $ convertFromBase @ByteString Base16 "3B40265111D8BB3C3C608D95B3A0BF83461ACE32D79336579A1939B3AAD1C0B7" - rootXPrv :: Key 'RootK XPrv - rootXPrv = - error "rootXPrv was evaluated but it shouldn't" - -instance AddressScheme (Map Address (Key 'AddressK XPrv)) where - keyFrom addr _ = Map.lookup addr - nextChangeAddress = error "AddressScheme.nextChangeAddress: not implemented" - {- NOTE: The above golden tests were obtained from 'cardano-sl@3.0.1', using the following code: diff --git a/test/unit/Cardano/WalletSpec.hs b/test/unit/Cardano/WalletSpec.hs index b9aec0f367e..4e437b892e5 100644 --- a/test/unit/Cardano/WalletSpec.hs +++ b/test/unit/Cardano/WalletSpec.hs @@ -21,9 +21,9 @@ import Cardano.Wallet.DB.MVar import Cardano.Wallet.Network.HttpBridge ( newNetworkLayer ) import Cardano.Wallet.Primitive.AddressDiscovery - ( AddressScheme (..) ) + ( GenChange (..), IsOurs (..), IsOwned (..) ) import Cardano.Wallet.Primitive.Types - ( Address (..), IsOurs (..), WalletId (..), WalletName (..) ) + ( Address (..), WalletId (..), WalletName (..) ) import Control.DeepSeq ( NFData (..) ) import Control.Monad @@ -157,9 +157,11 @@ instance Arbitrary DummyState where instance IsOurs DummyState where isOurs _ s = (True, s) -instance AddressScheme DummyState where - keyFrom _ _ _ = Nothing - nextChangeAddress s = (Address "dummy", s) +instance IsOwned DummyState where + isOwned _ _ _ = Nothing + +instance GenChange DummyState where + genChange s = (Address "dummy", s) instance Arbitrary WalletId where shrink _ = []