module Hydra.Generator where

import Hydra.Cardano.Api hiding (getVerificationKey, signTx)
import Hydra.Prelude hiding (size)
import Test.Hydra.Prelude

import Cardano.Api.UTxO qualified as UTxO
import CardanoClient (QueryPoint (QueryTip), localNodeConnectInfo, mkGenesisTx, queryUTxOFor)
import Control.Monad (foldM)
import Data.Aeson (object, withObject, (.:), (.=))
import Data.List qualified as List
import Hydra.Chain.Backend (buildTransaction)
import Hydra.Chain.Direct (runDirectBackend)
import Hydra.Cluster.Faucet (FaucetException (..))
import Hydra.Cluster.Fixture (availableInitialFunds)
import Hydra.Ledger.Cardano (mkSimpleTx, mkTransferTx)
import Hydra.Options qualified as Options
import Hydra.Tx.Crypto (getVerificationKey, signTx)
import Hydra.Tx.Secret (Secret, mkSecret, withSecret)
import Test.Hydra.Tx.Gen (genSigningKey)
import Test.QuickCheck (choose, generate, sized)

networkId :: NetworkId
networkId :: NetworkId
networkId = NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId) -> NetworkMagic -> NetworkId
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkMagic
NetworkMagic Word32
42

-- | A 'Dataset' that can be run for testing purpose. Each `Dataset` represents
-- a complete scenario where several `ClientDataset` are run concurrently
-- against one or more `HydraNode`s. A dataset can optionally have a `title` and
-- `description` which will be used to report results.
data Dataset = Dataset
  { Dataset -> Tx
fundingTransaction :: Tx
  , Dataset -> [Secret (SigningKey PaymentKey)]
hydraNodeKeys :: [Secret (SigningKey PaymentKey)]
  -- ^ Cardano signing keys that will hold fuel.
  , Dataset -> [ClientDataset]
clientDatasets :: [ClientDataset]
  , Dataset -> Maybe Text
title :: Maybe Text
  , Dataset -> Maybe Text
description :: Maybe Text
  }
  deriving stock (Int -> Dataset -> ShowS
[Dataset] -> ShowS
Dataset -> String
(Int -> Dataset -> ShowS)
-> (Dataset -> String) -> ([Dataset] -> ShowS) -> Show Dataset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dataset -> ShowS
showsPrec :: Int -> Dataset -> ShowS
$cshow :: Dataset -> String
show :: Dataset -> String
$cshowList :: [Dataset] -> ShowS
showList :: [Dataset] -> ShowS
Show, (forall x. Dataset -> Rep Dataset x)
-> (forall x. Rep Dataset x -> Dataset) -> Generic Dataset
forall x. Rep Dataset x -> Dataset
forall x. Dataset -> Rep Dataset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dataset -> Rep Dataset x
from :: forall x. Dataset -> Rep Dataset x
$cto :: forall x. Rep Dataset x -> Dataset
to :: forall x. Rep Dataset x -> Dataset
Generic)

-- NOTE: Hand-written ToJSON and FromJSON instances to deliberately
-- serialize signing keys. The 'withSecret' / 'mkSecret' bookends make
-- the serialisation an explicit, grep-able escape from the 'Secret'
-- wrapper. These datasets are written to disk by the benchmark
-- machinery (see 'hydra-cluster/bench/'), and that is the one place
-- where we knowingly let signing-key bytes leave the in-memory wrapper.

instance ToJSON Dataset where
  toJSON :: Dataset -> Value
toJSON Dataset{Tx
fundingTransaction :: Dataset -> Tx
fundingTransaction :: Tx
fundingTransaction, [Secret (SigningKey PaymentKey)]
hydraNodeKeys :: Dataset -> [Secret (SigningKey PaymentKey)]
hydraNodeKeys :: [Secret (SigningKey PaymentKey)]
hydraNodeKeys, [ClientDataset]
clientDatasets :: Dataset -> [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets, Maybe Text
title :: Dataset -> Maybe Text
title :: Maybe Text
title, Maybe Text
description :: Dataset -> Maybe Text
description :: Maybe Text
description} =
    [Pair] -> Value
object
      [ Key
"fundingTransaction" Key -> Tx -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx
fundingTransaction
      , Key
"hydraNodeKeys" Key -> [TextEnvelope] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Secret (SigningKey PaymentKey)
-> (SigningKey PaymentKey -> TextEnvelope) -> TextEnvelope
forall a r. Secret a -> (a -> r) -> r
withSecret (Secret (SigningKey PaymentKey)
 -> (SigningKey PaymentKey -> TextEnvelope) -> TextEnvelope)
-> (SigningKey PaymentKey -> TextEnvelope)
-> Secret (SigningKey PaymentKey)
-> TextEnvelope
forall a b c. (a -> b -> c) -> b -> a -> c
`flip` Maybe TextEnvelopeDescr -> SigningKey PaymentKey -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"hydraNodeKey") (Secret (SigningKey PaymentKey) -> TextEnvelope)
-> [Secret (SigningKey PaymentKey)] -> [TextEnvelope]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Secret (SigningKey PaymentKey)]
hydraNodeKeys)
      , Key
"clientDatasets" Key -> [ClientDataset] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [ClientDataset]
clientDatasets
      , Key
"title" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
title
      , Key
"description" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
description
      ]

instance FromJSON Dataset where
  parseJSON :: Value -> Parser Dataset
parseJSON = String -> (Object -> Parser Dataset) -> Value -> Parser Dataset
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Dataset" ((Object -> Parser Dataset) -> Value -> Parser Dataset)
-> (Object -> Parser Dataset) -> Value -> Parser Dataset
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Tx
fundingTransaction <- Object
o Object -> Key -> Parser Tx
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fundingTransaction"
    [Secret (SigningKey PaymentKey)]
hydraNodeKeys <- Object
o Object -> Key -> Parser [TextEnvelope]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hydraNodeKeys" Parser [TextEnvelope]
-> ([TextEnvelope] -> Parser [Secret (SigningKey PaymentKey)])
-> Parser [Secret (SigningKey PaymentKey)]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TextEnvelope -> Parser (Secret (SigningKey PaymentKey)))
-> [TextEnvelope] -> Parser [Secret (SigningKey PaymentKey)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TextEnvelope -> Parser (Secret (SigningKey PaymentKey))
parseSigningKey
    [ClientDataset]
clientDatasets <- Object
o Object -> Key -> Parser [ClientDataset]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"clientDatasets"
    Maybe Text
title <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
    Maybe Text
description <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    Dataset -> Parser Dataset
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Dataset{Tx
fundingTransaction :: Tx
fundingTransaction :: Tx
fundingTransaction, [Secret (SigningKey PaymentKey)]
hydraNodeKeys :: [Secret (SigningKey PaymentKey)]
hydraNodeKeys :: [Secret (SigningKey PaymentKey)]
hydraNodeKeys, [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets, Maybe Text
title :: Maybe Text
title :: Maybe Text
title, Maybe Text
description :: Maybe Text
description :: Maybe Text
description}
   where
    parseSigningKey :: TextEnvelope -> Parser (Secret (SigningKey PaymentKey))
parseSigningKey =
      (SigningKey PaymentKey -> Secret (SigningKey PaymentKey))
-> Parser (SigningKey PaymentKey)
-> Parser (Secret (SigningKey PaymentKey))
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret (Parser (SigningKey PaymentKey)
 -> Parser (Secret (SigningKey PaymentKey)))
-> (TextEnvelope -> Parser (SigningKey PaymentKey))
-> TextEnvelope
-> Parser (Secret (SigningKey PaymentKey))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextEnvelopeError -> Parser (SigningKey PaymentKey))
-> (SigningKey PaymentKey -> Parser (SigningKey PaymentKey))
-> Either TextEnvelopeError (SigningKey PaymentKey)
-> Parser (SigningKey PaymentKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser (SigningKey PaymentKey)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (SigningKey PaymentKey))
-> (TextEnvelopeError -> String)
-> TextEnvelopeError
-> Parser (SigningKey PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEnvelopeError -> String
forall b a. (Show a, IsString b) => a -> b
show) SigningKey PaymentKey -> Parser (SigningKey PaymentKey)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TextEnvelopeError (SigningKey PaymentKey)
 -> Parser (SigningKey PaymentKey))
-> (TextEnvelope
    -> Either TextEnvelopeError (SigningKey PaymentKey))
-> TextEnvelope
-> Parser (SigningKey PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEnvelope -> Either TextEnvelopeError (SigningKey PaymentKey)
forall a.
HasTextEnvelope a =>
TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope

instance Arbitrary Dataset where
  arbitrary :: Gen Dataset
arbitrary = (Int -> Gen Dataset) -> Gen Dataset
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Dataset) -> Gen Dataset)
-> (Int -> Gen Dataset) -> Gen Dataset
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
    SigningKey PaymentKey
sk <- Gen (SigningKey PaymentKey)
genSigningKey
    Secret (SigningKey PaymentKey) -> Int -> Int -> Gen Dataset
