{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Generic.Instances () where

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.Scripts (isPlutusScript)
import Cardano.Ledger.Babbage (BabbageEra)
import Cardano.Ledger.BaseTypes (
  EpochInterval (..),
  ProtVer (..),
  SlotNo (..),
  StrictMaybe (..),
  mkTxIxPartial,
 )
import Cardano.Ledger.Coin (Coin (..), compactCoinOrError)
import Cardano.Ledger.Compactible (fromCompact)
import Cardano.Ledger.Conway (ConwayEra)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Credential (Credential (..), Ptr (..))
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Plutus (ExUnits (..), Language (..))
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Scripts (pattern RequireAllOf, pattern RequireAnyOf)
import Cardano.Ledger.Shelley.TxCert (ShelleyDelegCert (..), ShelleyTxCert (..))
import Cardano.Ledger.Val (Val (..))
import Control.Monad.RWS.Strict (gets)
import Control.Monad.Trans (MonadTrans (..))
import qualified Data.Foldable as F
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import Data.TreeDiff (ToExpr (..))
import Lens.Micro (Lens', (&), (.~), (<>~), (?~), (^.))
import qualified Lens.Micro as L
import Test.Cardano.Ledger.Alonzo.Era (AlonzoEraTest, EraTest (..), registerTestAccount)
import Test.Cardano.Ledger.Alonzo.Scripts (alwaysFails, alwaysSucceeds)
import Test.Cardano.Ledger.Common (Arbitrary (..), Gen, choose, chooseInt, elements)
import Test.Cardano.Ledger.Examples.STSTestUtils (EraModel (..))
import Test.Cardano.Ledger.Generic.ApplyTx (applyTxBody, applyTxFail, applyTxSimple, epochBoundary)
import Test.Cardano.Ledger.Generic.GenState (
  EraGenericGen (..),
  GenEnv (..),
  GenRS,
  GenSize (..),
  GenState (..),
 )
import Test.Cardano.Ledger.Generic.ModelState (Model, ModelNewEpochState (..))
import Test.Cardano.Ledger.Generic.Proof (Reflect)
import Test.Cardano.Ledger.Generic.TxGen (
  alonzoMkRedeemers,
  alonzoMkRedeemersFromTags,
  mkAlonzoPlutusPurposePointer,
  mkConwayPlutusPurposePointer,
 )
import Test.Cardano.Ledger.Generic.Updaters (alonzoNewScriptIntegrityHash)
import Test.Cardano.Ledger.Shelley.Generator.Core (genNatural)
import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo)

shelleyGenPParams :: EraPParams era => Gen (PParams era)
shelleyGenPParams :: forall era. EraPParams era => Gen (PParams era)
shelleyGenPParams = do
  minfeeA <- 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
0, Integer
1000)
  minfeeB <- Coin <$> choose (0, 10000)
  pure $
    emptyPParams
      & ppMinFeeAL .~ minfeeA
      & ppMinFeeBL .~ minfeeB
      & ppMaxTxSizeL .~ fromIntegral (maxBound :: Int)
      & ppProtocolVersionL .~ ProtVer (eraProtVerLow @ShelleyEra) 0
      & ppPoolDepositL .~ Coin 5
      & ppKeyDepositL .~ Coin 2
      & ppEMaxL .~ EpochInterval 5

applyShelleyCert :: forall era. EraTest era => Model era -> ShelleyTxCert era -> Model era
applyShelleyCert :: forall era.
EraTest era =>
Model era -> ShelleyTxCert era -> Model era
applyShelleyCert Model era
model ShelleyTxCert era
dcert = case ShelleyTxCert era
dcert of
  ShelleyTxCertDelegCert (ShelleyRegCert Credential Staking
cred) ->
    Model era
model
      { mAccounts =
          registerTestAccount
            cred
            (Just (Ptr minBound minBound minBound))
            (compactCoinOrError (pp ^. ppKeyDepositL))
            Nothing
            Nothing
            (mAccounts model)
      , mDeposited = mDeposited model <+> pp ^. ppKeyDepositL
      }
    where
      pp :: PParams era
pp = Model era -> PParams era
forall era. ModelNewEpochState era -> PParams era
mPParams Model era
model
  ShelleyTxCertDelegCert (ShelleyUnRegCert Credential Staking
cred) ->
    case Credential Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
forall era.
EraAccounts era =>
Credential Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
unregisterAccount Credential Staking
cred (Model era -> Accounts era
forall era. ModelNewEpochState era -> Accounts era
mAccounts Model era
model) of
      (Maybe (AccountState era)
Nothing, Accounts era
_) -> [Char] -> Model era
forall a. HasCallStack => [Char] -> a
error ([Char]
"DeRegKey not in rewards: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Expr -> [Char]
forall a. Show a => a -> [Char]
show (Credential Staking -> Expr
forall a. ToExpr a => a -> Expr
toExpr Credential Staking
cred))
      (Just AccountState era
accountState, Accounts era
accounts)
        | AccountState era
accountState AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL CompactForm Coin -> CompactForm Coin -> Bool
forall a. Eq a => a -> a -> Bool
== CompactForm Coin
forall a. Monoid a => a
mempty ->
            Model era
model
              { mAccounts = accounts
              , mDeposited = mDeposited model <-> fromCompact (accountState ^. depositAccountStateL)
              }
      (Maybe (AccountState era), Accounts era)
_ -> [Char] -> Model era
forall a. HasCallStack => [Char] -> a
error [Char]
"DeRegKey with non-zero balance"
  ShelleyTxCertDelegCert (ShelleyDelegCert Credential Staking
cred KeyHash StakePool
poolId) ->
    Model era
model
      { mAccounts =
          adjustAccountState (stakePoolDelegationAccountStateL ?~ poolId) cred (mAccounts model)
      }
  ShelleyTxCertPool (RegPool StakePoolParams
stakePoolParams) ->
    Model era
model
      { mStakePools =
          Map.insert
            hk
            (mkStakePoolState (pp ^. ppPoolDepositCompactL) mempty stakePoolParams)
            (mStakePools model)
      , mDeposited =
          if Map.member hk (mStakePools model)
            then mDeposited model
            else mDeposited model <+> pp ^. ppPoolDepositL
      }
    where
      hk :: KeyHash StakePool
hk = StakePoolParams -> KeyHash StakePool
sppId StakePoolParams
stakePoolParams
      pp :: PParams era
pp = Model era -> PParams era
forall era. ModelNewEpochState era -> PParams era
mPParams Model era
model
  ShelleyTxCertPool (RetirePool KeyHash StakePool
keyhash EpochNo
epoch) ->
    Model era
model
      { mRetiring = Map.insert keyhash epoch (mRetiring model)
      , mDeposited = mDeposited model <-> pp ^. ppPoolDepositL
      }
    where
      pp :: PParams era
pp = Model era -> PParams era
forall era. ModelNewEpochState era -> PParams era
mPParams Model era
model
  ShelleyTxCertGenesisDeleg GenesisDelegCert
_ -> Model era
model
  ShelleyTxCertMir MIRCert
_ -> Model era
model

timeToLive :: ValidityInterval -> SlotNo
timeToLive :: ValidityInterval -> SlotNo
timeToLive (ValidityInterval StrictMaybe SlotNo
_ (SJust SlotNo
n)) = SlotNo
n
timeToLive (ValidityInterval StrictMaybe SlotNo
_ StrictMaybe SlotNo
SNothing) = Word64 -> SlotNo
SlotNo Word64
forall a. Bounded a => a
maxBound

shelleySetValidity :: ValidityInterval -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
shelleySetValidity :: ValidityInterval
-> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
shelleySetValidity ValidityInterval
vi = (SlotNo -> Identity SlotNo)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody TopTx era) SlotNo
Lens' (TxBody TopTx ShelleyEra) SlotNo
ttlTxBodyL ((SlotNo -> Identity SlotNo)
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> SlotNo -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval -> SlotNo
timeToLive ValidityInterval
vi

allegraSetValidity ::
  AllegraEraTxBody era => ValidityInterval -> TxBody TopTx era -> TxBody TopTx era
allegraSetValidity :: forall era.
AllegraEraTxBody era =>
ValidityInterval -> TxBody TopTx era -> TxBody TopTx era
allegraSetValidity ValidityInterval
vi = (ValidityInterval -> Identity ValidityInterval)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l era) ValidityInterval
vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> ValidityInterval -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vi

allegraValidTxOut :: EraTxOut era => Map ScriptHash (Script era) -> TxOut era -> Bool
allegraValidTxOut :: forall era.
EraTxOut era =>
Map ScriptHash (Script era) -> TxOut era -> Bool
allegraValidTxOut Map ScriptHash (Script era)
_ TxOut era
txOut = case TxOut era
txOut TxOut era -> Getting Addr (TxOut era) Addr -> Addr
forall s a. s -> Getting a s a -> a
^. Getting Addr (TxOut era) Addr
forall era. EraTxOut era => Lens' (TxOut era) Addr
Lens' (TxOut era) Addr
addrTxOutL of
  Addr Network
_ KeyHashObj {} StakeReference
_ -> Bool
True
  Addr
_ -> Bool
False

