Merge #1834

1834: Make shelley fee estimation faster r=rvl a=rvl Relates to #1825. ### Overview This removes the crypto signature operations from the function which calculates a transaction's size. It reduces fee estimation (x100 runs) time from 7.98s to 1.66s. Co-authored-by: Rodney Lorrimar <[email protected]>
cardano-foundation · Jun 30, 2020 · e71dd1a · e71dd1a
2 parents bfc9408 + cdd5472
commit e71dd1a
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 22 deletions.
diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -282,7 +282,7 @@ import Cardano.Wallet.Primitive.Types
     , TxMeta (..)
     , TxOut (..)
     , TxStatus (..)
-    , UTxO
+    , UTxO (..)
     , UTxOStatistics
     , UnsignedTx (..)
     , WalletDelegation (..)
@@ -368,7 +368,7 @@ import Data.Vector.Shuffle
 import Data.Word
     ( Word16, Word64 )
 import Fmt
-    ( blockListF, pretty )
+    ( blockListF, pretty, (+|), (|+) )
 import GHC.Generics
     ( Generic )
 import Numeric.Natural
@@ -384,6 +384,7 @@ import qualified Cardano.Wallet.Primitive.CoinSelection.Random as CoinSelection
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
+import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Vector as V
@@ -1134,6 +1135,7 @@ selectCoinsForPaymentFromUTxO
     -> NonEmpty TxOut
     -> ExceptT (ErrSelectForPayment e) IO CoinSelection
 selectCoinsForPaymentFromUTxO ctx utxo txp recipients = do
+    lift . traceWith tr $ MsgPaymentCoinSelectionStart utxo txp recipients
     (sel, utxo') <- withExceptT ErrSelectForPaymentCoinSelection $ do
         let opts = coinSelOpts tl (txp ^. #getTxMaxSize)
         CoinSelection.random opts recipients utxo
@@ -2091,6 +2093,7 @@ data WalletLog
     | MsgTip BlockHeader
     | MsgBlocks (NonEmpty Block)
     | MsgDelegationCoinSelection CoinSelection
+    | MsgPaymentCoinSelectionStart W.UTxO W.TxParameters (NonEmpty TxOut)
     | MsgPaymentCoinSelection CoinSelection
     | MsgPaymentCoinSelectionAdjusted CoinSelection
     | MsgRewardBalanceQuery BlockHeader
@@ -2134,6 +2137,10 @@ instance ToText WalletLog where
             "blocks: " <> pretty (NE.toList blocks)
         MsgDelegationCoinSelection sel ->
             "Coins selected for delegation: \n" <> pretty sel
+        MsgPaymentCoinSelectionStart utxo _txp recipients ->
+            "Starting coin selection " <>
+            "|utxo| = "+|Map.size (getUTxO utxo)|+" " <>
+            "#recipients = "+|NE.length recipients|+""
         MsgPaymentCoinSelection sel ->
             "Coins selected for payment: \n" <> pretty sel
         MsgPaymentCoinSelectionAdjusted sel ->
@@ -2166,6 +2173,7 @@ instance HasSeverityAnnotation WalletLog where
         MsgTip _ -> Info
         MsgBlocks _ -> Debug
         MsgDelegationCoinSelection _ -> Debug
+        MsgPaymentCoinSelectionStart{} -> Debug
         MsgPaymentCoinSelection _ -> Debug
         MsgPaymentCoinSelectionAdjusted _ -> Debug
         MsgRewardBalanceQuery _ -> Debug

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -81,8 +82,6 @@ import Cardano.Wallet.Transaction
     , ErrValidateSelection
     , TransactionLayer (..)
     )
-import Cardano.Wallet.Unsafe
-    ( unsafeXPrv )
 import Control.Monad
     ( forM )
 import Crypto.Error
@@ -96,11 +95,13 @@ import Data.List
 import Data.Maybe
     ( fromMaybe, isJust )
 import Data.Proxy
-    ( Proxy )
+    ( Proxy (..) )
 import Data.Quantity
     ( Quantity (..) )
 import Data.Word
     ( Word16, Word8 )
+import Ouroboros.Consensus.Shelley.Protocol.Crypto
+    ( Crypto (..) )
 import Ouroboros.Network.Block
     ( SlotNo )
 
@@ -113,8 +114,8 @@ import qualified Codec.CBOR.Read as CBOR
 import qualified Codec.CBOR.Write as CBOR
 import qualified Crypto.PubKey.Ed25519 as Ed25519
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as L8
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Shelley.Spec.Ledger.BaseTypes as SL
@@ -402,26 +403,31 @@ computeTxSize certs (CoinSelection inps outs chngs) =
                 Cardano.shelleyDeregisterStakingAddress dummyKeyHash
 
     (addrWits, certWits) =
-        ( Set.map dummyWitness $ Set.fromList (fst <$> inps)
+        ( Set.map dummyWitnessUniq $ Set.fromList (fst <$> inps)
         , if null certs
             then Set.empty
-            else Set.singleton (dummyWitness dummyTxIn)
+            else Set.singleton (dummyWitness "a")
         )
       where
-        dummyWitness :: TxIn -> SL.WitVKey TPraosStandardCrypto 'SL.Witness
-        dummyWitness = mkWitness unsigned . (,mempty) . dummyXPrv
-
-        dummyTxIn :: TxIn
-        dummyTxIn = TxIn (Hash (BS.pack (replicate 32 0))) 0
-
-        -- NOTE: We need relatively unique fake XPrv so that we can generate
-        -- relatively unique witnesses. So we use the transaction input as a
-        -- source of entropy to create a somewhat unique fake XPrv corresponding
-        -- to that input.
-        dummyXPrv :: TxIn -> XPrv
-        dummyXPrv (TxIn (Hash txid) ix) =
-            unsafeXPrv $ BS.take 128 $ mconcat $ replicate 4 $
-                txid <> B8.pack (show ix)
+        dummyWitness :: BL.ByteString -> SL.WitVKey TPraosStandardCrypto 'SL.Witness
+        dummyWitness chaff = SL.WitVKey key sig
+          where
+            sig = SignedDSIGN
+                $ fromMaybe (error "error creating dummy witness sig")
+                $ rawDeserialiseSigDSIGN
+                $ bloatChaff sigLen
+            key = SL.VKey
+                $ fromMaybe (error "error creating dummy witness ver key")
+                $ rawDeserialiseVerKeyDSIGN
+                $ bloatChaff keyLen
+            sigLen = sizeSigDSIGN $ Proxy @(DSIGN TPraosStandardCrypto)
+            keyLen = sizeVerKeyDSIGN $ Proxy @(DSIGN TPraosStandardCrypto)
+            bloatChaff n = BL.toStrict $ BL.take (fromIntegral n) $ BL.cycle chaff
+
+        dummyWitnessUniq :: TxIn -> SL.WitVKey TPraosStandardCrypto 'SL.Witness
+        dummyWitnessUniq (TxIn (Hash txid) ix) = dummyWitness chaff
+          where
+            chaff = L8.pack (show ix) <> BL.fromStrict txid
 
     wits = SL.WitnessSet (Set.union addrWits certWits) mempty mempty