generateConstantUTxODataset (SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
sk) (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10) Int
n

data ClientDataset = ClientDataset
  { ClientDataset -> Secret (SigningKey PaymentKey)
paymentKey :: Secret (SigningKey PaymentKey)
  , ClientDataset -> UTxO Era
initialUTxO :: UTxO
  , ClientDataset -> [Tx]
txSequence :: [Tx]
  }
  deriving stock (Int -> ClientDataset -> ShowS
[ClientDataset] -> ShowS
ClientDataset -> String
(Int -> ClientDataset -> ShowS)
-> (ClientDataset -> String)
-> ([ClientDataset] -> ShowS)
-> Show ClientDataset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientDataset -> ShowS
showsPrec :: Int -> ClientDataset -> ShowS
$cshow :: ClientDataset -> String
show :: ClientDataset -> String
$cshowList :: [ClientDataset] -> ShowS
showList :: [ClientDataset] -> ShowS
Show, (forall x. ClientDataset -> Rep ClientDataset x)
-> (forall x. Rep ClientDataset x -> ClientDataset)
-> Generic ClientDataset
forall x. Rep ClientDataset x -> ClientDataset
forall x. ClientDataset -> Rep ClientDataset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientDataset -> Rep ClientDataset x
from :: forall x. ClientDataset -> Rep ClientDataset x
$cto :: forall x. Rep ClientDataset x -> ClientDataset
to :: forall x. Rep ClientDataset x -> ClientDataset
Generic)

instance ToJSON ClientDataset where
  toJSON :: ClientDataset -> Value
toJSON ClientDataset{Secret (SigningKey PaymentKey)
paymentKey :: ClientDataset -> Secret (SigningKey PaymentKey)
paymentKey :: Secret (SigningKey PaymentKey)
paymentKey, UTxO Era
initialUTxO :: ClientDataset -> UTxO Era
initialUTxO :: UTxO Era
initialUTxO, [Tx]
txSequence :: ClientDataset -> [Tx]
txSequence :: [Tx]
txSequence} =
    [Pair] -> Value
object
      [ Key
"paymentKey" Key -> TextEnvelope -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Secret (SigningKey PaymentKey)
-> (SigningKey PaymentKey -> TextEnvelope) -> TextEnvelope
forall a r. Secret a -> (a -> r) -> r
withSecret Secret (SigningKey PaymentKey)
paymentKey (Maybe TextEnvelopeDescr -> SigningKey PaymentKey -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"paymentKey"))
      , Key
"initialUTxO" Key -> UTxO Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO Era
initialUTxO
      , Key
"txSequence" Key -> [Tx] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Tx]
txSequence
      ]

instance FromJSON ClientDataset where
  parseJSON :: Value -> Parser ClientDataset
parseJSON =
    String
-> (Object -> Parser ClientDataset)
-> Value
-> Parser ClientDataset
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ClientDataset" ((Object -> Parser ClientDataset) -> Value -> Parser ClientDataset)
-> (Object -> Parser ClientDataset)
-> Value
-> Parser ClientDataset
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Secret (SigningKey PaymentKey)
paymentKey <- Object
o Object -> Key -> Parser TextEnvelope
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"paymentKey" Parser TextEnvelope
-> (TextEnvelope -> Parser (Secret (SigningKey PaymentKey)))
-> Parser (Secret (SigningKey PaymentKey))
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextEnvelope -> Parser (Secret (SigningKey PaymentKey))
parseSigningKey
      UTxO Era
initialUTxO <- Object
o Object -> Key -> Parser (UTxO Era)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"initialUTxO"
      [Tx]
txSequence <- Object
o Object -> Key -> Parser [Tx]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txSequence"
      ClientDataset -> Parser ClientDataset
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientDataset{Secret (SigningKey PaymentKey)
paymentKey :: Secret (SigningKey PaymentKey)
paymentKey :: Secret (SigningKey PaymentKey)
paymentKey, UTxO Era
initialUTxO :: UTxO Era
initialUTxO :: UTxO Era
initialUTxO, [Tx]
txSequence :: [Tx]
txSequence :: [Tx]
txSequence}
   where
    parseSigningKey :: TextEnvelope -> Parser (Secret (SigningKey PaymentKey))
parseSigningKey =
      (SigningKey PaymentKey -> Secret (SigningKey PaymentKey))
-> Parser (SigningKey PaymentKey)
-> Parser (Secret (SigningKey PaymentKey))
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret (Parser (SigningKey PaymentKey)
 -> Parser (Secret (SigningKey PaymentKey)))
-> (TextEnvelope -> Parser (SigningKey PaymentKey))
-> TextEnvelope
-> Parser (Secret (SigningKey PaymentKey))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextEnvelopeError -> Parser (SigningKey PaymentKey))
-> (SigningKey PaymentKey -> Parser (SigningKey PaymentKey))
-> Either TextEnvelopeError (SigningKey PaymentKey)
-> Parser (SigningKey PaymentKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser (SigningKey PaymentKey)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (SigningKey PaymentKey))
-> (TextEnvelopeError -> String)
-> TextEnvelopeError
-> Parser (SigningKey PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEnvelopeError -> String
forall b a. (Show a, IsString b) => a -> b
show) SigningKey PaymentKey -> Parser (SigningKey PaymentKey)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TextEnvelopeError (SigningKey PaymentKey)
 -> Parser (SigningKey PaymentKey))
-> (TextEnvelope
    -> Either TextEnvelopeError (SigningKey PaymentKey))