alonzoValidTxOut ::
  ( EraTxOut era
  , AlonzoEraScript era
  ) =>
  Map ScriptHash (Script era) -> TxOut era -> Bool
alonzoValidTxOut :: forall era.
(EraTxOut era, AlonzoEraScript era) =>
Map ScriptHash (Script era) -> TxOut era -> Bool
alonzoValidTxOut Map ScriptHash (Script era)
scripts TxOut era
txOut = case TxOut era
txOut TxOut era -> Getting Addr (TxOut era) Addr -> Addr
forall s a. s -> Getting a s a -> a
^. Getting Addr (TxOut era) Addr
forall era. EraTxOut era => Lens' (TxOut era) Addr
Lens' (TxOut era) Addr
addrTxOutL of
  Addr Network
_ KeyHashObj {} StakeReference
_ -> Bool
True
  Addr Network
_ (ScriptHashObj ScriptHash
sh) StakeReference
_ ->
    case ScriptHash -> Map ScriptHash (Script era) -> Maybe (Script era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash
sh Map ScriptHash (Script era)
scripts of
      Just Script era
s -> Script era -> Bool
forall era. AlonzoEraScript era => Script era -> Bool
isPlutusScript Script era
s
      Maybe (Script era)
_ -> Bool
False
  AddrBootstrap {} -> Bool
False

alonzoGenPParams :: forall era. AlonzoEraTest era => GenSize -> Gen (PParams era)
alonzoGenPParams :: forall era. AlonzoEraTest era => GenSize -> Gen (PParams era)
alonzoGenPParams GenSize
gsize = do
  pp <- Gen (PParams era)
forall era. EraPParams era => Gen (PParams era)
shelleyGenPParams
  maxTxExUnits <- arbitrary :: Gen ExUnits
  maxCollateralInputs <- elements [1 .. collInputsMax gsize]
  collateralPercentage <- fromIntegral <$> chooseInt (1, 10000)
  pure $
    pp
      & ppMaxTxExUnitsL .~ maxTxExUnits
      & ppCostModelsL .~ zeroCostModels @era
      & ppMaxValSizeL .~ 1000
      & ppMaxCollateralInputsL .~ maxCollateralInputs
      & ppCollateralPercentageL .~ collateralPercentage
      & ppProtocolVersionL .~ ProtVer (eraProtVerLow @era) 0

instance EraModel ShelleyEra where
  applyTx :: Int
-> SlotNo
-> Model ShelleyEra
-> Tx TopTx ShelleyEra
-> Model ShelleyEra
applyTx = Int
-> SlotNo
-> Model ShelleyEra
-> Tx TopTx ShelleyEra
-> Model ShelleyEra
forall era.
EraModel era =>
Int -> SlotNo -> Model era -> Tx TopTx era -> Model era
shelleyApplyTx
  applyCert :: Model ShelleyEra -> TxCert ShelleyEra -> Model ShelleyEra
applyCert = Model ShelleyEra -> TxCert ShelleyEra -> Model ShelleyEra
Model ShelleyEra -> ShelleyTxCert ShelleyEra -> Model ShelleyEra
forall era.
EraTest era =>
Model era -> ShelleyTxCert era -> Model era
applyShelleyCert
  always :: Natural -> Script ShelleyEra
always Natural
_ = NativeScript ShelleyEra -> Script ShelleyEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript ShelleyEra -> Script ShelleyEra)
-> NativeScript ShelleyEra -> Script ShelleyEra
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript ShelleyEra) -> NativeScript ShelleyEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf []
  never :: Natural -> Script ShelleyEra
never Natural
_ = NativeScript ShelleyEra -> Script ShelleyEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript ShelleyEra -> Script ShelleyEra)
-> NativeScript ShelleyEra -> Script ShelleyEra
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript ShelleyEra) -> NativeScript ShelleyEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf []
  collateralReturnTxBodyT :: Lens' (TxBody TopTx ShelleyEra) (StrictMaybe (TxOut ShelleyEra))
collateralReturnTxBodyT = StrictMaybe (ShelleyTxOut ShelleyEra)
-> Lens'
     (TxBody TopTx ShelleyEra) (StrictMaybe (ShelleyTxOut ShelleyEra))
forall b a. b -> Lens' a b
dummyLens StrictMaybe (ShelleyTxOut ShelleyEra)
forall a. StrictMaybe a
SNothing
  validTxOut :: Map ScriptHash (Script ShelleyEra) -> TxOut ShelleyEra -> Bool
validTxOut Map ScriptHash (Script ShelleyEra)
scripts TxOut ShelleyEra
txOut =
    case TxOut ShelleyEra
ShelleyTxOut ShelleyEra
txOut ShelleyTxOut ShelleyEra
-> Getting Addr (ShelleyTxOut ShelleyEra) Addr -> Addr
forall s a. s -> Getting a s a -> a
^. (Addr -> Const Addr Addr)
-> TxOut ShelleyEra -> Const Addr (TxOut ShelleyEra)
Getting Addr (ShelleyTxOut ShelleyEra) Addr
forall era. EraTxOut era => Lens' (TxOut era) Addr
Lens' (TxOut ShelleyEra) Addr
addrTxOutL of
      Addr Network
_ (KeyHashObj KeyHash Payment
_) StakeReference
_ -> Bool
True
      Addr Network
_ (ScriptHashObj ScriptHash
sh) StakeReference
_ -> ScriptHash -> Map ScriptHash (MultiSig ShelleyEra) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member ScriptHash
sh Map ScriptHash (Script ShelleyEra)
Map ScriptHash (MultiSig ShelleyEra)
scripts
      AddrBootstrap {} -> Bool
False

instance EraModel AllegraEra where
  applyTx :: Int
-> SlotNo
-> Model AllegraEra
-> Tx TopTx AllegraEra
-> Model AllegraEra
applyTx = Int
-> SlotNo
-> Model AllegraEra
-> Tx TopTx AllegraEra
-> Model AllegraEra
forall era.
EraModel era =>
Int -> SlotNo -> Model era -> Tx TopTx era -> Model era
shelleyApplyTx
  applyCert :: Model AllegraEra -> TxCert AllegraEra -> Model AllegraEra
applyCert = Model AllegraEra -> TxCert AllegraEra -> Model AllegraEra
Model AllegraEra -> ShelleyTxCert AllegraEra -> Model AllegraEra
forall era.
EraTest era =>
Model era -> ShelleyTxCert era -> Model era
applyShelleyCert
  always :: Natural -> Script AllegraEra
always Natural
_ = NativeScript AllegraEra -> Script AllegraEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript AllegraEra -> Script AllegraEra)
-> NativeScript AllegraEra -> Script AllegraEra
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf []
  never :: Natural -> Script AllegraEra
never Natural
_ = NativeScript AllegraEra -> Script AllegraEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript AllegraEra -> Script AllegraEra)
-> NativeScript AllegraEra -> Script AllegraEra
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript AllegraEra) -> NativeScript AllegraEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf []
  collateralReturnTxBodyT :: Lens' (TxBody TopTx AllegraEra) (StrictMaybe (TxOut AllegraEra))
collateralReturnTxBodyT = StrictMaybe (ShelleyTxOut AllegraEra)
-> Lens'
     (TxBody TopTx AllegraEra) (StrictMaybe (ShelleyTxOut AllegraEra))
forall b a. b -> Lens' a b
dummyLens StrictMaybe (ShelleyTxOut AllegraEra)
forall a. StrictMaybe a
SNothing
  validTxOut :: Map ScriptHash (Script AllegraEra) -> TxOut AllegraEra -> Bool
validTxOut = Map ScriptHash (Script AllegraEra) -> TxOut AllegraEra -> Bool
forall era.
EraTxOut era =>
Map ScriptHash (Script era) -> TxOut era -> Bool
allegraValidTxOut

instance EraModel MaryEra where
  applyTx :: Int -> SlotNo -> Model MaryEra -> Tx TopTx MaryEra -> Model MaryEra
applyTx = Int -> SlotNo -> Model MaryEra -> Tx TopTx MaryEra -> Model MaryEra
forall era.
EraModel era =>
Int -> SlotNo -> Model era -> Tx TopTx era -> Model era
shelleyApplyTx
  applyCert :: Model MaryEra -> TxCert MaryEra -> Model MaryEra
applyCert = Model MaryEra -> TxCert MaryEra -> Model MaryEra
Model MaryEra -> ShelleyTxCert MaryEra -> Model MaryEra
forall era.
EraTest era =>
Model era -> ShelleyTxCert era -> Model era
applyShelleyCert
  always :: Natural -> Script MaryEra
always Natural
_ = NativeScript MaryEra -> Script MaryEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript MaryEra -> Script MaryEra)
-> NativeScript MaryEra -> Script MaryEra
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript MaryEra) -> NativeScript MaryEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf []
  never :: Natural -> Script MaryEra
never Natural
_ = NativeScript MaryEra -> Script MaryEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript MaryEra -> Script MaryEra)
-> NativeScript MaryEra -> Script MaryEra
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript MaryEra) -> NativeScript MaryEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf []
  collateralReturnTxBodyT :: Lens' (TxBody TopTx MaryEra) (StrictMaybe (TxOut MaryEra))
