module Hydra.Generator where

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

import Cardano.Api.UTxO qualified as UTxO
import CardanoClient (QueryPoint (QueryTip), mkGenesisTx, queryUTxOFor)
import Control.Monad (foldM)
import Data.Aeson (object, withObject, (.:), (.=))
import Hydra.Chain.Backend (buildTransaction)
import Hydra.Chain.Direct (DirectBackend (..))
import Hydra.Cluster.Faucet (FaucetException (..))
import Hydra.Cluster.Fixture (availableInitialFunds)
import Hydra.Ledger.Cardano (mkTransferTx)
import Hydra.Options qualified as Options
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
. 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
    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
. 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
  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, Coin)]
clientFunds <- [SigningKey PaymentKey]
-> Integer -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [SigningKey PaymentKey]
allPaymentKeys Integer
forall a. Num a => a
availableInitialFunds
  let fundingTransaction :: Tx
fundingTransaction =
        NetworkId
-> SigningKey PaymentKey
-> Coin
-> [(VerificationKey PaymentKey, Coin)]
-> Tx
mkGenesisTx
          NetworkId
networkId
          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, [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 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
  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) = UTxO -> Coin
UTxO.totalLovelace 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, 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 -> Gen [(VerificationKey PaymentKey, Coin)]
genClientFunds [SigningKey PaymentKey]
allPaymentKeys Integer
fundsAvailable
  -- 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

    DirectBackend
-> AddressInEra Era
-> UTxO
-> [TxIn]
-> [TxOut CtxTx]
-> IO (Either (TxBodyErrorAutoBalance Era) Tx)
forall backend.
ChainBackend backend =>
backend
-> AddressInEra Era
-> UTxO
-> [TxIn]
-> [TxOut CtxTx]
-> IO (Either (TxBodyErrorAutoBalance Era) Tx)
buildTransaction (DirectOptions -> DirectBackend
DirectBackend (DirectOptions -> DirectBackend) -> DirectOptions -> DirectBackend
forall a b. (a -> b) -> a -> b
$ Options.DirectOptions{$sel:networkId:DirectOptions :: NetworkId
Options.networkId = NetworkId
network, SocketPath
nodeSocket :: SocketPath
$sel:nodeSocket:DirectOptions :: SocketPath
Options.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{$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
$ 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, Coin)]
genClientFunds [SigningKey PaymentKey]
paymentKeys Integer
availableFunds =
  [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
    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
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
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)