-> TextEnvelope
-> Parser (SigningKey PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEnvelope -> Either TextEnvelopeError (SigningKey PaymentKey)
forall a.
HasTextEnvelope a =>
TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope

-- | Generate a 'Dataset' which does not grow the per-client UTXO set over time.
-- This version provided faucet key owns funds on the initial funds of the
-- devnet (See 'availableInitialFunds' and 'genesis-shelley.json'). Then for a
-- given number of clients a number of transactions are generated.
generateConstantUTxODataset ::
  -- | Faucet signing key
  Secret (SigningKey PaymentKey) ->
  -- | Number of clients
  Int ->
  -- | Number of transactions
  Int ->
  Gen Dataset
generateConstantUTxODataset :: Secret (SigningKey PaymentKey) -> Int -> Int -> Gen Dataset
generateConstantUTxODataset Secret (SigningKey PaymentKey)
faucetSk Int
nClients Int
nTxs = do
  [SigningKey PaymentKey]
hydraNodeKeys <- Int -> Gen (SigningKey PaymentKey) -> Gen [SigningKey PaymentKey]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nClients Gen (SigningKey PaymentKey)
genSigningKey
  [SigningKey PaymentKey]
allPaymentKeys <- Int -> Gen (SigningKey PaymentKey) -> Gen [SigningKey PaymentKey]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nClients Gen (SigningKey PaymentKey)
genSigningKey
  -- Prepare funding transaction which will give every client's
  -- 'externalSigningKey' "some" lovelace. The internal 'signingKey' will get
  -- funded in the beginning of the benchmark run.
  [(VerificationKey PaymentKey, Coin)]
clientFunds <- [SigningKey PaymentKey]
-> Integer -> Int -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [SigningKey PaymentKey]
allPaymentKeys Integer
forall a. Num a => a
availableInitialFunds Int
nTxs
  let fundingTransaction :: Tx
fundingTransaction =
        NetworkId
-> Secret (SigningKey PaymentKey)
-> Coin
-> [(VerificationKey PaymentKey, Coin)]
-> Tx
mkGenesisTx NetworkId
networkId Secret (SigningKey PaymentKey)
faucetSk (Integer -> Coin
Coin Integer
forall a. Num a => a
availableInitialFunds) [(VerificationKey PaymentKey, Coin)]
clientFunds
  [ClientDataset]
clientDatasets <- [SigningKey PaymentKey]
-> (SigningKey PaymentKey -> Gen ClientDataset)
-> Gen [ClientDataset]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SigningKey PaymentKey]
allPaymentKeys (NetworkId
-> Tx -> Int -> SigningKey PaymentKey -> Gen ClientDataset
generateClientDataset NetworkId
networkId Tx
fundingTransaction Int
nTxs)
  Dataset -> Gen Dataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Dataset
      { Tx
fundingTransaction :: Tx
fundingTransaction :: Tx
fundingTransaction
      , hydraNodeKeys :: [Secret (SigningKey PaymentKey)]
hydraNodeKeys = SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret (SigningKey PaymentKey -> Secret (SigningKey PaymentKey))
-> [SigningKey PaymentKey] -> [Secret (SigningKey PaymentKey)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigningKey PaymentKey]
hydraNodeKeys
      , [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets
      , title :: Maybe Text
title = Maybe Text
forall a. Maybe a
Nothing
      , description :: Maybe Text
description = Maybe Text
forall a. Maybe a
Nothing
      }

generateGrowingUTxODataset ::
  -- | Faucet signing key
  Secret (SigningKey PaymentKey) ->
  -- | Number of clients
  Int ->
  -- | Number of transactions
  Int ->
  Gen Dataset
generateGrowingUTxODataset :: Secret (SigningKey PaymentKey) -> Int -> Int -> Gen Dataset
generateGrowingUTxODataset Secret (SigningKey PaymentKey)
faucetSk Int
nClients Int
nTxs = do
  -- TODO: DRY
  [SigningKey PaymentKey]
hydraNodeKeys <- Int -> Gen (SigningKey PaymentKey) -> Gen [SigningKey PaymentKey]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nClients Gen (SigningKey PaymentKey)
genSigningKey
  [SigningKey PaymentKey]
allPaymentKeys <- Int -> Gen (SigningKey PaymentKey) -> Gen [SigningKey PaymentKey]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nClients Gen (SigningKey PaymentKey)
genSigningKey
  -- Prepare funding transaction which will give every client's
  -- 'externalSigningKey' "some" lovelace. The internal 'signingKey' will get
  -- funded in the beginning of the benchmark run.
  [(VerificationKey PaymentKey, Coin)]
clientFunds <- [SigningKey PaymentKey]
-> Integer -> Int -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [SigningKey PaymentKey]
allPaymentKeys Integer
forall a. Num a => a
availableInitialFunds Int
nTxs
  let fundingTransaction :: Tx
fundingTransaction =
        NetworkId
-> Secret (SigningKey PaymentKey)
-> Coin
-> [(VerificationKey PaymentKey, Coin)]
-> Tx
mkGenesisTx NetworkId
networkId Secret (SigningKey PaymentKey)
faucetSk (Integer -> Coin
Coin Integer
forall a. Num a => a
availableInitialFunds) [(VerificationKey PaymentKey, Coin)]
clientFunds
  [ClientDataset]
clientDatasets <- [SigningKey PaymentKey]
-> (SigningKey PaymentKey -> Gen ClientDataset)
-> Gen [ClientDataset]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SigningKey PaymentKey]
allPaymentKeys (Tx -> SigningKey PaymentKey -> Gen ClientDataset
genClientDataset Tx
fundingTransaction)
  Dataset -> Gen Dataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Dataset
      { Tx
fundingTransaction :: Tx
fundingTransaction :: Tx
fundingTransaction
      , hydraNodeKeys :: [Secret (SigningKey PaymentKey)]
hydraNodeKeys = SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret (SigningKey PaymentKey -> Secret (SigningKey PaymentKey))
-> [SigningKey PaymentKey] -> [Secret (SigningKey PaymentKey)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigningKey PaymentKey]
hydraNodeKeys
      , [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets
      , title :: Maybe Text
title = Maybe Text
forall a. Maybe a
Nothing
      , description :: Maybe Text
description = Maybe Text
forall a. Maybe a
Nothing
      }
 where
  genClientDataset :: Tx -> SigningKey PaymentKey -> Gen ClientDataset
  genClientDataset :: Tx -> SigningKey PaymentKey -> Gen ClientDataset
genClientDataset Tx
fundingTransaction SigningKey PaymentKey
paymentKey = do
    let initialUTxO :: UTxO Era
initialUTxO = SigningKey PaymentKey -> Tx -> UTxO Era
withInitialUTxO SigningKey PaymentKey
paymentKey Tx
fundingTransaction
    let (UTxO Era
_, [Tx]
txs) = ((UTxO Era, [Tx]) -> Int -> (UTxO Era, [Tx]))
-> (UTxO Era, [Tx]) -> [Int] -> (UTxO Era, [Tx])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (SigningKey PaymentKey
-> (UTxO Era, [Tx]) -> Int -> (UTxO Era, [Tx])
genTx SigningKey PaymentKey
paymentKey) (UTxO Era
initialUTxO, []) [Int
1 .. Int
nTxs]
    ClientDataset -> Gen ClientDataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientDataset{paymentKey :: Secret (SigningKey PaymentKey)
paymentKey = SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
paymentKey, UTxO Era
initialUTxO :: UTxO Era
initialUTxO :: UTxO Era
initialUTxO, txSequence :: [Tx]
txSequence = [Tx] -> [Tx]
forall a. [a] -> [a]
reverse [Tx]
txs}

  genTx :: SigningKey PaymentKey -> (UTxO.UTxO Era, [Tx]) -> Int -> (UTxO.UTxO Era, [Tx])
  genTx :: SigningKey PaymentKey
-> (UTxO Era, [Tx]) -> Int -> (UTxO Era, [Tx])
genTx SigningKey PaymentKey
sk (UTxO Era
utxo, [Tx]
txs) Int
_tx = do
    let vk :: VerificationKey PaymentKey
vk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey SigningKey PaymentKey
sk
    case (TxOut CtxUTxO Era -> Bool)
-> UTxO Era -> Maybe (TxIn, TxOut CtxUTxO Era)
forall era.
(TxOut CtxUTxO era -> Bool)
-> UTxO era -> Maybe (TxIn, TxOut CtxUTxO era)
UTxO.find (VerificationKey PaymentKey -> TxOut CtxUTxO Era -> Bool
forall ctx era. VerificationKey PaymentKey -> TxOut ctx era -> Bool
isVkTxOut VerificationKey PaymentKey
vk) UTxO Era
utxo of
      Maybe (TxIn, TxOut CtxUTxO Era)
Nothing -> Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"no utxo left to spend"
      Just (TxIn
txIn, TxOut CtxUTxO Era
txOut) -> do
        -- Shave 2 ADA off to grow the UTxO set, but only while the output can
        -- spare it and stay above the min-UTxO. Otherwise pass the full value
        -- through, so we never build a negative TxOut.
        let valueOut :: Value
valueOut
              | Value -> Coin
selectLovelace (TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
txOut) Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
> Coin
2 Coin -> Coin -> Coin
forall a. Num a => a -> a -> a
* Coin
2_000_000 =
                  TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
txOut Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
negateValue (Coin -> Value
lovelaceToValue Coin
2_000_000)
              | Bool
otherwise = TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
txOut
        case (TxIn, TxOut CtxUTxO Era)
-> (AddressInEra Era, Value)
-> Secret (SigningKey PaymentKey)
-> Either TxBodyError Tx
mkSimpleTx (TxIn
txIn, TxOut CtxUTxO Era
txOut) (NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk, Value
valueOut) (SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
sk) of
          Left TxBodyError
err ->
            Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (UTxO Era, [Tx])) -> Text -> (UTxO Era, [Tx])
forall a b. (a -> b) -> a -> b
$ Text
"mkSimpleTx failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> Text
forall b a. (Show a, IsString b) => a -> b
show TxBodyError
err
          Right Tx
tx -> (Tx -> UTxO Era
utxoFromTx Tx
tx, Tx
tx Tx -> [Tx] -> [Tx]
forall a. a -> [a] -> [a]
: [Tx]
txs)

-- | Generate a 'Dataset' that grows the head's UTxO set for the first half of
-- the tx sequence and contracts it again for the second half. Phase 1 reuses
-- the same per-tx pattern as 'generateGrowingUTxODataset' (1-in -> 2-out via
-- 'mkSimpleTx' with reduced output value). Phase 2 issues 2-in -> 1-out
-- merges that consume two previously created outputs and produce a single
-- combined output. End-state has a single UTxO again.
generateMixedUTxODataset ::
  -- | Faucet signing key
  Secret (SigningKey PaymentKey) ->
  -- | Number of clients
  Int ->
  -- | Number of transactions
  Int ->
  Gen Dataset
generateMixedUTxODataset :: Secret (SigningKey PaymentKey) -> Int -> Int -> Gen Dataset
generateMixedUTxODataset Secret (SigningKey PaymentKey)
faucetSk Int
nClients Int
nTxs = do
  [SigningKey PaymentKey]
hydraNodeKeys <- Int -> Gen (SigningKey PaymentKey) -> Gen [SigningKey PaymentKey]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nClients Gen (SigningKey PaymentKey)
genSigningKey
  [SigningKey PaymentKey]
allPaymentKeys <- Int -> Gen (SigningKey PaymentKey) -> Gen [SigningKey PaymentKey]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nClients Gen (SigningKey PaymentKey)
genSigningKey
  [(VerificationKey PaymentKey, Coin)]
clientFunds <- [SigningKey PaymentKey]
-> Integer -> Int -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [SigningKey PaymentKey]
allPaymentKeys Integer
forall a. Num a => a
availableInitialFunds Int
nTxs
  let fundingTransaction :: Tx
fundingTransaction =
        NetworkId
-> Secret (SigningKey PaymentKey)
-> Coin
-> [(VerificationKey PaymentKey, Coin)]
-> Tx
mkGenesisTx NetworkId
networkId Secret (SigningKey PaymentKey)
faucetSk (Integer -> Coin
Coin Integer
forall a. Num a => a
availableInitialFunds) [(VerificationKey PaymentKey, Coin)]
clientFunds
  [ClientDataset]