collateralReturnTxBodyT = StrictMaybe (ShelleyTxOut MaryEra)
-> Lens'
     (TxBody TopTx MaryEra) (StrictMaybe (ShelleyTxOut MaryEra))
forall b a. b -> Lens' a b
dummyLens StrictMaybe (ShelleyTxOut MaryEra)
forall a. StrictMaybe a
SNothing
  validTxOut :: Map ScriptHash (Script MaryEra) -> TxOut MaryEra -> Bool
validTxOut = Map ScriptHash (Script MaryEra) -> TxOut MaryEra -> Bool
forall era.
EraTxOut era =>
Map ScriptHash (Script era) -> TxOut era -> Bool
allegraValidTxOut

instance EraModel AlonzoEra where
  applyTx :: Int
-> SlotNo
-> Model AlonzoEra
-> Tx TopTx AlonzoEra
-> Model AlonzoEra
applyTx = Int
-> SlotNo
-> Model AlonzoEra
-> Tx TopTx AlonzoEra
-> Model AlonzoEra
forall era.
(EraModel era, AlonzoEraTx era, Reflect era) =>
Int -> SlotNo -> Model era -> Tx TopTx era -> Model era
alonzoApplyTx
  applyCert :: Model AlonzoEra -> TxCert AlonzoEra -> Model AlonzoEra
applyCert = Model AlonzoEra -> TxCert AlonzoEra -> Model AlonzoEra
Model AlonzoEra -> ShelleyTxCert AlonzoEra -> Model AlonzoEra
forall era.
EraTest era =>
Model era -> ShelleyTxCert era -> Model era
applyShelleyCert
  mkRedeemersFromTags :: [((PlutusPurposeTag, Word32), (Data AlonzoEra, ExUnits))]
