Merge pull request #3449 from input-output-hk/feature/cbr-380-shuffle-tx-outs

[CBR-380] Shuffle tx outputs after coin selection

Author: edsko

wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs

@@ -185,16 +185,19 @@ feeOptions CoinSelectionOptions{..} = FeeOptions{
 -- multisignature transactions, etc.
 mkStdTx :: Monad m
         => Core.ProtocolMagic
+        -> (forall a. NonEmpty a -> m (NonEmpty a))
+        -- ^ Shuffle function
         -> (Core.Address -> Either e Core.SafeSigner)
+        -- ^ Signer for each input of the transaction
         -> NonEmpty (Core.TxIn, Core.TxOutAux)
         -- ^ Selected inputs
         -> NonEmpty Core.TxOutAux
         -- ^ Selected outputs
         -> [Core.TxOutAux]
-        -- ^ A list of change addresess, in the form of 'TxOutAux'(s).
+        -- ^ Change outputs
         -> m (Either e Core.TxAux)
-mkStdTx pm hdwSigners inps outs change = do
-    let allOuts = foldl' (flip NE.cons) outs change
+mkStdTx pm shuffle hdwSigners inps outs change = do
+    allOuts <- shuffle $ foldl' (flip NE.cons) outs change
     return $ Core.makeMPubKeyTxAddrs pm hdwSigners (fmap repack inps) allOuts
   where
     -- Repack a utxo-derived tuple into a format suitable for
@@ -250,7 +253,6 @@ runCoinSelT opts pickUtxo policy request utxo = do
             originalOuts = case outs of
                                []   -> error "runCoinSelT: empty list of outputs"
                                o:os -> o :| os
-        -- TODO: We should shuffle allOuts CBR-380
         return . Right $ CoinSelFinalResult allInps
                                             originalOuts
                                             (concatMap coinSelChange css)

wallet-new/src/Cardano/Wallet/Kernel/Transactions.hs

@@ -61,6 +61,7 @@ import           Cardano.Wallet.Kernel.Pending (newPending)
 import           Cardano.Wallet.Kernel.Read (getWalletSnapshot)
 import           Cardano.Wallet.Kernel.Types (AccountId (..),
                      RawResolvedTx (..), WalletId (..))
+import           Cardano.Wallet.Kernel.Util (shuffleNE)
 import           Cardano.Wallet.Kernel.Util.Core (paymentAmount, utxoBalance,
                      utxoRestrictToInputs)
 import           Cardano.Wallet.WalletLayer.Kernel.Conv (exceptT)
@@ -198,7 +199,7 @@ newTransaction ActiveWallet{..} spendingPassword options accountId payees = runE
                (WalletIdHdRnd $ accountId ^. hdAccountIdParent)
                (walletPassive ^. walletKeystore)
     let signAddress = mkSigner spendingPassword mbEsk snapshot
-        mkTx        = mkStdTx walletProtocolMagic signAddress
+        mkTx        = mkStdTx walletProtocolMagic shuffleNE signAddress
 
     txAux <- withExceptT NewTransactionErrorSignTxFailed $ ExceptT $
                mkTx inputs outputs changeAddresses
@@ -208,43 +209,43 @@ newTransaction ActiveWallet{..} spendingPassword options accountId payees = runE
     txMeta <- createNewMeta accountId txId inputs (toaOut <$> outputs)
     return (txAux, txMeta, availableUtxo)
   where
-        -- Generate an initial seed for the random generator using the hash of
-        -- the payees, which ensure that the coin selection (and the fee estimation)
-        -- is \"pseudo deterministic\" and replicable.
-        newEnvironment :: IO Env
-        newEnvironment =
-            let initialSeed = V.fromList . map fromIntegral
-                                         . B.unpack
-                                         . encodeUtf8 @Text @ByteString
-                                         . sformat build
-                                         $ hash payees
-            in Env <$> initialize initialSeed
-
-        toTxOut :: (Address, Coin) -> TxOutAux
-        toTxOut (a, c) = TxOutAux (TxOut a c)
-
-        -- | Generates the list of change outputs from a list of change coins.
-        genChangeOuts :: MonadIO m
-                      => [Coin]
-                      -> ExceptT Kernel.CreateAddressError m [TxOutAux]
-        genChangeOuts css = forM css $ \change -> do
-            changeAddr <- genChangeAddr
-            return TxOutAux {
-                toaOut = TxOut {
-                    txOutAddress = changeAddr
-                  , txOutValue   = change
-                  }
+    -- Generate an initial seed for the random generator using the hash of
+    -- the payees, which ensure that the coin selection (and the fee estimation)
+    -- is \"pseudo deterministic\" and replicable.
+    newEnvironment :: IO Env
+    newEnvironment =
+        let initialSeed = V.fromList . map fromIntegral
+                                     . B.unpack
+                                     . encodeUtf8 @Text @ByteString
+                                     . sformat build
+                                     $ hash payees
+        in Env <$> initialize initialSeed
+
+    toTxOut :: (Address, Coin) -> TxOutAux
+    toTxOut (a, c) = TxOutAux (TxOut a c)
+
+    -- | Generates the list of change outputs from a list of change coins.
+    genChangeOuts :: MonadIO m
+                  => [Coin]
+                  -> ExceptT Kernel.CreateAddressError m [TxOutAux]
+    genChangeOuts css = forM css $ \change -> do
+        changeAddr <- genChangeAddr
+        return TxOutAux {
+            toaOut = TxOut {
+                txOutAddress = changeAddr
+              , txOutValue   = change
               }
-
-        -- | Monadic computation to generate a new change 'Address'. This will
-        -- run after coin selection, when we create the final transaction as
-        -- part of 'mkTx'.
-        genChangeAddr :: MonadIO m
-                      => ExceptT Kernel.CreateAddressError m Address
-        genChangeAddr = ExceptT $ liftIO $
-            Kernel.createAddress spendingPassword
-                                 (AccountIdHdRnd accountId)
-                                 walletPassive
+          }
+
+    -- | Monadic computation to generate a new change 'Address'. This will
+    -- run after coin selection, when we create the final transaction as
+    -- part of 'mkTx'.
+    genChangeAddr :: MonadIO m
+                  => ExceptT Kernel.CreateAddressError m Address
+    genChangeAddr = ExceptT $ liftIO $
+        Kernel.createAddress spendingPassword
+                             (AccountIdHdRnd accountId)
+                             walletPassive
 
 createNewMeta :: HdAccountId -> TxId -> NonEmpty (TxIn, TxOutAux) -> NonEmpty TxOut -> ExceptT NewTransactionError IO TxMeta
 createNewMeta hdId txId inp out = do

wallet-new/src/Cardano/Wallet/Kernel/Util.hs

@@ -6,6 +6,8 @@ module Cardano.Wallet.Kernel.Util (
     -- * Lists
     at
   , neHead
+  , shuffle
+  , shuffleNE
     -- * Maps and sets
   , disjoint
   , withoutKeys
@@ -34,9 +36,14 @@ module Cardano.Wallet.Kernel.Util (
 import           Universum
 
 import           Control.Monad.Except (MonadError (..))
+import           Crypto.Number.Generate (generateBetween)
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Merge.Strict as Map.Merge
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
+import qualified Data.Vector as V
+import           Data.Vector.Mutable (IOVector)
+import qualified Data.Vector.Mutable as MV
 import           Pos.Core.Chrono
 import qualified Test.QuickCheck as QC
 
@@ -53,6 +60,29 @@ at (_:xs) i = at xs (i - 1)
 neHead :: Lens' (NonEmpty a) a
 neHead f (x :| xs) = (:| xs) <$> f x
 
+shuffle :: [a] -> IO [a]
+shuffle = modifyInPlace $ \v -> do
+    let (lo, hi) = (0, MV.length v - 1)
+    forM_ [lo .. hi] $ \i -> do
+      j <- fromInteger <$> generateBetween (fromIntegral lo) (fromIntegral hi)
+      swapElems v i j
+  where
+    swapElems :: IOVector a -> Int -> Int -> IO ()
+    swapElems v i j = do
+        x <- MV.read v i
+        y <- MV.read v j
+        MV.write v i y
+        MV.write v j x
+
+shuffleNE :: NonEmpty a -> IO (NonEmpty a)
+shuffleNE = fmap NE.fromList . shuffle . NE.toList
+
+modifyInPlace :: forall a. (IOVector a -> IO ()) -> [a] -> IO [a]
+modifyInPlace f xs = do
+    v' <- V.thaw $ V.fromList xs
+    f v'
+    V.toList <$> V.freeze v'
+
 {-------------------------------------------------------------------------------
   Maps and sets
 -------------------------------------------------------------------------------}

wallet-new/test/unit/Test/Spec/CoinSelection.hs

@@ -475,7 +475,7 @@ mkTx :: Core.ProtocolMagic
      -> [Core.TxOutAux]
      -- ^ A list of change addresess, in the form of 'TxOutAux'(s).
      -> Gen (Either CoinSelHardErr Core.TxAux)
-mkTx pm key = mkStdTx pm (\_addr -> Right (fakeSigner key))
+mkTx pm key = mkStdTx pm return (\_addr -> Right (fakeSigner key))
 
 
 payRestrictInputsTo :: Word64

wallet-new/test/unit/Wallet/Inductive/Generator.hs

@@ -28,7 +28,7 @@ import           Data.Tree
 import           Pos.Core.Chrono
 import           Test.QuickCheck
 
-import           Cardano.Wallet.Kernel.Util
+import           Cardano.Wallet.Kernel.Util (Probability, toss, withoutKeys)
 import           UTxO.DSL
 import           UTxO.Generator
 import           Wallet.Inductive