module Hydra.Generator where

import Hydra.Cardano.Api
import Hydra.Prelude hiding (size)

import Cardano.Api.UTxO qualified as UTxO
import CardanoClient (QueryPoint (QueryTip), buildRawTransaction, buildTransaction, queryUTxOFor, sign)
import Control.Monad (foldM)
import Data.Aeson (object, withObject, (.:), (.=))
import Data.Default (def)
import Hydra.Cluster.Faucet (FaucetException (..))
import Hydra.Cluster.Fixture (Actor (..), availableInitialFunds)
import Hydra.Cluster.Util (keysFor)
import Hydra.Ledger.Cardano (
  generateOneRandomTransfer,
  generateOneSelfTransfer,
 )
import Hydra.Tx (balance)
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 -> [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)
  deriving anyclass ([Dataset] -> Value
[Dataset] -> Encoding
Dataset -> Bool
Dataset -> Value
Dataset -> Encoding
(Dataset -> Value)
-> (Dataset -> Encoding)
-> ([Dataset] -> Value)
-> ([Dataset] -> Encoding)
-> (Dataset -> Bool)
-> ToJSON Dataset
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Dataset -> Value
toJSON :: Dataset -> Value
$ctoEncoding :: Dataset -> Encoding
toEncoding :: Dataset -> Encoding
$ctoJSONList :: [Dataset] -> Value
toJSONList :: [Dataset] -> Value
$ctoEncodingList :: [Dataset] -> Encoding
toEncodingList :: [Dataset] -> Encoding
$comitField :: Dataset -> Bool
omitField :: Dataset -> Bool
ToJSON, Maybe Dataset
Value -> Parser [Dataset]
Value -> Parser Dataset
(Value -> Parser Dataset)
-> (Value -> Parser [Dataset]) -> Maybe Dataset -> FromJSON Dataset
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Dataset
parseJSON :: Value -> Parser Dataset
$cparseJSONList :: Value -> Parser [Dataset]
parseJSONList :: Value -> Parser [Dataset]
$comittedField :: Maybe Dataset
omittedField :: Maybe Dataset
FromJSON)

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
    SigningKey PaymentKey -> Int -> Int -> Gen Dataset
generateConstantUTxODataset SigningKey PaymentKey
sk (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10) Int
n

data ClientKeys = ClientKeys
  { ClientKeys -> SigningKey PaymentKey
signingKey :: SigningKey PaymentKey
  -- ^ Key used by the hydra-node to authorize hydra transactions and holding fuel.
  , ClientKeys -> SigningKey PaymentKey
externalSigningKey :: SigningKey PaymentKey
  -- ^ Key holding funds to commit.
  }
  deriving stock (Int -> ClientKeys -> ShowS
[ClientKeys] -> ShowS
ClientKeys -> String
(Int -> ClientKeys -> ShowS)
-> (ClientKeys -> String)
-> ([ClientKeys] -> ShowS)
-> Show ClientKeys
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientKeys -> ShowS
showsPrec :: Int -> ClientKeys -> ShowS
$cshow :: ClientKeys -> String
show :: ClientKeys -> String
$cshowList :: [ClientKeys] -> ShowS
showList :: [ClientKeys] -> ShowS
Show)

instance ToJSON ClientKeys where
  toJSON :: ClientKeys -> Value
toJSON ClientKeys{SigningKey PaymentKey
signingKey :: ClientKeys -> SigningKey PaymentKey
signingKey :: SigningKey PaymentKey
signingKey, SigningKey PaymentKey
externalSigningKey :: ClientKeys -> SigningKey PaymentKey
externalSigningKey :: SigningKey PaymentKey
externalSigningKey} =
    [Pair] -> Value
object
      [ Key
"signingKey" Key -> TextEnvelope -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe TextEnvelopeDescr -> SigningKey PaymentKey -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"signingKey") SigningKey PaymentKey
signingKey
      , Key
"externalSigningKey" Key -> TextEnvelope -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe TextEnvelopeDescr -> SigningKey PaymentKey -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"externalSigningKey") SigningKey PaymentKey
externalSigningKey
      ]