-> Redeemers AlonzoEra
mkRedeemersFromTags = [((PlutusPurposeTag, Word32), (Data AlonzoEra, ExUnits))]
-> Redeemers AlonzoEra
forall era.
(AlonzoEraScript era, EraModel era) =>
[((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
alonzoMkRedeemersFromTags
  mkRedeemers :: [(PlutusPurpose AsIx AlonzoEra, (Data AlonzoEra, ExUnits))]
-> Redeemers AlonzoEra
mkRedeemers = [(PlutusPurpose AsIx AlonzoEra, (Data AlonzoEra, ExUnits))]
-> Redeemers AlonzoEra
forall era.
AlonzoEraScript era =>
[(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
alonzoMkRedeemers
  newScriptIntegrityHash :: PParams AlonzoEra
-> [Language]
-> Redeemers AlonzoEra
-> TxDats AlonzoEra
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash = PParams AlonzoEra
-> [Language]
-> Redeemers AlonzoEra
-> TxDats AlonzoEra
-> StrictMaybe ScriptIntegrityHash
forall era.
(AlonzoEraScript era, AlonzoEraPParams era) =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
alonzoNewScriptIntegrityHash
  mkPlutusPurposePointer :: PlutusPurposeTag -> Word32 -> PlutusPurpose AsIx AlonzoEra
mkPlutusPurposePointer = PlutusPurposeTag -> Word32 -> AlonzoPlutusPurpose AsIx AlonzoEra
PlutusPurposeTag -> Word32 -> PlutusPurpose AsIx AlonzoEra
forall era.
Era era =>
PlutusPurposeTag -> Word32 -> AlonzoPlutusPurpose AsIx era
mkAlonzoPlutusPurposePointer
  always :: Natural -> Script AlonzoEra
always = forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @PlutusV1
  never :: Natural -> Script AlonzoEra
never = forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysFails @PlutusV1
  collateralReturnTxBodyT :: Lens' (TxBody TopTx AlonzoEra) (StrictMaybe (TxOut AlonzoEra))
collateralReturnTxBodyT = StrictMaybe (AlonzoTxOut AlonzoEra)
-> Lens'
     (TxBody TopTx AlonzoEra) (StrictMaybe (AlonzoTxOut AlonzoEra))
forall b a. b -> Lens' a b
dummyLens StrictMaybe (AlonzoTxOut AlonzoEra)
forall a. StrictMaybe a
SNothing
  validTxOut :: Map ScriptHash (Script AlonzoEra) -> TxOut AlonzoEra -> Bool
validTxOut = Map ScriptHash (Script AlonzoEra) -> TxOut AlonzoEra -> Bool
forall era.
(EraTxOut era, AlonzoEraScript era) =>
Map ScriptHash (Script era) -> TxOut era -> Bool
alonzoValidTxOut

instance EraModel BabbageEra where
  applyTx :: Int
-> SlotNo
-> Model BabbageEra
-> Tx TopTx BabbageEra
-> Model BabbageEra
applyTx = Int
-> SlotNo
-> Model BabbageEra
-> Tx TopTx BabbageEra
-> Model BabbageEra
forall era.
(EraModel era, AlonzoEraTx era, Reflect era) =>
Int -> SlotNo -> Model era -> Tx TopTx era -> Model era
alonzoApplyTx
  applyCert :: Model BabbageEra -> TxCert BabbageEra -> Model BabbageEra
applyCert = Model BabbageEra -> TxCert BabbageEra -> Model BabbageEra
Model BabbageEra -> ShelleyTxCert BabbageEra -> Model BabbageEra
forall era.
EraTest era =>
Model era -> ShelleyTxCert era -> Model era
applyShelleyCert
  mkRedeemersFromTags :: [((PlutusPurposeTag, Word32), (Data BabbageEra, ExUnits))]
-> Redeemers BabbageEra
mkRedeemersFromTags = [((PlutusPurposeTag, Word32), (Data BabbageEra, ExUnits))]
-> Redeemers BabbageEra
forall era.
(AlonzoEraScript era, EraModel era) =>
[((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
alonzoMkRedeemersFromTags
  mkRedeemers :: [(PlutusPurpose AsIx BabbageEra, (Data BabbageEra, ExUnits))]
-> Redeemers BabbageEra
mkRedeemers = [(PlutusPurpose AsIx BabbageEra, (Data BabbageEra, ExUnits))]
-> Redeemers BabbageEra
forall era.
AlonzoEraScript era =>
[(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
alonzoMkRedeemers
  newScriptIntegrityHash :: PParams BabbageEra
-> [Language]
-> Redeemers BabbageEra
-> TxDats BabbageEra
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash = PParams BabbageEra
-> [Language]
-> Redeemers BabbageEra
-> TxDats BabbageEra
-> StrictMaybe ScriptIntegrityHash
forall era.
(AlonzoEraScript era, AlonzoEraPParams era) =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
alonzoNewScriptIntegrityHash
  mkPlutusPurposePointer :: PlutusPurposeTag -> Word32 -> PlutusPurpose AsIx BabbageEra
mkPlutusPurposePointer = PlutusPurposeTag -> Word32 -> AlonzoPlutusPurpose AsIx BabbageEra
PlutusPurposeTag -> Word32 -> PlutusPurpose AsIx BabbageEra
forall era.
Era era =>
PlutusPurposeTag -> Word32 -> AlonzoPlutusPurpose AsIx era
mkAlonzoPlutusPurposePointer
  always :: Natural -> Script BabbageEra
always = forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @PlutusV1
  never :: Natural -> Script BabbageEra
never = forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysFails @PlutusV1
  collateralReturnTxBodyT :: Lens' (TxBody TopTx BabbageEra) (StrictMaybe (TxOut BabbageEra))
collateralReturnTxBodyT = (StrictMaybe (TxOut BabbageEra)
 -> f (StrictMaybe (TxOut BabbageEra)))
-> TxBody TopTx BabbageEra -> f (TxBody TopTx BabbageEra)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (TxOut era))
Lens' (TxBody TopTx BabbageEra) (StrictMaybe (TxOut BabbageEra))
collateralReturnTxBodyL
  validTxOut :: Map ScriptHash (Script BabbageEra) -> TxOut BabbageEra -> Bool
validTxOut = Map ScriptHash (Script BabbageEra) -> TxOut BabbageEra -> Bool
forall era.
(EraTxOut era, AlonzoEraScript era) =>
Map ScriptHash (Script era) -> TxOut era -> Bool
alonzoValidTxOut

instance EraModel ConwayEra where
  applyTx :: Int
-> SlotNo
-> Model ConwayEra
-> Tx TopTx ConwayEra
-> Model ConwayEra
applyTx = Int
-> SlotNo
-> Model ConwayEra
-> Tx TopTx ConwayEra
-> Model ConwayEra
forall era.
(EraModel era, AlonzoEraTx era, Reflect era) =>
Int -> SlotNo -> Model era -> Tx TopTx era -> Model era
alonzoApplyTx
  applyCert :: Model ConwayEra -> TxCert ConwayEra -> Model ConwayEra
applyCert = [Char]
-> Model ConwayEra -> ConwayTxCert ConwayEra -> Model ConwayEra
forall a. HasCallStack => [Char] -> a
error [Char]
"Not yet implemented"
  mkRedeemersFromTags :: [((PlutusPurposeTag, Word32), (Data ConwayEra, ExUnits))]
-> Redeemers ConwayEra
mkRedeemersFromTags = [((PlutusPurposeTag, Word32), (Data ConwayEra, ExUnits))]
-> Redeemers ConwayEra
forall era.
(AlonzoEraScript era, EraModel era) =>
[((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
alonzoMkRedeemersFromTags
  mkRedeemers :: [(PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))]
-> Redeemers ConwayEra
mkRedeemers = [(PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))]
-> Redeemers ConwayEra
forall era.
AlonzoEraScript era =>
[(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
alonzoMkRedeemers
  newScriptIntegrityHash :: PParams ConwayEra
-> [Language]
-> Redeemers ConwayEra
-> TxDats ConwayEra
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash = PParams ConwayEra
-> [Language]
-> Redeemers ConwayEra
-> TxDats ConwayEra
-> StrictMaybe ScriptIntegrityHash
forall era.
(AlonzoEraScript era, AlonzoEraPParams era) =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
alonzoNewScriptIntegrityHash
  mkPlutusPurposePointer :: PlutusPurposeTag -> Word32 -> PlutusPurpose AsIx ConwayEra
mkPlutusPurposePointer = PlutusPurposeTag -> Word32 -> PlutusPurpose AsIx ConwayEra
PlutusPurposeTag -> Word32 -> ConwayPlutusPurpose AsIx ConwayEra
forall era.
PlutusPurposeTag -> Word32 -> ConwayPlutusPurpose AsIx era
mkConwayPlutusPurposePointer
  always :: Natural -> Script ConwayEra
always = forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @PlutusV1
  never :: Natural -> Script ConwayEra
never = forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysFails @PlutusV1
  collateralReturnTxBodyT :: Lens' (TxBody TopTx ConwayEra) (StrictMaybe (TxOut ConwayEra))
collateralReturnTxBodyT = (StrictMaybe (TxOut ConwayEra)
 -> f (StrictMaybe (TxOut ConwayEra)))
-> TxBody TopTx ConwayEra -> f (TxBody TopTx ConwayEra)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (TxOut era))
Lens' (TxBody TopTx ConwayEra) (StrictMaybe (TxOut ConwayEra))
collateralReturnTxBodyL
  validTxOut :: Map ScriptHash (Script ConwayEra) -> TxOut ConwayEra -> Bool
validTxOut = Map ScriptHash (Script ConwayEra) -> TxOut ConwayEra -> Bool
forall era.
(EraTxOut era, AlonzoEraScript era) =>
Map ScriptHash (Script era) -> TxOut era -> Bool
alonzoValidTxOut

instance EraGenericGen ShelleyEra where
  setValidity :: ValidityInterval
-> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
setValidity = ValidityInterval
-> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
shelleySetValidity
  setReferenceInputs :: Set TxIn -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
setReferenceInputs = (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> Set TxIn -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall a b. a -> b -> a
const TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall a. a -> a
id
  setCollateralInputs :: Set TxIn -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
setCollateralInputs = (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> Set TxIn -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall a b. a -> b -> a
const TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall a. a -> a
id
  setTotalCollateral :: StrictMaybe Coin
-> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
setTotalCollateral = (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> StrictMaybe Coin
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall a b. a -> b -> a
const TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall a. a -> a
id
  setCollateralReturn :: StrictMaybe (TxOut ShelleyEra)
-> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
setCollateralReturn = (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> StrictMaybe (ShelleyTxOut ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall a b. a -> b -> a
const TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall a. a -> a
id
  addRedeemers :: Redeemers ShelleyEra -> TxWits ShelleyEra -> TxWits ShelleyEra
addRedeemers = (ShelleyTxWits ShelleyEra -> ShelleyTxWits ShelleyEra)
-> Redeemers ShelleyEra
-> ShelleyTxWits ShelleyEra
-> ShelleyTxWits ShelleyEra
forall a b. a -> b -> a
const ShelleyTxWits ShelleyEra -> ShelleyTxWits ShelleyEra
forall a. a -> a
id
  setScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
-> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
setScriptIntegrityHash = (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> StrictMaybe ScriptIntegrityHash
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall a b. a -> b -> a
const TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall a. a -> a
id
  setNetworkIdTxBody :: StrictMaybe Network
-> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
setNetworkIdTxBody = (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> StrictMaybe Network
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall a b. a -> b -> a
const TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall a. a -> a
id
  genExUnits :: Int -> GenRS ShelleyEra [ExUnits]
genExUnits = GenRS ShelleyEra [ExUnits] -> Int -> GenRS ShelleyEra [ExUnits]
forall a b. a -> b -> a
const (GenRS ShelleyEra [ExUnits] -> Int -> GenRS ShelleyEra [ExUnits])
-> GenRS ShelleyEra [ExUnits] -> Int -> GenRS ShelleyEra [ExUnits]
forall a b. (a -> b) -> a -> b
$ [ExUnits] -> GenRS ShelleyEra [ExUnits]
forall a.
a -> RWST (GenEnv ShelleyEra) () (GenState ShelleyEra) Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  ppMaxCollateralInputsT :: Lens' (PParams ShelleyEra) Natural
ppMaxCollateralInputsT = Natural -> Lens' (PParams ShelleyEra) Natural
forall b a. b -> Lens' a b
dummyLens Natural
0
  ppCollateralPercentageT :: Lens' (PParams ShelleyEra) Natural
ppCollateralPercentageT = Natural -> Lens' (PParams ShelleyEra) Natural
forall b a. b -> Lens' a b
dummyLens Natural
0
  ppCostModelsT :: Lens' (PParams ShelleyEra) CostModels
ppCostModelsT = CostModels -> Lens' (PParams ShelleyEra) CostModels
forall b a. b -> Lens' a b
dummyLens CostModels
forall a. Monoid a => a
mempty
  ppMaxTxExUnitsT :: Lens' (PParams ShelleyEra) ExUnits
ppMaxTxExUnitsT = ExUnits -> Lens' (PParams ShelleyEra) ExUnits
forall b a. b -> Lens' a b
dummyLens ExUnits
forall a. Monoid a => a
mempty
  ppMaxBlockExUnitsT :: Lens' (PParams ShelleyEra) ExUnits
ppMaxBlockExUnitsT = ExUnits -> Lens' (PParams ShelleyEra) ExUnits
forall b a. b -> Lens' a b
dummyLens ExUnits
forall a. Monoid a => a
mempty
  ppMaxValSizeT :: Lens' (PParams ShelleyEra) Natural
ppMaxValSizeT = Natural -> Lens' (PParams ShelleyEra) Natural
forall b a. b -> Lens' a b
dummyLens Natural
0
  mkScriptIntegrityHash :: PParams ShelleyEra
-> [Language]
-> TxWits ShelleyEra
-> StrictMaybe ScriptIntegrityHash
mkScriptIntegrityHash PParams ShelleyEra
_ [Language]
_ TxWits ShelleyEra
_ = StrictMaybe ScriptIntegrityHash
forall a. StrictMaybe a
SNothing
  genPParams :: GenSize -> Gen (PParams ShelleyEra)
genPParams GenSize
_ = Gen (PParams ShelleyEra)
forall era. EraPParams era => Gen (PParams era)
shelleyGenPParams

instance EraGenericGen MaryEra where
  setValidity :: ValidityInterval -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
setValidity = ValidityInterval -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall era.
AllegraEraTxBody era =>
ValidityInterval -> TxBody TopTx era -> TxBody TopTx era
allegraSetValidity
  setReferenceInputs :: Set TxIn -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
setReferenceInputs = (TxBody TopTx MaryEra -> TxBody TopTx MaryEra)
-> Set TxIn -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall a b. a -> b -> a
const TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall a. a -> a
id
  setCollateralInputs :: Set TxIn -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
setCollateralInputs = (TxBody TopTx MaryEra -> TxBody TopTx MaryEra)
-> Set TxIn -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall a b. a -> b -> a
const TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall a. a -> a
id
  setTotalCollateral :: StrictMaybe Coin -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
setTotalCollateral = (TxBody TopTx MaryEra -> TxBody TopTx MaryEra)
-> StrictMaybe Coin -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall a b. a -> b -> a
const TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall a. a -> a
id
  setCollateralReturn :: StrictMaybe (TxOut MaryEra)
-> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
setCollateralReturn = (TxBody TopTx MaryEra -> TxBody TopTx MaryEra)
-> StrictMaybe (ShelleyTxOut MaryEra)
-> TxBody TopTx MaryEra
-> TxBody TopTx MaryEra
forall a b. a -> b -> a
const TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall a. a -> a
id
  addRedeemers :: Redeemers MaryEra -> TxWits MaryEra -> TxWits MaryEra
addRedeemers = (ShelleyTxWits MaryEra -> ShelleyTxWits MaryEra)
-> Redeemers MaryEra
-> ShelleyTxWits MaryEra
-> ShelleyTxWits MaryEra
forall a b. a -> b -> a
const ShelleyTxWits MaryEra -> ShelleyTxWits MaryEra
forall a. a -> a
id
  setScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
-> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
setScriptIntegrityHash = (TxBody TopTx MaryEra -> TxBody TopTx MaryEra)
-> StrictMaybe ScriptIntegrityHash
-> TxBody TopTx MaryEra
-> TxBody TopTx MaryEra
forall a b. a -> b -> a
const TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall a. a -> a
id
  setNetworkIdTxBody :: StrictMaybe Network -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
setNetworkIdTxBody = (TxBody TopTx MaryEra -> TxBody TopTx MaryEra)
-> StrictMaybe Network
-> TxBody TopTx MaryEra
-> TxBody TopTx MaryEra
forall a b. a -> b -> a
const TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall a. a -> a
id
  genExUnits :: Int -> GenRS MaryEra [ExUnits]
genExUnits = GenRS MaryEra [ExUnits] -> Int -> GenRS MaryEra [ExUnits]
forall a b. a -> b -> a
const (GenRS MaryEra [ExUnits] -> Int -> GenRS MaryEra [ExUnits])
-> GenRS MaryEra [ExUnits] -> Int -> GenRS MaryEra [ExUnits]
forall a b. (a -> b) -> a -> b
$ [ExUnits] -> GenRS MaryEra [ExUnits]
forall a. a -> RWST (GenEnv MaryEra) () (GenState MaryEra) Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  ppMaxCollateralInputsT :: Lens' (PParams MaryEra) Natural
ppMaxCollateralInputsT = Natural -> Lens' (PParams MaryEra) Natural
forall b a. b -> Lens' a b
dummyLens Natural
0
  ppCollateralPercentageT :: Lens' (PParams MaryEra) Natural
ppCollateralPercentageT = Natural -> Lens' (PParams MaryEra) Natural
forall b a. b -> Lens' a b
dummyLens Natural
0
  ppCostModelsT :: Lens' (PParams MaryEra) CostModels
ppCostModelsT = CostModels -> Lens' (PParams MaryEra) CostModels
forall b a. b -> Lens' a b
dummyLens CostModels
forall a. Monoid a => a
mempty
  ppMaxTxExUnitsT :: Lens' (PParams MaryEra) ExUnits
ppMaxTxExUnitsT = ExUnits -> Lens' (PParams MaryEra) ExUnits
forall b a. b -> Lens' a b
dummyLens ExUnits
forall a. Monoid a => a
mempty
  ppMaxBlockExUnitsT :: Lens' (PParams MaryEra) ExUnits
ppMaxBlockExUnitsT = ExUnits -> Lens' (PParams MaryEra) ExUnits
forall b a. b -> Lens' a b
dummyLens ExUnits
forall a. Monoid a => a
mempty
  ppMaxValSizeT :: Lens' (PParams MaryEra) Natural
ppMaxValSizeT = Natural -> Lens' (PParams MaryEra) Natural
forall b a. b -> Lens' a b
dummyLens Natural
0
  mkScriptIntegrityHash :: PParams MaryEra
-> [Language] -> TxWits MaryEra -> StrictMaybe ScriptIntegrityHash
mkScriptIntegrityHash PParams MaryEra
_ [Language]
_ TxWits MaryEra
_ = StrictMaybe ScriptIntegrityHash
forall a. StrictMaybe a
SNothing
  genPParams :: GenSize -> Gen (PParams MaryEra)
genPParams GenSize
_ = Gen (PParams MaryEra)
forall era. EraPParams era => Gen (PParams era)
shelleyGenPParams

instance EraGenericGen AllegraEra where
  setValidity :: ValidityInterval
-> TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
setValidity = ValidityInterval
-> TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
forall era.
AllegraEraTxBody era =>
ValidityInterval -> TxBody TopTx era -> TxBody TopTx era
allegraSetValidity
  setReferenceInputs :: Set TxIn -> TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
setReferenceInputs = (TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra)
-> Set TxIn -> TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
forall a b. a -> b -> a
const TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
forall a. a -> a
id
  setCollateralInputs :: Set TxIn -> TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
setCollateralInputs = (TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra)
-> Set TxIn -> TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
forall a b. a -> b -> a
const TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
forall a. a -> a
id
  setTotalCollateral :: StrictMaybe Coin
-> TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
setTotalCollateral = (TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra)
-> StrictMaybe Coin
-> TxBody TopTx AllegraEra
-> TxBody TopTx AllegraEra
forall a b. a -> b -> a
const TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
forall a. a -> a
id
  setCollateralReturn :: StrictMaybe (TxOut AllegraEra)
-> TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
setCollateralReturn = (TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra)
-> StrictMaybe (ShelleyTxOut AllegraEra)
-> TxBody TopTx AllegraEra
-> TxBody TopTx AllegraEra
forall a b. a -> b -> a
const TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
forall a. a -> a
id
  addRedeemers :: Redeemers AllegraEra -> TxWits AllegraEra -> TxWits AllegraEra
addRedeemers = (ShelleyTxWits AllegraEra -> ShelleyTxWits AllegraEra)
-> Redeemers AllegraEra
-> ShelleyTxWits AllegraEra
-> ShelleyTxWits AllegraEra
forall a b. a -> b -> a
const ShelleyTxWits AllegraEra -> ShelleyTxWits AllegraEra
forall a. a -> a
id
  setScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
-> TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
setScriptIntegrityHash = (TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra)
-> StrictMaybe ScriptIntegrityHash
-> TxBody TopTx AllegraEra
-> TxBody TopTx AllegraEra
forall a b. a -> b -> a
const TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
forall a. a -> a
id
  setNetworkIdTxBody :: StrictMaybe Network
-> TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
setNetworkIdTxBody = (TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra)
-> StrictMaybe Network
-> TxBody TopTx AllegraEra
-> TxBody TopTx AllegraEra
forall a b. a -> b -> a
const TxBody TopTx AllegraEra -> TxBody TopTx AllegraEra
forall a. a -> a
id
  genExUnits :: Int -> GenRS AllegraEra [ExUnits]
genExUnits = GenRS AllegraEra [ExUnits] -> Int -> GenRS AllegraEra [ExUnits]
forall a b. a -> b -> a
const (GenRS AllegraEra [ExUnits] -> Int -> GenRS AllegraEra [ExUnits])
-> GenRS AllegraEra [ExUnits] -> Int -> GenRS AllegraEra [ExUnits]
forall a b. (a -> b) -> a -> b
$ [ExUnits] -> GenRS AllegraEra [ExUnits]
forall a.
a -> RWST (GenEnv AllegraEra) () (GenState AllegraEra) Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  ppMaxCollateralInputsT :: Lens' (PParams AllegraEra) Natural
ppMaxCollateralInputsT = Natural -> Lens' (PParams AllegraEra) Natural
forall b a. b -> Lens' a b
dummyLens Natural
0
  ppCollateralPercentageT :: Lens' (PParams AllegraEra) Natural
ppCollateralPercentageT = Natural -> Lens' (PParams AllegraEra) Natural
forall b a. b -> Lens' a b
dummyLens Natural
0
  ppCostModelsT :: Lens' (PParams AllegraEra) CostModels
ppCostModelsT = CostModels -> Lens' (PParams AllegraEra) CostModels
forall b a. b -> Lens' a b
dummyLens CostModels
forall a. Monoid a => a
mempty
  ppMaxTxExUnitsT :: Lens' (PParams AllegraEra) ExUnits
ppMaxTxExUnitsT = ExUnits -> Lens' (PParams AllegraEra) ExUnits
forall b a. b -> Lens' a b
dummyLens ExUnits
forall a. Monoid a => a
mempty
  ppMaxBlockExUnitsT :: Lens' (PParams AllegraEra) ExUnits
ppMaxBlockExUnitsT = ExUnits -> Lens' (PParams AllegraEra) ExUnits
forall b a. b -> Lens' a b
dummyLens ExUnits
forall a. Monoid a => a
mempty
  ppMaxValSizeT :: Lens' (PParams AllegraEra) Natural
ppMaxValSizeT = Natural -> Lens' (PParams AllegraEra) Natural
forall b a. b -> Lens' a b
dummyLens Natural
0
  mkScriptIntegrityHash :: PParams AllegraEra
-> [Language]
-> TxWits AllegraEra
-> StrictMaybe ScriptIntegrityHash
mkScriptIntegrityHash PParams AllegraEra
_ [Language]
_ TxWits AllegraEra
_ = StrictMaybe ScriptIntegrityHash
forall a. StrictMaybe a
SNothing
  genPParams :: GenSize -> Gen (PParams AllegraEra)
genPParams GenSize
_ = Gen (PParams AllegraEra)
forall era. EraPParams era => Gen (PParams era)
shelleyGenPParams

alonzoMkScriptIntegrityHash ::
  ( EraModel era
  , AlonzoEraTxWits era
  ) =>
  PParams era -> [Language] -> TxWits era -> StrictMaybe ScriptIntegrityHash
alonzoMkScriptIntegrityHash :: forall era.
(EraModel era, AlonzoEraTxWits era) =>
PParams era
-> [Language] -> TxWits era -> StrictMaybe ScriptIntegrityHash
alonzoMkScriptIntegrityHash PParams era
pp [Language]
langs TxWits era
wits =
  PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
EraModel era =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash PParams era
pp [Language]
langs (TxWits era
wits TxWits era
-> Getting (Redeemers era) (TxWits era) (Redeemers era)
-> Redeemers era
forall s a. s -> Getting a s a -> a
^. Getting (Redeemers era) (TxWits era) (Redeemers era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL) (TxWits era
wits TxWits era
-> Getting (TxDats era) (TxWits era) (TxDats era) -> TxDats era
forall s a. s -> Getting a s a -> a
^. Getting (TxDats era) (TxWits era) (TxDats era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL)

-- | Generate a list of specified length with randomish `ExUnit`s where the sum
--   of all values produced will not exceed the maxTxExUnits.
alonzoGenExUnits :: AlonzoEraPParams era => Int -> GenRS era [ExUnits]
alonzoGenExUnits :: forall era. AlonzoEraPParams era => Int -> GenRS era [ExUnits]
alonzoGenExUnits Int
n = do
  GenEnv {gePParams} <- (GenState era -> GenEnv era)
-> RWST (GenEnv era) () (GenState era) Gen (GenEnv era)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GenState era -> GenEnv era
forall era. GenState era -> GenEnv era
gsGenEnv
  let ExUnits maxMemUnits maxStepUnits = gePParams ^. ppMaxTxExUnitsL
  memUnits <- lift $ genSequenceSum maxMemUnits
  stepUnits <- lift $ genSequenceSum maxStepUnits
  pure $ zipWith ExUnits memUnits stepUnits
  where
    un :: Natural
un = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    genUpTo :: Natural -> (a, [a]) -> p -> Gen (a, [a])
genUpTo Natural
maxVal (!a
totalLeft, ![a]
acc) p
_
      | a
totalLeft a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = (a, [a]) -> Gen (a, [a])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
0, a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)
      | Bool
otherwise = do
          x <- a -> a -> a
forall a. Ord a => a -> a -> a
min a
totalLeft (a -> a) -> (Natural -> a) -> Natural -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio Natural -> a
forall b. Integral b => Ratio Natural -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Ratio Natural -> a) -> (Natural -> Ratio Natural) -> Natural -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> Ratio Natural
forall a. Integral a => a -> a -> Ratio a
% Natural
un) (Natural -> a) -> Gen Natural -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Natural -> Gen Natural
genNatural Natural
0 Natural
maxVal
          pure (totalLeft - x, x : acc)
    genSequenceSum :: Natural -> Gen [Natural]
genSequenceSum Natural
maxVal
      | Natural
maxVal Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0 = [Natural] -> Gen [Natural]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Natural] -> Gen [Natural]) -> [Natural] -> Gen [Natural]
forall a b. (a -> b) -> a -> b
$ Int -> Natural -> [Natural]
forall a. Int -> a -> [a]
replicate Int
n Natural
0
      | Bool
otherwise = (Natural, [Natural]) -> [Natural]
forall a b. (a, b) -> b
snd ((Natural, [Natural]) -> [Natural])
-> Gen (Natural, [Natural]) -> Gen [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Natural, [Natural]) -> Int -> Gen (Natural, [Natural]))
-> (Natural, [Natural]) -> [Int] -> Gen (Natural, [Natural])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
F.foldlM (Natural -> (Natural, [Natural]) -> Int -> Gen (Natural, [Natural])
forall {a} {p}.
Integral a =>
Natural -> (a, [a]) -> p -> Gen (a, [a])
genUpTo Natural
maxVal) (Natural
maxVal, []) ([Int
Item [Int]
1 .. Int
Item [Int]
n] :: [Int])

instance EraGenericGen AlonzoEra where
  setValidity :: ValidityInterval
-> TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
setValidity = ValidityInterval
-> TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
forall era.
AllegraEraTxBody era =>
ValidityInterval -> TxBody TopTx era -> TxBody TopTx era
allegraSetValidity
  setCollateralInputs :: Set TxIn -> TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
setCollateralInputs = ASetter
  (TxBody TopTx AlonzoEra)
  (TxBody TopTx AlonzoEra)
  (Set TxIn)
  (Set TxIn)
-> Set TxIn -> TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx AlonzoEra)
  (TxBody TopTx AlonzoEra)
  (Set TxIn)
  (Set TxIn)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody TopTx era) (Set TxIn)
Lens' (TxBody TopTx AlonzoEra) (Set TxIn)
collateralInputsTxBodyL
  addRedeemers :: Redeemers AlonzoEra -> TxWits AlonzoEra -> TxWits AlonzoEra
addRedeemers Redeemers AlonzoEra
x = (Redeemers AlonzoEra -> Identity (Redeemers AlonzoEra))
-> TxWits AlonzoEra -> Identity (TxWits AlonzoEra)
(Redeemers AlonzoEra -> Identity (Redeemers AlonzoEra))
-> AlonzoTxWits AlonzoEra -> Identity (AlonzoTxWits AlonzoEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits AlonzoEra) (Redeemers AlonzoEra)
rdmrsTxWitsL ((Redeemers AlonzoEra -> Identity (Redeemers AlonzoEra))
 -> AlonzoTxWits AlonzoEra -> Identity (AlonzoTxWits AlonzoEra))
-> Redeemers AlonzoEra
-> AlonzoTxWits AlonzoEra
-> AlonzoTxWits AlonzoEra
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Redeemers AlonzoEra
x
  genExUnits :: Int -> GenRS AlonzoEra [ExUnits]
genExUnits = Int -> GenRS AlonzoEra [ExUnits]
forall era. AlonzoEraPParams era => Int -> GenRS era [ExUnits]
alonzoGenExUnits
  setNetworkIdTxBody :: StrictMaybe Network
-> TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
setNetworkIdTxBody = ASetter
  (TxBody TopTx AlonzoEra)
  (TxBody TopTx AlonzoEra)
  (StrictMaybe Network)
  (StrictMaybe Network)
-> StrictMaybe Network
-> TxBody TopTx AlonzoEra
-> TxBody TopTx AlonzoEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx AlonzoEra)
  (TxBody TopTx AlonzoEra)
  (StrictMaybe Network)
  (StrictMaybe Network)
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe Network)
forall (l :: TxLevel).
Lens' (TxBody l AlonzoEra) (StrictMaybe Network)
networkIdTxBodyL
  ppMaxCollateralInputsT :: Lens' (PParams AlonzoEra) Natural
ppMaxCollateralInputsT = (Natural -> f Natural)
-> PParams AlonzoEra -> f (PParams AlonzoEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams AlonzoEra) Natural
ppMaxCollateralInputsL
  ppCollateralPercentageT :: Lens' (PParams AlonzoEra) Natural
ppCollateralPercentageT = (Natural -> f Natural)
-> PParams AlonzoEra -> f (PParams AlonzoEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams AlonzoEra) Natural
ppCollateralPercentageL
  mkScriptIntegrityHash :: PParams AlonzoEra
-> [Language]
-> TxWits AlonzoEra
-> StrictMaybe ScriptIntegrityHash
mkScriptIntegrityHash = PParams AlonzoEra
-> [Language]
-> TxWits AlonzoEra
-> StrictMaybe ScriptIntegrityHash
forall era.
(EraModel era, AlonzoEraTxWits era) =>
PParams era
-> [Language] -> TxWits era -> StrictMaybe ScriptIntegrityHash
alonzoMkScriptIntegrityHash
  ppCostModelsT :: Lens' (PParams AlonzoEra) CostModels
ppCostModelsT = (CostModels -> f CostModels)
-> PParams AlonzoEra -> f (PParams AlonzoEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams AlonzoEra) CostModels
ppCostModelsL
  ppMaxTxExUnitsT :: Lens' (PParams AlonzoEra) ExUnits
ppMaxTxExUnitsT = (ExUnits -> f ExUnits)
-> PParams AlonzoEra -> f (PParams AlonzoEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams AlonzoEra) ExUnits
ppMaxTxExUnitsL
  ppMaxBlockExUnitsT :: Lens' (PParams AlonzoEra) ExUnits
ppMaxBlockExUnitsT = (ExUnits -> f ExUnits)
-> PParams AlonzoEra -> f (PParams AlonzoEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams AlonzoEra) ExUnits
ppMaxBlockExUnitsL
  ppMaxValSizeT :: Lens' (PParams AlonzoEra) Natural
ppMaxValSizeT = (Natural -> f Natural)
-> PParams AlonzoEra -> f (PParams AlonzoEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams AlonzoEra) Natural
ppMaxValSizeL
  setScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
-> TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
setScriptIntegrityHash = ASetter
  (TxBody TopTx AlonzoEra)
  (TxBody TopTx AlonzoEra)
  (StrictMaybe ScriptIntegrityHash)
  (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ScriptIntegrityHash
-> TxBody TopTx AlonzoEra
-> TxBody TopTx AlonzoEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx AlonzoEra)
  (TxBody TopTx AlonzoEra)
  (StrictMaybe ScriptIntegrityHash)
  (StrictMaybe ScriptIntegrityHash)
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe ScriptIntegrityHash)
forall (l :: TxLevel).
Lens' (TxBody l AlonzoEra) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
  setReferenceInputs :: Set TxIn -> TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
setReferenceInputs = (TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra)
-> Set TxIn -> TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
forall a b. a -> b -> a
const TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
forall a. a -> a
id
  setTotalCollateral :: StrictMaybe Coin
-> TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
setTotalCollateral = (TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra)
-> StrictMaybe Coin
-> TxBody TopTx AlonzoEra
-> TxBody TopTx AlonzoEra
forall a b. a -> b -> a
const TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
forall a. a -> a
id
  setCollateralReturn :: StrictMaybe (TxOut AlonzoEra)
-> TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
setCollateralReturn = (TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra)
-> StrictMaybe (AlonzoTxOut AlonzoEra)
-> TxBody TopTx AlonzoEra
-> TxBody TopTx AlonzoEra
forall a b. a -> b -> a
const TxBody TopTx AlonzoEra -> TxBody TopTx AlonzoEra
forall a. a -> a
id
  genPParams :: GenSize -> Gen (PParams AlonzoEra)
genPParams = GenSize -> Gen (PParams AlonzoEra)
forall era. AlonzoEraTest era => GenSize -> Gen (PParams era)
alonzoGenPParams

shelleyApplyTx :: EraModel era => Int -> SlotNo -> Model era -> Tx TopTx era -> Model era
shelleyApplyTx :: forall era.
EraModel era =>
Int -> SlotNo -> Model era -> Tx TopTx era -> Model era
shelleyApplyTx Int
count SlotNo
slot Model era
model Tx TopTx era
tx = Int -> Model era -> TxBody TopTx era -> Model era
forall era.
EraModel era =>
Int -> Model era -> TxBody TopTx era -> Model era
applyTxBody Int
count Model era
epochAccurateModel (TxBody TopTx era -> Model era) -> TxBody TopTx era -> Model era
forall a b. (a -> b) -> a -> b
$ Tx TopTx era
tx Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL
  where
    modelEpoch :: EpochNo
modelEpoch = Model era -> EpochNo
forall era. ModelNewEpochState era -> EpochNo
mEL Model era
model
    transactionEpoch :: EpochNo
transactionEpoch = SlotNo -> EpochNo
epochFromSlotNo SlotNo
slot
    epochAccurateModel :: Model era
epochAccurateModel = EpochNo -> EpochNo -> Model era -> Model era
forall era.
(EraPParams era, EraStake era) =>
EpochNo -> EpochNo -> Model era -> Model era
epochBoundary EpochNo
transactionEpoch EpochNo
modelEpoch Model era
model

alonzoApplyTx ::
  forall era.
  (EraModel era, AlonzoEraTx era, Reflect era) =>
  Int -> SlotNo -> Model era -> Tx TopTx era -> Model era
alonzoApplyTx :: forall era.
(EraModel era, AlonzoEraTx era, Reflect era) =>
Int -> SlotNo -> Model era -> Tx TopTx era -> Model era
alonzoApplyTx Int
count SlotNo
slot Model era
model Tx TopTx era
tx = case Tx TopTx era
tx Tx TopTx era -> Getting IsValid (Tx TopTx era) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx TopTx era) IsValid
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsValid
Lens' (Tx TopTx era) IsValid
isValidTxL of
  IsValid Bool
True -> Int -> Model era -> Tx TopTx era -> Model era
forall era.
EraModel era =>
Int -> Model era -> Tx TopTx era -> Model era
applyTxSimple Int
count Model era
epochAccurateModel Tx TopTx era
tx
  IsValid Bool
False -> Int -> TxIx -> Model era -> Tx TopTx era -> Model era
forall era.
(Reflect era, AlonzoEraTxBody era, EraModel era) =>
Int -> TxIx -> Model era -> Tx TopTx era -> Model era
applyTxFail Int
count TxIx
nextTxIx Model era
epochAccurateModel Tx TopTx era
tx
  where
    transactionEpoch :: EpochNo
transactionEpoch = SlotNo -> EpochNo
epochFromSlotNo SlotNo
slot
    modelEpoch :: EpochNo
modelEpoch = Model era -> EpochNo
forall era. ModelNewEpochState era -> EpochNo
mEL Model era
model
    epochAccurateModel :: Model era
epochAccurateModel = EpochNo -> EpochNo -> Model era -> Model era
forall era.
(EraPParams era, EraStake era) =>
EpochNo -> EpochNo -> Model era -> Model era
epochBoundary EpochNo
transactionEpoch EpochNo
modelEpoch Model era
model
    txbody :: TxBody TopTx era
txbody = Tx TopTx era
tx Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL
    outputs :: StrictSeq (TxOut era)
outputs = TxBody TopTx era
txbody TxBody TopTx era
-> Getting
     (StrictSeq (TxOut era)) (TxBody TopTx era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody TopTx era) (StrictSeq (TxOut era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL
    nextTxIx :: TxIx
nextTxIx = HasCallStack => Integer -> TxIx
Integer -> TxIx
mkTxIxPartial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StrictSeq (TxOut era) -> Int
forall a. StrictSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length StrictSeq (TxOut era)
outputs)) -- When IsValid is false, ColRet will get this TxIx

instance EraGenericGen BabbageEra where
  setValidity :: ValidityInterval
-> TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
setValidity = ValidityInterval
-> TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
forall era.
AllegraEraTxBody era =>
ValidityInterval -> TxBody TopTx era -> TxBody TopTx era
allegraSetValidity
  setReferenceInputs :: Set TxIn -> TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
setReferenceInputs = ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (Set TxIn)
  (Set TxIn)
-> Set TxIn -> TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (Set TxIn)
  (Set TxIn)
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l BabbageEra) (Set TxIn)
referenceInputsTxBodyL
  setCollateralInputs :: Set TxIn -> TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
setCollateralInputs = ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (Set TxIn)
  (Set TxIn)
-> Set TxIn -> TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (Set TxIn)
  (Set TxIn)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody TopTx era) (Set TxIn)
Lens' (TxBody TopTx BabbageEra) (Set TxIn)
collateralInputsTxBodyL
  setTotalCollateral :: StrictMaybe Coin
-> TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
setTotalCollateral = ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
-> StrictMaybe Coin
-> TxBody TopTx BabbageEra
-> TxBody TopTx BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe Coin)
Lens' (TxBody TopTx BabbageEra) (StrictMaybe Coin)
totalCollateralTxBodyL
  setCollateralReturn :: StrictMaybe (TxOut BabbageEra)
-> TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
setCollateralReturn = ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (StrictMaybe (BabbageTxOut BabbageEra))
  (StrictMaybe (BabbageTxOut BabbageEra))
-> StrictMaybe (BabbageTxOut BabbageEra)
-> TxBody TopTx BabbageEra
-> TxBody TopTx BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set (StrictMaybe (TxOut BabbageEra)
 -> Identity (StrictMaybe (TxOut BabbageEra)))
-> TxBody TopTx BabbageEra -> Identity (TxBody TopTx BabbageEra)
ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (StrictMaybe (BabbageTxOut BabbageEra))
  (StrictMaybe (BabbageTxOut BabbageEra))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (TxOut era))
Lens' (TxBody TopTx BabbageEra) (StrictMaybe (TxOut BabbageEra))
collateralReturnTxBodyL
  addRedeemers :: Redeemers BabbageEra -> TxWits BabbageEra -> TxWits BabbageEra
addRedeemers Redeemers BabbageEra
x = (Redeemers BabbageEra -> Identity (Redeemers BabbageEra))
-> TxWits BabbageEra -> Identity (TxWits BabbageEra)
(Redeemers BabbageEra -> Identity (Redeemers BabbageEra))
-> AlonzoTxWits BabbageEra -> Identity (AlonzoTxWits BabbageEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits BabbageEra) (Redeemers BabbageEra)
rdmrsTxWitsL ((Redeemers BabbageEra -> Identity (Redeemers BabbageEra))
 -> AlonzoTxWits BabbageEra -> Identity (AlonzoTxWits BabbageEra))
-> Redeemers BabbageEra
-> AlonzoTxWits BabbageEra
-> AlonzoTxWits BabbageEra
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Redeemers BabbageEra
x
  genExUnits :: Int -> GenRS BabbageEra [ExUnits]
genExUnits = Int -> GenRS BabbageEra [ExUnits]
forall era. AlonzoEraPParams era => Int -> GenRS era [ExUnits]
alonzoGenExUnits
  setNetworkIdTxBody :: StrictMaybe Network
-> TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
setNetworkIdTxBody = ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (StrictMaybe Network)
  (StrictMaybe Network)
-> StrictMaybe Network
-> TxBody TopTx BabbageEra
-> TxBody TopTx BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (StrictMaybe Network)
  (StrictMaybe Network)
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe Network)
forall (l :: TxLevel).
Lens' (TxBody l BabbageEra) (StrictMaybe Network)
networkIdTxBodyL
  ppMaxCollateralInputsT :: Lens' (PParams BabbageEra) Natural
ppMaxCollateralInputsT = (Natural -> f Natural)
-> PParams BabbageEra -> f (PParams BabbageEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams BabbageEra) Natural
ppMaxCollateralInputsL
  ppCollateralPercentageT :: Lens' (PParams BabbageEra) Natural
ppCollateralPercentageT = (Natural -> f Natural)
-> PParams BabbageEra -> f (PParams BabbageEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams BabbageEra) Natural
ppCollateralPercentageL
  mkScriptIntegrityHash :: PParams BabbageEra
-> [Language]
-> TxWits BabbageEra
-> StrictMaybe ScriptIntegrityHash
mkScriptIntegrityHash = PParams BabbageEra
-> [Language]
-> TxWits BabbageEra
-> StrictMaybe ScriptIntegrityHash
forall era.
(EraModel era, AlonzoEraTxWits era) =>
PParams era
-> [Language] -> TxWits era -> StrictMaybe ScriptIntegrityHash
alonzoMkScriptIntegrityHash
  ppCostModelsT :: Lens' (PParams BabbageEra) CostModels
ppCostModelsT = (CostModels -> f CostModels)
-> PParams BabbageEra -> f (PParams BabbageEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams BabbageEra) CostModels
ppCostModelsL
  ppMaxTxExUnitsT :: Lens' (PParams BabbageEra) ExUnits
ppMaxTxExUnitsT = (ExUnits -> f ExUnits)
-> PParams BabbageEra -> f (PParams BabbageEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams BabbageEra) ExUnits
ppMaxTxExUnitsL
  ppMaxBlockExUnitsT :: Lens' (PParams BabbageEra) ExUnits
ppMaxBlockExUnitsT = (ExUnits -> f ExUnits)
-> PParams BabbageEra -> f (PParams BabbageEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams BabbageEra) ExUnits
ppMaxBlockExUnitsL
  ppMaxValSizeT :: Lens' (PParams BabbageEra) Natural
ppMaxValSizeT = (Natural -> f Natural)
-> PParams BabbageEra -> f (PParams BabbageEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams BabbageEra) Natural
ppMaxValSizeL
  setScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
-> TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
setScriptIntegrityHash = ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (StrictMaybe ScriptIntegrityHash)
  (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ScriptIntegrityHash
-> TxBody TopTx BabbageEra
-> TxBody TopTx BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
  (StrictMaybe ScriptIntegrityHash)
  (StrictMaybe ScriptIntegrityHash)
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe ScriptIntegrityHash)
forall (l :: TxLevel).
Lens' (TxBody l BabbageEra) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
  genPParams :: GenSize -> Gen (PParams BabbageEra)
genPParams = GenSize -> Gen (PParams BabbageEra)
forall era. AlonzoEraTest era => GenSize -> Gen (PParams era)
alonzoGenPParams

instance EraGenericGen ConwayEra where
  setValidity :: ValidityInterval
-> TxBody TopTx ConwayEra -> TxBody TopTx ConwayEra
setValidity = ValidityInterval
-> TxBody TopTx ConwayEra -> TxBody TopTx ConwayEra
forall era.
AllegraEraTxBody era =>
ValidityInterval -> TxBody TopTx era -> TxBody TopTx era
allegraSetValidity
  setReferenceInputs :: Set TxIn -> TxBody TopTx ConwayEra -> TxBody TopTx ConwayEra
setReferenceInputs = ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (Set TxIn)
  (Set TxIn)
-> Set TxIn -> TxBody TopTx ConwayEra -> TxBody TopTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (Set TxIn)
  (Set TxIn)
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) (Set TxIn)
referenceInputsTxBodyL
  setCollateralInputs :: Set TxIn -> TxBody TopTx ConwayEra -> TxBody TopTx ConwayEra
setCollateralInputs = ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (Set TxIn)
  (Set TxIn)
-> Set TxIn -> TxBody TopTx ConwayEra -> TxBody TopTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (Set TxIn)
  (Set TxIn)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody TopTx era) (Set TxIn)
Lens' (TxBody TopTx ConwayEra) (Set TxIn)
collateralInputsTxBodyL
  setTotalCollateral :: StrictMaybe Coin
-> TxBody TopTx ConwayEra -> TxBody TopTx ConwayEra
setTotalCollateral = ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
-> StrictMaybe Coin
-> TxBody TopTx ConwayEra
-> TxBody TopTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe Coin)
Lens' (TxBody TopTx ConwayEra) (StrictMaybe Coin)
totalCollateralTxBodyL
  setCollateralReturn :: StrictMaybe (TxOut ConwayEra)