clientDatasets <- [SigningKey PaymentKey]
-> (SigningKey PaymentKey -> Gen ClientDataset)
-> Gen [ClientDataset]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SigningKey PaymentKey]
allPaymentKeys (Tx -> SigningKey PaymentKey -> Gen ClientDataset
genClientDataset Tx
fundingTransaction)
  Dataset -> Gen Dataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Dataset
      { Tx
fundingTransaction :: Tx
fundingTransaction :: Tx
fundingTransaction
      , hydraNodeKeys :: [Secret (SigningKey PaymentKey)]
hydraNodeKeys = SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret (SigningKey PaymentKey -> Secret (SigningKey PaymentKey))
-> [SigningKey PaymentKey] -> [Secret (SigningKey PaymentKey)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigningKey PaymentKey]
hydraNodeKeys
      , [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets
      , title :: Maybe Text
title = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Mixed UTxO Scenario"
      , description :: Maybe Text
description =
          Text -> Maybe Text
forall a. a -> Maybe a
Just
            Text
"Each client first grows its UTxO set (1-in to 2-out) for half of \
            \its tx budget, then contracts it back (2-in to 1-out) for the \
            \remainder."
      }
 where
  growSteps :: Int
growSteps = Int
nTxs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
  contractSteps :: Int
contractSteps = Int
nTxs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
growSteps

  genClientDataset :: Tx -> SigningKey PaymentKey -> Gen ClientDataset
  genClientDataset :: Tx -> SigningKey PaymentKey -> Gen ClientDataset
genClientDataset Tx
fundingTransaction SigningKey PaymentKey
paymentKey = do
    let initialUTxO :: UTxO Era
initialUTxO = SigningKey PaymentKey -> Tx -> UTxO Era
withInitialUTxO SigningKey PaymentKey
paymentKey Tx
fundingTransaction
    let vk :: VerificationKey PaymentKey
vk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey SigningKey PaymentKey
paymentKey
    let (UTxO Era
afterGrow, [Tx]
growTxs) =
          ((UTxO Era, [Tx]) -> Int -> (UTxO Era, [Tx]))
-> (UTxO Era, [Tx]) -> [Int] -> (UTxO Era, [Tx])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (SigningKey PaymentKey
-> VerificationKey PaymentKey
-> (UTxO Era, [Tx])
-> Int
-> (UTxO Era, [Tx])
genGrowTx SigningKey PaymentKey
paymentKey VerificationKey PaymentKey
vk) (UTxO Era
initialUTxO, []) [Int
1 .. Int
growSteps]
    let (UTxO Era
_, [Tx]
contractTxs) =
          ((UTxO Era, [Tx]) -> Int -> (UTxO Era, [Tx]))
-> (UTxO Era, [Tx]) -> [Int] -> (UTxO Era, [Tx])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (SigningKey PaymentKey
-> VerificationKey PaymentKey
-> (UTxO Era, [Tx])
-> Int
-> (UTxO Era, [Tx])
genContractTx SigningKey PaymentKey
paymentKey VerificationKey PaymentKey
vk) (UTxO Era
afterGrow, []) [Int
1 .. Int
contractSteps]
    ClientDataset -> Gen ClientDataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ClientDataset
        { paymentKey :: Secret (SigningKey PaymentKey)
paymentKey = SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
paymentKey
        , UTxO Era
initialUTxO :: UTxO Era
initialUTxO :: UTxO Era
initialUTxO
        , txSequence :: [Tx]
txSequence = [Tx] -> [Tx]
forall a. [a] -> [a]
reverse [Tx]
growTxs [Tx] -> [Tx] -> [Tx]
forall a. [a] -> [a] -> [a]
++ [Tx] -> [Tx]
forall a. [a] -> [a]
reverse [Tx]
contractTxs
        }

  -- Splits 4 ADA off the largest available UTxO so the change output is large
  -- enough that subsequent iterations can spend it safely.
  growChunk :: Coin
  growChunk :: Coin
growChunk = Integer -> Coin
Coin Integer
4_000_000

  -- The grow phase consumes the largest VK-owned UTxO each iteration. Picking
  -- 'UTxO.find' instead would eventually land on one of the small change
  -- outputs from earlier iterations, producing a negative-value txout when
  -- 'growChunk' is subtracted.
  genGrowTx ::
    SigningKey PaymentKey ->
    VerificationKey PaymentKey ->
    (UTxO.UTxO Era, [Tx]) ->
    Int ->
    (UTxO.UTxO Era, [Tx])
  genGrowTx :: SigningKey PaymentKey
-> VerificationKey PaymentKey
-> (UTxO Era, [Tx])
-> Int
-> (UTxO Era, [Tx])
genGrowTx SigningKey PaymentKey
sk VerificationKey PaymentKey
vk (UTxO Era
utxo, [Tx]
txs) Int
_ =
    case VerificationKey PaymentKey
-> UTxO Era -> Maybe (TxIn, TxOut CtxUTxO Era)
largestVkUTxO VerificationKey PaymentKey
vk UTxO Era
utxo of
      Maybe (TxIn, TxOut CtxUTxO Era)
Nothing -> Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"mixed/grow: no utxo left to spend"
      Just (TxIn
txIn, TxOut CtxUTxO Era
txOut)
        | Value -> Coin
selectLovelace (TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
txOut) Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
growChunk ->
            Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (UTxO Era, [Tx])) -> Text -> (UTxO Era, [Tx])
forall a b. (a -> b) -> a -> b
$ Text
"mixed/grow: largest VK utxo (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
forall b a. (Show a, IsString b) => a -> b
show (TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
txOut) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") is too small to split off " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Coin -> Text
forall b a. (Show a, IsString b) => a -> b
show Coin
growChunk
        | Bool
otherwise ->
            let chunkValue :: Value
chunkValue = Coin -> Value
lovelaceToValue Coin
growChunk
             in case (TxIn, TxOut CtxUTxO Era)
-> (AddressInEra Era, Value)
-> Secret (SigningKey PaymentKey)
-> Either TxBodyError Tx
mkSimpleTx (TxIn
txIn, TxOut CtxUTxO Era
txOut) (NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk, Value
chunkValue) (SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
sk) of
                  Left TxBodyError
err -> Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (UTxO Era, [Tx])) -> Text -> (UTxO Era, [Tx])
forall a b. (a -> b) -> a -> b
$ Text
"mixed/grow mkSimpleTx failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> Text
forall b a. (Show a, IsString b) => a -> b
show TxBodyError
err
                  Right Tx
tx ->
                    let remaining :: UTxO Era
remaining = UTxO Era -> UTxO Era -> UTxO Era
forall era. UTxO era -> UTxO era -> UTxO era
UTxO.difference UTxO Era
utxo (TxIn -> TxOut CtxUTxO Era -> UTxO Era
forall era. TxIn -> TxOut CtxUTxO era -> UTxO era
UTxO.singleton TxIn
txIn TxOut CtxUTxO Era
txOut)
                     in (UTxO Era
remaining UTxO Era -> UTxO Era -> UTxO Era
forall a. Semigroup a => a -> a -> a
<> Tx -> UTxO Era
utxoFromTx Tx
tx, Tx
tx Tx -> [Tx] -> [Tx]
forall a. a -> [a] -> [a]
: [Tx]
txs)

  genContractTx ::
    SigningKey PaymentKey ->
    VerificationKey PaymentKey ->
    (UTxO.UTxO Era, [Tx]) ->
    Int ->
    (UTxO.UTxO Era, [Tx])
  genContractTx :: SigningKey PaymentKey
-> VerificationKey PaymentKey
-> (UTxO Era, [Tx])
-> Int
-> (UTxO Era, [Tx])
genContractTx SigningKey PaymentKey
sk VerificationKey PaymentKey
vk (UTxO Era
utxo, [Tx]
txs) Int
_ =
    case Int -> [(TxIn, TxOut CtxUTxO Era)] -> [(TxIn, TxOut CtxUTxO Era)]
forall a. Int -> [a] -> [a]
take Int
2 (UTxO Era -> [(TxIn, TxOut CtxUTxO Era)]
forall era. UTxO era -> [(TxIn, TxOut CtxUTxO era)]
UTxO.toList ((TxOut CtxUTxO Era -> Bool) -> UTxO Era -> UTxO Era
forall era. (TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era
UTxO.filter (VerificationKey PaymentKey -> TxOut CtxUTxO Era -> Bool
forall ctx era. VerificationKey PaymentKey -> TxOut ctx era -> Bool
isVkTxOut VerificationKey PaymentKey
vk) UTxO Era
utxo)) of
      [(TxIn
in1, TxOut CtxUTxO Era
out1), (TxIn
in2, TxOut CtxUTxO Era
out2)] ->
        case NetworkId
-> SigningKey PaymentKey
-> (TxIn, TxOut CtxUTxO Era)
-> (TxIn, TxOut CtxUTxO Era)
-> Either TxBodyError Tx
mkMergeTx NetworkId
networkId SigningKey PaymentKey
sk (TxIn
in1, TxOut CtxUTxO Era
out1) (TxIn
in2, TxOut CtxUTxO Era
out2) of
          Left TxBodyError
err -> Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (UTxO Era, [Tx])) -> Text -> (UTxO Era, [Tx])
forall a b. (a -> b) -> a -> b
$ Text
"mixed/contract mkMergeTx failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> Text
forall b a. (Show a, IsString b) => a -> b
show TxBodyError
err
          Right Tx
