{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.Ledger.Cardano (
  module Hydra.Ledger.Cardano,
  module Hydra.Ledger.Cardano.Builder,
  Ledger.ShelleyGenesis (..),
  Tx,
) where

import Hydra.Prelude

import Hydra.Cardano.Api hiding (initialLedgerState)
import Hydra.Ledger.Cardano.Builder

import Cardano.Api.UTxO (fromPairs, pairs)
import Cardano.Api.UTxO qualified as UTxO
import Cardano.Crypto.DSIGN qualified as CC
import Cardano.Ledger.Api (updateTxBodyL)
import Cardano.Ledger.Babbage.Tx qualified as Ledger
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Binary (decCBOR, decodeFullAnnotator, serialize')
import Cardano.Ledger.Credential qualified as Ledger
import Cardano.Ledger.Shelley.API.Mempool qualified as Ledger
import Cardano.Ledger.Shelley.Genesis qualified as Ledger
import Cardano.Ledger.Shelley.LedgerState qualified as Ledger
import Cardano.Ledger.Shelley.Rules qualified as Ledger
import Cardano.Ledger.Shelley.UTxO qualified as Ledger
import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding qualified as CBOR
import Control.Lens (set)
import Control.Monad (foldM)
import Data.Aeson (object, (.:), (.:?), (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Types (withObject)
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as Base16
import Data.Default (def)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromJust)
import Data.Text.Lazy.Builder (toLazyText)
import Formatting.Buildable (build)
import Hydra.Contract.Head qualified as Head
import Hydra.Ledger (ChainSlot (..), IsTx (..), Ledger (..), ValidationError (..))
import PlutusLedgerApi.V2 (fromBuiltin)
import Test.Cardano.Ledger.Babbage.Arbitrary ()
import Test.QuickCheck (
  choose,
  getSize,
  listOf,
  oneof,
  scale,
  shrinkList,
  shrinkMapBy,
  suchThat,
  vectorOf,
 )

-- * Ledger

-- | Use the cardano-ledger as an in-hydra 'Ledger'.
cardanoLedger :: Ledger.Globals -> Ledger.LedgerEnv LedgerEra -> Ledger Tx
cardanoLedger :: Globals -> LedgerEnv (ShelleyLedgerEra Era) -> Ledger Tx
cardanoLedger Globals
globals LedgerEnv (ShelleyLedgerEra Era)
ledgerEnv =
  Ledger{ChainSlot
-> UTxO' (TxOut CtxUTxO Era)
-> [Tx]
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
ChainSlot
-> UTxOType Tx
-> [Tx]
-> Either (Tx, ValidationError) (UTxOType Tx)
applyTransactions :: ChainSlot
-> UTxO' (TxOut CtxUTxO Era)
-> [Tx]
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
$sel:applyTransactions:Ledger :: ChainSlot
-> UTxOType Tx
-> [Tx]
-> Either (Tx, ValidationError) (UTxOType Tx)
applyTransactions}
 where
  -- NOTE(SN): See full note on 'applyTx' why we only have a single transaction
  -- application here.
  applyTransactions :: ChainSlot
-> UTxO' (TxOut CtxUTxO Era)
-> [Tx]
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
applyTransactions ChainSlot
slot UTxO' (TxOut CtxUTxO Era)
utxo = \case
    [] -> UTxO' (TxOut CtxUTxO Era)
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
forall a b. b -> Either a b
Right UTxO' (TxOut CtxUTxO Era)
utxo
    (Tx
tx : [Tx]
txs) -> do
      UTxO' (TxOut CtxUTxO Era)
utxo' <- ChainSlot
-> UTxO' (TxOut CtxUTxO Era)
-> Tx
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
applyTx ChainSlot
slot UTxO' (TxOut CtxUTxO Era)
utxo Tx
tx
      ChainSlot
-> UTxO' (TxOut CtxUTxO Era)
-> [Tx]
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
applyTransactions ChainSlot
slot UTxO' (TxOut CtxUTxO Era)
utxo' [Tx]
txs

  -- TODO(SN): Pre-validate transactions to get less confusing errors on
  -- transactions which are not expected to work on a layer-2
  -- NOTE(SN): This is will fail on any transaction requiring the 'DPState' to be
  -- in a certain state as we do throw away the resulting 'DPState' and only take
  -- the ledger's 'UTxO' forward.
  --
  -- We came to this signature of only applying a single transaction because we
  -- got confused why a sequence of transactions worked but sequentially applying
  -- single transactions didn't. This was because of this not-keeping the'DPState'
  -- as described above.
  applyTx :: ChainSlot
-> UTxO' (TxOut CtxUTxO Era)
-> Tx
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
applyTx (ChainSlot Natural
slot) UTxO' (TxOut CtxUTxO Era)
utxo Tx
tx =
    case Globals
-> MempoolEnv (BabbageEra StandardCrypto)
-> MempoolState (BabbageEra StandardCrypto)
-> Tx (BabbageEra StandardCrypto)
-> Either
     (ApplyTxError (BabbageEra StandardCrypto))
     (MempoolState (BabbageEra StandardCrypto),
      Validated (Tx (BabbageEra StandardCrypto)))
forall era (m :: * -> *).
(ApplyTx era, MonadError (ApplyTxError era) m) =>
Globals
-> MempoolEnv era
-> MempoolState era
-> Tx era
-> m (MempoolState era, Validated (Tx era))
forall (m :: * -> *).
MonadError (ApplyTxError (BabbageEra StandardCrypto)) m =>
Globals
-> MempoolEnv (BabbageEra StandardCrypto)
-> MempoolState (BabbageEra StandardCrypto)
-> Tx (BabbageEra StandardCrypto)
-> m (MempoolState (BabbageEra StandardCrypto),
      Validated (Tx (BabbageEra StandardCrypto)))
Ledger.applyTx Globals
globals MempoolEnv (BabbageEra StandardCrypto)
env' MempoolState (BabbageEra StandardCrypto)
memPoolState (Tx -> Tx (ShelleyLedgerEra Era)
forall era.
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto,
 AlonzoEraTx (ShelleyLedgerEra era)) =>
Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
tx) of
      Left ApplyTxError (BabbageEra StandardCrypto)
err ->
        (Tx, ValidationError)
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
forall a b. a -> Either a b
Left (Tx
tx, ApplyTxError (BabbageEra StandardCrypto) -> ValidationError
toValidationError ApplyTxError (BabbageEra StandardCrypto)
err)
      Right (Ledger.LedgerState{lsUTxOState :: forall era. LedgerState era -> UTxOState era
Ledger.lsUTxOState = UTxOState (BabbageEra StandardCrypto)
us}, Validated (AlonzoTx (BabbageEra StandardCrypto))
_validatedTx) ->
        UTxO' (TxOut CtxUTxO Era)
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
forall a b. b -> Either a b
Right (UTxO' (TxOut CtxUTxO Era)
 -> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era)))
-> (UTxO (BabbageEra StandardCrypto) -> UTxO' (TxOut CtxUTxO Era))
-> UTxO (BabbageEra StandardCrypto)
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO (ShelleyLedgerEra Era) -> UTxO' (TxOut CtxUTxO Era)
UTxO (BabbageEra StandardCrypto) -> UTxO' (TxOut CtxUTxO Era)
fromLedgerUTxO (UTxO (BabbageEra StandardCrypto)
 -> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era)))
