diff --git a/core/test/Test/Pos/Core/Arbitrary.hs b/core/test/Test/Pos/Core/Arbitrary.hs index ce500033865..796ed21cd83 100644 --- a/core/test/Test/Pos/Core/Arbitrary.hs +++ b/core/test/Test/Pos/Core/Arbitrary.hs @@ -19,6 +19,7 @@ module Test.Pos.Core.Arbitrary , SafeCoinPairSub (..) , UnreasonableEoS (..) + , genAddress , genSlotId , genLocalSlotIndex ) where @@ -259,6 +260,11 @@ instance Arbitrary Address where arbitrary = makeAddress <$> arbitrary <*> arbitrary shrink = genericShrink +genAddress :: NetworkMagic -> Gen Address +genAddress nm = makeAddress <$> arbitrary <*> genAddrAttr + where + genAddrAttr = AddrAttributes <$> arbitrary <*> arbitrary <*> pure nm + ---------------------------------------------------------------------------- -- Attributes ---------------------------------------------------------------------------- diff --git a/wallet-new/src/Cardano/Wallet/API/V1/ReifyWalletError.hs b/wallet-new/src/Cardano/Wallet/API/V1/ReifyWalletError.hs index 4d2983005d1..ad22df3083a 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/ReifyWalletError.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/ReifyWalletError.hs @@ -361,3 +361,6 @@ newPaymentError e = case e of (NewPaymentUnknownAccountId e') -> unknownHdAccount e' + + ex@(NewPaymentAddressBadNetworkMagic _ _) -> + V1.UnknownError $ (sformat build ex) diff --git a/wallet-new/src/Cardano/Wallet/WalletLayer.hs b/wallet-new/src/Cardano/Wallet/WalletLayer.hs index 22883227823..bb57d5baf38 100644 --- a/wallet-new/src/Cardano/Wallet/WalletLayer.hs +++ b/wallet-new/src/Cardano/Wallet/WalletLayer.hs @@ -39,7 +39,9 @@ import Pos.Chain.Block (Blund) import Pos.Chain.Txp (Tx, TxId, Utxo) import Pos.Chain.Update (ConfirmedProposalState, SoftwareVersion) import Pos.Core (Coin, Timestamp) +import qualified Pos.Core as Core (Address) import Pos.Core.Chrono (NE, NewestFirst (..), OldestFirst (..)) +import Pos.Core.NetworkMagic (NetworkMagic) import Pos.Crypto (EncryptedSecretKey, PassPhrase) import Cardano.Wallet.API.Request (RequestParams (..)) @@ -569,6 +571,7 @@ data NewPaymentError = | NewPaymentTimeLimitReached TimeExecutionLimit | NewPaymentWalletIdDecodingFailed Text | NewPaymentUnknownAccountId Kernel.UnknownHdAccount + | NewPaymentAddressBadNetworkMagic NetworkMagic (NonEmpty Core.Address) -- | Unsound show instance needed for the 'Exception' instance. instance Show NewPaymentError where @@ -585,6 +588,10 @@ instance Buildable NewPaymentError where bprint ("NewPaymentWalletIdDecodingFailed " % build) txt build (NewPaymentUnknownAccountId err) = bprint ("NewPaymentUnknownAccountId " % build) err + build (NewPaymentAddressBadNetworkMagic expectedNM dstAddrs) = + bprint ("NewPaymentAddressBadNetworkMagic " % build % " " % build) + expectedNM + (toList dstAddrs) data EstimateFeesError = diff --git a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs index 3e7c61cd9ab..75054b4c773 100644 --- a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs +++ b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs @@ -17,7 +17,9 @@ import Data.Time.Units (Second) import Pos.Binary.Class (decodeFull') import Pos.Chain.Txp (Tx (..), TxSigData (..)) -import Pos.Core (Address, Coin, TxFeePolicy) +import Pos.Core (AddrAttributes (..), Address (..), Coin, TxFeePolicy) +import Pos.Core.Attributes (Attributes (..)) +import Pos.Core.NetworkMagic (NetworkMagic, makeNetworkMagic) import Pos.Crypto (PassPhrase, PublicKey, Signature (..)) import Cardano.Crypto.Wallet (xsignature) @@ -29,6 +31,7 @@ import Cardano.Wallet.Kernel.CoinSelection.FromGeneric InputGrouping, newOptions) import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD import Cardano.Wallet.Kernel.DB.TxMeta.Types +import Cardano.Wallet.Kernel.Internal (walletProtocolMagic) import qualified Cardano.Wallet.Kernel.NodeStateAdaptor as Node import qualified Cardano.Wallet.Kernel.Transactions as Kernel import Cardano.Wallet.WalletLayer (EstimateFeesError (..), @@ -52,8 +55,39 @@ pay activeWallet pw grouping regulation payment = liftIO $ do runExceptT $ do (opts, accId, payees) <- withExceptT NewPaymentWalletIdDecodingFailed $ setupPayment policy grouping regulation payment + + -- Verify that all payee addresses are of the same `NetworkMagic` + -- as our `ActiveWallet`. + let nm = makeNetworkMagic $ Kernel.walletPassive activeWallet ^. walletProtocolMagic + ExceptT $ pure $ verifyPayeesNM nm payees + + -- Pay the payees withExceptT NewPaymentError $ ExceptT $ - Kernel.pay activeWallet pw opts accId payees + Kernel.pay activeWallet pw opts accId payees + +-- | Verifies that the `NetworkMagic` of each payee address matches the +-- provided `NetworkMagic`. +verifyPayeesNM + :: NetworkMagic + -> NonEmpty (Address, Coin) + -> Either NewPaymentError () +verifyPayeesNM nm payees = + case nonEmpty invalidPayees of + Nothing -> Right () + Just is -> Left $ NewPaymentAddressBadNetworkMagic nm is + where + addressHasValidMagic :: AddrAttributes -> Bool + addressHasValidMagic addrAttrs = nm == (aaNetworkMagic addrAttrs) + -- + verifyPayeeNM + :: (Address, Coin) + -> Either Address () + verifyPayeeNM (addr, _) + | (addressHasValidMagic ((attrData . addrAttributes) addr)) = Right () + | otherwise = Left addr + -- + invalidPayees :: [Address] + invalidPayees = fst $ partitionEithers (toList (map verifyPayeeNM payees)) -- | Estimates the fees for a payment. estimateFees :: MonadIO m diff --git a/wallet-new/test/unit/Test/Spec/CoinSelection/Generators.hs b/wallet-new/test/unit/Test/Spec/CoinSelection/Generators.hs index 19b5e2b427f..9ead2ed9e60 100644 --- a/wallet-new/test/unit/Test/Spec/CoinSelection/Generators.hs +++ b/wallet-new/test/unit/Test/Spec/CoinSelection/Generators.hs @@ -2,6 +2,7 @@ module Test.Spec.CoinSelection.Generators ( genGroupedUtxo , genPayee + , genPayeeWithNM , genPayees , genFiddlyPayees , genUtxo @@ -26,11 +27,12 @@ import Test.QuickCheck (Gen, arbitrary, choose, suchThat) import qualified Pos.Chain.Txp as Core import qualified Pos.Core as Core +import Pos.Core.NetworkMagic (NetworkMagic) import Cardano.Wallet.Kernel.Util.Core (paymentAmount, utxoBalance) -- type class instances -import Test.Pos.Core.Arbitrary () +import Test.Pos.Core.Arbitrary (genAddress) {------------------------------------------------------------------------------- Useful types @@ -92,6 +94,16 @@ arbitraryAddress opts = do not (Core.isRedeemAddress a) arbitrary `suchThat` (\a -> fiddlyCondition a && redeemCondition a) +arbitraryAddressWithNM :: NetworkMagic + -> StakeGenOptions + -> Gen Core.Address +arbitraryAddressWithNM nm opts = do + let fiddlyCondition a = not (fiddlyAddresses opts) || + (length (sformat F.build a) < 104) + let redeemCondition a = allowRedeemAddresses opts || + not (Core.isRedeemAddress a) + (genAddress nm) `suchThat` (\a -> fiddlyCondition a && redeemCondition a) + -- | Finalise the generation of 'a' by transferring all the remaining \"slack\". finalise :: Semigroup a @@ -257,6 +269,14 @@ genTxOut opts = fromStakeOptions opts genOne paymentAmount addr <- arbitraryAddress opts return (Core.TxOut addr coins :| []) +genTxOutWithNM :: NetworkMagic -> StakeGenOptions -> Gen (NonEmpty Core.TxOut) +genTxOutWithNM nm opts = fromStakeOptions opts genOne paymentAmount + where + genOne :: Maybe (NonEmpty Core.TxOut) -> Core.Coin -> Gen (NonEmpty Core.TxOut) + genOne _ coins = do + addr <- arbitraryAddressWithNM nm opts + return (Core.TxOut addr coins :| []) + utxoSmallestEntry :: Core.Utxo -> Core.Coin utxoSmallestEntry utxo = case sort (Map.toList utxo) of @@ -320,6 +340,18 @@ genPayee _utxo payment = do , allowRedeemAddresses = False } +genPayeeWithNM :: NetworkMagic -> Core.Utxo -> Pay -> Gen (NonEmpty Core.TxOut) +genPayeeWithNM nm _utxo payment = do + let balance = toLovelaces payment + genTxOutWithNM nm StakeGenOptions { + stakeMaxValue = Nothing + , stakeGenerationTarget = AtLeast + , stakeNeeded = Core.mkCoin balance + , stakeMaxEntries = Just 1 + , fiddlyAddresses = False + , allowRedeemAddresses = False + } + -- | Generates a single payee which has a redeem address inside. genRedeemPayee :: Core.Utxo -> Pay -> Gen (NonEmpty Core.TxOut) genRedeemPayee _utxo payment = do diff --git a/wallet-new/test/unit/Test/Spec/GetTransactions.hs b/wallet-new/test/unit/Test/Spec/GetTransactions.hs index 0dd6be13d57..7096fffc22c 100644 --- a/wallet-new/test/unit/Test/Spec/GetTransactions.hs +++ b/wallet-new/test/unit/Test/Spec/GetTransactions.hs @@ -72,7 +72,7 @@ import Cardano.Wallet.WalletLayer.Kernel.Transactions (toTransaction) import qualified Test.Spec.Addresses as Addresses import Test.Spec.CoinSelection.Generators (InitialBalance (..), - Pay (..), genPayee, genUtxoWithAtLeast) + Pay (..), genPayeeWithNM, genUtxoWithAtLeast) import qualified Test.Spec.Fixture as Fixture import qualified Test.Spec.NewPayment as NewPayment import TxMetaStorageSpecs (Isomorphic (..), genMeta) @@ -297,8 +297,9 @@ spec = do prop "pay works normally for coin selection with additional utxos and changes" $ withMaxSuccess 10 $ monadicIO $ do pm <- pick arbitrary + let nm = makeNetworkMagic pm distr <- fmap (\(TxOut addr coin) -> V1.PaymentDistribution (V1.V1 addr) (V1.V1 coin)) - <$> pick (genPayee mempty (PayLovelace 100)) + <$> pick (genPayeeWithNM nm mempty (PayLovelace 100)) withUtxosFixture @IO pm [300, 400, 500, 600, 5000000] $ \_keystore _activeLayer aw f@Fix{..} -> do let pw = Kernel.walletPassive aw -- get the balance before the payment @@ -320,8 +321,9 @@ spec = do prop "estimateFees looks sane for coin selection with additional utxos and changes" $ withMaxSuccess 10 $ monadicIO $ do pm <- pick arbitrary + let nm = makeNetworkMagic pm distr <- fmap (\(TxOut addr coin) -> V1.PaymentDistribution (V1.V1 addr) (V1.V1 coin)) - <$> pick (genPayee mempty (PayLovelace 100)) + <$> pick (genPayeeWithNM nm mempty (PayLovelace 100)) withUtxosFixture @IO pm [300, 400, 500, 600, 5000000] $ \_keystore _activeLayer aw Fix{..} -> do let pw = Kernel.walletPassive aw -- do the payment diff --git a/wallet-new/test/unit/Test/Spec/NewPayment.hs b/wallet-new/test/unit/Test/Spec/NewPayment.hs index d65dad80b0a..2552fafbda6 100644 --- a/wallet-new/test/unit/Test/Spec/NewPayment.hs +++ b/wallet-new/test/unit/Test/Spec/NewPayment.hs @@ -32,7 +32,7 @@ import Pos.Crypto (EncryptedSecretKey, ProtocolMagic, safeDeterministicKeyGen) import Test.Spec.CoinSelection.Generators (InitialBalance (..), - Pay (..), genPayee, genUtxoWithAtLeast) + Pay (..), genPayeeWithNM, genUtxoWithAtLeast) import qualified Cardano.Wallet.API.V1.Types as V1 import qualified Cardano.Wallet.Kernel as Kernel @@ -110,7 +110,7 @@ prepareFixtures nm initialBalance toPay = do (getHdAddressIx newIndex) return $ M.insert txIn (TxOutAux (TxOut addr coin)) acc ) M.empty (M.toList utxo) - payees <- fmap (\(TxOut addr coin) -> (addr, coin)) <$> pick (genPayee utxo toPay) + payees <- fmap (\(TxOut addr coin) -> (addr, coin)) <$> pick (genPayeeWithNM nm utxo toPay) return $ \keystore aw -> do liftIO $ Keystore.insert (WalletIdHdRnd newRootId) esk keystore