tx ->
            let spent :: UTxO Era
spent = [(TxIn, TxOut CtxUTxO Era)] -> UTxO Era
forall era. [(TxIn, TxOut CtxUTxO era)] -> UTxO era
UTxO.fromList [(TxIn
in1, TxOut CtxUTxO Era
out1), (TxIn
in2, TxOut CtxUTxO Era
out2)]
                remaining :: UTxO Era
remaining = UTxO Era -> UTxO Era -> UTxO Era
forall era. UTxO era -> UTxO era -> UTxO era
UTxO.difference UTxO Era
utxo UTxO Era
spent
             in (UTxO Era
remaining UTxO Era -> UTxO Era -> UTxO Era
forall a. Semigroup a => a -> a -> a
<> Tx -> UTxO Era
utxoFromTx Tx
tx, Tx
tx Tx -> [Tx] -> [Tx]
forall a. a -> [a] -> [a]
: [Tx]
txs)
      [(TxIn, TxOut CtxUTxO Era)]
_ -> Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"mixed/contract: need at least 2 utxos to merge"

largestVkUTxO :: VerificationKey PaymentKey -> UTxO.UTxO Era -> Maybe (TxIn, TxOut CtxUTxO)
largestVkUTxO :: VerificationKey PaymentKey
-> UTxO Era -> Maybe (TxIn, TxOut CtxUTxO Era)
largestVkUTxO VerificationKey PaymentKey
vk =
  let byLovelace :: (TxIn, TxOut CtxUTxO) -> Coin
      byLovelace :: (TxIn, TxOut CtxUTxO Era) -> Coin
byLovelace (TxIn
_, TxOut CtxUTxO Era
o) = Value -> Coin
selectLovelace (TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
o)
   in (NonEmpty (TxIn, TxOut CtxUTxO Era) -> (TxIn, TxOut CtxUTxO Era))
-> Maybe (NonEmpty (TxIn, TxOut CtxUTxO Era))
-> Maybe (TxIn, TxOut CtxUTxO Era)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((TxIn, TxOut CtxUTxO Era)
 -> (TxIn, TxOut CtxUTxO Era) -> Ordering)
-> NonEmpty (TxIn, TxOut CtxUTxO Era) -> (TxIn, TxOut CtxUTxO Era)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.maximumBy (((TxIn, TxOut CtxUTxO Era) -> Coin)
-> (TxIn, TxOut CtxUTxO Era)
-> (TxIn, TxOut CtxUTxO Era)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (TxIn, TxOut CtxUTxO Era) -> Coin
byLovelace)) (Maybe (NonEmpty (TxIn, TxOut CtxUTxO Era))
 -> Maybe (TxIn, TxOut CtxUTxO Era))
-> (UTxO Era -> Maybe (NonEmpty (TxIn, TxOut CtxUTxO Era)))
-> UTxO Era
-> Maybe (TxIn, TxOut CtxUTxO Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxIn, TxOut CtxUTxO Era)]
-> Maybe (NonEmpty (TxIn, TxOut CtxUTxO Era))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([(TxIn, TxOut CtxUTxO Era)]
 -> Maybe (NonEmpty (TxIn, TxOut CtxUTxO Era)))
