tx-generator: remove fund-set / ix-set

Author: MarcFontaine

bench/tx-generator/src/Cardano/Benchmarking/FundSet.hs

@@ -12,10 +12,6 @@ module Cardano.Benchmarking.FundSet
 where
 import           Prelude
 
-import           Data.IxSet.Typed as IxSet
-import           Data.Proxy
-
-import           Control.Applicative ((<|>))
 import           Cardano.Api as Api
 
 -- Outputs that are available for spending.
@@ -26,50 +22,29 @@ data FundInEra era = FundInEra {
   , _fundWitness :: Witness WitCtxTxIn era
   , _fundVal  :: !(TxOutValue era)
   , _fundSigningKey :: !(Maybe (SigningKey PaymentKey))
-  , _fundVariant :: !Variant
-  , _fundValidity :: !Validity
   } deriving (Show)
 
-data Variant
-  = PlainOldFund
-  -- maybe better use the script itself instead of the filePath
-  | PlutusScriptFund
-  -- A collateralFund is just a regular (PlainOldFund) on the chain,
-  -- but tagged in the wallet so that it is not selected for spending.
-  | CollateralFund
-  deriving  (Show, Eq, Ord)
+newtype Fund = Fund {unFund :: InAnyCardanoEra FundInEra}
 
-data Validity
-  = Confirmed
-  | InFlight !Target !SeqNumber
-  deriving  (Show, Eq, Ord)
+type FundSet = [ Fund ]
 
-newtype Target = Target String
-  deriving  (Show, Eq, Ord)
+type FundSource m = m (Either String [Fund])
+type FundToStore m = [Fund] -> m ()
 
 newtype SeqNumber = SeqNumber Int
   deriving  (Show, Eq, Ord, Enum)
 
-newtype Fund = Fund {unFund :: InAnyCardanoEra FundInEra}
-
-getFundVariant :: Fund -> Variant
-getFundVariant (Fund (InAnyCardanoEra _ a)) = _fundVariant a
-
 getFundTxIn :: Fund -> TxIn
 getFundTxIn (Fund (InAnyCardanoEra _ a)) = _fundTxIn a
 
 getFundKey :: Fund -> Maybe (SigningKey PaymentKey)
 getFundKey (Fund (InAnyCardanoEra _ a)) = _fundSigningKey a
 
-getFundValidity :: Fund -> Validity
-getFundValidity (Fund (InAnyCardanoEra _ a)) = _fundValidity a
-
 getFundLovelace :: Fund -> Lovelace
 getFundLovelace (Fund (InAnyCardanoEra _ a)) = case _fundVal a of
   TxOutAdaOnly _era l -> l
   TxOutValue _era v -> selectLovelace v
 
-
 -- This effectively rules out era-transitions for transactions !
 -- This is not what we want !!
 getFundWitness :: forall era. IsShelleyBasedEra era => Fund -> Witness WitCtxTxIn era
@@ -85,14 +60,6 @@ getFundWitness fund = case (cardanoEra @ era, fund) of
 -- It should be possible to cast KeyWitnesses from one era to an other !
   (_ , _) -> error "getFundWitness: era mismatch"
 
-data IsConfirmed = IsConfirmed | IsNotConfirmed
-  deriving  (Show, Eq, Ord)
-
-isConfirmed :: Fund -> IsConfirmed
-isConfirmed f = case getFundValidity f of
-  Confirmed -> IsConfirmed
-  InFlight _ _ -> IsNotConfirmed
-
 instance Show Fund where
   show (Fund (InAnyCardanoEra _ f)) = show f
 
@@ -105,32 +72,12 @@ instance Eq Fund where
 instance Ord Fund where
   compare a b = compare (getFundTxIn a) (getFundTxIn b)
 
-type FundIndices = '[ TxIn, IsConfirmed, Target, SeqNumber, Lovelace, Variant ]
-type FundSet = IxSet FundIndices Fund
-
-instance Indexable FundIndices Fund where
-  indices = ixList
-    (ixFun $ \f -> [ getFundTxIn f ])
-    (ixFun $ \f -> [ isConfirmed f ])
-    (ixFun $ \f -> case getFundValidity f of
-      Confirmed -> []
-      InFlight t _ -> [t]
-    )
-    (ixFun $ \f -> case getFundValidity f of
-      Confirmed -> [SeqNumber (-1) ] -- Confirmed Txs get SeqNumber -1
-      InFlight _ n -> [ n ]
-    )
-    (ixFun $ \f -> [ getFundLovelace f ])
-    (ixFun $ \f -> [ getFundVariant f ])
 
 emptyFunds :: FundSet
-emptyFunds = IxSet.empty
+emptyFunds = [ ]
 
 insertFund :: FundSet -> Fund -> FundSet