-> TxBody TopTx ConwayEra -> TxBody TopTx ConwayEra
setCollateralReturn = ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (StrictMaybe (BabbageTxOut ConwayEra))
  (StrictMaybe (BabbageTxOut ConwayEra))
-> StrictMaybe (BabbageTxOut ConwayEra)
-> TxBody TopTx ConwayEra
-> TxBody TopTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set (StrictMaybe (TxOut ConwayEra)
 -> Identity (StrictMaybe (TxOut ConwayEra)))
-> TxBody TopTx ConwayEra -> Identity (TxBody TopTx ConwayEra)
ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (StrictMaybe (BabbageTxOut ConwayEra))
  (StrictMaybe (BabbageTxOut ConwayEra))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (TxOut era))
Lens' (TxBody TopTx ConwayEra) (StrictMaybe (TxOut ConwayEra))
collateralReturnTxBodyL
  addRedeemers :: Redeemers ConwayEra -> TxWits ConwayEra -> TxWits ConwayEra
addRedeemers Redeemers ConwayEra
x = (Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra)
(Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits ConwayEra) (Redeemers ConwayEra)
rdmrsTxWitsL ((Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
 -> AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
-> Redeemers ConwayEra
-> AlonzoTxWits ConwayEra
-> AlonzoTxWits ConwayEra
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Redeemers ConwayEra
x
  genExUnits :: Int -> GenRS ConwayEra [ExUnits]
genExUnits = Int -> GenRS ConwayEra [ExUnits]
forall era. AlonzoEraPParams era => Int -> GenRS era [ExUnits]
alonzoGenExUnits
  setNetworkIdTxBody :: StrictMaybe Network
-> TxBody TopTx ConwayEra -> TxBody TopTx ConwayEra
setNetworkIdTxBody = ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (StrictMaybe Network)
  (StrictMaybe Network)
-> StrictMaybe Network
-> TxBody TopTx ConwayEra
-> TxBody TopTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (StrictMaybe Network)
  (StrictMaybe Network)
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe Network)
forall (l :: TxLevel).
Lens' (TxBody l ConwayEra) (StrictMaybe Network)
networkIdTxBodyL
  ppMaxCollateralInputsT :: Lens' (PParams ConwayEra) Natural
ppMaxCollateralInputsT = (Natural -> f Natural)
-> PParams ConwayEra -> f (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams ConwayEra) Natural
ppMaxCollateralInputsL
  ppCollateralPercentageT :: Lens' (PParams ConwayEra) Natural
ppCollateralPercentageT = (Natural -> f Natural)
-> PParams ConwayEra -> f (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams ConwayEra) Natural
ppCollateralPercentageL
  mkScriptIntegrityHash :: PParams ConwayEra
-> [Language]
-> TxWits ConwayEra
-> StrictMaybe ScriptIntegrityHash
mkScriptIntegrityHash = PParams ConwayEra
-> [Language]
-> TxWits ConwayEra
-> StrictMaybe ScriptIntegrityHash
forall era.
(EraModel era, AlonzoEraTxWits era) =>
PParams era
-> [Language] -> TxWits era -> StrictMaybe ScriptIntegrityHash
alonzoMkScriptIntegrityHash
  ppCostModelsT :: Lens' (PParams ConwayEra) CostModels
ppCostModelsT = (CostModels -> f CostModels)
-> PParams ConwayEra -> f (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams ConwayEra) CostModels
ppCostModelsL
  ppMaxTxExUnitsT :: Lens' (PParams ConwayEra) ExUnits
ppMaxTxExUnitsT = (ExUnits -> f ExUnits)
-> PParams ConwayEra -> f (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams ConwayEra) ExUnits
ppMaxTxExUnitsL
  ppMaxBlockExUnitsT :: Lens' (PParams ConwayEra) ExUnits
ppMaxBlockExUnitsT = (ExUnits -> f ExUnits)
-> PParams ConwayEra -> f (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams ConwayEra) ExUnits
ppMaxBlockExUnitsL
  ppMaxValSizeT :: Lens' (PParams ConwayEra) Natural
ppMaxValSizeT = (Natural -> f Natural)
-> PParams ConwayEra -> f (PParams ConwayEra)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams ConwayEra) Natural
ppMaxValSizeL
  setScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
-> TxBody TopTx ConwayEra -> TxBody TopTx ConwayEra
setScriptIntegrityHash = ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (StrictMaybe ScriptIntegrityHash)
  (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ScriptIntegrityHash
-> TxBody TopTx ConwayEra
-> TxBody TopTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (TxBody TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
  (StrictMaybe ScriptIntegrityHash)
  (StrictMaybe ScriptIntegrityHash)
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe ScriptIntegrityHash)
forall (l :: TxLevel).
Lens' (TxBody l ConwayEra) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
  genPParams :: GenSize -> Gen (PParams ConwayEra)
genPParams = GenSize -> Gen (PParams ConwayEra)
forall era. AlonzoEraTest era => GenSize -> Gen (PParams era)
alonzoGenPParams

-- Utils

-- | Create an unlawful "lens" that returns the specified value when used as a
-- getter and does nothing when used as a setter
dummyLens :: b -> Lens' a b
dummyLens :: forall b a. b -> Lens' a b
dummyLens b
val = (a -> b) -> (a -> b -> a) -> Lens a a b b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
L.lens (b -> a -> b
forall a b. a -> b -> a
const b
val) a -> b -> a
forall a b. a -> b -> a
const