-> UTxO (BabbageEra StandardCrypto)
-> Either (Tx, ValidationError) (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ UTxOState (BabbageEra StandardCrypto)
-> UTxO (BabbageEra StandardCrypto)
forall era. UTxOState era -> UTxO era
Ledger.utxosUtxo UTxOState (BabbageEra StandardCrypto)
us
   where
    toValidationError :: ApplyTxError (BabbageEra StandardCrypto) -> ValidationError
toValidationError = Text -> ValidationError
ValidationError (Text -> ValidationError)
-> (ApplyTxError (BabbageEra StandardCrypto) -> Text)
-> ApplyTxError (BabbageEra StandardCrypto)
-> ValidationError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplyTxError (BabbageEra StandardCrypto) -> Text
forall b a. (Show a, IsString b) => a -> b
show

    env' :: MempoolEnv (BabbageEra StandardCrypto)
env' = LedgerEnv (ShelleyLedgerEra Era)
ledgerEnv{Ledger.ledgerSlotNo = fromIntegral slot}

    memPoolState :: MempoolState (BabbageEra StandardCrypto)
memPoolState =
      Ledger.LedgerState
        { lsUTxOState :: UTxOState (BabbageEra StandardCrypto)
Ledger.lsUTxOState = UTxOState (BabbageEra StandardCrypto)
forall a. Default a => a
def{Ledger.utxosUtxo = toLedgerUTxO utxo}
        , lsCertState :: CertState (BabbageEra StandardCrypto)
Ledger.lsCertState = CertState (BabbageEra StandardCrypto)
forall a. Default a => a
def
        }

-- | Simple conversion from a generic slot to a specific local one.
fromChainSlot :: ChainSlot -> SlotNo
fromChainSlot :: ChainSlot -> SlotNo
fromChainSlot (ChainSlot Natural
s) = Natural -> SlotNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
s

-- * Cardano Tx

instance IsTx Tx where
  type TxIdType Tx = TxId
  type UTxOType Tx = UTxO
  type ValueType Tx = Value

  txId :: Tx -> TxIdType Tx
txId = TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId (TxBody Era -> TxId) -> (Tx -> TxBody Era) -> Tx -> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody
  balance :: UTxOType Tx -> ValueType Tx
balance = (TxOut CtxUTxO Era -> Value) -> UTxO' (TxOut CtxUTxO Era) -> Value
forall m a. Monoid m => (a -> m) -> UTxO' a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue

  -- NOTE: See note from `Head.hashTxOuts`.
  hashUTxO :: UTxOType Tx -> ByteString
hashUTxO = BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
fromBuiltin (BuiltinByteString -> ByteString)
-> (UTxO' (TxOut CtxUTxO Era) -> BuiltinByteString)
-> UTxO' (TxOut CtxUTxO Era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOut] -> BuiltinByteString
Head.hashTxOuts ([TxOut] -> BuiltinByteString)
-> (UTxO' (TxOut CtxUTxO Era) -> [TxOut])
-> UTxO' (TxOut CtxUTxO Era)
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut CtxUTxO Era -> Maybe TxOut)
-> [TxOut CtxUTxO Era] -> [TxOut]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe HasCallStack => TxOut CtxUTxO Era -> Maybe TxOut
TxOut CtxUTxO Era -> Maybe TxOut
toPlutusTxOut ([TxOut CtxUTxO Era] -> [TxOut])
-> (UTxO' (TxOut CtxUTxO Era) -> [TxOut CtxUTxO Era])
-> UTxO' (TxOut CtxUTxO Era)
-> [TxOut]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO' (TxOut CtxUTxO Era) -> [TxOut CtxUTxO Era]
forall a. UTxO' a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance ToCBOR Tx where
  toCBOR :: Tx -> Encoding
toCBOR = ByteString -> Encoding
CBOR.encodeBytes (ByteString -> Encoding) -> (Tx -> ByteString) -> Tx -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> AlonzoTx (BabbageEra StandardCrypto) -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
ledgerEraVersion (AlonzoTx (BabbageEra StandardCrypto) -> ByteString)
-> (Tx -> AlonzoTx (BabbageEra StandardCrypto)) -> Tx -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> Tx (ShelleyLedgerEra Era)
Tx -> AlonzoTx (BabbageEra StandardCrypto)
forall era.
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto,
 AlonzoEraTx (ShelleyLedgerEra era)) =>
Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx

instance FromCBOR Tx where
  fromCBOR :: forall s. Decoder s Tx
fromCBOR = do
    ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
    Version
-> Text
-> (forall s.
    Decoder s (Annotator (AlonzoTx (BabbageEra StandardCrypto))))
-> ByteString
-> Either DecoderError (AlonzoTx (BabbageEra StandardCrypto))
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator Version
ledgerEraVersion Text
"Tx" Decoder s (Annotator (AlonzoTx (BabbageEra StandardCrypto)))
forall s.
Decoder s (Annotator (AlonzoTx (BabbageEra StandardCrypto)))
forall a s. DecCBOR a => Decoder s a
decCBOR (ByteString -> ByteString
forall l s. LazyStrict l s => s -> l
fromStrict ByteString
bs)
      Either DecoderError (AlonzoTx (BabbageEra StandardCrypto))
-> (Either DecoderError (AlonzoTx (BabbageEra StandardCrypto))
    -> Decoder s Tx)
-> Decoder s Tx
forall a b. a -> (a -> b) -> b
& (DecoderError -> Decoder s Tx)
-> (AlonzoTx (BabbageEra StandardCrypto) -> Decoder s Tx)
-> Either DecoderError (AlonzoTx (BabbageEra StandardCrypto))
-> Decoder s Tx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (String -> Decoder s Tx
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s Tx)
-> (DecoderError -> String) -> DecoderError -> Decoder s Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString (Text -> String)
-> (DecoderError -> Text) -> DecoderError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text)
-> (DecoderError -> Builder) -> DecoderError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> Builder
forall p. Buildable p => p -> Builder
build)
        (Tx -> Decoder s Tx
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx -> Decoder s Tx)
-> (AlonzoTx (BabbageEra StandardCrypto) -> Tx)
-> AlonzoTx (BabbageEra StandardCrypto)
-> Decoder s Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx (ShelleyLedgerEra Era) -> Tx
AlonzoTx (BabbageEra StandardCrypto) -> Tx
fromLedgerTx)

instance ToJSON Tx where
  toJSON :: Tx -> Value
toJSON Tx
tx =
    let TextEnvelopeType String
envelopeType = AsType Tx -> TextEnvelopeType
forall a. HasTextEnvelope a => AsType a -> TextEnvelopeType
textEnvelopeType (Proxy Tx -> AsType Tx
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Tx))
     in [Pair] -> Value
object
          [ Key
"cborHex" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Tx -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR Tx
tx)
          , Key
"txId" Key -> TxId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
tx
          , Key
"type" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
envelopeType
          , Key
"description" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
forall a. Monoid a => a
mempty
          ]

instance FromJSON Tx where
  parseJSON :: Value -> Parser Tx
parseJSON =
    String -> (Object -> Parser Tx) -> Value -> Parser Tx
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Tx" ((Object -> Parser Tx) -> Value -> Parser Tx)
-> (Object -> Parser Tx) -> Value -> Parser Tx
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      let TextEnvelopeType String
envelopeType = AsType Tx -> TextEnvelopeType
forall a. HasTextEnvelope a => AsType a -> TextEnvelopeType
textEnvelopeType (Proxy Tx -> AsType Tx
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Tx))
      Text
hexText <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cborHex"
      String
ty <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
envelopeType String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ty)
      ByteString
bytes <- Text -> Parser ByteString
forall (f :: * -> *). MonadFail f => Text -> f ByteString
decodeBase16 Text
hexText

      case AsType Tx -> ByteString -> Either DecoderError Tx
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR (Proxy Tx -> AsType Tx
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Tx)) ByteString
bytes of
        Left DecoderError
e -> String -> Parser Tx
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Tx) -> String -> Parser Tx
forall a b. (a -> b) -> a -> b
$ DecoderError -> String
forall b a. (Show a, IsString b) => a -> b
show DecoderError
e
        Right Tx
tx ->
          (Object
o Object -> Key -> Parser (Maybe TxId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"txId") Parser (Maybe TxId) -> (Maybe TxId -> Parser Tx) -> Parser Tx
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe TxId
Nothing -> Tx -> Parser Tx
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx
tx
            Just TxId
txid' -> do
              Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TxId
txid' TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
== Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
tx)
              Tx -> Parser Tx
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx
tx

instance Arbitrary Tx where
  -- TODO: shrinker!
  arbitrary :: Gen Tx
arbitrary = Tx (ShelleyLedgerEra Era) -> Tx
AlonzoTx (BabbageEra StandardCrypto) -> Tx
fromLedgerTx (AlonzoTx (BabbageEra StandardCrypto) -> Tx)
-> (AlonzoTx (BabbageEra StandardCrypto)
    -> AlonzoTx (BabbageEra StandardCrypto))
-> AlonzoTx (BabbageEra StandardCrypto)
-> Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx (BabbageEra StandardCrypto)
-> AlonzoTx (BabbageEra StandardCrypto)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ProtVerIsInBounds
   "at most"
   era
   8
   (OrdCond (CmpNat (ProtVerLow era) 8) 'True 'True 'False),
 ShelleyEraTxBody era) =>
