[CBR-313] Round of refactoring after code review

Author: adinapoli-iohk

src/Cardano/Wallet/API/V1/Handlers/Transactions.hs

@@ -54,7 +54,8 @@ newTransaction aw payment@Payment{..} = do
 
     -- TODO(adn) If the wallet is being restored, we need to disallow any @Payment@ from
     -- being submitted.
-
+    -- NOTE(adn) The 'SenderPaysFee' option will become configurable as part
+    -- of CBR-291.
     res <- liftIO $ runProduction $ (WalletLayer.pay aw) (maybe mempty coerce pmtSpendingPassword)
                                                          (toInputGrouping pmtGroupingPolicy)
                                                          SenderPaysFee
@@ -63,6 +64,8 @@ newTransaction aw payment@Payment{..} = do
          Left err -> throwM err
          Right tx -> do
              now <- liftIO getCurrentTimestamp
+             -- NOTE(adn) As part of [CBR-329], we could simply fetch the
+             -- entire 'Transaction' as part of the TxMeta.
              return $ single Transaction {
                                txId            = V1 (hash tx)
                              , txConfirmations = 0

src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs

@@ -168,6 +168,7 @@ feeOptions CoinSelectionOptions{..} = FeeOptions{
 -- | Build a transaction
 type MkTx m = NonEmpty (Core.TxIn, Core.TxOutAux) -- ^ Transaction inputs
            -> NonEmpty Core.TxOutAux              -- ^ Transaction outputs
+           -> [Core.Coin]                         -- ^ Generated change.
            -> m (Either CoinSelHardErr Core.TxAux)
 
 -- | Construct a standard transaction
@@ -176,10 +177,16 @@ type MkTx m = NonEmpty (Core.TxIn, Core.TxOutAux) -- ^ Transaction inputs
 -- multisignature transactions, etc.
 mkStdTx :: Monad m
         => Core.ProtocolMagic
+        -> ([Core.Coin] -> m [Core.TxOutAux])
+        -- ^ Function to turn a list of change into proper Core.TxOutAux.
+        -- This function is likely going to do some IO like creating and
+        -- persisting change addresses into the database.
         -> (Core.Address -> Either CoinSelHardErr Core.SafeSigner)
         -> MkTx m
-mkStdTx pm hdwSigners inps outs =
-    return $ Core.makeMPubKeyTxAddrs pm hdwSigners (fmap repack inps) outs
+mkStdTx pm genChange hdwSigners inps outs change = do
+    chng <- genChange change
+    let allOuts = foldl' (flip NE.cons) outs chng
+    return $ Core.makeMPubKeyTxAddrs pm hdwSigners (fmap repack inps) allOuts
   where
     -- Repack a utxo-derived tuple into a format suitable for
     -- 'TxOwnedInputs'.
@@ -206,14 +213,13 @@ type PickUtxo m = Core.Coin  -- ^ Fee to still cover
 -- just be run again on a new snapshot of the wallet DB.
 runCoinSelT :: forall m. Monad m
             => CoinSelectionOptions
-            -> m Core.Address
             -> PickUtxo m
             -> MkTx m
             -> (forall utxo. PickFromUtxo utxo
                   => NonEmpty (Output (Dom utxo))
                   -> CoinSelT utxo CoinSelHardErr m [CoinSelResult (Dom utxo)])
             -> CoinSelPolicy Core.Utxo m Core.TxAux
-runCoinSelT opts genChangeAddr pickUtxo mkTx policy request utxo = do
+runCoinSelT opts pickUtxo mkTx policy request utxo = do
     mSelection <- unwrapCoinSelT policy' utxo
     case mSelection of
       Left err -> return (Left err)
@@ -222,22 +228,14 @@ runCoinSelT opts genChangeAddr pickUtxo mkTx policy request utxo = do
             inps = concatMap selectedEntries
                      (additionalUtxo : map coinSelInputs css)
             outs = map coinSelOutput css
-        changeOuts <- forM (concatMap coinSelChange css) $ \change -> do
-                        changeAddr <- genChangeAddr
-                        return Core.TxOutAux {
-                            Core.toaOut = Core.TxOut {
-                                Core.txOutAddress = changeAddr
-                              , Core.txOutValue   = change
-                              }
-                          }
         let allInps = case inps of
                         []   -> error "runCoinSelT: empty list of inputs"
                         i:is -> i :| is
-            allOuts = case outs ++ changeOuts of
-                        []   -> error "runCoinSelT: empty list of outputs"
-                        o:os -> o :| os
+            originalOuts = case outs of
+                               []   -> error "runCoinSelT: empty list of outputs"
+                               o:os -> o :| os
         -- TODO: We should shuffle allOuts
-        mkTx allInps allOuts
+        mkTx allInps originalOuts (concatMap coinSelChange css)
   where
     policy' :: CoinSelT Core.Utxo CoinSelHardErr m
                  ([CoinSelResult Cardano], SelectedUtxo Cardano)
@@ -315,12 +313,11 @@ validateOutput out =
 -- | Random input selection policy
 random :: forall m. MonadRandom m
        => CoinSelectionOptions
-       -> m Core.Address  -- ^ Generate change address
        -> MkTx m          -- ^ Build and sign transaction
        -> Word64          -- ^ Maximum number of inputs
        -> CoinSelPolicy Core.Utxo m Core.TxAux
-random opts changeAddr mkTx maxInps =
-      runCoinSelT opts changeAddr pickUtxo mkTx
+random opts mkTx maxInps =
+      runCoinSelT opts pickUtxo mkTx
     $ Random.random Random.PrivacyModeOn maxInps . NE.toList
   where
     -- We ignore the size of the fee, and just pick randomly
@@ -332,12 +329,11 @@ random opts changeAddr mkTx maxInps =
 -- NOTE: Not for production use.
 largestFirst :: forall m. Monad m
              => CoinSelectionOptions
-             -> m Core.Address
              -> MkTx m
              -> Word64
              -> CoinSelPolicy Core.Utxo m Core.TxAux
-largestFirst opts changeAddr mkTx maxInps =
-      runCoinSelT opts changeAddr pickUtxo mkTx
+largestFirst opts mkTx maxInps =
+      runCoinSelT opts pickUtxo mkTx
     $ LargestFirst.largestFirst maxInps . NE.toList
   where
     pickUtxo :: PickUtxo m
@@ -355,6 +351,10 @@ largestFirst opts changeAddr mkTx maxInps =
   Cardano-specific fee-estimation.
 -------------------------------------------------------------------------------}
 
+-- NOTE(adn): Once https://github.com/input-output-hk/cardano-sl/pull/3232
+-- will be merged, we should use the proper formula rather than the unrolled
+-- computation below.
+
 {-| Estimate the size of a transaction, in bytes.
 
      The magic numbers appearing in the formula have the following origins:

src/Cardano/Wallet/Kernel/DB/HdWallet/Read.hs

@@ -160,6 +160,6 @@ readHdAddressByCardanoAddress cardanoAddr = do
     aux . IxSet.getEQ cardanoAddr . readAllHdAddresses
   where
     aux :: IxSet HdAddress -> Either UnknownHdAddress HdAddress
-    aux ixset = case IxSet.onlyOne ixset of
+    aux ixset = case IxSet.getOne ixset of
                      Just x  -> Right x
                      Nothing -> Left (UnknownHdCardanoAddress cardanoAddr)

src/Cardano/Wallet/Kernel/DB/Util/IxSet.hs

@@ -17,7 +17,7 @@ module Cardano.Wallet.Kernel.DB.Util.IxSet (
   , getEQ
   , member
   , size
-  , onlyOne
+  , getOne
     -- * Construction
   , fromList
   , omap
@@ -152,10 +152,8 @@ size = IxSet.size . unwrapIxSet
 -- one, i.e. only if it has @exactly@ one element in it. Usually this is
 -- used in tandem with 'getEQ' to witness the existence of exactly one element
 -- in the set indexed by a particular index.
-onlyOne :: IxSet a -> Maybe a
-onlyOne ixset = case IxSet.toList . unwrapIxSet $ ixset of
-                  [WrapOrdByPrimKey x] -> Just x
-                  _                    -> Nothing
+getOne :: HasPrimKey a => IxSet a -> Maybe a
+getOne = fmap coerce . IxSet.getOne . unwrapIxSet
 
 {-------------------------------------------------------------------------------
   Construction

src/Cardano/Wallet/Kernel/Transactions.hs

@@ -16,7 +16,7 @@ import           Universum
 
 import           Control.Lens (to)
 import           Control.Retry (RetryPolicyM, RetryStatus, applyPolicy,
-                     constantDelay, limitRetries, retrying)
+                     fullJitterBackoff, limitRetries, retrying)
 import           Crypto.Random (MonadRandom (..))
 import qualified Data.Set as Set
 import           Test.QuickCheck (Arbitrary (..))
@@ -25,6 +25,7 @@ import           Formatting (bprint, build, sformat, (%))
 import qualified Formatting.Buildable
 
 import qualified Data.ByteArray as ByteArray
+import qualified Pos.Binary as Bi
 
 import           Cardano.Wallet.Kernel.CoinSelection.FromGeneric (Cardano,
                      CoinSelectionOptions, estimateCardanoFee, mkStdTx)
@@ -100,10 +101,12 @@ pay activeWallet genChangeAddr signAddress opts accountId payees = do
             case tx of
                  Left e      -> return (Left $ PaymentNewTransactionError e)
                  Right txAux -> do
+                     -- TODO(adn) As part of CBR-239 or CBR-324, we should
+                     -- ensure that 'newPending' inserts the transaction
+                     -- inside the TxMeta storage.
                      succeeded <- newPending activeWallet accountId txAux
                      case succeeded of
                           Left e   -> do
-                              print (sformat build e)
                               -- If the next retry would bring us to the
                               -- end of our allowed retries, we fail with
                               -- a proper error
@@ -115,8 +118,9 @@ pay activeWallet genChangeAddr signAddress opts accountId payees = do
                                        PaymentNewPendingError e
                           Right () -> return . Right . taTx $ txAux
     where
+        -- See <https://aws.amazon.com/blogs/architecture/exponential-backoff-and-jitter>
         retryPolicy :: RetryPolicyM IO
-        retryPolicy = constantDelay 5000000 <> limitRetries 6
+        retryPolicy = fullJitterBackoff 5000000 <> limitRetries 6
 
         -- If this is a hard coin selection error we cannot recover, stop
         -- retrying. If we get a 'Tx' as output, stop retrying immediately.
@@ -142,14 +146,23 @@ newTransaction :: ActiveWallet
 newTransaction ActiveWallet{..} genChangeAddr signAddress options accountId payees = do
     snapshot <- getWalletSnapshot walletPassive
     let toTxOuts = fmap (\(a,c) -> TxOutAux (TxOut a c))
-    let mkTx = mkStdTx walletProtocolMagic signAddress
+    let genChangeOuts css = forM css $ \change -> do
+            changeAddr <- liftIO genChangeAddr
+            return TxOutAux {
+                toaOut = TxOut {
+                    txOutAddress = changeAddr
+                  , txOutValue   = change
+                  }
+              }
+    let mkTx = mkStdTx walletProtocolMagic genChangeOuts signAddress
     -- | NOTE(adn) This number was computed out of the work Matt Noonan did
     -- on the size estimation. See [CBR-318].
     let maxInputs = 350
     let availableUtxo = accountAvailableUtxo snapshot accountId
-    res <- flip runReaderT payees . buildPayment $
+    freshCounter <- newIORef 1
+    let initialSeed = encodeUtf8 @Text @ByteString . sformat build $ hash payees
+    res <- flip runReaderT (initialSeed, freshCounter) . buildPayment $
            CoinSelection.random options
-                                (liftIO genChangeAddr)
                                 mkTx
                                 maxInputs
                                 (toTxOuts payees)
@@ -163,17 +176,28 @@ newTransaction ActiveWallet{..} genChangeAddr signAddress options accountId paye
 -- when we estimate the fees and later create a transaction, the coin selection
 -- will always yield the same value, making the process externally-predicatable.
 newtype PayMonad a = PayMonad {
-      buildPayment :: ReaderT (NonEmpty (Address, Coin)) IO a
-    } deriving (Functor, Applicative, Monad, MonadIO, MonadReader (NonEmpty (Address, Coin)))
+      buildPayment :: ReaderT (ByteString, IORef Word16) IO a
+    } deriving ( Functor
+               , Applicative
+               , Monad
+               , MonadIO
+               , MonadReader (ByteString, IORef Word16)
+               )
 
 -- | \"Invalid\" 'MonadRandom' instance for 'PayMonad' which generates
--- randomness using the hash of 'NonEmpty (Address, Coin)' as fixed seed.
+-- randomness using the hash of 'NonEmpty (Address, Coin)' as fixed seed,
+-- plus an internal counter used to shift the bits of such hash.
+-- This ensures that the coin selection algorithm runs in a random environment
+-- which is yet deterministically reproduceable by feeding the same set of
+-- payees.
 instance MonadRandom PayMonad where
-    getRandomBytes _ =
-        ask >>= return . ByteArray.convert
-                       . encodeUtf8 @Text @ByteString
-                       . sformat build
-                       . hash
+    getRandomBytes _ = do
+        (initialSeed, counterRef) <- ask
+        counterValue <- readIORef counterRef
+        let randVal = ByteArray.convert . mappend (Bi.serialize' counterValue)
+                                        $ initialSeed
+        modifyIORef' counterRef succ
+        return randVal
 
 {-------------------------------------------------------------------------------
   Estimating fees
@@ -208,9 +232,10 @@ estimateFees activeWallet@ActiveWallet{..} genChangeAddr signAddress options acc
     case res of
          Left e  -> return . Left . EstFeesTxCreationFailed $ e
          Right tx -> -- calculate the fee as the difference between inputs and outputs.
-             -- NOTE(adn) Apparently we shouldn't worry about the 'ExpenseRegulation'
-             -- affecting the way we sum, as no matter who pays for the fee,
-             -- the final difference won't be affected.
+             -- NOTE(adn) In case of 'SenderPaysFee' is practice there might be a slightly
+             -- increase of the projected fee in the case we are forced to pick "yet another input"
+             -- to be able to pay the fee, which would, in turn, also increase the fee due to
+             -- the extra input being picked.
              return $ Right
                     $ sumOfInputs tx originalUtxo `unsafeSubCoin` sumOfOutputs tx
   where

test/unit/Test/Spec/CoinSelection.hs

@@ -391,7 +391,6 @@ errorWas predicate _ _ (STB hardErr) =
 -------------------------------------------------------------------------------}
 
 type Policy = CoinSelectionOptions
-           -> Gen Core.Address
            -> MkTx Gen
            -> Word64
            -> CoinSelPolicy Core.Utxo Gen Core.TxAux
@@ -404,8 +403,22 @@ type RunResult = ( Core.Utxo
 maxNumInputs :: Word64
 maxNumInputs = 300
 
-mkTx :: Core.ProtocolMagic -> SecretKey -> MkTx Gen
-mkTx pm key = mkStdTx pm (\_addr -> Right (fakeSigner key))
+genChange :: Core.Utxo -> NonEmpty Core.TxOut -> [Core.Coin] -> Gen [Core.TxOutAux]
+genChange utxo payee css = forM css $ \change -> do
+    changeAddr <- genUniqueChangeAddress utxo payee
+    return Core.TxOutAux {
+        Core.toaOut = Core.TxOut {
+            Core.txOutAddress = changeAddr
+          , Core.txOutValue   = change
+          }
+      }
+
+mkTx :: Core.Utxo
+     -> NonEmpty Core.TxOut
+     -> Core.ProtocolMagic
+     -> SecretKey
+     -> MkTx Gen
+mkTx utxo payee pm key = mkStdTx pm (genChange utxo payee) (\_addr -> Right (fakeSigner key))
 
 payRestrictInputsTo :: Word64
                     -> (InitialBalance -> Gen Core.Utxo)
@@ -425,8 +438,7 @@ payRestrictInputsTo maxInputs genU genP feeFunction adjustOptions bal amount pol
         res <- bimap STB identity <$>
                  policy
                    options
-                   (genUniqueChangeAddress utxo payee)
-                   (mkTx pm key)
+                   (mkTx utxo payee pm key)
                    maxInputs
                    (fmap Core.TxOutAux payee)
                    utxo