-> (UTxO Era -> [(TxIn, TxOut CtxUTxO Era)])
-> UTxO Era
-> Maybe (NonEmpty (TxIn, TxOut CtxUTxO Era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO Era -> [(TxIn, TxOut CtxUTxO Era)]
forall era. UTxO era -> [(TxIn, TxOut CtxUTxO era)]
UTxO.toList (UTxO Era -> [(TxIn, TxOut CtxUTxO Era)])
-> (UTxO Era -> UTxO Era)
-> UTxO Era
-> [(TxIn, TxOut CtxUTxO Era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut CtxUTxO Era -> Bool) -> UTxO Era -> UTxO Era
forall era. (TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era
UTxO.filter (VerificationKey PaymentKey -> TxOut CtxUTxO Era -> Bool
forall ctx era. VerificationKey PaymentKey -> TxOut ctx era -> Bool
isVkTxOut VerificationKey PaymentKey
vk)

-- | Generate a 'Dataset' that grows each client's UTxO set to a target size
-- ("plateau") with 1-in 10-out split transactions, then holds that size with
-- full-value self-transfers (1-in 1-out, no change output). While the plateau
-- holds, every snapshot carries the accumulator cost of the full UTxO set,
-- making this the reference workload for large-UTxO head performance.
--
-- The head-level UTxO size is roughly clients * target and must stay below
-- the 4095 accumulator element limit.
generateLargeUTxODataset ::
  -- | Faucet signing key
  Secret (SigningKey PaymentKey) ->
  -- | Number of clients
  Int ->
  -- | Number of transactions
  Int ->
  -- | Target UTxO entries per client (plateau)
  Int ->
  Gen Dataset
generateLargeUTxODataset :: Secret (SigningKey PaymentKey) -> Int -> Int -> Int -> Gen Dataset
generateLargeUTxODataset Secret (SigningKey PaymentKey)
faucetSk Int
nClients Int
nTxs Int
plateauTarget = do
  [SigningKey PaymentKey]
hydraNodeKeys <- Int -> Gen (SigningKey PaymentKey) -> Gen [SigningKey PaymentKey]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nClients Gen (SigningKey PaymentKey)
genSigningKey
  [SigningKey PaymentKey]
allPaymentKeys <- Int -> Gen (SigningKey PaymentKey) -> Gen [SigningKey PaymentKey]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nClients Gen (SigningKey PaymentKey)
genSigningKey
  [(VerificationKey PaymentKey, Coin)]
clientFunds <- [SigningKey PaymentKey]
-> Integer -> Int -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [SigningKey PaymentKey]
allPaymentKeys Integer
forall a. Num a => a
availableInitialFunds Int
nTxs
  let fundingTransaction :: Tx
fundingTransaction =
        NetworkId
-> Secret (SigningKey PaymentKey)
-> Coin
-> [(VerificationKey PaymentKey, Coin)]
-> Tx
mkGenesisTx NetworkId
networkId Secret (SigningKey PaymentKey)
faucetSk (Integer -> Coin
Coin Integer
forall a. Num a => a
availableInitialFunds) [(VerificationKey PaymentKey, Coin)]
clientFunds
  [ClientDataset]
clientDatasets <- [SigningKey PaymentKey]
-> (SigningKey PaymentKey -> Gen ClientDataset)
-> Gen [ClientDataset]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SigningKey PaymentKey]
allPaymentKeys (Tx -> SigningKey PaymentKey -> Gen ClientDataset
genClientDataset Tx
fundingTransaction)
  Dataset -> Gen Dataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Dataset
      { Tx
fundingTransaction :: Tx
fundingTransaction :: Tx
fundingTransaction
      , hydraNodeKeys :: [Secret (SigningKey PaymentKey)]
hydraNodeKeys = SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret (SigningKey PaymentKey -> Secret (SigningKey PaymentKey))
-> [SigningKey PaymentKey] -> [Secret (SigningKey PaymentKey)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigningKey PaymentKey]
hydraNodeKeys
      , [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets
      , title :: Maybe Text
title = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Plateau " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
plateauTarget Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" UTxO"
      , description :: Maybe Text
description =
          Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
            Text
"Each client splits its funds into "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
plateauTarget
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" outputs (1-in 10-out), then holds that plateau with \
                 \full-value self-transfers so every snapshot carries the \
                 \large UTxO set."
      }
 where
  splitFanout :: Int
splitFanout = Int
10

  chunk :: Coin
chunk = Integer -> Coin
Coin Integer
2_000_000

  -- Each split adds (splitFanout - 1) net outputs on top of the initial one.
  splitSteps :: Int
splitSteps = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ((Int
plateauTarget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
splitFanout Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
splitFanout Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

  genClientDataset :: Tx -> SigningKey PaymentKey -> Gen ClientDataset
  genClientDataset :: Tx -> SigningKey PaymentKey -> Gen ClientDataset
genClientDataset Tx
fundingTransaction SigningKey PaymentKey
paymentKey = do
    let initialUTxO :: UTxO Era
initialUTxO = SigningKey PaymentKey -> Tx -> UTxO Era
withInitialUTxO SigningKey PaymentKey
paymentKey Tx
fundingTransaction
        vk :: VerificationKey PaymentKey
vk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey SigningKey PaymentKey
paymentKey
        nSplits :: Int
nSplits = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
nTxs Int
splitSteps
        (UTxO Era
afterGrow, [Tx]
splitTxs) = ((UTxO Era, [Tx]) -> Int -> (UTxO Era, [Tx]))
-> (UTxO Era, [Tx]) -> [Int] -> (UTxO Era, [Tx])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (SigningKey PaymentKey
-> VerificationKey PaymentKey
-> (UTxO Era, [Tx])
-> Int
-> (UTxO Era, [Tx])
genSplitTx SigningKey PaymentKey
paymentKey VerificationKey PaymentKey
vk) (UTxO Era
initialUTxO, []) [Int
1 .. Int
nSplits]
        (UTxO Era
_, [Tx]
holdTxs) = ((UTxO Era, [Tx]) -> Int -> (UTxO Era, [Tx]))
-> (UTxO Era, [Tx]) -> [Int] -> (UTxO Era, [Tx])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (SigningKey PaymentKey
-> VerificationKey PaymentKey
-> (UTxO Era, [Tx])
-> Int
-> (UTxO Era, [Tx])
genHoldTx SigningKey PaymentKey
paymentKey VerificationKey PaymentKey
vk) (UTxO Era
afterGrow, []) [Int
1 .. Int
nTxs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nSplits]
    ClientDataset -> Gen ClientDataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ClientDataset
        { paymentKey :: Secret (SigningKey PaymentKey)
paymentKey = SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
paymentKey
        , UTxO Era
initialUTxO :: UTxO Era
initialUTxO :: UTxO Era
initialUTxO
        , txSequence :: [Tx]
txSequence = [Tx] -> [Tx]
forall a. [a] -> [a]
reverse [Tx]
splitTxs [Tx] -> [Tx] -> [Tx]
forall a. Semigroup a => a -> a -> a
<> [Tx] -> [Tx]
forall a. [a] -> [a]
reverse [Tx]
holdTxs
        }

  genSplitTx ::
    SigningKey PaymentKey ->
    VerificationKey PaymentKey ->
    (UTxO.UTxO Era, [Tx]) ->
    Int ->
    (UTxO.UTxO Era, [Tx])
  genSplitTx :: SigningKey PaymentKey
-> VerificationKey PaymentKey
-> (UTxO Era, [Tx])
-> Int
-> (UTxO Era, [Tx])
genSplitTx SigningKey PaymentKey
sk VerificationKey PaymentKey
vk (UTxO Era
utxo, [Tx]
txs) Int
_ =
    case VerificationKey PaymentKey
-> UTxO Era -> Maybe (TxIn, TxOut CtxUTxO Era)
largestVkUTxO VerificationKey PaymentKey
vk UTxO Era
utxo of
      Maybe (TxIn, TxOut CtxUTxO Era)
Nothing -> Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"plateau/split: no utxo left to spend"
      Just (TxIn
txIn, TxOut CtxUTxO Era
txOut)
        | Value -> Coin
selectLovelace (TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
txOut) Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
minSplitValue ->
            Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (UTxO Era, [Tx])) -> Text -> (UTxO Era, [Tx])
forall a b. (a -> b) -> a -> b
$ Text
"plateau/split: largest VK utxo (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
forall b a. (Show a, IsString b) => a -> b
show (TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
txOut) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") is too small to split"
        | Bool
otherwise ->
            case NetworkId
-> SigningKey PaymentKey
-> Int
-> Coin
-> (TxIn, TxOut CtxUTxO Era)
-> Either TxBodyError Tx
mkSplitTx NetworkId
networkId SigningKey PaymentKey
sk (Int
splitFanout Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Coin
chunk (TxIn
txIn, TxOut CtxUTxO Era
txOut) of
              Left TxBodyError
err -> Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (UTxO Era, [Tx])) -> Text -> (UTxO Era, [Tx])
forall a b. (a -> b) -> a -> b
$ Text
"plateau/split mkSplitTx failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> Text
forall b a. (Show a, IsString b) => a -> b
show TxBodyError
err
              Right Tx
tx ->
                let remaining :: UTxO Era
remaining = UTxO Era -> UTxO Era -> UTxO Era
forall era. UTxO era -> UTxO era -> UTxO era
UTxO.difference UTxO Era
utxo (TxIn -> TxOut CtxUTxO Era -> UTxO Era
forall era. TxIn -> TxOut CtxUTxO era -> UTxO era
UTxO.singleton TxIn
txIn TxOut CtxUTxO Era
txOut)
                 in (UTxO Era
remaining UTxO Era -> UTxO Era -> UTxO Era
forall a. Semigroup a => a -> a -> a
<> Tx -> UTxO Era
utxoFromTx Tx
tx, Tx
tx Tx -> [Tx] -> [Tx]
forall a. a -> [a] -> [a]
: [Tx]
txs)
   where
    -- Chunks plus a change output that stays comfortably spendable
    Coin Integer
chunkLovelace = Coin
chunk
    minSplitValue :: Coin
minSplitValue = Integer -> Coin
Coin (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
splitFanout Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
chunkLovelace)

  genHoldTx ::
    SigningKey PaymentKey ->
    VerificationKey PaymentKey ->
    (UTxO.UTxO Era, [Tx]) ->
    Int ->
    (UTxO.UTxO Era, [Tx])
  genHoldTx :: SigningKey PaymentKey
-> VerificationKey PaymentKey
-> (UTxO Era, [Tx])
-> Int
-> (UTxO Era, [Tx])
genHoldTx SigningKey PaymentKey
sk VerificationKey PaymentKey
vk (UTxO Era
utxo, [Tx]
txs) Int
_ =
    case (TxOut CtxUTxO Era -> Bool)
-> UTxO Era -> Maybe (TxIn, TxOut CtxUTxO Era)
forall era.
(TxOut CtxUTxO era -> Bool)
-> UTxO era -> Maybe (TxIn, TxOut CtxUTxO era)
UTxO.find (VerificationKey PaymentKey -> TxOut CtxUTxO Era -> Bool
forall ctx era. VerificationKey PaymentKey -> TxOut ctx era -> Bool
isVkTxOut VerificationKey PaymentKey
vk) UTxO Era
utxo of
      Maybe (TxIn, TxOut CtxUTxO Era)
Nothing -> Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"plateau/hold: no utxo left to spend"
      Just (TxIn
txIn, TxOut CtxUTxO Era
txOut) ->
        -- Full-value self-transfer: 'mkSimpleTx' omits the change output when
        -- the transferred value equals the input value, keeping the UTxO set
        -- size constant.
        case (TxIn, TxOut CtxUTxO Era)
-> (AddressInEra Era, Value)
-> Secret (SigningKey PaymentKey)
-> Either TxBodyError Tx
mkSimpleTx (TxIn
txIn, TxOut CtxUTxO Era
txOut) (NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk, TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
txOut) (SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
sk) of
          Left TxBodyError
err -> Text -> (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (UTxO Era, [Tx])) -> Text -> (UTxO Era, [Tx])
forall a b. (a -> b) -> a -> b
$ Text
"plateau/hold mkSimpleTx failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> Text
forall b a. (Show a, IsString b) => a -> b
show TxBodyError
err
          Right Tx
tx ->
            let remaining :: UTxO Era
remaining = UTxO Era -> UTxO Era -> UTxO Era
forall era. UTxO era -> UTxO era -> UTxO era
UTxO.difference UTxO Era
utxo (TxIn -> TxOut CtxUTxO Era -> UTxO Era
forall era. TxIn -> TxOut CtxUTxO era -> UTxO era
UTxO.singleton TxIn
txIn TxOut CtxUTxO Era
txOut)
             in (UTxO Era
remaining UTxO Era -> UTxO Era -> UTxO Era
forall a. Semigroup a => a -> a -> a
<> Tx -> UTxO Era
utxoFromTx Tx
tx, Tx
tx Tx -> [Tx] -> [Tx]
forall a. a -> [a] -> [a]
: [Tx]
txs)

-- | Build a zero-fee 1-in N-out transaction that splits off @nChunks@ outputs
-- of @chunkValue@ each and returns the remainder as change. Used by the
-- Plateau generator to grow a client's UTxO set inside the head.
mkSplitTx ::
  NetworkId ->
  SigningKey PaymentKey ->
  -- | Number of chunk outputs
  Int ->
  -- | Value of each chunk output
  Coin ->
  (TxIn, TxOut CtxUTxO) ->
  Either TxBodyError Tx
mkSplitTx :: NetworkId
-> SigningKey PaymentKey
-> Int
-> Coin
-> (TxIn, TxOut CtxUTxO Era)
-> Either TxBodyError Tx
mkSplitTx NetworkId
network SigningKey PaymentKey
sk Int
nChunks Coin
chunkValue (TxIn
txIn, TxOut CtxUTxO Era
txOut) = do
  TxBody
body <- TxBodyContent BuildTx -> Either TxBodyError TxBody
createAndValidateTransactionBody TxBodyContent BuildTx
bodyContent
  let witnesses :: [KeyWitness]
witnesses = [TxBody -> ShelleyWitnessSigningKey -> KeyWitness
makeShelleyKeyWitness TxBody
body (SigningKey PaymentKey -> ShelleyWitnessSigningKey
WitnessPaymentKey SigningKey PaymentKey
sk)]
  Tx -> Either TxBodyError Tx
forall a. a -> Either TxBodyError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx -> Either TxBodyError Tx) -> Tx -> Either TxBodyError Tx
forall a b. (a -> b) -> a -> b
$ [KeyWitness] -> TxBody -> Tx
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness]
witnesses TxBody
body
 where
  vk :: VerificationKey PaymentKey
vk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey SigningKey PaymentKey
sk
  addr :: AddressInEra Era
addr = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
network VerificationKey PaymentKey
vk
  chunkOut :: TxOut CtxTx
chunkOut = forall ctx.
AddressInEra Era
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut @CtxTx AddressInEra Era
addr (Coin -> Value
lovelaceToValue Coin
chunkValue) TxOutDatum CtxTx
forall ctx. TxOutDatum ctx
TxOutDatumNone ReferenceScript
ReferenceScriptNone
  Coin Integer
perChunk = Coin
chunkValue
  chunksTotal :: Value
chunksTotal = Coin -> Value
lovelaceToValue (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nChunks Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
perChunk)
  changeOut :: TxOut CtxTx
changeOut =
    forall ctx.
AddressInEra Era
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut @CtxTx
      AddressInEra Era
addr
      (TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
txOut Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
negateValue Value
chunksTotal)
      TxOutDatum CtxTx
forall ctx. TxOutDatum ctx
TxOutDatumNone
      ReferenceScript
ReferenceScriptNone
  bodyContent :: TxBodyContent BuildTx
bodyContent =
    TxBodyContent BuildTx
defaultTxBodyContent
      { txIns = [(txIn, BuildTxWith $ KeyWitness KeyWitnessForSpending)]
      , txOuts = replicate nChunks chunkOut <> [changeOut]
      , txFee = TxFeeExplicit (Coin 0)
      }

-- | Build a zero-fee 2-in 1-out transaction that merges two of a sender's own
-- outputs into one. Used by the Mixed generator to contract the UTxO set.
mkMergeTx ::
  NetworkId ->
  SigningKey PaymentKey ->
  (TxIn, TxOut CtxUTxO) ->
  (TxIn, TxOut CtxUTxO) ->
  Either TxBodyError Tx
mkMergeTx :: NetworkId
-> SigningKey PaymentKey
-> (TxIn, TxOut CtxUTxO Era)
-> (TxIn, TxOut CtxUTxO Era)
-> Either TxBodyError Tx
mkMergeTx NetworkId
network SigningKey PaymentKey
sk (TxIn
in1, TxOut CtxUTxO Era
out1) (TxIn
in2, TxOut CtxUTxO Era
out2) = do
  TxBody
body <- TxBodyContent BuildTx -> Either TxBodyError TxBody
createAndValidateTransactionBody TxBodyContent BuildTx
bodyContent
  let witnesses :: [KeyWitness]
witnesses = [TxBody -> ShelleyWitnessSigningKey -> KeyWitness
makeShelleyKeyWitness TxBody
body (SigningKey PaymentKey -> ShelleyWitnessSigningKey
WitnessPaymentKey SigningKey PaymentKey
sk)]
  Tx -> Either TxBodyError Tx
forall a. a -> Either TxBodyError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx -> Either TxBodyError Tx) -> Tx -> Either TxBodyError Tx
forall a b. (a -> b) -> a -> b
$ [KeyWitness] -> TxBody -> Tx
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness]
witnesses TxBody
body
 where
  vk :: VerificationKey PaymentKey
vk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey SigningKey PaymentKey
sk
  combined :: Value
combined = TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
out1 Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
out2
  bodyContent :: TxBodyContent BuildTx
bodyContent =
    TxBodyContent BuildTx
defaultTxBodyContent
      { txIns =
          [ (in1, BuildTxWith $ KeyWitness KeyWitnessForSpending)
          , (in2, BuildTxWith $ KeyWitness KeyWitnessForSpending)
          ]
      , txOuts =
          [ TxOut @CtxTx
              (mkVkAddress network vk)
              combined
              TxOutDatumNone
              ReferenceScriptNone
          ]
      , txFee = TxFeeExplicit (Coin 0)
      }

-- | Generate a 'Dataset' from an already running network by querying available
-- funds of the well-known 'faucet.sk' and assuming the hydra-nodes we connect
-- to have fuel available. Then for a given number of clients a number of
-- transactions are generated.
generateDemoUTxODataset ::
  NetworkId ->
  SocketPath ->
  -- | Faucet signing key
  Secret (SigningKey PaymentKey) ->
  -- | Number of clients.
  Int ->
  -- | Number of transactions
  Int ->
  IO Dataset
generateDemoUTxODataset :: NetworkId
-> SocketPath
-> Secret (SigningKey PaymentKey)
-> Int
-> Int
-> IO Dataset
generateDemoUTxODataset NetworkId
network SocketPath
nodeSocket Secret (SigningKey PaymentKey)
faucetSk Int
nClients Int
nTxs = do
  -- Query available funds
  UTxO Era
faucetUTxO <-
    LocalNodeConnectInfo
-> QueryPoint -> VerificationKey PaymentKey -> IO (UTxO Era)
queryUTxOFor (NetworkId -> SocketPath -> LocalNodeConnectInfo
localNodeConnectInfo NetworkId
network SocketPath
nodeSocket) QueryPoint
QueryTip VerificationKey PaymentKey
faucetVk
  let (Coin Integer
fundsAvailable) = UTxO Era -> Coin
forall era. UTxO era -> Coin
UTxO.totalLovelace UTxO Era
faucetUTxO
  -- Generate client datasets
  [SigningKey PaymentKey]
allPaymentKeys <- Gen [SigningKey PaymentKey] -> IO [SigningKey PaymentKey]
forall a. Gen a -> IO a
generate (Gen [SigningKey PaymentKey] -> IO [SigningKey PaymentKey])
-> Gen [SigningKey PaymentKey] -> IO [SigningKey PaymentKey]
forall a b. (a -> b) -> a -> b
$ Int -> Gen (SigningKey PaymentKey) -> Gen [SigningKey PaymentKey]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nClients Gen (SigningKey PaymentKey)
genSigningKey
  [(VerificationKey PaymentKey, Coin)]
clientFunds <- Gen [(VerificationKey PaymentKey, Coin)]
-> IO [(VerificationKey PaymentKey, Coin)]
forall a. Gen a -> IO a
generate (Gen [(VerificationKey PaymentKey, Coin)]
 -> IO [(VerificationKey PaymentKey, Coin)])
-> Gen [(VerificationKey PaymentKey, Coin)]
-> IO [(VerificationKey PaymentKey, Coin)]
forall a b. (a -> b) -> a -> b
$ [SigningKey PaymentKey]
-> Integer -> Int -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [SigningKey PaymentKey]
allPaymentKeys Integer
fundsAvailable Int
nTxs
  -- XXX: DRY with 'seedFromFaucet'
  Tx
fundingTransaction <- do
    let recipientOutputs :: [TxOut CtxTx]
recipientOutputs =
          (((VerificationKey PaymentKey, Coin) -> TxOut CtxTx)
 -> [(VerificationKey PaymentKey, Coin)] -> [TxOut CtxTx])
-> [(VerificationKey PaymentKey, Coin)]
-> ((VerificationKey PaymentKey, Coin) -> TxOut CtxTx)
-> [TxOut CtxTx]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((VerificationKey PaymentKey, Coin) -> TxOut CtxTx)
-> [(VerificationKey PaymentKey, Coin)] -> [TxOut CtxTx]
forall a b. (a -> b) -> [a] -> [b]
map [(VerificationKey PaymentKey, Coin)]
clientFunds (((VerificationKey PaymentKey, Coin) -> TxOut CtxTx)
 -> [TxOut CtxTx])
-> ((VerificationKey PaymentKey, Coin) -> TxOut CtxTx)
-> [TxOut CtxTx]
forall a b. (a -> b) -> a -> b
$ \(VerificationKey PaymentKey
vk, Coin
ll) ->
            AddressInEra Era
-> Value -> TxOutDatum CtxTx -> ReferenceScript -> TxOut CtxTx
forall ctx.
AddressInEra Era
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut
              (NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
network VerificationKey PaymentKey
vk)
              (Coin -> Value
lovelaceToValue Coin
ll)
              TxOutDatum CtxTx
forall ctx. TxOutDatum ctx
TxOutDatumNone
              ReferenceScript
ReferenceScriptNone

    DirectOptions
-> DirectBackend (Either (TxBodyErrorAutoBalance Era) Tx)
-> IO (Either (TxBodyErrorAutoBalance Era) Tx)
forall a. DirectOptions -> DirectBackend a -> IO a
runDirectBackend Options.DirectOptions{$sel:networkId:DirectOptions :: NetworkId
Options.networkId = NetworkId
network, SocketPath
nodeSocket :: SocketPath
$sel:nodeSocket:DirectOptions :: SocketPath
Options.nodeSocket} (AddressInEra Era
-> UTxO Era
-> [TxIn]
-> [TxOut CtxTx]
-> DirectBackend (Either (TxBodyErrorAutoBalance Era) Tx)
forall (m :: * -> *).
(ChainBackend m, MonadIO m) =>
AddressInEra Era
-> UTxO Era
-> [TxIn]
-> [TxOut CtxTx]
-> m (Either (TxBodyErrorAutoBalance Era) Tx)
buildTransaction AddressInEra Era
faucetAddress UTxO Era
faucetUTxO [] [TxOut CtxTx]
recipientOutputs) IO (Either (TxBodyErrorAutoBalance Era) Tx)
-> (Either (TxBodyErrorAutoBalance Era) Tx -> IO Tx) -> IO Tx
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left TxBodyErrorAutoBalance Era
e -> FaucetException -> IO Tx
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (FaucetException -> IO Tx) -> FaucetException -> IO Tx
forall a b. (a -> b) -> a -> b
$ FaucetFailedToBuildTx{$sel:reason:FaucetHasNotEnoughFunds :: TxBodyErrorAutoBalance Era
reason = TxBodyErrorAutoBalance Era
e}
      Right Tx
tx -> Tx -> IO Tx
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx -> IO Tx) -> Tx -> IO Tx
forall a b. (a -> b) -> a -> b
$ Secret (SigningKey PaymentKey) -> Tx -> Tx
forall s. CanSignTx s => s -> Tx -> Tx
signTx Secret (SigningKey PaymentKey)
faucetSk Tx
tx
  Gen Dataset -> IO Dataset