AlonzoTx era -> AlonzoTx era
withoutProtocolUpdates (AlonzoTx (BabbageEra StandardCrypto) -> Tx)
-> Gen (AlonzoTx (BabbageEra StandardCrypto)) -> Gen Tx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTx (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
   where
    withoutProtocolUpdates :: AlonzoTx era -> AlonzoTx era
withoutProtocolUpdates tx :: AlonzoTx era
tx@(Ledger.AlonzoTx TxBody era
body TxWits era
_ IsValid
_ StrictMaybe (TxAuxData era)
_) =
      let body' :: TxBody era
body' = TxBody era
body TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& ASetter
  (TxBody era)
  (TxBody era)
  (StrictMaybe (Update era))
  (StrictMaybe (Update era))
-> StrictMaybe (Update era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (TxBody era)
  (TxBody era)
  (StrictMaybe (Update era))
  (StrictMaybe (Update era))
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL StrictMaybe (Update era)
forall a. StrictMaybe a
SNothing
       in AlonzoTx era
tx{Ledger.body = body'}

-- | Create a zero-fee, payment cardano transaction.
mkSimpleTx ::
  (TxIn, TxOut CtxUTxO) ->
  -- | Recipient address and amount.
  (AddressInEra, Value) ->
  -- | Sender's signing key.
  SigningKey PaymentKey ->
  Either TxBodyError Tx
mkSimpleTx :: (TxIn, TxOut CtxUTxO Era)
-> (AddressInEra, Value)
-> SigningKey PaymentKey
-> Either TxBodyError Tx
mkSimpleTx (TxIn
txin, TxOut AddressInEra
owner Value
valueIn TxOutDatum CtxUTxO
datum ReferenceScript
refScript) (AddressInEra
recipient, Value
valueOut) SigningKey PaymentKey
sk = do
  TxBody Era
body <- TxBodyContent BuildTx -> Either TxBodyError (TxBody Era)
createAndValidateTransactionBody TxBodyContent BuildTx
bodyContent
  let witnesses :: [KeyWitness]
witnesses = [TxBody Era -> ShelleyWitnessSigningKey -> KeyWitness
makeShelleyKeyWitness TxBody Era
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 Era -> Tx
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness]
witnesses TxBody Era
body
 where
  bodyContent :: TxBodyContent BuildTx
bodyContent =
    TxBodyContent BuildTx
emptyTxBody
      { txIns = [(txin, BuildTxWith $ KeyWitness KeyWitnessForSpending)]
      , txOuts = outs
      , txFee = TxFeeExplicit fee
      }

  outs :: [TxOut CtxTx]
outs =
    forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut @CtxTx AddressInEra
recipient Value
valueOut TxOutDatum CtxTx
forall ctx. TxOutDatum ctx
TxOutDatumNone ReferenceScript
ReferenceScriptNone
      TxOut CtxTx -> [TxOut CtxTx] -> [TxOut CtxTx]
forall a. a -> [a] -> [a]
: [ forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut @CtxTx
          AddressInEra
owner
          (Value
valueIn Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
negateValue Value
valueOut)
          (TxOutDatum CtxUTxO -> TxOutDatum CtxTx
forall era. TxOutDatum CtxUTxO era -> TxOutDatum CtxTx era
forall {k} (f :: * -> k -> *) (era :: k).
ToTxContext f =>
f CtxUTxO era -> f CtxTx era
toTxContext TxOutDatum CtxUTxO
datum)
          ReferenceScript
refScript
        | Value
valueOut Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
valueIn
        ]

  fee :: Coin
fee = Integer -> Coin
Coin Integer
0

-- | Create a zero-fee, payment cardano transaction with validity range.
mkRangedTx ::
  (TxIn, TxOut CtxUTxO) ->
  -- | Recipient address and amount.
  (AddressInEra, Value) ->
  -- | Sender's signing key.
  SigningKey PaymentKey ->
  (Maybe TxValidityLowerBound, Maybe TxValidityUpperBound) ->
  Either TxBodyError Tx
mkRangedTx :: (TxIn, TxOut CtxUTxO Era)
-> (AddressInEra, Value)
-> SigningKey PaymentKey
-> (Maybe TxValidityLowerBound, Maybe TxValidityUpperBound)
-> Either TxBodyError Tx
mkRangedTx (TxIn
txin, TxOut AddressInEra
owner Value
valueIn TxOutDatum CtxUTxO
datum ReferenceScript
refScript) (AddressInEra
recipient, Value
valueOut) SigningKey PaymentKey
sk (Maybe TxValidityLowerBound
validityLowerBound, Maybe TxValidityUpperBound
validityUpperBound) = do
  TxBody Era
body <- TxBodyContent BuildTx -> Either TxBodyError (TxBody Era)
createAndValidateTransactionBody TxBodyContent BuildTx
bodyContent
  let witnesses :: [KeyWitness]
witnesses = [TxBody Era -> ShelleyWitnessSigningKey -> KeyWitness
makeShelleyKeyWitness TxBody Era
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 Era -> Tx
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [KeyWitness]
witnesses TxBody Era
body
 where
  bodyContent :: TxBodyContent BuildTx
bodyContent =
    TxBodyContent BuildTx
emptyTxBody
      { txIns = [(txin, BuildTxWith $ KeyWitness KeyWitnessForSpending)]
      , txOuts =
          TxOut @CtxTx recipient valueOut TxOutDatumNone ReferenceScriptNone
            : [ TxOut @CtxTx
                owner
                (valueIn <> negateValue valueOut)
                (toTxContext datum)
                refScript
              | valueOut /= valueIn
              ]
      , txFee = TxFeeExplicit $ Coin 0
      , txValidityLowerBound = fromMaybe TxValidityNoLowerBound validityLowerBound
      , txValidityUpperBound = fromMaybe TxValidityNoUpperBound validityUpperBound
      }

-- | Utility function to "adjust" a `UTxO` set given a `Tx`
--
--  The inputs from the `Tx` are removed from the internal map of the `UTxO` and
--  the outputs added, correctly indexed by the `TxIn`. This function is useful
--  to manually maintain a `UTxO` set without caring too much about the `Ledger`
--  rules.
adjustUTxO :: Tx -> UTxO -> UTxO
adjustUTxO :: Tx -> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
adjustUTxO Tx
tx UTxO' (TxOut CtxUTxO Era)
utxo =
  let txid :: TxIdType Tx
txid = Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
tx
      consumed :: [TxIn]
consumed = Tx -> [TxIn]
forall era. Tx era -> [TxIn]
txIns' Tx
tx
      produced :: UTxO' (TxOut CtxUTxO Era)
produced =
        TxOut CtxTx -> TxOut CtxUTxO Era
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
forall {k} (f :: * -> k -> *) (era :: k).
ToUTxOContext f =>
f CtxTx era -> f CtxUTxO era
toUTxOContext
          (TxOut CtxTx -> TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxTx) -> UTxO' (TxOut CtxUTxO Era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, TxOut CtxTx)] -> UTxO' (TxOut CtxTx)
forall out. [(TxIn, out)] -> UTxO' out
fromPairs ((\(TxOut CtxTx
txout, Word
ix) -> (TxId -> TxIx -> TxIn
TxIn TxId
TxIdType Tx
txid (Word -> TxIx
TxIx Word
ix), TxOut CtxTx
txout)) ((TxOut CtxTx, Word) -> (TxIn, TxOut CtxTx))
-> [(TxOut CtxTx, Word)] -> [(TxIn, TxOut CtxTx)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut CtxTx] -> [Word] -> [(TxOut CtxTx, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Tx -> [TxOut CtxTx]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx
tx) [Word
0 ..])
      utxo' :: UTxO' (TxOut CtxUTxO Era)
utxo' = [(TxIn, TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era)
forall out. [(TxIn, out)] -> UTxO' out
fromPairs ([(TxIn, TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era))
-> [(TxIn, TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ ((TxIn, TxOut CtxUTxO Era) -> Bool)
-> [(TxIn, TxOut CtxUTxO Era)] -> [(TxIn, TxOut CtxUTxO Era)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(TxIn
txin, TxOut CtxUTxO Era
_) -> TxIn
txin TxIn -> [TxIn] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [TxIn]
consumed) ([(TxIn, TxOut CtxUTxO Era)] -> [(TxIn, TxOut CtxUTxO Era)])
-> [(TxIn, TxOut CtxUTxO Era)] -> [(TxIn, TxOut CtxUTxO Era)]
forall a b. (a -> b) -> a -> b
$ UTxO' (TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
pairs UTxO' (TxOut CtxUTxO Era)
utxo
   in UTxO' (TxOut CtxUTxO Era)
utxo' UTxO' (TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a. Semigroup a => a -> a -> a
<> UTxO' (TxOut CtxUTxO Era)
produced

-- * Generators

genSigningKey :: Gen (SigningKey PaymentKey)
genSigningKey :: Gen (SigningKey PaymentKey)
genSigningKey = do
  -- NOTE: not using 'genKeyDSIGN' purposely here, it is not pure and does not
  -- play well with pure generation from seed.
  SignKeyDSIGN Ed25519DSIGN
sk <- Maybe (SignKeyDSIGN Ed25519DSIGN) -> SignKeyDSIGN Ed25519DSIGN
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (SignKeyDSIGN Ed25519DSIGN) -> SignKeyDSIGN Ed25519DSIGN)
-> ([Word8] -> Maybe (SignKeyDSIGN Ed25519DSIGN))
-> [Word8]
-> SignKeyDSIGN Ed25519DSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (SignKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
CC.rawDeserialiseSignKeyDSIGN (ByteString -> Maybe (SignKeyDSIGN Ed25519DSIGN))
-> ([Word8] -> ByteString)
-> [Word8]
-> Maybe (SignKeyDSIGN Ed25519DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
[Item ByteString] -> ByteString
forall l. IsList l => [Item l] -> l
fromList ([Word8] -> SignKeyDSIGN Ed25519DSIGN)
-> Gen [Word8] -> Gen (SignKeyDSIGN Ed25519DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
  SigningKey PaymentKey -> Gen (SigningKey PaymentKey)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignKeyDSIGN StandardCrypto -> SigningKey PaymentKey
PaymentSigningKey SignKeyDSIGN StandardCrypto
SignKeyDSIGN Ed25519DSIGN
sk)

genVerificationKey :: Gen (VerificationKey PaymentKey)
genVerificationKey :: Gen (VerificationKey PaymentKey)
genVerificationKey = SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey (SigningKey PaymentKey -> VerificationKey PaymentKey)
-> Gen (SigningKey PaymentKey) -> Gen (VerificationKey PaymentKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SigningKey PaymentKey)
genSigningKey

genKeyPair :: Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair :: Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair = do
  SigningKey PaymentKey
sk <- Gen (SigningKey PaymentKey)
genSigningKey
  (VerificationKey PaymentKey, SigningKey PaymentKey)
-> Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
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
sk, SigningKey PaymentKey
sk)

-- | Generates a sequence of simple "transfer" transactions for a single key.
-- The kind of transactions produced by this generator is very limited, see `generateOneTransfer`.
genSequenceOfSimplePaymentTransactions :: Gen (UTxO, [Tx])
genSequenceOfSimplePaymentTransactions :: Gen (UTxO' (TxOut CtxUTxO Era), [Tx])
genSequenceOfSimplePaymentTransactions = do
  Int
n <- Gen Int
getSize
  Int
numTxs <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
n)
  Int -> Gen (UTxO' (TxOut CtxUTxO Era), [Tx])
genFixedSizeSequenceOfSimplePaymentTransactions Int
numTxs

genFixedSizeSequenceOfSimplePaymentTransactions :: Int -> Gen (UTxO, [Tx])
genFixedSizeSequenceOfSimplePaymentTransactions :: Int -> Gen (UTxO' (TxOut CtxUTxO Era), [Tx])
genFixedSizeSequenceOfSimplePaymentTransactions Int
numTxs = do
  keyPair :: (VerificationKey PaymentKey, SigningKey PaymentKey)
keyPair@(VerificationKey PaymentKey
vk, SigningKey PaymentKey
_) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
  UTxO' (TxOut CtxUTxO Era)
utxo <- VerificationKey PaymentKey -> Gen (UTxO' (TxOut CtxUTxO Era))
genOneUTxOFor VerificationKey PaymentKey
vk
  [Tx]
txs <-
    [Tx] -> [Tx]
forall a. [a] -> [a]
reverse
      ([Tx] -> [Tx])
-> ((UTxO' (TxOut CtxUTxO Era),
     (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
    -> [Tx])
-> (UTxO' (TxOut CtxUTxO Era),
    (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
-> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxO' (TxOut CtxUTxO Era),
 (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
-> [Tx]
forall {a} {b} {c}. (a, b, c) -> c
thrd
      ((UTxO' (TxOut CtxUTxO Era),
  (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
 -> [Tx])
-> Gen
     (UTxO' (TxOut CtxUTxO Era),
      (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
-> Gen [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((UTxO' (TxOut CtxUTxO Era),
  (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
 -> Int
 -> Gen
      (UTxO' (TxOut CtxUTxO Era),
       (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx]))
-> (UTxO' (TxOut CtxUTxO Era),
    (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
-> [Int]
-> Gen
     (UTxO' (TxOut CtxUTxO Era),
      (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (NetworkId
-> (UTxO' (TxOut CtxUTxO Era),
    (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
-> Int
-> Gen
     (UTxO' (TxOut CtxUTxO Era),
      (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
generateOneTransfer NetworkId
testNetworkId) (UTxO' (TxOut CtxUTxO Era)
utxo, (VerificationKey PaymentKey, SigningKey PaymentKey)
keyPair, []) [Int
1 .. Int
numTxs]
  (UTxO' (TxOut CtxUTxO Era), [Tx])
-> Gen (UTxO' (TxOut CtxUTxO Era), [Tx])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO' (TxOut CtxUTxO Era)
utxo, [Tx]
txs)
 where
  thrd :: (a, b, c) -> c
thrd (a
_, b
_, c
c) = c
c
  testNetworkId :: NetworkId
testNetworkId = NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId) -> NetworkMagic -> NetworkId
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkMagic
NetworkMagic Word32
42

generateOneTransfer ::
  NetworkId ->
  (UTxO, (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx]) ->
  Int ->
  Gen (UTxO, (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
generateOneTransfer :: NetworkId
-> (UTxO' (TxOut CtxUTxO Era),
    (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
-> Int
-> Gen
     (UTxO' (TxOut CtxUTxO Era),
      (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
generateOneTransfer NetworkId
networkId (UTxO' (TxOut CtxUTxO Era)
utxo, (VerificationKey PaymentKey
_, SigningKey PaymentKey
sender), [Tx]
txs) Int
_ = do
  (VerificationKey PaymentKey, SigningKey PaymentKey)
recipient <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
  -- NOTE(AB): elements is partial, it crashes if given an empty list, We don't expect
  -- this function to be ever used in production, and crash will be caught in tests
  case UTxO' (TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.pairs UTxO' (TxOut CtxUTxO Era)
utxo of
    [(TxIn, TxOut CtxUTxO Era)
txin] ->
      case (TxIn, TxOut CtxUTxO Era)
-> (AddressInEra, Value)
-> SigningKey PaymentKey
-> Either TxBodyError Tx
mkSimpleTx (TxIn, TxOut CtxUTxO Era)
txin (NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId ((VerificationKey PaymentKey, SigningKey PaymentKey)
-> VerificationKey PaymentKey
forall a b. (a, b) -> a
fst (VerificationKey PaymentKey, SigningKey PaymentKey)
recipient), forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance @Tx UTxO' (TxOut CtxUTxO Era)
UTxOType Tx
utxo) SigningKey PaymentKey
sender of
        Left TxBodyError
e -> Text
-> Gen
     (UTxO' (TxOut CtxUTxO Era),
      (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error (Text
 -> Gen
      (UTxO' (TxOut CtxUTxO Era),
       (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx]))
-> Text
-> Gen
     (UTxO' (TxOut CtxUTxO Era),
      (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
forall a b. (a -> b) -> a -> b
$ Text
"Tx construction failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> Text
forall b a. (Show a, IsString b) => a -> b
show TxBodyError
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", utxo: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UTxO' (TxOut CtxUTxO Era) -> Text
forall b a. (Show a, IsString b) => a -> b
show UTxO' (TxOut CtxUTxO Era)
utxo
        Right Tx
tx ->
          (UTxO' (TxOut CtxUTxO Era),
 (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
-> Gen
     (UTxO' (TxOut CtxUTxO Era),
      (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx -> UTxO' (TxOut CtxUTxO Era)
utxoFromTx Tx
tx, (VerificationKey PaymentKey, SigningKey PaymentKey)
recipient, Tx
tx Tx -> [Tx] -> [Tx]
forall a. a -> [a] -> [a]
: [Tx]
txs)
    [(TxIn, TxOut CtxUTxO Era)]
_ ->
      Text
-> Gen
     (UTxO' (TxOut CtxUTxO Era),
      (VerificationKey PaymentKey, SigningKey PaymentKey), [Tx])
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Couldn't generate transaction sequence: need exactly one UTXO."

-- TODO: Enable arbitrary datum in generators
-- TODO: This should better be called 'genOutputFor'
genOutput ::
  forall ctx.
  VerificationKey PaymentKey ->
  Gen (TxOut ctx)
genOutput :: forall ctx. VerificationKey PaymentKey -> Gen (TxOut ctx)
genOutput VerificationKey PaymentKey
vk = do
  Value
value <- Gen Value
genValue
  TxOut ctx -> Gen (TxOut ctx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut ctx -> Gen (TxOut ctx)) -> TxOut ctx -> Gen (TxOut ctx)
forall a b. (a -> b) -> a -> b
$ AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut (NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress (NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId) -> NetworkMagic -> NetworkId
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkMagic
NetworkMagic Word32
42) VerificationKey PaymentKey
vk) Value
value TxOutDatum ctx
forall ctx. TxOutDatum ctx
TxOutDatumNone ReferenceScript
ReferenceScriptNone

-- | Generate an ada-only 'TxOut' payed to an arbitrary public key.
genTxOutAdaOnly :: VerificationKey PaymentKey -> Gen (TxOut ctx)
genTxOutAdaOnly :: forall ctx. VerificationKey PaymentKey -> Gen (TxOut ctx)
genTxOutAdaOnly VerificationKey PaymentKey
vk = do
  Value
value <- Coin -> Value
lovelaceToValue (Coin -> Value) -> (Integer -> Coin) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Value) -> Gen Integer -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen Integer -> Gen Integer
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Gen Integer
forall a. Arbitrary a => Gen a
arbitrary Gen Integer -> (Integer -> Bool) -> Gen Integer
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0)
  TxOut ctx -> Gen (TxOut ctx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut ctx -> Gen (TxOut ctx)) -> TxOut ctx -> Gen (TxOut ctx)
forall a b. (a -> b) -> a -> b
$ AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut (NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress (NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId) -> NetworkMagic -> NetworkId
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkMagic
NetworkMagic Word32
42) VerificationKey PaymentKey
vk) Value
value TxOutDatum ctx
forall ctx. TxOutDatum ctx
TxOutDatumNone ReferenceScript
ReferenceScriptNone

-- | Generate a fixed size UTxO with ada-only outputs.
genUTxOAdaOnlyOfSize :: Int -> Gen UTxO
genUTxOAdaOnlyOfSize :: Int -> Gen (UTxO' (TxOut CtxUTxO Era))
genUTxOAdaOnlyOfSize Int
numUTxO =
  [UTxO' (TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era)
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([UTxO' (TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era))
-> Gen [UTxO' (TxOut CtxUTxO Era)]
-> Gen (UTxO' (TxOut CtxUTxO Era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Gen (UTxO' (TxOut CtxUTxO Era))
-> Gen [UTxO' (TxOut CtxUTxO Era)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
numUTxO ((TxIn, TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton ((TxIn, TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era))
-> Gen (TxIn, TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxIn, TxOut CtxUTxO Era)
forall {ctx}. Gen (TxIn, TxOut ctx)
gen)
 where
  gen :: Gen (TxIn, TxOut ctx)
gen = (,) (TxIn -> TxOut ctx -> (TxIn, TxOut ctx))
-> Gen TxIn -> Gen (TxOut ctx -> (TxIn, TxOut ctx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary Gen (TxOut ctx -> (TxIn, TxOut ctx))
-> Gen (TxOut ctx) -> Gen (TxIn, TxOut ctx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VerificationKey PaymentKey -> Gen (TxOut ctx)
forall ctx. VerificationKey PaymentKey -> Gen (TxOut ctx)
genTxOutAdaOnly (VerificationKey PaymentKey -> Gen (TxOut ctx))
-> Gen (VerificationKey PaymentKey) -> Gen (TxOut ctx)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen (VerificationKey PaymentKey)
forall a. Arbitrary a => Gen a
arbitrary)

-- | Generate 'Babbage' era 'UTxO', which may contain arbitrary assets in
-- 'TxOut's addressed to public keys *and* scripts. NOTE: This is not reducing
-- size when generating assets in 'TxOut's, so will end up regularly with 300+
-- assets with generator size 30. NOTE: The Arbitrary TxIn instance from the
-- ledger is producing colliding values, so we replace them.
genUTxOAlonzo :: Gen UTxO
genUTxOAlonzo :: Gen (UTxO' (TxOut CtxUTxO Era))
genUTxOAlonzo = do
  [(TxIn (EraCrypto (BabbageEra StandardCrypto)),
  TxOut (BabbageEra StandardCrypto))]
utxoMap <- Map
  (TxIn (EraCrypto (BabbageEra StandardCrypto)))
  (TxOut (BabbageEra StandardCrypto))
-> [(TxIn (EraCrypto (BabbageEra StandardCrypto)),
     TxOut (BabbageEra StandardCrypto))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map
   (TxIn (EraCrypto (BabbageEra StandardCrypto)))
   (TxOut (BabbageEra StandardCrypto))
 -> [(TxIn (EraCrypto (BabbageEra StandardCrypto)),
      TxOut (BabbageEra StandardCrypto))])
-> (UTxO (BabbageEra StandardCrypto)
    -> Map
         (TxIn (EraCrypto (BabbageEra StandardCrypto)))
         (TxOut (BabbageEra StandardCrypto)))
-> UTxO (BabbageEra StandardCrypto)
-> [(TxIn (EraCrypto (BabbageEra StandardCrypto)),
     TxOut (BabbageEra StandardCrypto))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO (BabbageEra StandardCrypto)
-> Map
     (TxIn (EraCrypto (BabbageEra StandardCrypto)))
     (TxOut (BabbageEra StandardCrypto))
forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
Ledger.unUTxO (UTxO (BabbageEra StandardCrypto)
 -> [(TxIn (EraCrypto (BabbageEra StandardCrypto)),
      TxOut (BabbageEra StandardCrypto))])
-> Gen (UTxO (BabbageEra StandardCrypto))
-> Gen
     [(TxIn (EraCrypto (BabbageEra StandardCrypto)),
       TxOut (BabbageEra StandardCrypto))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (UTxO (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
  ([(TxIn, TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era))
-> Gen [(TxIn, TxOut CtxUTxO Era)]
-> Gen (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(TxIn, TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era)
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromPairs (Gen [(TxIn, TxOut CtxUTxO Era)]
 -> Gen (UTxO' (TxOut CtxUTxO Era)))
-> (((TxIn (EraCrypto (BabbageEra StandardCrypto)),
      TxOut (BabbageEra StandardCrypto))
     -> Gen (TxIn, TxOut CtxUTxO Era))
    -> Gen [(TxIn, TxOut CtxUTxO Era)])
-> ((TxIn (EraCrypto (BabbageEra StandardCrypto)),
     TxOut (BabbageEra StandardCrypto))
    -> Gen (TxIn, TxOut CtxUTxO Era))
-> Gen (UTxO' (TxOut CtxUTxO Era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxIn (EraCrypto (BabbageEra StandardCrypto)),
  TxOut (BabbageEra StandardCrypto))]
-> ((TxIn (EraCrypto (BabbageEra StandardCrypto)),
     TxOut (BabbageEra StandardCrypto))
    -> Gen (TxIn, TxOut CtxUTxO Era))
-> Gen [(TxIn, TxOut CtxUTxO Era)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(TxIn (EraCrypto (BabbageEra StandardCrypto)),
  TxOut (BabbageEra StandardCrypto))]
utxoMap (((TxIn (EraCrypto (BabbageEra StandardCrypto)),
   TxOut (BabbageEra StandardCrypto))
  -> Gen (TxIn, TxOut CtxUTxO Era))
 -> Gen (UTxO' (TxOut CtxUTxO Era)))
-> ((TxIn (EraCrypto (BabbageEra StandardCrypto)),
     TxOut (BabbageEra StandardCrypto))
    -> Gen (TxIn, TxOut CtxUTxO Era))
-> Gen (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ \(TxIn (EraCrypto (BabbageEra StandardCrypto))
_, TxOut (BabbageEra StandardCrypto)
o) -> do
    TxIn
i <- Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary
    (TxIn, TxOut CtxUTxO Era) -> Gen (TxIn, TxOut CtxUTxO Era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxIn
i, TxOut (ShelleyLedgerEra Era) -> TxOut CtxUTxO Era
forall ctx. TxOut (ShelleyLedgerEra Era) -> TxOut ctx Era
fromLedgerTxOut TxOut (ShelleyLedgerEra Era)
TxOut (BabbageEra StandardCrypto)
o)

-- | Generate a 'Babbage' era 'UTxO' with given number of outputs. See also
-- 'genTxOut'.
genUTxOSized :: Int -> Gen UTxO
genUTxOSized :: Int -> Gen (UTxO' (TxOut CtxUTxO Era))
genUTxOSized Int
numUTxO =
  [UTxO' (TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era)
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([UTxO' (TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era))
-> Gen [UTxO' (TxOut CtxUTxO Era)]
-> Gen (UTxO' (TxOut CtxUTxO Era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Gen (UTxO' (TxOut CtxUTxO Era))
-> Gen [UTxO' (TxOut CtxUTxO Era)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
numUTxO ((TxIn, TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton ((TxIn, TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era))
-> Gen (TxIn, TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxIn, TxOut CtxUTxO Era)
forall {ctx}. Gen (TxIn, TxOut ctx)
gen)
 where
  gen :: Gen (TxIn, TxOut ctx)
gen = (,) (TxIn -> TxOut ctx -> (TxIn, TxOut ctx))
-> Gen TxIn -> Gen (TxOut ctx -> (TxIn, TxOut ctx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary Gen (TxOut ctx -> (TxIn, TxOut ctx))
-> Gen (TxOut ctx) -> Gen (TxIn, TxOut ctx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (TxOut ctx)
forall ctx. Gen (TxOut ctx)
genTxOut

-- | Genereate a 'UTxO' with a single entry using given 'TxOut' generator.
genUTxO1 :: Gen (TxOut CtxUTxO) -> Gen UTxO
genUTxO1 :: Gen (TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era))
genUTxO1 Gen (TxOut CtxUTxO Era)
gen = do
  TxIn
txIn <- Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary
  TxOut CtxUTxO Era
txOut <- Gen (TxOut CtxUTxO Era)
gen
  UTxO' (TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO' (TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era)))
-> UTxO' (TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ (TxIn, TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton (TxIn
txIn, TxOut CtxUTxO Era
txOut)

-- | Generate a 'Babbage' era 'TxOut', which may contain arbitrary assets
-- addressed to public keys and scripts, as well as datums.
--
-- NOTE: This generator does
--  * not produce byron addresses as most of the cardano ecosystem dropped support for that (including plutus),
--  * not produce reference scripts as they are not fully "visible" from plutus,
--  * replace stake pointers with null references as nobody uses that.
genTxOut :: Gen (TxOut ctx)
genTxOut :: forall ctx. Gen (TxOut ctx)
genTxOut =
  (TxOut ctx -> TxOut ctx
forall {ctx}. TxOut ctx -> TxOut ctx
noRefScripts (TxOut ctx -> TxOut ctx)
-> (TxOut ctx -> TxOut ctx) -> TxOut ctx -> TxOut ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut ctx -> TxOut ctx
forall {ctx}. TxOut ctx -> TxOut ctx
noStakeRefPtr (TxOut ctx -> TxOut ctx) -> Gen (TxOut ctx) -> Gen (TxOut ctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxOut ctx)
gen)
    Gen (TxOut ctx) -> (TxOut ctx -> Bool) -> Gen (TxOut ctx)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` TxOut ctx -> Bool
forall {ctx}. TxOut ctx -> Bool
notByronAddress
 where
  gen :: Gen (TxOut ctx)
gen =
    (Value -> Value) -> TxOut ctx -> TxOut ctx
forall era ctx.
(IsMaryEraOnwards era, IsShelleyBasedEra era) =>
(Value -> Value) -> TxOut ctx era -> TxOut ctx era
modifyTxOutValue (Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> (Coin -> Value
lovelaceToValue (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10_000_000))
      (TxOut ctx -> TxOut ctx) -> Gen (TxOut ctx) -> Gen (TxOut ctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (TxOut ctx)] -> Gen (TxOut ctx)
forall a. [Gen a] -> Gen a
oneof
        [ TxOut (ShelleyLedgerEra Era) -> TxOut ctx
BabbageTxOut (BabbageEra StandardCrypto) -> TxOut ctx
forall ctx. TxOut (ShelleyLedgerEra Era) -> TxOut ctx Era
fromLedgerTxOut (BabbageTxOut (BabbageEra StandardCrypto) -> TxOut ctx)
-> Gen (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen (TxOut ctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (BabbageTxOut (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
        , TxOut ctx -> TxOut ctx
forall {ctx}. TxOut ctx -> TxOut ctx
notMultiAsset (TxOut ctx -> TxOut ctx)
-> (BabbageTxOut (BabbageEra StandardCrypto) -> TxOut ctx)
-> BabbageTxOut (BabbageEra StandardCrypto)
-> TxOut ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut (ShelleyLedgerEra Era) -> TxOut ctx
BabbageTxOut (BabbageEra StandardCrypto) -> TxOut ctx
forall ctx. TxOut (ShelleyLedgerEra Era) -> TxOut ctx Era
fromLedgerTxOut (BabbageTxOut (BabbageEra StandardCrypto) -> TxOut ctx)
-> Gen (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen (TxOut ctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (BabbageTxOut (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary
        ]

  notMultiAsset :: TxOut ctx Era -> TxOut ctx Era
notMultiAsset =
    (Value -> Value) -> TxOut ctx Era -> TxOut ctx Era
forall era ctx.
(IsMaryEraOnwards era, IsShelleyBasedEra era) =>
(Value -> Value) -> TxOut ctx era -> TxOut ctx era
modifyTxOutValue (Coin -> Value
lovelaceToValue (Coin -> Value) -> (Value -> Coin) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Coin
selectLovelace)

  notByronAddress :: TxOut ctx -> Bool
notByronAddress (TxOut AddressInEra
addr Value
_ TxOutDatum ctx
_ ReferenceScript
_) = case AddressInEra
addr of
    ByronAddressInEra{} -> Bool
False
    AddressInEra
_ -> Bool
True

  noStakeRefPtr :: TxOut ctx -> TxOut ctx
noStakeRefPtr out :: TxOut ctx
out@(TxOut AddressInEra
addr Value
val TxOutDatum ctx
dat ReferenceScript
refScript) = case AddressInEra
addr of
    ShelleyAddressInEra (ShelleyAddress Network
_ PaymentCredential StandardCrypto
cre StakeReference StandardCrypto
sr) ->
      case StakeReference StandardCrypto
sr of
        Ledger.StakeRefPtr Ptr
_ ->
          AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut (Address ShelleyAddr -> AddressInEra
ShelleyAddressInEra (Network
-> PaymentCredential StandardCrypto
-> StakeReference StandardCrypto
-> Address ShelleyAddr
ShelleyAddress Network
Ledger.Testnet PaymentCredential StandardCrypto
cre StakeReference StandardCrypto
forall c. StakeReference c
Ledger.StakeRefNull)) Value
val TxOutDatum ctx
dat ReferenceScript
refScript
        StakeReference StandardCrypto
_ ->
          AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut (Address ShelleyAddr -> AddressInEra
ShelleyAddressInEra (Network
-> PaymentCredential StandardCrypto
-> StakeReference StandardCrypto
-> Address ShelleyAddr
ShelleyAddress Network
Ledger.Testnet PaymentCredential StandardCrypto
cre StakeReference StandardCrypto
sr)) Value
val TxOutDatum ctx
dat ReferenceScript
refScript
    AddressInEra
_ -> TxOut ctx
out

  noRefScripts :: TxOut ctx -> TxOut ctx
noRefScripts TxOut ctx
out =
    TxOut ctx
out{txOutReferenceScript = ReferenceScriptNone}

-- | Generate a 'TxOut' with a byron address. This is usually not supported by
-- Hydra or Plutus.
genTxOutByron :: Gen (TxOut ctx)
genTxOutByron :: forall ctx. Gen (TxOut ctx)
genTxOutByron = do
  AddressInEra
addr <- Address ByronAddr -> AddressInEra
ByronAddressInEra (Address ByronAddr -> AddressInEra)
-> Gen (Address ByronAddr) -> Gen AddressInEra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Address ByronAddr)
forall a. Arbitrary a => Gen a
arbitrary
  Value
value <- Gen Value
genValue
  TxOut ctx -> Gen (TxOut ctx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut ctx -> Gen (TxOut ctx)) -> TxOut ctx -> Gen (TxOut ctx)
forall a b. (a -> b) -> a -> b
$ AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra
addr Value
value TxOutDatum ctx
forall ctx. TxOutDatum ctx
TxOutDatumNone ReferenceScript
ReferenceScriptNone

-- | Generate a 'TxOut' with a reference script. The standard 'genTxOut' is not
-- including reference scripts, use this generator if you are interested in
-- these cases.
genTxOutWithReferenceScript :: Gen (TxOut ctx)
genTxOutWithReferenceScript :: forall ctx. Gen (TxOut ctx)
genTxOutWithReferenceScript = do
  -- Have the ledger generate a TxOut with a reference script as instances are
  -- not so easily accessible.
  ReferenceScript
refScript <- (TxOut Any -> ReferenceScript
forall ctx. TxOut ctx -> ReferenceScript
txOutReferenceScript (TxOut Any -> ReferenceScript)
-> (BabbageTxOut (BabbageEra StandardCrypto) -> TxOut Any)
-> BabbageTxOut (BabbageEra StandardCrypto)
-> ReferenceScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut (ShelleyLedgerEra Era) -> TxOut Any
BabbageTxOut (BabbageEra StandardCrypto) -> TxOut Any
forall ctx. TxOut (ShelleyLedgerEra Era) -> TxOut ctx Era
fromLedgerTxOut (BabbageTxOut (BabbageEra StandardCrypto) -> ReferenceScript)
-> Gen (BabbageTxOut (BabbageEra StandardCrypto))
-> Gen ReferenceScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (BabbageTxOut (BabbageEra StandardCrypto))
forall a. Arbitrary a => Gen a
arbitrary) Gen ReferenceScript
-> (ReferenceScript -> Bool) -> Gen ReferenceScript
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (ReferenceScript -> ReferenceScript -> Bool
forall a. Eq a => a -> a -> Bool
/= ReferenceScript
ReferenceScriptNone)
  Gen (TxOut ctx)
forall ctx. Gen (TxOut ctx)
genTxOut Gen (TxOut ctx) -> (TxOut ctx -> TxOut ctx) -> Gen (TxOut ctx)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \TxOut ctx
out -> TxOut ctx
out{txOutReferenceScript = refScript}

-- | Generate utxos owned by the given cardano key.
genUTxOFor :: VerificationKey PaymentKey -> Gen UTxO
genUTxOFor :: VerificationKey PaymentKey -> Gen (UTxO' (TxOut CtxUTxO Era))
genUTxOFor VerificationKey PaymentKey
vk = do
  Int
n <- Gen Int
forall a. Arbitrary a => Gen a
arbitrary Gen Int -> (Int -> Bool) -> Gen Int
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
  [TxIn]
inps <- Int -> Gen TxIn -> Gen [TxIn]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary
  [TxOut CtxUTxO Era]
outs <- Int -> Gen (TxOut CtxUTxO Era) -> Gen [TxOut CtxUTxO Era]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (VerificationKey PaymentKey -> Gen (TxOut CtxUTxO Era)
forall ctx. VerificationKey PaymentKey -> Gen (TxOut ctx)
genOutput VerificationKey PaymentKey
vk)
  UTxO' (TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO' (TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era)))
-> UTxO' (TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall out. Map TxIn out -> UTxO' out
UTxO (Map TxIn (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era))
-> Map TxIn (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ [(TxIn, TxOut CtxUTxO Era)] -> Map TxIn (TxOut CtxUTxO Era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, TxOut CtxUTxO Era)] -> Map TxIn (TxOut CtxUTxO Era))
-> [(TxIn, TxOut CtxUTxO Era)] -> Map TxIn (TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ [TxIn] -> [TxOut CtxUTxO Era] -> [(TxIn, TxOut CtxUTxO Era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn]
inps [TxOut CtxUTxO Era]
outs

-- | Generate a single UTXO owned by 'vk'.
genOneUTxOFor :: VerificationKey PaymentKey -> Gen UTxO
genOneUTxOFor :: VerificationKey PaymentKey -> Gen (UTxO' (TxOut CtxUTxO Era))
genOneUTxOFor VerificationKey PaymentKey
vk = do
  TxIn
input <- Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary
  -- NOTE(AB): calling this generator while running a property will yield larger and larger
  -- values (quikcheck increases the 'size' parameter upon success) up to the point they are
  -- too large to fit in a transaction and validation fails in the ledger
  TxOut CtxUTxO Era
output <- (Int -> Int) -> Gen (TxOut CtxUTxO Era) -> Gen (TxOut CtxUTxO Era)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a b. a -> b -> a
const Int
1) (Gen (TxOut CtxUTxO Era) -> Gen (TxOut CtxUTxO Era))
-> Gen (TxOut CtxUTxO Era) -> Gen (TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Gen (TxOut CtxUTxO Era)
forall ctx. VerificationKey PaymentKey -> Gen (TxOut ctx)
genOutput VerificationKey PaymentKey
vk
  UTxO' (TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO' (TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era)))
-> UTxO' (TxOut CtxUTxO Era) -> Gen (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall out. Map TxIn out -> UTxO' out
UTxO (Map TxIn (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era))
-> Map TxIn (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ TxIn -> TxOut CtxUTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall k a. k -> a -> Map k a
Map.singleton TxIn
input TxOut CtxUTxO Era
output

-- | NOTE: See note on 'mkVkAddress' about 'NetworkId'.
genAddressInEra :: NetworkId -> Gen AddressInEra
genAddressInEra :: NetworkId -> Gen AddressInEra
genAddressInEra NetworkId
networkId =
  NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId (VerificationKey PaymentKey -> AddressInEra)
-> Gen (VerificationKey PaymentKey) -> Gen AddressInEra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VerificationKey PaymentKey)
genVerificationKey

genValue :: Gen Value
genValue :: Gen Value
genValue = (Value -> Value) -> Gen Value -> Gen Value
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Coin -> Value
lovelaceToValue (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10_000_000) <>) ((Int -> Int) -> Gen Value -> Gen Value
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10) (Gen Value -> Gen Value) -> Gen Value -> Gen Value
forall a b. (a -> b) -> a -> b
$ MaryValue StandardCrypto -> Value
fromLedgerValue (MaryValue StandardCrypto -> Value)
-> Gen (MaryValue StandardCrypto) -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (MaryValue StandardCrypto)
forall a. Arbitrary a => Gen a
arbitrary)

-- | Generate UTXO entries that do not contain any assets. Useful to test /
-- measure cases where
genAdaOnlyUTxO :: Gen UTxO
genAdaOnlyUTxO :: Gen (UTxO' (TxOut CtxUTxO Era))
genAdaOnlyUTxO = (TxOut CtxUTxO Era -> TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a b. (a -> b) -> UTxO' a -> UTxO' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxOut CtxUTxO Era -> TxOut CtxUTxO Era
adaOnly (UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era))
-> Gen (UTxO' (TxOut CtxUTxO Era))
-> Gen (UTxO' (TxOut CtxUTxO Era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (UTxO' (TxOut CtxUTxO Era))
forall a. Arbitrary a => Gen a
arbitrary

adaOnly :: TxOut CtxUTxO -> TxOut CtxUTxO
adaOnly :: TxOut CtxUTxO Era -> TxOut CtxUTxO Era
adaOnly = \case
  TxOut AddressInEra
addr Value
value TxOutDatum CtxUTxO
datum ReferenceScript
refScript ->
    AddressInEra
-> Value
-> TxOutDatum CtxUTxO
-> ReferenceScript
-> TxOut CtxUTxO Era
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra
addr (Coin -> Value
lovelaceToValue (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Coin
selectLovelace Value
value) TxOutDatum CtxUTxO
datum ReferenceScript
refScript

-- | Generate "simplified" UTXO, ie. without some of the complexities required
-- for backward-compatibility and obscure features.
genUTxOWithSimplifiedAddresses :: Gen UTxO
genUTxOWithSimplifiedAddresses :: Gen (UTxO' (TxOut CtxUTxO Era))
genUTxOWithSimplifiedAddresses =
  [(TxIn, TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era)
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromPairs ([(TxIn, TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era))
-> Gen [(TxIn, TxOut CtxUTxO Era)]
-> Gen (UTxO' (TxOut CtxUTxO Era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxIn, TxOut CtxUTxO Era) -> Gen [(TxIn, TxOut CtxUTxO Era)]
forall a. Gen a -> Gen [a]
listOf Gen (TxIn, TxOut CtxUTxO Era)
forall {ctx}. Gen (TxIn, TxOut ctx)
genEntry
 where
  genEntry :: Gen (TxIn, TxOut ctx)
genEntry = (,) (TxIn -> TxOut ctx -> (TxIn, TxOut ctx))
-> Gen TxIn -> Gen (TxOut ctx -> (TxIn, TxOut ctx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
genTxIn Gen (TxOut ctx -> (TxIn, TxOut ctx))
-> Gen (TxOut ctx) -> Gen (TxIn, TxOut ctx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (TxOut ctx)
forall ctx. Gen (TxOut ctx)
genTxOut

shrinkUTxO :: UTxO -> [UTxO]
shrinkUTxO :: UTxO' (TxOut CtxUTxO Era) -> [UTxO' (TxOut CtxUTxO Era)]
shrinkUTxO = ([(TxIn, TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era))
-> (UTxO' (TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)])
-> ([(TxIn, TxOut CtxUTxO Era)] -> [[(TxIn, TxOut CtxUTxO Era)]])
-> UTxO' (TxOut CtxUTxO Era)
-> [UTxO' (TxOut CtxUTxO Era)]
forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy (Map TxIn (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall out. Map TxIn out -> UTxO' out
UTxO (Map TxIn (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era))
-> ([(TxIn, TxOut CtxUTxO Era)] -> Map TxIn (TxOut CtxUTxO Era))
-> [(TxIn, TxOut CtxUTxO Era)]
-> UTxO' (TxOut CtxUTxO Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxIn, TxOut CtxUTxO Era)] -> Map TxIn (TxOut CtxUTxO Era)
[Item (Map TxIn (TxOut CtxUTxO Era))]
-> Map TxIn (TxOut CtxUTxO Era)
forall l. IsList l => [Item l] -> l
fromList) UTxO' (TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.pairs (((TxIn, TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)])
-> [(TxIn, TxOut CtxUTxO Era)] -> [[(TxIn, TxOut CtxUTxO Era)]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (TxIn, TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
shrinkOne)
 where
  shrinkOne :: (TxIn, TxOut CtxUTxO) -> [(TxIn, TxOut CtxUTxO)]
  shrinkOne :: (TxIn, TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
shrinkOne (TxIn
i, TxOut CtxUTxO Era
o) = case TxOut CtxUTxO Era
o of
    TxOut AddressInEra
addr Value
value TxOutDatum CtxUTxO
datum ReferenceScript
refScript ->
      [ (TxIn
i, AddressInEra
-> Value
-> TxOutDatum CtxUTxO
-> ReferenceScript
-> TxOut CtxUTxO Era
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra
addr Value
value' TxOutDatum CtxUTxO
datum ReferenceScript
refScript)
      | Value
value' <- Value -> [Value]
shrinkValue Value
value
      ]

shrinkValue :: Value -> [Value]
shrinkValue :: Value -> [Value]
shrinkValue =
  ([(AssetId, Quantity)] -> Value)
-> (Value -> [(AssetId, Quantity)])
-> ([(AssetId, Quantity)] -> [[(AssetId, Quantity)]])
-> Value
-> [Value]
forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy [(AssetId, Quantity)] -> Value
valueFromList Value -> [(AssetId, Quantity)]
valueToList [(AssetId, Quantity)] -> [[(AssetId, Quantity)]]
forall a. [a] -> [[a]]
shrinkListAggressively

-- * Orphans

instance Arbitrary AssetName where
  arbitrary :: Gen AssetName
arbitrary = ByteString -> AssetName
AssetName (ByteString -> AssetName)
-> (ByteString -> ByteString) -> ByteString -> AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.take Int
32 (ByteString -> AssetName) -> Gen ByteString -> Gen AssetName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary TxId where
  arbitrary :: Gen TxId
arbitrary = TxIn -> TxId
onlyTxId (TxIn -> TxId) -> Gen TxIn -> Gen TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary
   where
    onlyTxId :: TxIn -> TxId
onlyTxId (TxIn TxId
txi TxIx
_) = TxId
txi

instance Arbitrary (TxOut CtxUTxO) where
  arbitrary :: Gen (TxOut CtxUTxO Era)
arbitrary = Gen (TxOut CtxUTxO Era)
forall ctx. Gen (TxOut ctx)
genTxOut
  shrink :: TxOut CtxUTxO Era -> [TxOut CtxUTxO Era]
shrink TxOut CtxUTxO Era
txOut = TxOut (ShelleyLedgerEra Era) -> TxOut CtxUTxO Era
BabbageTxOut (BabbageEra StandardCrypto) -> TxOut CtxUTxO Era
forall ctx. TxOut (ShelleyLedgerEra Era) -> TxOut ctx Era
fromLedgerTxOut (BabbageTxOut (BabbageEra StandardCrypto) -> TxOut CtxUTxO Era)
-> [BabbageTxOut (BabbageEra StandardCrypto)]
-> [TxOut CtxUTxO Era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BabbageTxOut (BabbageEra StandardCrypto)
-> [BabbageTxOut (BabbageEra StandardCrypto)]
forall a. Arbitrary a => a -> [a]
shrink (TxOut CtxUTxO Era -> TxOut (ShelleyLedgerEra Era)
toLedgerTxOut TxOut CtxUTxO Era
txOut)

instance Arbitrary (VerificationKey PaymentKey) where
  arbitrary :: Gen (VerificationKey PaymentKey)
arbitrary = (VerificationKey PaymentKey, SigningKey PaymentKey)
-> VerificationKey PaymentKey
forall a b. (a, b) -> a
fst ((VerificationKey PaymentKey, SigningKey PaymentKey)
 -> VerificationKey PaymentKey)
-> Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> Gen (VerificationKey PaymentKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair

instance Arbitrary (Hash PaymentKey) where
  arbitrary :: Gen (Hash PaymentKey)
arbitrary = HasCallStack => ByteString -> Hash PaymentKey
ByteString -> Hash PaymentKey
unsafePaymentKeyHashFromBytes (ByteString -> Hash PaymentKey)
-> ([Word8] -> ByteString) -> [Word8] -> Hash PaymentKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Hash PaymentKey)
-> Gen [Word8] -> Gen (Hash PaymentKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
28 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

instance ToCBOR UTxO where
  toCBOR :: UTxO' (TxOut CtxUTxO Era) -> Encoding
toCBOR = UTxO (BabbageEra StandardCrypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (UTxO (BabbageEra StandardCrypto) -> Encoding)
-> (UTxO' (TxOut CtxUTxO Era) -> UTxO (BabbageEra StandardCrypto))
-> UTxO' (TxOut CtxUTxO Era)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO' (TxOut CtxUTxO Era) -> UTxO (ShelleyLedgerEra Era)
UTxO' (TxOut CtxUTxO Era) -> UTxO (BabbageEra StandardCrypto)
toLedgerUTxO
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (UTxO' (TxOut CtxUTxO Era)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
sz Proxy (UTxO' (TxOut CtxUTxO Era))
_ = (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (UTxO (BabbageEra StandardCrypto)) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. ToCBOR t => Proxy t -> Size
sz (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Ledger.UTxO LedgerEra))

instance FromCBOR UTxO where
  fromCBOR :: forall s. Decoder s (UTxO' (TxOut CtxUTxO Era))
fromCBOR = UTxO (ShelleyLedgerEra Era) -> UTxO' (TxOut CtxUTxO Era)
UTxO (BabbageEra StandardCrypto) -> UTxO' (TxOut CtxUTxO Era)
fromLedgerUTxO (UTxO (BabbageEra StandardCrypto) -> UTxO' (TxOut CtxUTxO Era))
-> Decoder s (UTxO (BabbageEra StandardCrypto))
-> Decoder s (UTxO' (TxOut CtxUTxO Era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (UTxO (BabbageEra StandardCrypto))
forall s. Decoder s (UTxO (BabbageEra StandardCrypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
  label :: Proxy (UTxO' (TxOut CtxUTxO Era)) -> Text
label Proxy (UTxO' (TxOut CtxUTxO Era))
_ = Proxy (UTxO (BabbageEra StandardCrypto)) -> Text
forall a. FromCBOR a => Proxy a -> Text
label (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Ledger.UTxO LedgerEra))

instance Arbitrary UTxO where
  shrink :: UTxO' (TxOut CtxUTxO Era) -> [UTxO' (TxOut CtxUTxO Era)]
shrink = UTxO' (TxOut CtxUTxO Era) -> [UTxO' (TxOut CtxUTxO Era)]
shrinkUTxO
  arbitrary :: Gen (UTxO' (TxOut CtxUTxO Era))
arbitrary = Gen (UTxO' (TxOut CtxUTxO Era))
genUTxOAlonzo