instance FromJSON ClientKeys where
  parseJSON :: Value -> Parser ClientKeys
parseJSON =
    String
-> (Object -> Parser ClientKeys) -> Value -> Parser ClientKeys
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ClientKeys" ((Object -> Parser ClientKeys) -> Value -> Parser ClientKeys)
-> (Object -> Parser ClientKeys) -> Value -> Parser ClientKeys
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      SigningKey PaymentKey -> SigningKey PaymentKey -> ClientKeys
ClientKeys
        (SigningKey PaymentKey -> SigningKey PaymentKey -> ClientKeys)
-> Parser (SigningKey PaymentKey)
-> Parser (SigningKey PaymentKey -> ClientKeys)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (SigningKey PaymentKey)
decodeSigningKey (Value -> Parser (SigningKey PaymentKey))
-> Parser Value -> Parser (SigningKey PaymentKey)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"signingKey")
        Parser (SigningKey PaymentKey -> ClientKeys)
-> Parser (SigningKey PaymentKey) -> Parser ClientKeys
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser (SigningKey PaymentKey)
decodeSigningKey (Value -> Parser (SigningKey PaymentKey))
-> Parser Value -> Parser (SigningKey PaymentKey)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"externalSigningKey")
   where
    decodeSigningKey :: Value -> Parser (SigningKey PaymentKey)
decodeSigningKey Value
v = do
      TextEnvelope