forall a. Gen a -> IO a
generate (Gen Dataset -> IO Dataset) -> Gen Dataset -> IO Dataset
forall a b. (a -> b) -> a -> b
$ do
    [ClientDataset]
clientDatasets <- [SigningKey PaymentKey]
-> (SigningKey PaymentKey -> Gen ClientDataset)
-> Gen [ClientDataset]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SigningKey PaymentKey]
allPaymentKeys (NetworkId
-> Tx -> Int -> SigningKey PaymentKey -> Gen ClientDataset
generateClientDataset NetworkId
network Tx
fundingTransaction Int
nTxs)
    Dataset -> Gen Dataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      Dataset
        { Tx
fundingTransaction :: Tx
fundingTransaction :: Tx
fundingTransaction
        , hydraNodeKeys :: [Secret (SigningKey PaymentKey)]
hydraNodeKeys = [] -- Not needed as we won't start nodes
        , [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets :: [ClientDataset]
clientDatasets
        , title :: Maybe Text
title = Maybe Text
forall a. Maybe a
Nothing
        , description :: Maybe Text
description = Maybe Text
forall a. Maybe a
Nothing
        }
 where
  faucetVk :: VerificationKey PaymentKey
faucetVk = Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey Secret (SigningKey PaymentKey)
faucetSk

  faucetAddress :: AddressInEra Era
faucetAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
network VerificationKey PaymentKey
faucetVk

-- * Helpers

withInitialUTxO :: SigningKey PaymentKey -> Tx -> UTxO
withInitialUTxO :: SigningKey PaymentKey -> Tx -> UTxO Era
withInitialUTxO SigningKey PaymentKey
externalSigningKey Tx
fundingTransaction =
  let vk :: VerificationKey PaymentKey
vk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey SigningKey PaymentKey
externalSigningKey
   in -- NOTE: The initialUTxO must all UTXO we will later commit. We assume
      -- that everything owned by the externalSigningKey will get committed
      -- into the head.
      Tx -> UTxO Era
utxoFromTx Tx
fundingTransaction
        UTxO Era -> (UTxO Era -> UTxO Era) -> UTxO Era
forall a b. a -> (a -> b) -> b
& (TxOut CtxUTxO Era -> Bool) -> UTxO Era -> UTxO Era
forall era. (TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era
UTxO.filter ((AddressInEra Era -> AddressInEra Era -> Bool
forall a. Eq a => a -> a -> Bool
== NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk) (AddressInEra Era -> Bool)
-> (TxOut CtxUTxO Era -> AddressInEra Era)
-> TxOut CtxUTxO Era
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxUTxO Era -> AddressInEra Era
forall ctx. TxOut ctx -> AddressInEra Era
txOutAddress)

genClientFunds :: [SigningKey PaymentKey] -> Integer -> Int -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds :: [SigningKey PaymentKey]
-> Integer -> Int -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [SigningKey PaymentKey]
paymentKeys Integer
availableFunds Int
nTxs =
  [SigningKey PaymentKey]
-> (SigningKey PaymentKey
    -> Gen (VerificationKey PaymentKey, Coin))
-> Gen [(VerificationKey PaymentKey, Coin)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SigningKey PaymentKey]
paymentKeys ((SigningKey PaymentKey -> Gen (VerificationKey PaymentKey, Coin))
 -> Gen [(VerificationKey PaymentKey, Coin)])
-> (SigningKey PaymentKey
    -> Gen (VerificationKey PaymentKey, Coin))
-> Gen [(VerificationKey PaymentKey, Coin)]
forall a b. (a -> b) -> a -> b
$ \SigningKey PaymentKey
paymentKey -> do
    -- Every client must be funded enough to run its whole tx sequence. The
    -- growing/mixed/plateau generators shave up to 4 ADA off an output per tx,
    -- so a client funded below that budget underflows into an invalid negative
    -- TxOut. Floor the draw at that budget (plus a min-UTxO buffer), clamped to
    -- what is actually available.
    let perClientBudget :: Integer
perClientBudget = (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nTxs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
4_000_000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
30_000_000
        maxPerClient :: Integer
maxPerClient = Integer
availableFunds Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nClients
    Coin
amount <- Integer -> Coin
Coin (Integer -> Coin) -> Gen Integer -> Gen Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
perClientBudget Integer
maxPerClient, Integer
maxPerClient)
    (VerificationKey PaymentKey, Coin)
-> Gen (VerificationKey PaymentKey, Coin)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SigningKey PaymentKey -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey SigningKey PaymentKey
paymentKey, Coin
amount)
 where
  nClients :: Int
nClients = [SigningKey PaymentKey] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SigningKey PaymentKey]
paymentKeys