-insertFund s f = updateIx (getFundTxIn f) f s
-
-deleteFund :: FundSet -> Fund -> FundSet
-deleteFund s f = deleteIx (getFundTxIn f) s
+insertFund s f = f : s
 
 liftAnyEra :: ( forall era. IsCardanoEra era => f1 era -> f2 era ) -> InAnyCardanoEra f1 -> InAnyCardanoEra f2
 liftAnyEra f x = case x of
@@ -141,126 +88,6 @@ liftAnyEra f x = case x of
   InAnyCardanoEra AlonzoEra a  ->   InAnyCardanoEra AlonzoEra $ f a
   InAnyCardanoEra BabbageEra a  ->  InAnyCardanoEra BabbageEra $ f a  
 
-type FundSelector = FundSet -> Either String [Fund]
-type FundSource m = m (Either String [Fund])
-type FundToStore m = [Fund] -> m ()
-
--- Select Funds to cover a minimum value.
--- TODO:
--- This fails unless there is a single fund with the required value
--- Extend this to really return a list of funds.
-selectMinValue :: Lovelace -> FundSet -> Either String [Fund]
-selectMinValue minValue fs = case coins of
-    [] -> Left $ "findSufficientCoin: no single coin with min value >= " ++ show minValue
-    (c:_) -> Right [c]
-    where coins = toAscList ( Proxy :: Proxy Lovelace) (fs @=PlainOldFund @= IsConfirmed @>= minValue)
-
-selectCollateral :: FundSet -> Either String [Fund]
-selectCollateral fs = case coins of
-  [] -> Left "no matching none-Plutus fund found"
-  (c:_) -> Right [c]
- where
-  coins = toAscList ( Proxy :: Proxy Lovelace) (fs @=CollateralFund @= IsConfirmed )
-
-data AllowRecycle
-  = UseConfirmedOnly
-  | ReuseSameTarget
--- ReuseAny can cause none-deterministic runtime errors !
--- The problematic case is the reuse of an UTxO/Tx that is not yet confirmed
--- and still waits in the mempool of an other target-node.
-  | ReuseAny
-  | ConfirmedBeforeReuse -- useful for testing
-  deriving (Eq, Ord, Enum, Show)
-
--- There are many possible heuristics to implement the selectInputs function.
--- TODO: Check that the complexity of selectInputs is good enough.
-selectInputs ::
-     AllowRecycle
-  -> Int
-  -> Lovelace
-  -> Variant
-  -> Target
-  -> FundSet
-  -> Either String [Fund]
-selectInputs allowRecycle count minTotalValue variant targetNode fs
-  = case allowRecycle of
-    UseConfirmedOnly     -> selectConfirmed
-    ReuseSameTarget      -> reuseSameTarget <|> selectConfirmed
-    ReuseAny             -> reuseSameTarget <|> selectConfirmed <|> reuseAnyCoin
-    ConfirmedBeforeReuse -> selectConfirmed <|> reuseSameTarget
-  where
-  selectConfirmed = selectConfirmedSmallValue <|> selectConfirmedBigValue
-
-  isSufficientCoins coins = length coins == count && sum (map getFundLovelace coins) >= minTotalValue
-
-  checkCoins :: String -> [Fund] -> Either String [Fund]
-  checkCoins err coins
-    = if isSufficientCoins coins then Right coins else Left err
-
-  -- Share intermediate results for variantIxSet confirmedIxSet and targetIxSet
-  -- TODO: it unclear if this helps on the complexity or it it is even harmful.
-  variantIxSet   = fs @= variant
-  confirmedIxSet = variantIxSet @= IsConfirmed
-  targetIxSet    = variantIxSet @= targetNode
-
-  confirmedBigValueList = toDescList (Proxy :: Proxy Lovelace) confirmedIxSet
-  sameTargetList = toAscList (Proxy :: Proxy SeqNumber) targetIxSet
-
-  selectConfirmedSmallValue
-    = checkCoins
-        "selectConfirmedSmall: not enough coins available"
-        (take count $ toAscList (Proxy :: Proxy Lovelace) confirmedIxSet)
-
-  selectConfirmedBigValue
-    = checkCoins
-        "selectConfirmedSmall: not enough coins available"
-        (take count confirmedBigValueList)
-
-  -- reuseSameTargetStrict is problematic: It fails if the coins in the queues are too small. But it will never consume the small coins.
-  -- therefore: (reuseSameTargetStrict <|> reuseSameTargetWithBackup)
-  reuseSameTargetStrict
-    = checkCoins
-        "reuseSameTargetStrict: not enough coins available"
-        (take count sameTargetList)
-
-  -- reuseSameTargetWithBackup can collect some dust.
-  -- reuseSameTargetWithBackup works fine if there is at least one sufficient confirmed UTxO available.
-  reuseSameTargetWithBackup = checkCoins "reuseSameTargetWithBackup: not enough coins available" (backupCoin ++ targetCoins)
-    where
-      -- targetCoins and backupCoins must be disjoint.
-      -- This is case because IsConfirmed \= InFlight target.
-      backupCoin = take 1 $ toAscList (Proxy :: Proxy Lovelace) (confirmedIxSet @> minTotalValue)
-      targetCoins = take (count - 1) sameTargetList
-
-  reuseSameTarget = reuseSameTargetStrict <|> reuseSameTargetWithBackup
-
-  -- reuseAnyCoin is the last resort !
-  reuseAnyCoin
-    = checkCoins
-        "reuseAnyTarget: not enough coins available"
-        (take count $ confirmedBigValueList ++ inFlightCoins)
-    where
-      -- inFlightCoins and confirmedCoins are disjoint
-      inFlightCoins = toAscList (Proxy :: Proxy SeqNumber) (variantIxSet @=IsNotConfirmed)
-
-selectToBuffer ::
-     Int
-  -> Lovelace
-  -> Maybe Variant
-  -> FundSet
-  -> Either String [Fund]
-selectToBuffer count minValue variant fs
-  = if length coins < count
-    then Left $ concat
-      [ "selectToBuffer: not enough coins found: count: ", show count
-      , " minValue: ", show minValue
-      , " variant: ", show variant
-      ]
-    else Right coins
- where
-  coins = case variant of
-    Just v -> take count $ toAscList ( Proxy :: Proxy Lovelace) (fs @=v @= IsConfirmed @>= minValue)
-    Nothing -> take count $ toAscList ( Proxy :: Proxy Lovelace) (fs @= IsConfirmed @>= minValue)
 -- Todo: check sufficient funds and minimumValuePerUtxo
 inputsToOutputsWithFee :: Lovelace -> Int -> [Lovelace] -> [Lovelace]
 inputsToOutputsWithFee fee count inputs = map (quantityToLovelace . Quantity) outputs

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs

@@ -39,7 +39,6 @@ import           Ouroboros.Consensus.Shelley.Eras (StandardShelley)
 
 import           Cardano.Api hiding (txFee)
 
-import qualified Cardano.Benchmarking.FundSet as FundSet
 import           Cardano.Benchmarking.GeneratorTx.Error
 import           Cardano.Benchmarking.GeneratorTx.Genesis
 import           Cardano.Benchmarking.GeneratorTx.NodeToNode
@@ -152,7 +151,7 @@ walletBenchmark :: forall era. IsShelleyBasedEra era
   -> SubmissionErrorPolicy
   -> AsType era
   -> NumberOfTxs
-  -> (FundSet.Target -> WalletScript era)
+  -> WalletScript era
   -> ExceptT TxGenError IO AsyncBenchmarkControl
 walletBenchmark
   traceSubmit
@@ -184,7 +183,7 @@ walletBenchmark
           client = txSubmissionClient
                      traceN2N
                      traceSubmit
-                     (walletTxSource (walletScript (FundSet.Target $ show remoteAddr)) tpsThrottle)
+                     (walletTxSource walletScript tpsThrottle)
                      (submitSubmissionThreadStats reportRef)
       async $ handle errorHandler (connectClient remoteAddr client)
 

bench/tx-generator/src/Cardano/Benchmarking/ListBufferedSelector.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE LambdaCase #-}
+-- todo: remove
 module Cardano.Benchmarking.ListBufferedSelector
 (
   mkBufferedSource
@@ -7,24 +7,18 @@ where
 import           Prelude
 
 import           Control.Concurrent.MVar
-import           Cardano.Api
 
 import           Cardano.Benchmarking.FundSet as FundSet
 import           Cardano.Benchmarking.Wallet as Wallet
 
 mkBufferedSource ::
      WalletRef
   -> Int
-  -> Lovelace
-  -> Maybe Variant
-  -> Int
-  -> IO (Either String (FundSource IO))
-mkBufferedSource walletRef count minValue variant munch
-  = mkWalletFundSource walletRef (selectToBuffer count minValue variant) >>= \case
-    Left err -> return $ Left err
-    Right funds -> do
-      buffer <- newMVar funds
-      return $ Right $ listSource buffer munch
+  -> IO (FundSource IO)
+mkBufferedSource walletRef munch = do
+  funds <- askWalletRef walletRef walletFunds
+  buffer <- newMVar funds
+  return $ listSource buffer munch
 
 listSource :: MVar [Fund] -> Int -> IO (Either String [Fund])
 listSource mvar count = modifyMVarMasked mvar popFunds