envelope <- Value -> Parser TextEnvelope
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      AsType (SigningKey PaymentKey)
-> TextEnvelope -> Either TextEnvelopeError (SigningKey PaymentKey)
forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope (AsType PaymentKey -> AsType (SigningKey PaymentKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey) TextEnvelope
envelope
        Either TextEnvelopeError (SigningKey PaymentKey)
-> (Either TextEnvelopeError (SigningKey PaymentKey)
    -> Parser (SigningKey PaymentKey))
-> Parser (SigningKey PaymentKey)
forall a b. a -> (a -> b) -> b
& (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

instance Arbitrary ClientKeys where
  arbitrary :: Gen ClientKeys
arbitrary = SigningKey PaymentKey -> SigningKey PaymentKey -> ClientKeys
ClientKeys (SigningKey PaymentKey -> SigningKey PaymentKey -> ClientKeys)
-> Gen (SigningKey PaymentKey)
-> Gen (SigningKey PaymentKey -> ClientKeys)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SigningKey PaymentKey)
genSigningKey Gen (SigningKey PaymentKey -> ClientKeys)
-> Gen (SigningKey PaymentKey) -> Gen ClientKeys
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (SigningKey PaymentKey)
genSigningKey

data ClientDataset = ClientDataset
  { ClientDataset -> ClientKeys
clientKeys :: ClientKeys
  , ClientDataset -> UTxO
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)
  deriving anyclass ([ClientDataset] -> Value
[ClientDataset] -> Encoding
ClientDataset -> Bool
ClientDataset -> Value
ClientDataset -> Encoding
(ClientDataset -> Value)
-> (ClientDataset -> Encoding)
-> ([ClientDataset] -> Value)
-> ([ClientDataset] -> Encoding)
-> (ClientDataset -> Bool)
-> ToJSON ClientDataset
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ClientDataset -> Value
toJSON :: ClientDataset -> Value
$ctoEncoding :: ClientDataset -> Encoding
toEncoding :: ClientDataset -> Encoding
$ctoJSONList :: [ClientDataset] -> Value
toJSONList :: [ClientDataset] -> Value
$ctoEncodingList :: [ClientDataset] -> Encoding
toEncodingList :: [ClientDataset] -> Encoding
$comitField :: ClientDataset -> Bool
omitField :: ClientDataset -> Bool
ToJSON, Maybe ClientDataset
Value -> Parser [ClientDataset]
Value -> Parser ClientDataset
(Value -> Parser ClientDataset)
-> (Value -> Parser [ClientDataset])
-> Maybe ClientDataset
-> FromJSON ClientDataset
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ClientDataset
parseJSON :: Value -> Parser ClientDataset
$cparseJSONList :: Value -> Parser [ClientDataset]
parseJSONList :: Value -> Parser [ClientDataset]
$comittedField :: Maybe ClientDataset
omittedField :: Maybe ClientDataset
FromJSON)

defaultProtocolParameters :: PParams LedgerEra
defaultProtocolParameters :: PParams LedgerEra
defaultProtocolParameters = PParams LedgerEra
PParams StandardConway
forall a. Default a => a
def

-- | Generate 'Dataset' which does not grow the per-client UTXO set over time.
-- The sequence of transactions generated consist only of simple payments from
-- and to arbitrary keys controlled by the individual clients.
generateConstantUTxODataset ::
  -- | Faucet signing key
  SigningKey PaymentKey ->
  -- | Number of clients
  Int ->
  -- | Number of transactions
  Int ->
  Gen Dataset
generateConstantUTxODataset :: SigningKey PaymentKey -> Int -> Int -> Gen Dataset
generateConstantUTxODataset SigningKey PaymentKey
faucetSk Int
nClients Int
nTxs = do
  [ClientKeys]
allClientKeys <- Int -> Gen ClientKeys -> Gen [ClientKeys]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nClients Gen ClientKeys
forall a. Arbitrary a => Gen a
arbitrary
  -- 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 <- [ClientKeys] -> Integer -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [ClientKeys]
allClientKeys Integer
forall a. Num a => a
availableInitialFunds
  let fundingTransaction :: Tx
fundingTransaction =
        NetworkId
-> TxIn
-> SigningKey PaymentKey
-> Coin
-> [(VerificationKey PaymentKey, Coin)]
-> Tx
buildRawTransaction
          NetworkId
networkId
          TxIn
initialInput
          SigningKey PaymentKey
faucetSk
          (Integer -> Coin
Coin Integer
forall a. Num a => a
availableInitialFunds)
          [(VerificationKey PaymentKey, Coin)]
clientFunds
  let dataset :: ClientKeys -> Gen ClientDataset
dataset ClientKeys
clientKeys =
        NetworkId
-> Tx
-> ClientKeys
-> Int
-> (NetworkId
    -> (UTxO, SigningKey PaymentKey, [Tx])
    -> Int
    -> Gen (UTxO, SigningKey PaymentKey, [Tx]))
-> Gen ClientDataset
generateClientDataset NetworkId
networkId Tx
fundingTransaction ClientKeys
clientKeys Int
nTxs NetworkId
-> (UTxO, SigningKey PaymentKey, [Tx])
-> Int
-> Gen (UTxO, SigningKey PaymentKey, [Tx])
generateOneRandomTransfer
  [ClientDataset]
clientDatasets <- [ClientKeys]
-> (ClientKeys -> Gen ClientDataset) -> Gen [ClientDataset]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ClientKeys]
allClientKeys ClientKeys -> Gen ClientDataset
dataset
  Dataset -> Gen Dataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Dataset{Tx
fundingTransaction :: Tx
fundingTransaction :: Tx
fundingTransaction, [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
  initialInput :: TxIn
initialInput =
    NetworkId -> Hash GenesisUTxOKey -> TxIn
genesisUTxOPseudoTxIn
      NetworkId
networkId
      (Hash PaymentKey -> Hash GenesisUTxOKey
forall a b.
(SerialiseAsCBOR (Hash a), SerialiseAsCBOR (Hash b),
 HasCallStack) =>
Hash a -> Hash b
unsafeCastHash (Hash PaymentKey -> Hash GenesisUTxOKey)
-> Hash PaymentKey -> Hash GenesisUTxOKey
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey PaymentKey -> Hash PaymentKey)
-> VerificationKey PaymentKey -> Hash PaymentKey
forall a b. (a -> b) -> a -> b
$ SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
faucetSk)

-- | Generate 'Dataset' which does not grow the per-client UTXO set over time.
-- This queries the network to fetch the current funds available in the faucet
-- to be distributed among the peers.
-- The sequence of transactions generated consist only of simple self payments.
generateDemoUTxODataset ::
  NetworkId ->
  SocketPath ->
  -- | Number of clients
  [ClientKeys] ->
  -- | Number of transactions
  Int ->
  IO Dataset
generateDemoUTxODataset :: NetworkId -> SocketPath -> [ClientKeys] -> Int -> IO Dataset
generateDemoUTxODataset NetworkId
network SocketPath
nodeSocket [ClientKeys]
allClientKeys Int
nTxs = do
  (VerificationKey PaymentKey
faucetVk, SigningKey PaymentKey
faucetSk) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
Faucet
  UTxO
faucetUTxO <- NetworkId
-> SocketPath
-> QueryPoint
-> VerificationKey PaymentKey
-> IO UTxO
queryUTxOFor NetworkId
network SocketPath
nodeSocket QueryPoint
QueryTip VerificationKey PaymentKey
faucetVk
  let (Coin Integer
fundsAvailable) = Value -> Coin
selectLovelace (forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance @Tx UTxO
UTxOType Tx
faucetUTxO)
  -- 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 <- 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
$ [ClientKeys] -> Integer -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [ClientKeys]
allClientKeys Integer
fundsAvailable
  Tx
fundingTransaction <- do
    let changeAddress :: AddressInEra Era
changeAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
network VerificationKey PaymentKey
faucetVk
    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
    NetworkId
-> SocketPath
-> AddressInEra Era
-> UTxO
-> [TxIn]
-> [TxOut CtxTx]
-> IO (Either (TxBodyErrorAutoBalance Era) TxBody)
buildTransaction NetworkId
network SocketPath
nodeSocket AddressInEra Era
changeAddress UTxO
faucetUTxO [] [TxOut CtxTx]
recipientOutputs IO (Either (TxBodyErrorAutoBalance Era) TxBody)
-> (Either (TxBodyErrorAutoBalance Era) TxBody -> 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{reason :: TxBodyErrorAutoBalance Era
reason = TxBodyErrorAutoBalance Era
e}
      Right TxBody
body -> do
        let signedTx :: Tx
signedTx = SigningKey PaymentKey -> TxBody -> Tx
sign SigningKey PaymentKey
faucetSk TxBody
body
        Tx -> IO Tx
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx
signedTx
  let dataset :: ClientKeys -> Gen ClientDataset
dataset ClientKeys
clientKeys =
        NetworkId
-> Tx
-> ClientKeys
-> Int
-> (NetworkId
    -> (UTxO, SigningKey PaymentKey, [Tx])
    -> Int
    -> Gen (UTxO, SigningKey PaymentKey, [Tx]))
-> Gen ClientDataset
generateClientDataset NetworkId
network Tx
fundingTransaction ClientKeys
clientKeys Int
nTxs NetworkId
-> (UTxO, SigningKey PaymentKey, [Tx])
-> Int
-> Gen (UTxO, SigningKey PaymentKey, [Tx])
generateOneSelfTransfer
  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 <- [ClientKeys]
-> (ClientKeys -> Gen ClientDataset) -> Gen [ClientDataset]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ClientKeys]
allClientKeys ClientKeys -> Gen ClientDataset
dataset
    Dataset -> Gen Dataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Dataset{Tx
fundingTransaction :: Tx
fundingTransaction :: Tx
fundingTransaction, [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}

-- * Helpers
thrd :: (a, b, c) -> c
thrd :: forall a b c. (a, b, c) -> c
thrd (a
_, b
_, c
c) = c
c

withInitialUTxO :: SigningKey PaymentKey -> Tx -> UTxO
withInitialUTxO :: SigningKey PaymentKey -> Tx -> UTxO
withInitialUTxO SigningKey PaymentKey
externalSigningKey Tx
fundingTransaction =
  let vk :: VerificationKey PaymentKey
vk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
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
utxoProducedByTx Tx
fundingTransaction
        UTxO -> (UTxO -> UTxO) -> UTxO
forall a b. a -> (a -> b) -> b
& (TxOut CtxUTxO Era -> Bool) -> UTxO -> UTxO
forall out. (out -> Bool) -> UTxO' out -> UTxO' out
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 :: [ClientKeys] -> Integer -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds :: [ClientKeys] -> Integer -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [ClientKeys]
clientKeys Integer
availableFunds =
  [ClientKeys]
-> (ClientKeys -> 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 [ClientKeys]
clientKeys ((ClientKeys -> Gen (VerificationKey PaymentKey, Coin))
 -> Gen [(VerificationKey PaymentKey, Coin)])
-> (ClientKeys -> Gen (VerificationKey PaymentKey, Coin))
-> Gen [(VerificationKey PaymentKey, Coin)]
forall a b. (a -> b) -> a -> b
$ \ClientKeys{SigningKey PaymentKey
externalSigningKey :: ClientKeys -> SigningKey PaymentKey
externalSigningKey :: SigningKey PaymentKey
externalSigningKey} -> do
    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
1, 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)
    (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 keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
externalSigningKey, Coin
amount)
 where
  nClients :: Int
nClients = [ClientKeys] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClientKeys]
clientKeys

generateClientDataset ::
  NetworkId ->
  Tx ->
  ClientKeys ->
  Int ->
  (NetworkId -> (UTxO, SigningKey PaymentKey, [Tx]) -> Int -> Gen (UTxO, SigningKey PaymentKey, [Tx])) ->
  Gen ClientDataset
generateClientDataset :: NetworkId
-> Tx
-> ClientKeys
-> Int
-> (NetworkId
    -> (UTxO, SigningKey PaymentKey, [Tx])
    -> Int
    -> Gen (UTxO, SigningKey PaymentKey, [Tx]))
-> Gen ClientDataset
generateClientDataset NetworkId
network Tx
fundingTransaction clientKeys :: ClientKeys
clientKeys@ClientKeys{SigningKey PaymentKey
externalSigningKey :: ClientKeys -> SigningKey PaymentKey
externalSigningKey :: SigningKey PaymentKey
externalSigningKey} Int
nTxs NetworkId
-> (UTxO, SigningKey PaymentKey, [Tx])
-> Int
-> Gen (UTxO, SigningKey PaymentKey, [Tx])
action = do
  let initialUTxO :: UTxO
initialUTxO = SigningKey PaymentKey -> Tx -> UTxO
withInitialUTxO SigningKey PaymentKey
externalSigningKey Tx
fundingTransaction
  [Tx]
txSequence <-
    [Tx] -> [Tx]
forall a. [a] -> [a]
reverse
      ([Tx] -> [Tx])
-> ((UTxO, SigningKey PaymentKey, [Tx]) -> [Tx])
-> (UTxO, SigningKey PaymentKey, [Tx])
-> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxO, SigningKey PaymentKey, [Tx]) -> [Tx]
forall a b c. (a, b, c) -> c
thrd
      ((UTxO, SigningKey PaymentKey, [Tx]) -> [Tx])
-> Gen (UTxO, SigningKey PaymentKey, [Tx]) -> Gen [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((UTxO, SigningKey PaymentKey, [Tx])
 -> Int -> Gen (UTxO, SigningKey PaymentKey, [Tx]))
-> (UTxO, SigningKey PaymentKey, [Tx])
-> [Int]
-> Gen (UTxO, SigningKey PaymentKey, [Tx])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (NetworkId
-> (UTxO, SigningKey PaymentKey, [Tx])
-> Int
-> Gen (UTxO, SigningKey PaymentKey, [Tx])
action NetworkId
network) (UTxO
initialUTxO, SigningKey PaymentKey
externalSigningKey, []) [Int
1 .. Int
nTxs]
  ClientDataset -> Gen ClientDataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientDataset{ClientKeys
clientKeys :: ClientKeys
clientKeys :: ClientKeys
clientKeys, UTxO
initialUTxO :: UTxO
initialUTxO :: UTxO
initialUTxO, [Tx]
txSequence :: [Tx]
txSequence :: [Tx]
txSequence}