module Hydra.Generator where

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

import Cardano.Api.UTxO qualified as UTxO
import CardanoClient (QueryPoint (QueryTip), buildTransaction, mkGenesisTx, queryUTxOFor)
import Control.Monad (foldM)
import Data.Aeson (object, withObject, (.:), (.=))
import Data.Default (def)
import Hydra.Cluster.Faucet (FaucetException (..))
import Hydra.Cluster.Fixture (availableInitialFunds)
import Hydra.Ledger.Cardano (mkTransferTx)
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 -> [SigningKey PaymentKey]
hydraNodeKeys :: [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.

instance ToJSON Dataset where
  toJSON :: Dataset -> Value
toJSON Dataset{Tx
fundingTransaction :: Dataset -> Tx
fundingTransaction :: Tx
fundingTransaction, [SigningKey PaymentKey]
hydraNodeKeys :: Dataset -> [SigningKey PaymentKey]
hydraNodeKeys :: [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
.= (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") (SigningKey PaymentKey -> TextEnvelope)
-> [SigningKey PaymentKey] -> [TextEnvelope]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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"
    [SigningKey PaymentKey]
hydraNodeKeys <- Object
o Object -> Key -> Parser [TextEnvelope]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hydraNodeKeys" Parser [TextEnvelope]
-> ([TextEnvelope] -> Parser [SigningKey PaymentKey])
-> Parser [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 (SigningKey PaymentKey))
-> [TextEnvelope] -> Parser [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 (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, [SigningKey PaymentKey]
hydraNodeKeys :: [SigningKey PaymentKey]
hydraNodeKeys :: [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 (SigningKey PaymentKey)
parseSigningKey =
      (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
. 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)

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 ClientDataset = ClientDataset
  { ClientDataset -> SigningKey PaymentKey
paymentKey :: SigningKey PaymentKey
  , 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)

instance ToJSON ClientDataset where
  toJSON :: ClientDataset -> Value
toJSON ClientDataset{SigningKey PaymentKey
paymentKey :: ClientDataset -> SigningKey PaymentKey
paymentKey :: SigningKey PaymentKey
paymentKey, UTxO
initialUTxO :: ClientDataset -> UTxO
initialUTxO :: UTxO
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
.= 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") SigningKey PaymentKey
paymentKey
      , Key
"initialUTxO" Key -> UTxO -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO
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
      SigningKey PaymentKey
paymentKey <- Object
o Object -> Key -> Parser TextEnvelope
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"paymentKey" Parser TextEnvelope
-> (TextEnvelope -> Parser (SigningKey PaymentKey))
-> Parser (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 (SigningKey PaymentKey)
parseSigningKey
      UTxO
initialUTxO <- Object
o Object -> Key -> Parser UTxO
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{SigningKey PaymentKey
paymentKey :: SigningKey PaymentKey
paymentKey :: SigningKey PaymentKey
paymentKey, UTxO
initialUTxO :: UTxO
initialUTxO :: UTxO
initialUTxO, [Tx]
txSequence :: [Tx]
txSequence :: [Tx]
txSequence}
   where
    parseSigningKey :: TextEnvelope -> Parser (SigningKey PaymentKey)
parseSigningKey =
      (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
. 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)

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

-- | 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
  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
  [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, Lovelace)]
clientFunds <- [SigningKey PaymentKey]
-> Integer -> Gen [(VerificationKey PaymentKey, Lovelace)]
genClientFunds [SigningKey PaymentKey]
allPaymentKeys Integer
forall a. Num a => a
availableInitialFunds
  let fundingTransaction :: Tx
fundingTransaction =
        NetworkId
-> SigningKey PaymentKey
-> Lovelace
-> [(VerificationKey PaymentKey, Lovelace)]
-> Tx
mkGenesisTx
          NetworkId
networkId
          SigningKey PaymentKey
faucetSk
          (Integer -> Lovelace
Coin Integer
forall a. Num a => a
availableInitialFunds)
          [(VerificationKey PaymentKey, Lovelace)]
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, [SigningKey PaymentKey]
hydraNodeKeys :: [SigningKey PaymentKey]
hydraNodeKeys :: [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}

-- | Generate a 'Dataset' from an already running network by quering 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
  SigningKey PaymentKey ->
  -- | Number of clients.
  Int ->
  -- | Number of transactions
  Int ->
  IO Dataset
generateDemoUTxODataset :: NetworkId
-> SocketPath -> SigningKey PaymentKey -> Int -> Int -> IO Dataset
generateDemoUTxODataset NetworkId
network SocketPath
nodeSocket SigningKey PaymentKey
faucetSk Int
nClients Int
nTxs = do
  -- Query available funds
  UTxO
faucetUTxO <- NetworkId
-> SocketPath
-> QueryPoint
-> VerificationKey PaymentKey
-> IO UTxO
queryUTxOFor NetworkId
network SocketPath
nodeSocket QueryPoint
QueryTip VerificationKey PaymentKey
faucetVk
  let (Coin Integer
fundsAvailable) = (TxOut CtxUTxO Era -> Lovelace) -> UTxO -> Lovelace
forall m a. Monoid m => (a -> m) -> UTxO' a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Value -> Lovelace
selectLovelace (Value -> Lovelace)
-> (TxOut CtxUTxO Era -> Value) -> TxOut CtxUTxO Era -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue) UTxO
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, Lovelace)]
clientFunds <- Gen [(VerificationKey PaymentKey, Lovelace)]
-> IO [(VerificationKey PaymentKey, Lovelace)]
forall a. Gen a -> IO a
generate (Gen [(VerificationKey PaymentKey, Lovelace)]
 -> IO [(VerificationKey PaymentKey, Lovelace)])
-> Gen [(VerificationKey PaymentKey, Lovelace)]
-> IO [(VerificationKey PaymentKey, Lovelace)]
forall a b. (a -> b) -> a -> b
$ [SigningKey PaymentKey]
-> Integer -> Gen [(VerificationKey PaymentKey, Lovelace)]
genClientFunds [SigningKey PaymentKey]
allPaymentKeys Integer
fundsAvailable
  -- XXX: DRY with 'seedFromFaucet'
  Tx
fundingTransaction <- do
    let recipientOutputs :: [TxOut CtxTx]
recipientOutputs =
          (((VerificationKey PaymentKey, Lovelace) -> TxOut CtxTx)
 -> [(VerificationKey PaymentKey, Lovelace)] -> [TxOut CtxTx])
-> [(VerificationKey PaymentKey, Lovelace)]
-> ((VerificationKey PaymentKey, Lovelace) -> TxOut CtxTx)
-> [TxOut CtxTx]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((VerificationKey PaymentKey, Lovelace) -> TxOut CtxTx)
-> [(VerificationKey PaymentKey, Lovelace)] -> [TxOut CtxTx]
forall a b. (a -> b) -> [a] -> [b]
map [(VerificationKey PaymentKey, Lovelace)]
clientFunds (((VerificationKey PaymentKey, Lovelace) -> TxOut CtxTx)
 -> [TxOut CtxTx])
-> ((VerificationKey PaymentKey, Lovelace) -> TxOut CtxTx)
-> [TxOut CtxTx]
forall a b. (a -> b) -> a -> b
$ \(VerificationKey PaymentKey
vk, Lovelace
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)
              (Lovelace -> Value
lovelaceToValue Lovelace
ll)
              TxOutDatum CtxTx
forall ctx. TxOutDatum ctx
TxOutDatumNone
              ReferenceScript
ReferenceScriptNone
    NetworkId
-> SocketPath
-> AddressInEra Era
-> UTxO
-> [TxIn]
-> [TxOut CtxTx]
-> IO (Either (TxBodyErrorAutoBalance Era) Tx)
buildTransaction NetworkId
network SocketPath
nodeSocket AddressInEra Era
faucetAddress UTxO
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{reason :: 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
$ SigningKey PaymentKey -> Tx -> Tx
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx 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 :: [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 = SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey 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
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 :: [SigningKey PaymentKey] -> Integer -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds :: [SigningKey PaymentKey]
-> Integer -> Gen [(VerificationKey PaymentKey, Lovelace)]
genClientFunds [SigningKey PaymentKey]
paymentKeys Integer
availableFunds =
  [SigningKey PaymentKey]
-> (SigningKey PaymentKey
    -> Gen (VerificationKey PaymentKey, Lovelace))
-> Gen [(VerificationKey PaymentKey, Lovelace)]
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, Lovelace))
 -> Gen [(VerificationKey PaymentKey, Lovelace)])
-> (SigningKey PaymentKey
    -> Gen (VerificationKey PaymentKey, Lovelace))
-> Gen [(VerificationKey PaymentKey, Lovelace)]
forall a b. (a -> b) -> a -> b
$ \SigningKey PaymentKey
paymentKey -> do
    Lovelace
amount <- Integer -> Lovelace
Coin (Integer -> Lovelace) -> Gen Integer -> Gen Lovelace
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, Lovelace)
-> Gen (VerificationKey PaymentKey, Lovelace)
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
paymentKey, Lovelace
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
initialUTxO = SigningKey PaymentKey -> Tx -> UTxO
withInitialUTxO SigningKey PaymentKey
paymentKey Tx
fundingTransaction
  (UTxO
_, [Tx]
txs) <- ((UTxO, [Tx]) -> Int -> Gen (UTxO, [Tx]))
-> (UTxO, [Tx]) -> [Int] -> Gen (UTxO, [Tx])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (SigningKey PaymentKey -> (UTxO, [Tx]) -> Int -> Gen (UTxO, [Tx])
go SigningKey PaymentKey
paymentKey) (UTxO
initialUTxO, []) [Int
1 .. Int
nTxs]
  ClientDataset -> Gen ClientDataset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientDataset{SigningKey PaymentKey
paymentKey :: SigningKey PaymentKey
paymentKey :: SigningKey PaymentKey
paymentKey, UTxO
initialUTxO :: UTxO
initialUTxO :: UTxO
initialUTxO, txSequence :: [Tx]
txSequence = [Tx] -> [Tx]
forall a. [a] -> [a]
reverse [Tx]
txs}
 where
  go :: SigningKey PaymentKey -> (UTxO, [Tx]) -> Int -> Gen (UTxO, [Tx])
go SigningKey PaymentKey
sk (UTxO
utxo, [Tx]
txs) Int
_ = do
    case NetworkId
-> UTxO
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> Either Text Tx
forall (m :: * -> *).
MonadFail m =>
NetworkId
-> UTxO
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> m Tx
mkTransferTx NetworkId
network UTxO
utxo SigningKey PaymentKey
sk (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
sk) of
      Left Text
err -> Text -> Gen (UTxO, [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Gen (UTxO, [Tx])) -> Text -> Gen (UTxO, [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, [Tx]) -> Gen (UTxO, [Tx])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx -> UTxO
utxoFromTx Tx
tx, Tx
tx Tx -> [Tx] -> [Tx]
forall a. a -> [a] -> [a]
: [Tx]
txs)