Merge pull request #3823 from input-output-hk/KtorZ/RCD-40/enforce-address-discrimination-when-sending-tx

[RCD-40] Enforce address discrimination check when sending transactions

Author: KtorZ

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
 ----------------------------------------------------------------------------

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)

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 =

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

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

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

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