generateClientDataset ::
  NetworkId ->
  Tx ->
  Int ->
  SigningKey PaymentKey ->
  Gen ClientDataset
generateClientDataset :: NetworkId
-> Tx -> Int -> SigningKey PaymentKey -> Gen ClientDataset
generateClientDataset NetworkId
network Tx
fundingTransaction Int
nTxs SigningKey PaymentKey
paymentKey = do
  let initialUTxO :: UTxO Era
initialUTxO = SigningKey PaymentKey -> Tx -> UTxO Era
withInitialUTxO SigningKey PaymentKey
paymentKey Tx
fundingTransaction
  (UTxO Era
_, [Tx]
txs) <- ((UTxO Era, [Tx]) -> Int -> Gen (UTxO Era, [Tx]))
-> (UTxO Era, [Tx]) -> [Int] -> Gen (UTxO Era, [Tx])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (SigningKey PaymentKey
-> (UTxO Era, [Tx]) -> Int -> Gen (UTxO Era, [Tx])
go SigningKey PaymentKey
paymentKey) (UTxO Era
initialUTxO, []) [Int
1 .. Int
nTxs]
  ClientDataset -> Gen ClientDataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientDataset{paymentKey :: Secret (SigningKey PaymentKey)
paymentKey = SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
paymentKey, UTxO Era
initialUTxO :: UTxO Era
initialUTxO :: UTxO Era
initialUTxO, txSequence :: [Tx]
txSequence = [Tx] -> [Tx]
forall a. [a] -> [a]
reverse [Tx]
txs}
 where
  go :: SigningKey PaymentKey
-> (UTxO Era, [Tx]) -> Int -> Gen (UTxO Era, [Tx])
go SigningKey PaymentKey
sk (UTxO Era
utxo, [Tx]
txs) Int
_ = do
    case NetworkId
-> UTxO Era
-> Secret (SigningKey PaymentKey)
-> VerificationKey PaymentKey
-> Either Text Tx
forall (m :: * -> *).
MonadFail m =>
NetworkId
-> UTxO Era
-> Secret (SigningKey PaymentKey)
-> VerificationKey PaymentKey
-> m Tx
mkTransferTx NetworkId
network UTxO Era
utxo (SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
sk) (SigningKey PaymentKey -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey SigningKey PaymentKey
sk) of
      Left Text
err -> Text -> Gen (UTxO Era, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Gen (UTxO Era, [Tx])) -> Text -> Gen (UTxO Era, [Tx])
forall a b. (a -> b) -> a -> b
$ Text
"mkTransferTx failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
      Right Tx
tx -> (UTxO Era, [Tx]) -> Gen (UTxO Era, [Tx])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx -> UTxO Era
utxoFromTx Tx
tx, Tx
tx Tx -> [Tx] -> [Tx]
forall a. a -> [a] -> [a]
: [Tx]
txs)