{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |  AlonzoEra instances for EraGen and ScriptClass
module Test.Cardano.Ledger.Alonzo.AlonzoEraGen where

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Allegra.Scripts (
  AllegraEraScript,
  Timelock (..),
  translateTimelock,
  pattern RequireTimeExpire,
  pattern RequireTimeStart,
 )
import Cardano.Ledger.Allegra.TxAuxData (AllegraTxAuxData (..))
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.PParams
import Cardano.Ledger.Alonzo.Rules (vKeyLocked)
import Cardano.Ledger.Alonzo.Scripts as Alonzo (
  AlonzoPlutusPurpose (..),
  AlonzoScript (..),
  ExUnits (..),
  Prices (..),
  isPlutusScript,
  plutusScriptLanguage,
  pointWiseExUnits,
  toAsIx,
  txscriptfee,
 )
import Cardano.Ledger.Alonzo.Tx (
  AlonzoTx (AlonzoTx),
  IsValid (..),
  hashScriptIntegrity,
  totExUnits,
 )
import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..), mkAlonzoTxAuxData)
import Cardano.Ledger.Alonzo.TxBody (
  AlonzoTxBody (..),
  AlonzoTxOut (..),
  inputs',
  utxoEntrySize,
 )
import Cardano.Ledger.Alonzo.TxWits (
  AlonzoTxWits (..),
  Redeemers (..),
  TxDats (..),
  nullRedeemers,
 )
import Cardano.Ledger.Alonzo.UTxO (AlonzoScriptsNeeded (..))
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash)
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (EncCBOR)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Crypto
import Cardano.Ledger.Keys (KeyHash, KeyRole (Witness))
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Mary.Value (
  AssetName (..),
  MultiAsset (..),
  PolicyID (..),
  multiAssetFromList,
  policies,
 )
import Cardano.Ledger.Plutus.Data (Data (..))
import Cardano.Ledger.Plutus.Language (Language (..), SLanguage (..))
import Cardano.Ledger.Shelley.PParams (Update)
import Cardano.Ledger.Shelley.Scripts
import Cardano.Ledger.TxIn (TxIn)
import Cardano.Ledger.UTxO (
  EraUTxO (..),
  UTxO (..),
  coinBalance,
  getScriptsNeeded,
  txInsFilter,
 )
import Cardano.Ledger.Val (Val (isAdaOnly, (<+>), (<×>)))
import Control.Monad (replicateM)
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import Data.Ratio ((%))
import Data.Sequence.Strict (StrictSeq ((:|>)))
import qualified Data.Sequence.Strict as Seq (fromList)
import Data.Set (Set)
import qualified Data.Set as Set
import Lens.Micro
import Lens.Micro.Extras (view)
import Numeric.Natural (Natural)
import qualified PlutusLedgerApi.Common as P (Data (..))
import System.Random
import Test.Cardano.Ledger.AllegraEraGen (genValidityInterval)
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysFails, alwaysSucceeds, mkPlutusScript')
import Test.Cardano.Ledger.Binary.Random
import Test.Cardano.Ledger.Common (tracedDiscard)
import Test.Cardano.Ledger.MaryEraGen (addTokens, genMint, maryGenesisValue, policyIndex)
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
import Test.Cardano.Ledger.Plutus.Examples
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (Mock)
import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
import Test.Cardano.Ledger.Shelley.Generator.Core (
  GenEnv (..),
  ScriptInfo,
  TwoPhase2ArgInfo (..),
  TwoPhase3ArgInfo (..),
  findPlutus,
  genNatural,
  hashData,
 )
import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen (..), MinGenTxout (..))
import Test.Cardano.Ledger.Shelley.Generator.ScriptClass (Quantifier (..), ScriptClass (..))
import Test.Cardano.Ledger.Shelley.Generator.Update (genM, genShelleyPParamsUpdate)
import qualified Test.Cardano.Ledger.Shelley.Generator.Update as Shelley (genPParams)
import Test.Cardano.Ledger.Shelley.Generator.Utxo (encodedLen)
import Test.Cardano.Ledger.Shelley.Utils (unsafeBoundRational)
import Test.QuickCheck hiding ((><))

-- ============================================================

-- | We are choosing new TxOut to pay fees, We want only Key locked addresss with Ada only values.
vKeyLockedAdaOnly :: Crypto c => TxOut (AlonzoEra c) -> Bool
vKeyLockedAdaOnly :: forall c. Crypto c => TxOut (AlonzoEra c) -> Bool
vKeyLockedAdaOnly TxOut (AlonzoEra c)
txOut = forall era. EraTxOut era => TxOut era -> Bool
vKeyLocked TxOut (AlonzoEra c)
txOut Bool -> Bool -> Bool
&& forall t. Val t => t -> Bool
isAdaOnly (TxOut (AlonzoEra c)
txOut forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) (Value era)
valueTxOutL)

phase2scripts3Arg :: forall era. AlonzoEraScript era => [TwoPhase3ArgInfo era]
phase2scripts3Arg :: forall era. AlonzoEraScript era => [TwoPhase3ArgInfo era]
phase2scripts3Arg =
  [ Script era
-> Data -> (Data, Natural, Natural) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo (forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV1 Natural
3) (Integer -> Data
P.I Integer
1) (Integer -> Data
P.I Integer
1, Natural
bigMem, Natural
bigStep) Bool
True
  , Script era
-> Data -> (Data, Natural, Natural) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (forall era (l :: Language).
(HasCallStack, AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Script era
mkPlutusScript' (forall (l :: Language). SLanguage l -> Plutus l
redeemerSameAsDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
9)
      (Integer -> Data
P.I Integer
9, Natural
bigMem, Natural
bigStep)
      Bool
True
  , Script era
-> Data -> (Data, Natural, Natural) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo (forall era (l :: Language).
(HasCallStack, AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Script era
mkPlutusScript' (forall (l :: Language). SLanguage l -> Plutus l
evenDatum SLanguage 'PlutusV1
SPlutusV1)) (Integer -> Data
P.I Integer
8) (Integer -> Data
P.I Integer
8, Natural
bigMem, Natural
bigStep) Bool
True
  , Script era
-> Data -> (Data, Natural, Natural) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo (forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysFails @'PlutusV1 Natural
3) (Integer -> Data
P.I Integer
1) (Integer -> Data
P.I Integer
1, Natural
bigMem, Natural
bigStep) Bool
False
  , Script era
-> Data -> (Data, Natural, Natural) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (forall era (l :: Language).
(HasCallStack, AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Script era
mkPlutusScript' (forall (l :: Language). SLanguage l -> Plutus l
purposeIsWellformedWithDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
3)
      (Integer -> Data
P.I Integer
4, Natural
bigMem, Natural
bigStep)
      Bool
True
  , Script era
-> Data -> (Data, Natural, Natural) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (forall era (l :: Language).
(HasCallStack, AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Script era
mkPlutusScript' (forall (l :: Language). SLanguage l -> Plutus l
datumIsWellformed SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
5)
      (Integer -> Data
P.I Integer
6, Natural
bigMem, Natural
bigStep)
      Bool
True
  , Script era
-> Data -> (Data, Natural, Natural) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (forall era (l :: Language).
(HasCallStack, AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Script era
mkPlutusScript' (forall (l :: Language). SLanguage l -> Plutus l
inputsOutputsAreNotEmptyWithDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
7)
      (Integer -> Data
P.I Integer
9, Natural
bigMem, Natural
bigStep)
      Bool
True
  ]
  where
    mkTwoPhase3ArgInfo :: Script era
-> Data -> (Data, Natural, Natural) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo Script era
script = forall era.
Script era
-> ScriptHash (EraCrypto era)
-> Data
-> (Data, Natural, Natural)
-> Bool
-> TwoPhase3ArgInfo era
TwoPhase3ArgInfo Script era
script (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era Script era
script)

phase2scripts2Arg :: forall era. AlonzoEraScript era => [TwoPhase2ArgInfo era]
phase2scripts2Arg :: forall era. AlonzoEraScript era => [TwoPhase2ArgInfo era]
phase2scripts2Arg =
  [ Script era
-> (Data, Natural, Natural) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo (forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV1 Natural
2) (Integer -> Data
P.I Integer
1, Natural
bigMem, Natural
bigStep) Bool
True
  , Script era
-> (Data, Natural, Natural) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo (forall era (l :: Language).
(HasCallStack, AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Script era
mkPlutusScript' (forall (l :: Language). SLanguage l -> Plutus l
evenRedeemerNoDatum SLanguage 'PlutusV1
SPlutusV1)) (Integer -> Data
P.I Integer
14, Natural
bigMem, Natural
bigStep) Bool
True
  , Script era
-> (Data, Natural, Natural) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo (forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysFails @'PlutusV1 Natural
2) (Integer -> Data
P.I Integer
1, Natural
bigMem, Natural
bigStep) Bool
False
  , Script era
-> (Data, Natural, Natural) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo
      (forall era (l :: Language).
(HasCallStack, AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Script era
mkPlutusScript' (forall (l :: Language). SLanguage l -> Plutus l
purposeIsWellformedNoDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
14, Natural
bigMem, Natural
bigStep)
      Bool
True
  , Script era
-> (Data, Natural, Natural) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo
      (forall era (l :: Language).
(HasCallStack, AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Script era
mkPlutusScript' (forall (l :: Language). SLanguage l -> Plutus l
inputsOutputsAreNotEmptyNoDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
15, Natural
bigMem, Natural
bigStep)
      Bool
True
  ]
  where
    mkTwoPhase2ArgInfo :: Script era
-> (Data, Natural, Natural) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo Script era
script = forall era.
Script era
-> ScriptHash (EraCrypto era)
-> (Data, Natural, Natural)
-> Bool
-> TwoPhase2ArgInfo era
TwoPhase2ArgInfo Script era
script (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era Script era
script)

phase2scripts3ArgSucceeds :: forall era. AlonzoEraScript era => Script era -> Bool
phase2scripts3ArgSucceeds :: forall era. AlonzoEraScript era => Script era -> Bool
phase2scripts3ArgSucceeds Script era
script =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True forall era. TwoPhase3ArgInfo era -> Bool
getSucceeds3 forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\TwoPhase3ArgInfo era
info -> forall era. TwoPhase3ArgInfo era -> Script era
getScript3 TwoPhase3ArgInfo era
info forall a. Eq a => a -> a -> Bool
== Script era
script) forall era. AlonzoEraScript era => [TwoPhase3ArgInfo era]
phase2scripts3Arg

phase2scripts2ArgSucceeds :: forall era. AlonzoEraScript era => Script era -> Bool
phase2scripts2ArgSucceeds :: forall era. AlonzoEraScript era => Script era -> Bool
phase2scripts2ArgSucceeds Script era
script =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True forall era. TwoPhase2ArgInfo era -> Bool
getSucceeds2 forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\TwoPhase2ArgInfo era
info -> forall era. TwoPhase2ArgInfo era -> Script era
getScript2 TwoPhase2ArgInfo era
info forall a. Eq a => a -> a -> Bool
== Script era
script) forall era. AlonzoEraScript era => [TwoPhase2ArgInfo era]
phase2scripts2Arg

genPlutus2Arg :: AlonzoEraScript era => Gen (Maybe (TwoPhase2ArgInfo era))
genPlutus2Arg :: forall era.
AlonzoEraScript era =>
Gen (Maybe (TwoPhase2ArgInfo era))
genPlutus2Arg = forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
10, forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
elements forall era. AlonzoEraScript era => [TwoPhase2ArgInfo era]
phase2scripts2Arg), (Int
90, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)]

-- | Gen a Mint value in the Alonzo Era, with a 10% chance that it includes an AlonzoScript
genAlonzoMint :: Crypto c => MultiAsset c -> Gen (MultiAsset c, [AlonzoScript (AlonzoEra c)])
genAlonzoMint :: forall c.
Crypto c =>
MultiAsset c -> Gen (MultiAsset c, [AlonzoScript (AlonzoEra c)])
genAlonzoMint MultiAsset c
startvalue = do
  Maybe (TwoPhase2ArgInfo (AlonzoEra c))
ans <- forall era.
AlonzoEraScript era =>
Gen (Maybe (TwoPhase2ArgInfo era))
genPlutus2Arg
  case Maybe (TwoPhase2ArgInfo (AlonzoEra c))
ans of
    Maybe (TwoPhase2ArgInfo (AlonzoEra c))
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultiAsset c
startvalue, [])
    Just (TwoPhase2ArgInfo Script (AlonzoEra c)
script ScriptHash (EraCrypto (AlonzoEra c))
shash (Data, Natural, Natural)
_ Bool
_) -> do
      Integer
count <- forall a. Enum a => (a, a) -> Gen a
chooseEnum (Integer
1, Integer
10)
      let assetname :: AssetName
assetname = ShortByteString -> AssetName
AssetName ShortByteString
"purple"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era. [(PolicyID era, AssetName, Integer)] -> MultiAsset era
multiAssetFromList [(forall c. ScriptHash c -> PolicyID c
PolicyID ScriptHash (EraCrypto (AlonzoEra c))
shash, AssetName
assetname, Integer
count)] forall a. Semigroup a => a -> a -> a
<> MultiAsset c
startvalue, [Script (AlonzoEra c)
script])

genPair :: Gen a -> Gen b -> Gen (a, b)
genPair :: forall a b. Gen a -> Gen b -> Gen (a, b)
genPair Gen a
x Gen b
y = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen b
y

genPlutusData :: Gen P.Data
genPlutusData :: Gen Data
genPlutusData = forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
5 (forall a. (Int -> Gen a) -> Gen a
sized forall {t}. Integral t => t -> Gen Data
gendata)
  where
    gendata :: t -> Gen Data
gendata t
n
      | t
n forall a. Ord a => a -> a -> Bool
> t
0 =
          forall a. HasCallStack => [Gen a] -> Gen a
oneof
            [ Integer -> Data
P.I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
            , ByteString -> Data
P.B forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
            , [(Data, Data)] -> Data
P.Map forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf (forall a b. Gen a -> Gen b -> Gen (a, b)
genPair (t -> Gen Data
gendata (t
n forall a. Integral a => a -> a -> a
`div` t
2)) (t -> Gen Data
gendata (t
n forall a. Integral a => a -> a -> a
`div` t
2)))
            , Integer -> [Data] -> Data
P.Constr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Gen a -> Gen [a]
listOf (t -> Gen Data
gendata (t
n forall a. Integral a => a -> a -> a
`div` t
2))
            , [Data] -> Data
P.List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf (t -> Gen Data
gendata (t
n forall a. Integral a => a -> a -> a
`div` t
2))
            ]
    gendata t
_ = forall a. HasCallStack => [Gen a] -> Gen a
oneof [Integer -> Data
P.I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary, ByteString -> Data
P.B forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary]

genSet :: Ord a => Gen a -> Gen (Set a)
genSet :: forall a. Ord a => Gen a -> Gen (Set a)
genSet Gen a
gen =
  forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
Set.empty)
    , (Int
2, forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Gen a
gen])
    , (Int
1, forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Gen a
gen, Gen a
gen])
    ]

genAux :: forall c. Mock c => Constants -> Gen (StrictMaybe (AlonzoTxAuxData (AlonzoEra c)))
genAux :: forall c.
Mock c =>
Constants -> Gen (StrictMaybe (AlonzoTxAuxData (AlonzoEra c)))
genAux Constants
constants = do
  StrictMaybe (AllegraTxAuxData (MaryEra c))
maybeAux <- forall era.
EraGen era =>
Constants -> Gen (StrictMaybe (TxAuxData era))
genEraAuxiliaryData @(MaryEra c) Constants
constants
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(AllegraTxAuxData Map Word64 Metadatum
x StrictSeq (Timelock (MaryEra c))
y) -> forall (f :: * -> *) era.
(Foldable f, AlonzoEraScript era) =>
Map Word64 Metadatum -> f (AlonzoScript era) -> AlonzoTxAuxData era
mkAlonzoTxAuxData Map Word64 Metadatum
x (forall era. Timelock era -> AlonzoScript era
TimelockScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
Timelock era1 -> Timelock era2
translateTimelock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock (MaryEra c))
y))
      StrictMaybe (AllegraTxAuxData (MaryEra c))
maybeAux

instance Crypto c => ScriptClass (AlonzoEra c) where
  basescript :: Proxy (AlonzoEra c)
-> KeyHash 'Witness (EraCrypto (AlonzoEra c))
-> Script (AlonzoEra c)
basescript = forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Proxy era -> KeyHash 'Witness (EraCrypto era) -> AlonzoScript era
someLeaf
  isKey :: Proxy (AlonzoEra c)
-> Script (AlonzoEra c)
-> Maybe (KeyHash 'Witness (EraCrypto (AlonzoEra c)))
isKey Proxy (AlonzoEra c)
_ (TimelockScript Timelock (AlonzoEra c)
x) = forall era.
ScriptClass era =>
Proxy era -> Script era -> Maybe (KeyHash 'Witness (EraCrypto era))
isKey (forall {k} (t :: k). Proxy t
Proxy @(MaryEra c)) forall a b. (a -> b) -> a -> b
$ forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
Timelock era1 -> Timelock era2
translateTimelock Timelock (AlonzoEra c)
x
  isKey Proxy (AlonzoEra c)
_ (PlutusScript PlutusScript (AlonzoEra c)
_) = forall a. Maybe a
Nothing
  isOnePhase :: Proxy (AlonzoEra c) -> Script (AlonzoEra c) -> Bool
isOnePhase Proxy (AlonzoEra c)
_ (TimelockScript Timelock (AlonzoEra c)
_) = Bool
True
  isOnePhase Proxy (AlonzoEra c)
_ (PlutusScript PlutusScript (AlonzoEra c)
_) = Bool
False
  quantify :: Proxy (AlonzoEra c)
-> Script (AlonzoEra c) -> Quantifier (Script (AlonzoEra c))
quantify Proxy (AlonzoEra c)
_ (TimelockScript Timelock (AlonzoEra c)
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era. Timelock era -> AlonzoScript era
TimelockScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
Timelock era1 -> Timelock era2
translateTimelock) (forall era.
ScriptClass era =>
Proxy era -> Script era -> Quantifier (Script era)
quantify (forall {k} (t :: k). Proxy t
Proxy @(MaryEra c)) (forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
Timelock era1 -> Timelock era2
translateTimelock Timelock (AlonzoEra c)
x))
  quantify Proxy (AlonzoEra c)
_ Script (AlonzoEra c)
x = forall t. t -> Quantifier t
Leaf Script (AlonzoEra c)
x
  unQuantify :: Proxy (AlonzoEra c)
-> Quantifier (Script (AlonzoEra c)) -> Script (AlonzoEra c)
unQuantify Proxy (AlonzoEra c)
_ Quantifier (Script (AlonzoEra c))
quant =
    forall era. Timelock era -> AlonzoScript era
TimelockScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
Timelock era1 -> Timelock era2
translateTimelock forall a b. (a -> b) -> a -> b
$
      forall era.
ScriptClass era =>
Proxy era -> Quantifier (Script era) -> Script era
unQuantify (forall {k} (t :: k). Proxy t
Proxy @(MaryEra c)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
Timelock era1 -> Timelock era2
translateTimelock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. AlonzoScript era -> Timelock era
unTime) Quantifier (Script (AlonzoEra c))
quant)

unTime :: AlonzoScript era -> Timelock era
unTime :: forall era. AlonzoScript era -> Timelock era
unTime (TimelockScript Timelock era
x) = Timelock era
x
unTime (PlutusScript PlutusScript era
_) = forall a. HasCallStack => [Char] -> a
error [Char]
"Plutus in Timelock"

okAsCollateral :: forall c. Mock c => UTxO (AlonzoEra c) -> TxIn c -> Bool
okAsCollateral :: forall c. Mock c => UTxO (AlonzoEra c) -> TxIn c -> Bool
okAsCollateral UTxO (AlonzoEra c)
utxo TxIn c
inputx =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False forall c. Crypto c => TxOut (AlonzoEra c) -> Bool
vKeyLockedAdaOnly forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn c
inputx (forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO UTxO (AlonzoEra c)
utxo)

genAlonzoTxBody ::
  forall c.
  Mock c =>
  GenEnv (AlonzoEra c) ->
  UTxO (AlonzoEra c) ->
  PParams (AlonzoEra c) ->
  SlotNo ->
  Set.Set (TxIn c) ->
  StrictSeq (TxOut (AlonzoEra c)) ->
  StrictSeq (TxCert (AlonzoEra c)) ->
  Withdrawals c ->
  Coin ->
  StrictMaybe (Update (AlonzoEra c)) ->
  StrictMaybe (AuxiliaryDataHash c) ->
  Gen (TxBody (AlonzoEra c), [Script (AlonzoEra c)])
genAlonzoTxBody :: forall c.
Mock c =>
GenEnv (AlonzoEra c)
-> UTxO (AlonzoEra c)
-> PParams (AlonzoEra c)
-> SlotNo
-> Set (TxIn c)
-> StrictSeq (TxOut (AlonzoEra c))
-> StrictSeq (TxCert (AlonzoEra c))
-> Withdrawals c
-> Coin
-> StrictMaybe (Update (AlonzoEra c))
-> StrictMaybe (AuxiliaryDataHash c)
-> Gen (TxBody (AlonzoEra c), [Script (AlonzoEra c)])
genAlonzoTxBody GenEnv (AlonzoEra c)
_genenv UTxO (AlonzoEra c)
utxo PParams (AlonzoEra c)
pparams SlotNo
currentslot Set (TxIn c)
input StrictSeq (TxOut (AlonzoEra c))
txOuts StrictSeq (TxCert (AlonzoEra c))
certs Withdrawals c
withdrawals Coin
fee StrictMaybe (Update (AlonzoEra c))
updates StrictMaybe (AuxiliaryDataHash c)
auxDHash = do
  StrictMaybe Network
netid <- forall a. Gen a -> Gen (StrictMaybe a)
genM forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Network
Testnet -- frequency [(2, pure Mainnet), (1, pure Testnet)]
  MultiAsset c
startvalue <- forall c. Crypto c => Gen (MultiAsset c)
genMint
  (MultiAsset c
minted, [AlonzoScript (AlonzoEra c)]
plutusScripts) <- forall c.
Crypto c =>
MultiAsset c -> Gen (MultiAsset c, [AlonzoScript (AlonzoEra c)])
genAlonzoMint MultiAsset c
startvalue
  let (MultiAsset c
minted2, StrictSeq (AlonzoTxOut (AlonzoEra c))
txouts2) = case forall era.
(EraGen era, Value era ~ MaryValue (EraCrypto era)) =>
Proxy era
-> StrictSeq (TxOut era)
-> PParams era
-> MultiAsset (EraCrypto era)
-> StrictSeq (TxOut era)
-> Maybe (StrictSeq (TxOut era))
addTokens (forall {k} (t :: k). Proxy t
Proxy @(AlonzoEra c)) forall a. Monoid a => a
mempty PParams (AlonzoEra c)
pparams MultiAsset c
minted StrictSeq (TxOut (AlonzoEra c))
txOuts of
        Maybe (StrictSeq (TxOut (AlonzoEra c)))
Nothing -> (forall a. Monoid a => a
mempty, StrictSeq (TxOut (AlonzoEra c))
txOuts)
        Just StrictSeq (TxOut (AlonzoEra c))
os -> (MultiAsset c
minted, StrictSeq (TxOut (AlonzoEra c))
os)
      scriptsFromPolicies :: [Timelock (AlonzoEra c)]
scriptsFromPolicies = (forall era.
AllegraEraScript era =>
Map (PolicyID (EraCrypto era)) (NativeScript era)
policyIndex forall k a. Ord k => Map k a -> k -> a
Map.!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList (forall c. MultiAsset c -> Set (PolicyID c)
policies MultiAsset c
startvalue)
      txouts3 :: StrictSeq (AlonzoTxOut (AlonzoEra c))
txouts3 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c. Mock c => TxOut (AlonzoEra c) -> TxOut (AlonzoEra c)
addMaybeDataHashToTxOut StrictSeq (AlonzoTxOut (AlonzoEra c))
txouts2
  ValidityInterval
validityInterval <- SlotNo -> Gen ValidityInterval
genValidityInterval SlotNo
currentslot
  forall (m :: * -> *) a. Monad m => a -> m a
return
    ( forall era.
(EraTxOut era, EraTxCert era) =>
Set (TxIn (EraCrypto era))
-> Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (EraCrypto era))
-> MultiAsset (EraCrypto era)
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> StrictMaybe Network
-> AlonzoTxBody era
AlonzoTxBody
        Set (TxIn c)
input
        (forall a. (a -> Bool) -> Set a -> Set a
Set.filter (forall c. Mock c => UTxO (AlonzoEra c) -> TxIn c -> Bool
okAsCollateral UTxO (AlonzoEra c)
utxo) Set (TxIn c)
input) -- Set.empty -- collateral -- TODO do something better here (use genenv ?)
        StrictSeq (AlonzoTxOut (AlonzoEra c))
txouts3
        StrictSeq (TxCert (AlonzoEra c))
certs
        Withdrawals c
withdrawals
        Coin
fee
        ValidityInterval
validityInterval -- (ValidityInterval SNothing SNothing) -- (ValidityInterval low high)
        StrictMaybe (Update (AlonzoEra c))
updates
        -- reqSignerHashes
        forall a. Set a
Set.empty -- TODO do something better here
        MultiAsset c
minted2
        -- scriptIntegrityHash starts out with empty Redeemers,
        -- as Remdeemers are added it is recomputed in updateEraTxBody
        (forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity @(AlonzoEra c) forall a. Set a
Set.empty (forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers forall k a. Map k a
Map.empty) (forall era.
Era era =>
Map (DataHash (EraCrypto era)) (Data era) -> TxDats era
TxDats forall k a. Map k a
Map.empty))
        StrictMaybe (AuxiliaryDataHash c)
auxDHash
        StrictMaybe Network
netid
    , forall a b. (a -> b) -> [a] -> [b]
List.map forall era. Timelock era -> AlonzoScript era
TimelockScript [Timelock (AlonzoEra c)]
scriptsFromPolicies forall a. Semigroup a => a -> a -> a
<> [AlonzoScript (AlonzoEra c)]
plutusScripts
    )

genSlotAfter :: SlotNo -> Gen SlotNo
genSlotAfter :: SlotNo -> Gen SlotNo
genSlotAfter SlotNo
currentSlot = do
  Natural
ttl <- Natural -> Natural -> Gen Natural
genNatural Natural
50 Natural
100
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SlotNo
currentSlot forall a. Num a => a -> a -> a
+ Word64 -> SlotNo
SlotNo (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
ttl)

-- | Gen an Alonzo PParamsUpdate, by adding to a Shelley PParamsData
genAlonzoPParamsUpdate ::
  forall c.
  Crypto c =>
  Constants ->
  PParams (AlonzoEra c) ->
  Gen (PParamsUpdate (AlonzoEra c))
genAlonzoPParamsUpdate :: forall c.
Crypto c =>
Constants
-> PParams (AlonzoEra c) -> Gen (PParamsUpdate (AlonzoEra c))
genAlonzoPParamsUpdate Constants
constants PParams (AlonzoEra c)
pp = do
  PParamsUpdate (MaryEra c)
maryPPUpdate <-
    forall era.
(ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8,
 EraPParams era) =>
Constants -> PParams era -> Gen (PParamsUpdate era)
genShelleyPParamsUpdate @(MaryEra c) Constants
constants forall a b. (a -> b) -> a -> b
$
      forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
DowngradePParams Identity era
-> PParams era -> PParams (PreviousEra era)
downgradePParams (DowngradeAlonzoPParams {dappMinUTxOValue :: HKD Identity Coin
dappMinUTxOValue = Integer -> Coin
Coin Integer
100}) PParams (AlonzoEra c)
pp
  StrictMaybe CoinPerWord
coinPerWord <- forall a. Gen a -> Gen (StrictMaybe a)
genM (Coin -> CoinPerWord
CoinPerWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
5))
  let genPrice :: Gen NonNegativeInterval
genPrice = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> Ratio a
% Integer
100) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
200)
  StrictMaybe Prices
prices <- forall a. Gen a -> Gen (StrictMaybe a)
genM (NonNegativeInterval -> NonNegativeInterval -> Prices
Prices forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NonNegativeInterval
genPrice forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NonNegativeInterval
genPrice)
  StrictMaybe ExUnits
maxTxExUnits <- forall a. Gen a -> Gen (StrictMaybe a)
genM Gen ExUnits
genMaxTxExUnits
  StrictMaybe ExUnits
maxBlockExUnits <- forall a. Gen a -> Gen (StrictMaybe a)
genM Gen ExUnits
genMaxBlockExUnits
  -- Not too small for maxValSize, if this is too small then any Tx with Value
  -- that has lots of policyIds will fail. The Shelley Era uses hard coded 4000
  StrictMaybe Natural
maxValSize <- forall a. Gen a -> Gen (StrictMaybe a)
genM (Natural -> Natural -> Gen Natural
genNatural Natural
4000 Natural
5000)
  let alonzoUpgrade :: UpgradeAlonzoPParams StrictMaybe
alonzoUpgrade =
        UpgradeAlonzoPParams
          { uappCoinsPerUTxOWord :: HKD StrictMaybe CoinPerWord
uappCoinsPerUTxOWord = StrictMaybe CoinPerWord
coinPerWord
          , uappCostModels :: HKD StrictMaybe CostModels
uappCostModels = forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1]
          , uappPrices :: HKD StrictMaybe Prices
uappPrices = StrictMaybe Prices
prices
          , uappMaxTxExUnits :: HKD StrictMaybe ExUnits
uappMaxTxExUnits = StrictMaybe ExUnits
maxTxExUnits
          , uappMaxBlockExUnits :: HKD StrictMaybe ExUnits
uappMaxBlockExUnits = StrictMaybe ExUnits
maxBlockExUnits
          , uappMaxValSize :: HKD StrictMaybe Natural
uappMaxValSize = StrictMaybe Natural
maxValSize
          , uappCollateralPercentage :: HKD StrictMaybe Natural
uappCollateralPercentage = forall a. a -> StrictMaybe a
SJust Natural
25 -- percent of fee in collateral
          , uappMaxCollateralInputs :: HKD StrictMaybe Natural
uappMaxCollateralInputs = forall a. a -> StrictMaybe a
SJust Natural
100 -- max number of inputs in collateral
          }
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams StrictMaybe era
-> PParamsUpdate (PreviousEra era) -> PParamsUpdate era
upgradePParamsUpdate UpgradeAlonzoPParams StrictMaybe
alonzoUpgrade PParamsUpdate (MaryEra c)
maryPPUpdate

genAlonzoPParams ::
  forall c.
  Crypto c =>
  Constants ->
  Gen (PParams (AlonzoEra c))
genAlonzoPParams :: forall c. Crypto c => Constants -> Gen (PParams (AlonzoEra c))
genAlonzoPParams Constants
constants = do
  -- This ensures that "_d" field is not 0, and that the major protocol version
  -- is large enough to not trigger plutus script failures
  -- (no bultins are alllowed before major version 5).
  PParams (MaryEra c)
maryPP' <- forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
Constants -> Gen (PParams era)
Shelley.genPParams @(MaryEra c) Constants
constants
  let maryPP :: PParams (MaryEra c)
maryPP = PParams (MaryEra c)
maryPP' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @5) Natural
0
      prices :: Prices
prices = NonNegativeInterval -> NonNegativeInterval -> Prices
Prices forall a. Bounded a => a
minBound forall a. Bounded a => a
minBound
  CoinPerWord
coinPerWord <- Coin -> CoinPerWord
CoinPerWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
5)
  -- prices <- Prices <$> (Coin <$> choose (100, 5000)) <*> (Coin <$> choose (100, 5000))
  ExUnits
maxTxExUnits <- Gen ExUnits
genMaxTxExUnits
  ExUnits
maxBlockExUnits <- Gen ExUnits
genMaxBlockExUnits
  Natural
maxValSize <- Natural -> Natural -> Gen Natural
genNatural Natural
4000 Natural
10000 -- This can't be too small. Shelley uses Hard coded 4000
  let alonzoUpgrade :: UpgradeAlonzoPParams Identity
alonzoUpgrade =
        UpgradeAlonzoPParams
          { uappCoinsPerUTxOWord :: HKD Identity CoinPerWord
uappCoinsPerUTxOWord = CoinPerWord
coinPerWord
          , uappCostModels :: HKD Identity CostModels
uappCostModels = HasCallStack => [Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1]
          , uappPrices :: HKD Identity Prices
uappPrices = Prices
prices
          , uappMaxTxExUnits :: HKD Identity ExUnits
uappMaxTxExUnits = ExUnits
maxTxExUnits
          , uappMaxBlockExUnits :: HKD Identity ExUnits
uappMaxBlockExUnits = ExUnits
maxBlockExUnits
          , uappMaxValSize :: HKD Identity Natural
uappMaxValSize = Natural
maxValSize
          , uappCollateralPercentage :: HKD Identity Natural
uappCollateralPercentage = HKD Identity Natural
25 -- percent of fee in collateral
          , uappMaxCollateralInputs :: HKD Identity Natural
uappMaxCollateralInputs = HKD Identity Natural
100 -- max number of inputs in collateral
          }
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams Identity era
-> PParams (PreviousEra era) -> PParams era
upgradePParams UpgradeAlonzoPParams Identity
alonzoUpgrade PParams (MaryEra c)
maryPP

bigMem :: Natural
bigMem :: Natural
bigMem = Natural
50000

bigStep :: Natural
bigStep :: Natural
bigStep = Natural
99999

genMaxTxExUnits :: Gen ExUnits
genMaxTxExUnits :: Gen ExUnits
genMaxTxExUnits =
  Natural -> Natural -> ExUnits
ExUnits
    -- Accommodate the maximum number of scripts in a transaction
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Natural -> Gen Natural
genNatural (Natural
10 forall a. Num a => a -> a -> a
* Natural
bigMem forall a. Num a => a -> a -> a
+ Natural
1) (Natural
20 forall a. Num a => a -> a -> a
* Natural
bigMem forall a. Num a => a -> a -> a
+ Natural
1)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Natural -> Gen Natural
genNatural (Natural
10 forall a. Num a => a -> a -> a
* Natural
bigStep forall a. Num a => a -> a -> a
+ Natural
1) (Natural
20 forall a. Num a => a -> a -> a
* Natural
bigStep forall a. Num a => a -> a -> a
+ Natural
1)

genMaxBlockExUnits :: Gen ExUnits
genMaxBlockExUnits :: Gen ExUnits
genMaxBlockExUnits =
  Natural -> Natural -> ExUnits
ExUnits
    -- Accommodate the maximum number of scripts in all transactions in a block
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Natural -> Gen Natural
genNatural (Natural
60 forall a. Num a => a -> a -> a
* Natural
bigMem forall a. Num a => a -> a -> a
+ Natural
1) (Natural
100 forall a. Num a => a -> a -> a
* Natural
bigMem forall a. Num a => a -> a -> a
+ Natural
1)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Natural -> Gen Natural
genNatural (Natural
60 forall a. Num a => a -> a -> a
* Natural
bigStep forall a. Num a => a -> a -> a
+ Natural
1) (Natural
100 forall a. Num a => a -> a -> a
* Natural
bigStep forall a. Num a => a -> a -> a
+ Natural
1)

instance Mock c => EraGen (AlonzoEra c) where
  genEraAuxiliaryData :: Constants -> Gen (StrictMaybe (TxAuxData (AlonzoEra c)))
genEraAuxiliaryData = forall c.
Mock c =>
Constants -> Gen (StrictMaybe (AlonzoTxAuxData (AlonzoEra c)))
genAux
  genGenesisValue :: GenEnv (AlonzoEra c) -> Gen (Value (AlonzoEra c))
genGenesisValue = forall era c. GenEnv era -> Gen (MaryValue c)
maryGenesisValue
  genEraTwoPhase3Arg :: [TwoPhase3ArgInfo (AlonzoEra c)]
genEraTwoPhase3Arg = forall era. AlonzoEraScript era => [TwoPhase3ArgInfo era]
phase2scripts3Arg
  genEraTwoPhase2Arg :: [TwoPhase2ArgInfo (AlonzoEra c)]
genEraTwoPhase2Arg = forall era. AlonzoEraScript era => [TwoPhase2ArgInfo era]
phase2scripts2Arg

  genEraTxBody :: GenEnv (AlonzoEra c)
-> UTxO (AlonzoEra c)
-> PParams (AlonzoEra c)
-> SlotNo
-> Set (TxIn (EraCrypto (AlonzoEra c)))
-> StrictSeq (TxOut (AlonzoEra c))
-> StrictSeq (TxCert (AlonzoEra c))
-> Withdrawals (EraCrypto (AlonzoEra c))
-> Coin
-> StrictMaybe (Update (AlonzoEra c))
-> StrictMaybe (AuxiliaryDataHash (EraCrypto (AlonzoEra c)))
-> Gen (TxBody (AlonzoEra c), [Script (AlonzoEra c)])
genEraTxBody = forall c.
Mock c =>
GenEnv (AlonzoEra c)
-> UTxO (AlonzoEra c)
-> PParams (AlonzoEra c)
-> SlotNo
-> Set (TxIn c)
-> StrictSeq (TxOut (AlonzoEra c))
-> StrictSeq (TxCert (AlonzoEra c))
-> Withdrawals c
-> Coin
-> StrictMaybe (Update (AlonzoEra c))
-> StrictMaybe (AuxiliaryDataHash c)
-> Gen (TxBody (AlonzoEra c), [Script (AlonzoEra c)])
genAlonzoTxBody
  updateEraTxBody :: UTxO (AlonzoEra c)
-> PParams (AlonzoEra c)
-> TxWits (AlonzoEra c)
-> TxBody (AlonzoEra c)
-> Coin
-> Set (TxIn (EraCrypto (AlonzoEra c)))
-> TxOut (AlonzoEra c)
-> TxBody (AlonzoEra c)
updateEraTxBody UTxO (AlonzoEra c)
utxo PParams (AlonzoEra c)
pp TxWits (AlonzoEra c)
wits TxBody (AlonzoEra c)
txb Coin
coinx Set (TxIn (EraCrypto (AlonzoEra c)))
txin TxOut (AlonzoEra c)
txout =
    TxBody (AlonzoEra c)
txb
      { atbInputs :: Set (TxIn (EraCrypto (AlonzoEra c)))
atbInputs = Set (TxIn (EraCrypto (AlonzoEra c)))
newInputs
      , atbCollateral :: Set (TxIn (EraCrypto (AlonzoEra c)))
atbCollateral = Set (TxIn c)
newCollaterals
      , atbTxFee :: Coin
atbTxFee = Coin
coinx
      , atbOutputs :: StrictSeq (TxOut (AlonzoEra c))
atbOutputs = StrictSeq (TxOut (AlonzoEra c))
newOutputs
      , -- The wits may have changed, recompute the scriptIntegrityHash.
        atbScriptIntegrityHash :: StrictMaybe (ScriptIntegrityHash (EraCrypto (AlonzoEra c)))
atbScriptIntegrityHash =
          forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity
            Set LangDepView
langViews
            (TxWits (AlonzoEra c)
wits forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL)
            (TxWits (AlonzoEra c)
wits forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
datsTxWitsL)
      }
    where
      langs :: Set Language
langs = forall era.
AlonzoEraScript era =>
Map (ScriptHash (EraCrypto era)) (Script era) -> Set Language
langsUsed @(AlonzoEra c) (TxWits (AlonzoEra c)
wits forall s a. s -> Getting a s a -> a
^. forall era.
EraTxWits era =>
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
scriptTxWitsL)
      langViews :: Set LangDepView
langViews = forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
getLanguageView PParams (AlonzoEra c)
pp) Set Language
langs
      requiredCollateral :: Integer
requiredCollateral = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (PParams (AlonzoEra c)
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppCollateralPercentageL) forall a. Num a => a -> a -> a
* Coin -> Integer
unCoin Coin
coinx forall a. Integral a => a -> a -> Ratio a
% Integer
100
      potentialCollateral :: Set (TxIn c)
potentialCollateral = forall a. (a -> Bool) -> Set a -> Set a
Set.filter (forall c. Mock c => UTxO (AlonzoEra c) -> TxIn c -> Bool
okAsCollateral UTxO (AlonzoEra c)
utxo) Set (TxIn (EraCrypto (AlonzoEra c)))
txin
      txInAmounts :: Set (TxIn c) -> [(TxIn c, Integer)]
txInAmounts = forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Coin -> Integer
unCoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting a s a -> s -> a
view forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. UTxO era -> Set (TxIn (EraCrypto era)) -> UTxO era
txInsFilter UTxO (AlonzoEra c)
utxo
      takeUntilSum :: b -> [(b, b)] -> [b]
takeUntilSum b
s = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> Bool) -> [a] -> [a]
takeUntil ((b
s forall a. Ord a => a -> a -> Bool
>=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> [a] -> [a]
scanl1 (\(b
_, b
s') (b
x, b
n) -> (b
x, b
s' forall a. Num a => a -> a -> a
+ b
n))
      takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil a -> Bool
p [a]
xs = let ([a]
y, [a]
n) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
p [a]
xs in [a]
y forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
1 [a]
n
      newCollaterals :: Set (TxIn c)
newCollaterals =
        if forall era. Redeemers era -> Bool
nullRedeemers (TxWits (AlonzoEra c)
wits forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL)
          then forall a. Monoid a => a
mempty
          else forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b} {b}. (Ord b, Num b) => b -> [(b, b)] -> [b]
takeUntilSum Integer
requiredCollateral forall a b. (a -> b) -> a -> b
$ Set (TxIn c) -> [(TxIn c, Integer)]
txInAmounts Set (TxIn c)
potentialCollateral
      newInputs :: Set (TxIn (EraCrypto (AlonzoEra c)))
newInputs = forall era.
(EraTxOut era, EraTxCert era) =>
AlonzoTxBody era -> Set (TxIn (EraCrypto era))
atbInputs TxBody (AlonzoEra c)
txb forall a. Semigroup a => a -> a -> a
<> Set (TxIn (EraCrypto (AlonzoEra c)))
txin
      newOutputs :: StrictSeq (TxOut (AlonzoEra c))
newOutputs = forall era.
(EraTxOut era, EraTxCert era) =>
AlonzoTxBody era -> StrictSeq (TxOut era)
atbOutputs TxBody (AlonzoEra c)
txb forall a. StrictSeq a -> a -> StrictSeq a
:|> TxOut (AlonzoEra c)
txout

  addInputs :: TxBody (AlonzoEra c)
-> Set (TxIn (EraCrypto (AlonzoEra c))) -> TxBody (AlonzoEra c)
addInputs TxBody (AlonzoEra c)
txb Set (TxIn (EraCrypto (AlonzoEra c)))
txin = TxBody (AlonzoEra c)
txb {atbInputs :: Set (TxIn (EraCrypto (AlonzoEra c)))
atbInputs = forall era.
(EraTxOut era, EraTxCert era) =>
AlonzoTxBody era -> Set (TxIn (EraCrypto era))
atbInputs TxBody (AlonzoEra c)
txb forall a. Semigroup a => a -> a -> a
<> Set (TxIn (EraCrypto (AlonzoEra c)))
txin}

  genEraPParamsUpdate :: Constants
-> PParams (AlonzoEra c) -> Gen (PParamsUpdate (AlonzoEra c))
genEraPParamsUpdate = forall c.
Crypto c =>
Constants
-> PParams (AlonzoEra c) -> Gen (PParamsUpdate (AlonzoEra c))
genAlonzoPParamsUpdate
  genEraPParams :: Constants -> Gen (PParams (AlonzoEra c))
genEraPParams = forall c. Crypto c => Constants -> Gen (PParams (AlonzoEra c))
genAlonzoPParams
  genEraTxWits :: (UTxO (AlonzoEra c), TxBody (AlonzoEra c),
 ScriptInfo (AlonzoEra c))
-> Set (WitVKey 'Witness (EraCrypto (AlonzoEra c)))
-> Map
     (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
-> TxWits (AlonzoEra c)
genEraTxWits (UTxO (AlonzoEra c)
utxo, TxBody (AlonzoEra c)
txbody, ScriptInfo (AlonzoEra c)
scriptinfo) Set (WitVKey 'Witness (EraCrypto (AlonzoEra c)))
setWitVKey Map (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
mapScriptWit = AlonzoTxWits (AlonzoEra c)
new
    where
      new :: AlonzoTxWits (AlonzoEra c)
new =
        forall era.
AlonzoEraScript era =>
Set (WitVKey 'Witness (EraCrypto era))
-> Set (BootstrapWitness (EraCrypto era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWits era
AlonzoTxWits
          Set (WitVKey 'Witness (EraCrypto (AlonzoEra c)))
setWitVKey
          forall a. Set a
Set.empty
          Map (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
mapScriptWit
          -- (dataMapFromTxOut (Prelude.foldr (:) [] (outputs' txbody)) (TxDats (getDataMap scriptinfo mapScriptWit)))
          (forall c.
Mock c =>
[TxOut (AlonzoEra c)]
-> TxDats (AlonzoEra c) -> TxDats (AlonzoEra c)
dataMapFromTxOut [TxOut (AlonzoEra c)]
smallUtxo (forall era.
Era era =>
Map (DataHash (EraCrypto era)) (Data era) -> TxDats era
TxDats (forall era.
Era era =>
ScriptInfo era
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Map (DataHash (EraCrypto era)) (Data era)
getDataMap ScriptInfo (AlonzoEra c)
scriptinfo Map (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
mapScriptWit)))
          -- The data hashes come from two places
          (forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
rdmrMap)
      txinputs :: Set (TxIn (EraCrypto (AlonzoEra c)))
txinputs = forall era. AlonzoTxBody era -> Set (TxIn (EraCrypto era))
inputs' TxBody (AlonzoEra c)
txbody
      smallUtxo :: [TxOut (AlonzoEra c)]
      smallUtxo :: [TxOut (AlonzoEra c)]
smallUtxo = forall k a. Map k a -> [a]
Map.elems (forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO (forall era. UTxO era -> Set (TxIn (EraCrypto era)) -> UTxO era
txInsFilter UTxO (AlonzoEra c)
utxo Set (TxIn (EraCrypto (AlonzoEra c)))
txinputs))
      AlonzoScriptsNeeded [(PlutusPurpose AsIxItem (AlonzoEra c),
  ScriptHash (EraCrypto (AlonzoEra c)))]
purposeHashPairs = forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded @(AlonzoEra c) UTxO (AlonzoEra c)
utxo TxBody (AlonzoEra c)
txbody
      rdmrMap :: Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
rdmrMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
-> (AlonzoPlutusPurpose AsIxItem (AlonzoEra c), ScriptHash c)
-> Map
     (AlonzoPlutusPurpose AsIx (AlonzoEra c))
     (Data (AlonzoEra c), ExUnits)
accum forall k a. Map k a
Map.empty [(PlutusPurpose AsIxItem (AlonzoEra c),
  ScriptHash (EraCrypto (AlonzoEra c)))]
purposeHashPairs -- Search through the pairs for Plutus scripts
      accum :: Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
-> (AlonzoPlutusPurpose AsIxItem (AlonzoEra c), ScriptHash c)
-> Map
     (AlonzoPlutusPurpose AsIx (AlonzoEra c))
     (Data (AlonzoEra c), ExUnits)
accum Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
ans (AlonzoPlutusPurpose AsIxItem (AlonzoEra c)
purpose, ScriptHash c
hash1) =
        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash c
hash1 Map (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
mapScriptWit of
          Maybe (AlonzoScript (AlonzoEra c))
Nothing -> Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
ans
          Just AlonzoScript (AlonzoEra c)
script ->
            if forall era. EraScript era => Script era -> Bool
isNativeScript @(AlonzoEra c) AlonzoScript (AlonzoEra c)
script
              then Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
ans -- Native scripts don't have redeemers
              else case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash c
hash1 (forall a b. (a, b) -> a
fst ScriptInfo (AlonzoEra c)
scriptinfo) of -- It could be one of the known 3-Arg Plutus Scripts
                Just TwoPhase3ArgInfo (AlonzoEra c)
info -> forall c.
Crypto c =>
(Data, Natural, Natural)
-> AlonzoPlutusPurpose AsIxItem (AlonzoEra c)
-> Map
     (AlonzoPlutusPurpose AsIx (AlonzoEra c))
     (Data (AlonzoEra c), ExUnits)
-> Map
     (AlonzoPlutusPurpose AsIx (AlonzoEra c))
     (Data (AlonzoEra c), ExUnits)
addRedeemMap (forall era. TwoPhase3ArgInfo era -> (Data, Natural, Natural)
getRedeemer3 TwoPhase3ArgInfo (AlonzoEra c)
info) AlonzoPlutusPurpose AsIxItem (AlonzoEra c)
purpose Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
ans -- Add it to the redeemer map
                Maybe (TwoPhase3ArgInfo (AlonzoEra c))
Nothing -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash c
hash1 (forall a b. (a, b) -> b
snd ScriptInfo (AlonzoEra c)
scriptinfo) of -- It could be one of the known 2-Arg Plutus Scripts
                  Just TwoPhase2ArgInfo (AlonzoEra c)
info -> forall c.
Crypto c =>
(Data, Natural, Natural)
-> AlonzoPlutusPurpose AsIxItem (AlonzoEra c)
-> Map
     (AlonzoPlutusPurpose AsIx (AlonzoEra c))
     (Data (AlonzoEra c), ExUnits)
-> Map
     (AlonzoPlutusPurpose AsIx (AlonzoEra c))
     (Data (AlonzoEra c), ExUnits)
addRedeemMap (forall era. TwoPhase2ArgInfo era -> (Data, Natural, Natural)
getRedeemer2 TwoPhase2ArgInfo (AlonzoEra c)
info) AlonzoPlutusPurpose AsIxItem (AlonzoEra c)
purpose Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
ans -- Add it to the redeemer map
                  Maybe (TwoPhase2ArgInfo (AlonzoEra c))
Nothing -> Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
ans

  constructTx :: TxBody (AlonzoEra c)
-> TxWits (AlonzoEra c)
-> StrictMaybe (TxAuxData (AlonzoEra c))
-> Tx (AlonzoEra c)
constructTx TxBody (AlonzoEra c)
bod TxWits (AlonzoEra c)
wit StrictMaybe (TxAuxData (AlonzoEra c))
auxdata = forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (AlonzoEra c)
bod TxWits (AlonzoEra c)
wit (Bool -> IsValid
IsValid Bool
v) StrictMaybe (TxAuxData (AlonzoEra c))
auxdata
    where
      v :: Bool
v = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all AlonzoScript (AlonzoEra c) -> Bool
twoPhaseValidates (forall era.
Era era =>
AlonzoTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
txscripts' TxWits (AlonzoEra c)
wit)
      twoPhaseValidates :: AlonzoScript (AlonzoEra c) -> Bool
twoPhaseValidates AlonzoScript (AlonzoEra c)
script =
        forall era. EraScript era => Script era -> Bool
isNativeScript @(AlonzoEra c) AlonzoScript (AlonzoEra c)
script
          Bool -> Bool -> Bool
|| (forall era. AlonzoEraScript era => Script era -> Bool
phase2scripts3ArgSucceeds AlonzoScript (AlonzoEra c)
script Bool -> Bool -> Bool
&& forall era. AlonzoEraScript era => Script era -> Bool
phase2scripts2ArgSucceeds AlonzoScript (AlonzoEra c)
script)

  genEraGoodTxOut :: TxOut (AlonzoEra c) -> Bool
genEraGoodTxOut = forall c. Crypto c => TxOut (AlonzoEra c) -> Bool
vKeyLockedAdaOnly

  genEraScriptCost :: PParams (AlonzoEra c) -> Script (AlonzoEra c) -> Coin
genEraScriptCost PParams (AlonzoEra c)
pp Script (AlonzoEra c)
script =
    if forall era. AlonzoEraScript era => Script era -> Bool
isPlutusScript Script (AlonzoEra c)
script
      then case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\TwoPhase3ArgInfo (AlonzoEra c)
info -> forall era. TwoPhase3ArgInfo era -> Script era
getScript3 @(AlonzoEra c) TwoPhase3ArgInfo (AlonzoEra c)
info forall a. Eq a => a -> a -> Bool
== Script (AlonzoEra c)
script) forall era. EraGen era => [TwoPhase3ArgInfo era]
genEraTwoPhase3Arg of
        Just (TwoPhase3ArgInfo Script (AlonzoEra c)
_script ScriptHash (EraCrypto (AlonzoEra c))
_hash Data
inputdata (Data
rdmr, Natural
mems, Natural
steps) Bool
_succeed) ->
          Prices -> ExUnits -> Coin
txscriptfee (PParams (AlonzoEra c)
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
ppPricesL) (Natural -> Natural -> ExUnits
ExUnits Natural
mems Natural
steps)
            forall t. Val t => t -> t -> t
<+> forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
10 PParams (AlonzoEra c)
pp (Data
rdmr, Natural -> Natural -> ExUnits
ExUnits Natural
mems Natural
steps) -- Extra 10 for the RdmrPtr
            forall t. Val t => t -> t -> t
<+> forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
32 PParams (AlonzoEra c)
pp Data
inputdata -- Extra 32 for the hash
            forall t. Val t => t -> t -> t
<+> forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
0 PParams (AlonzoEra c)
pp Script (AlonzoEra c)
script
        Maybe (TwoPhase3ArgInfo (AlonzoEra c))
Nothing -> forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
0 PParams (AlonzoEra c)
pp Script (AlonzoEra c)
script
      else forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
0 PParams (AlonzoEra c)
pp Script (AlonzoEra c)
script

  -- For some reason, the EraGen generators occasionally generate an extra script witness.
  --    There is some evidence that this arises because the script hash appears as the PolicyId
  --    in a Value. But that is not been verified. Regardless of the cause, we can fix this by
  --    discarding the trace. Note that this is failure to generate a "random" but valid
  --    transaction. Discarding the trace adjust for this inadequacy in the generation process.
  --    This only appears in the Alonzo era, so this "fix" is applied here, in the genEraDone
  --    method of the EraGen class in the (AlonzoEra c) instance.
  genEraDone :: UTxO (AlonzoEra c)
-> PParams (AlonzoEra c)
-> Tx (AlonzoEra c)
-> Gen (Tx (AlonzoEra c))
genEraDone UTxO (AlonzoEra c)
utxo PParams (AlonzoEra c)
pp Tx (AlonzoEra c)
tx =
    let theFee :: Coin
theFee = Tx (AlonzoEra c)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL -- Coin supplied to pay fees
        minimumFee :: Coin
minimumFee = forall era.
EraUTxO era =>
PParams era -> Tx era -> UTxO era -> Coin
getMinFeeTxUtxo @(AlonzoEra c) PParams (AlonzoEra c)
pp Tx (AlonzoEra c)
tx UTxO (AlonzoEra c)
utxo
        neededHashes :: Set (ScriptHash (EraCrypto (AlonzoEra c)))
neededHashes = forall era.
EraUTxO era =>
ScriptsNeeded era -> Set (ScriptHash (EraCrypto era))
getScriptsHashesNeeded forall a b. (a -> b) -> a -> b
$ forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded UTxO (AlonzoEra c)
utxo (Tx (AlonzoEra c)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL)
        oldScriptWits :: Map (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
oldScriptWits = Tx (AlonzoEra c)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxWits era =>
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
scriptTxWitsL
        newWits :: Map (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
newWits = Map (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
oldScriptWits forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set (ScriptHash (EraCrypto (AlonzoEra c)))
neededHashes
     in if Coin
minimumFee forall a. Ord a => a -> a -> Bool
<= Coin
theFee
          then
            if Map (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
oldScriptWits forall a. Eq a => a -> a -> Bool
== Map (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
newWits
              then forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx (AlonzoEra c)
tx
              else forall a. [Char] -> a
tracedDiscard forall a b. (a -> b) -> a -> b
$ [Char]
"Random extra scriptwitness: genEraDone: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Map (ScriptHash (EraCrypto (AlonzoEra c))) (Script (AlonzoEra c))
newWits
          else forall a. [Char] -> a
tracedDiscard forall a b. (a -> b) -> a -> b
$ [Char]
"MinFee violation: genEraDone: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Coin
theFee

  genEraTweakBlock :: PParams (AlonzoEra c)
-> Seq (Tx (AlonzoEra c)) -> Gen (Seq (Tx (AlonzoEra c)))
genEraTweakBlock PParams (AlonzoEra c)
pp Seq (Tx (AlonzoEra c))
txns =
    let txTotal, ppMax :: ExUnits
        txTotal :: ExUnits
txTotal = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
totExUnits Seq (Tx (AlonzoEra c))
txns
        ppMax :: ExUnits
ppMax = PParams (AlonzoEra c)
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxBlockExUnitsL
     in if (Natural -> Natural -> Bool) -> ExUnits -> ExUnits -> Bool
pointWiseExUnits forall a. Ord a => a -> a -> Bool
(<=) ExUnits
txTotal ExUnits
ppMax
          then forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq (Tx (AlonzoEra c))
txns
          else
            forall a. [Char] -> a
tracedDiscard forall a b. (a -> b) -> a -> b
$
              [Char]
"TotExUnits violation: genEraTweakBlock: "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (ExUnits -> ExUnits' Natural
unWrapExUnits ExUnits
txTotal)
                forall a. Semigroup a => a -> a -> a
<> [Char]
" instead of "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (ExUnits -> ExUnits' Natural
unWrapExUnits ExUnits
ppMax)

  hasFailedScripts :: Tx (AlonzoEra c) -> Bool
hasFailedScripts Tx (AlonzoEra c)
tx = Bool -> IsValid
IsValid Bool
False forall a. Eq a => a -> a -> Bool
== Tx (AlonzoEra c)
tx forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL

  feeOrCollateral :: Tx (AlonzoEra c) -> UTxO (AlonzoEra c) -> Coin
feeOrCollateral Tx (AlonzoEra c)
tx UTxO (AlonzoEra c)
utxo =
    case Tx (AlonzoEra c)
tx forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL of
      IsValid Bool
True -> Tx (AlonzoEra c)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL
      IsValid Bool
False -> forall era.
(EraTx era, AlonzoEraTxBody era) =>
Tx era -> UTxO era -> Coin
sumCollateral Tx (AlonzoEra c)
tx UTxO (AlonzoEra c)
utxo

sumCollateral :: (EraTx era, AlonzoEraTxBody era) => Tx era -> UTxO era -> Coin
sumCollateral :: forall era.
(EraTx era, AlonzoEraTxBody era) =>
Tx era -> UTxO era -> Coin
sumCollateral Tx era
tx UTxO era
utxo =
  forall era. EraTxOut era => UTxO era -> Coin
coinBalance forall a b. (a -> b) -> a -> b
$ forall era. UTxO era -> Set (TxIn (EraCrypto era)) -> UTxO era
txInsFilter UTxO era
utxo forall a b. (a -> b) -> a -> b
$ Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
collateralInputsTxBodyL

storageCost :: forall era t. (EraPParams era, EncCBOR t) => Integer -> PParams era -> t -> Coin
storageCost :: forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
extra PParams era
pp t
x = (Integer
extra forall a. Num a => a -> a -> a
+ forall era t. (Era era, EncCBOR t) => t -> Integer
encodedLen @era t
x) forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL

addRedeemMap ::
  forall c.
  Crypto c =>
  (P.Data, Natural, Natural) ->
  AlonzoPlutusPurpose AsIxItem (AlonzoEra c) ->
  Map (AlonzoPlutusPurpose AsIx (AlonzoEra c)) (Data (AlonzoEra c), ExUnits) ->
  Map (AlonzoPlutusPurpose AsIx (AlonzoEra c)) (Data (AlonzoEra c), ExUnits)
addRedeemMap :: forall c.
Crypto c =>
(Data, Natural, Natural)
-> AlonzoPlutusPurpose AsIxItem (AlonzoEra c)
-> Map
     (AlonzoPlutusPurpose AsIx (AlonzoEra c))
     (Data (AlonzoEra c), ExUnits)
-> Map
     (AlonzoPlutusPurpose AsIx (AlonzoEra c))
     (Data (AlonzoEra c), ExUnits)
addRedeemMap (Data
dat, Natural
space, Natural
steps) AlonzoPlutusPurpose AsIxItem (AlonzoEra c)
purpose Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
ans =
  let ptr :: PlutusPurpose AsIx (AlonzoEra c)
ptr = forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose forall ix it. AsIxItem ix it -> AsIx ix it
toAsIx AlonzoPlutusPurpose AsIxItem (AlonzoEra c)
purpose
   in forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PlutusPurpose AsIx (AlonzoEra c)
ptr (forall era. Era era => Data -> Data era
Data Data
dat, Natural -> Natural -> ExUnits
ExUnits Natural
space Natural
steps) Map
  (AlonzoPlutusPurpose AsIx (AlonzoEra c))
  (Data (AlonzoEra c), ExUnits)
ans

getDataMap ::
  forall era.
  Era era =>
  ScriptInfo era ->
  Map (ScriptHash (EraCrypto era)) (Script era) ->
  Map (DataHash (EraCrypto era)) (Data era)
getDataMap :: forall era.
Era era =>
ScriptInfo era
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Map (DataHash (EraCrypto era)) (Data era)
getDataMap (Map (ScriptHash (EraCrypto era)) (TwoPhase3ArgInfo era)
scriptInfo3, Map (ScriptHash (EraCrypto era)) (TwoPhase2ArgInfo era)
_) = forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (DataHash (EraCrypto era)) (Data era)
-> ScriptHash (EraCrypto era)
-> Script era
-> Map (DataHash (EraCrypto era)) (Data era)
accum forall k a. Map k a
Map.empty
  where
    accum :: Map (DataHash (EraCrypto era)) (Data era)
-> ScriptHash (EraCrypto era)
-> Script era
-> Map (DataHash (EraCrypto era)) (Data era)
accum Map (DataHash (EraCrypto era)) (Data era)
ans ScriptHash (EraCrypto era)
hsh Script era
_script =
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash (EraCrypto era)
hsh Map (ScriptHash (EraCrypto era)) (TwoPhase3ArgInfo era)
scriptInfo3 of
        Maybe (TwoPhase3ArgInfo era)
Nothing -> Map (DataHash (EraCrypto era)) (Data era)
ans
        Just (TwoPhase3ArgInfo Script era
_script ScriptHash (EraCrypto era)
_hash Data
dat (Data, Natural, Natural)
_redeem Bool
_) ->
          forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall era. Era era => Data -> DataHash (EraCrypto era)
hashData @era Data
dat) (forall era. Era era => Data -> Data era
Data Data
dat) Map (DataHash (EraCrypto era)) (Data era)
ans

instance Mock c => MinGenTxout (AlonzoEra c) where
  calcEraMinUTxO :: TxOut (AlonzoEra c) -> PParams (AlonzoEra c) -> Coin
calcEraMinUTxO TxOut (AlonzoEra c)
txOut PParams (AlonzoEra c)
pp = forall era. AlonzoEraTxOut era => TxOut era -> Integer
utxoEntrySize TxOut (AlonzoEra c)
txOut forall t i. (Val t, Integral i) => i -> t -> t
<×> CoinPerWord -> Coin
unCoinPerWord (PParams (AlonzoEra c)
pp forall s a. s -> Getting a s a -> a
^. forall era.
(AlonzoEraPParams era, ExactEra AlonzoEra era) =>
Lens' (PParams era) CoinPerWord
ppCoinsPerUTxOWordL)
  addValToTxOut :: Value (AlonzoEra c) -> TxOut (AlonzoEra c) -> TxOut (AlonzoEra c)
addValToTxOut Value (AlonzoEra c)
v (AlonzoTxOut Addr (EraCrypto (AlonzoEra c))
a Value (AlonzoEra c)
u StrictMaybe (DataHash (EraCrypto (AlonzoEra c)))
_b) = forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut Addr (EraCrypto (AlonzoEra c))
a (Value (AlonzoEra c)
v forall t. Val t => t -> t -> t
<+> Value (AlonzoEra c)
u) (forall c. Mock c => Addr c -> StrictMaybe (DataHash c)
dataFromAddr Addr (EraCrypto (AlonzoEra c))
a)
  genEraTxOut :: GenEnv (AlonzoEra c)
-> Gen (Value (AlonzoEra c))
-> [Addr (EraCrypto (AlonzoEra c))]
-> Gen [TxOut (AlonzoEra c)]
genEraTxOut GenEnv (AlonzoEra c)
genv Gen (Value (AlonzoEra c))
genVal [Addr (EraCrypto (AlonzoEra c))]
addrs = do
    [MaryValue c]
values <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Addr (EraCrypto (AlonzoEra c))]
addrs) Gen (Value (AlonzoEra c))
genVal
    let makeTxOut :: Addr c -> MaryValue c -> AlonzoTxOut (AlonzoEra c)
makeTxOut Addr c
addr MaryValue c
val =
          case Addr c
addr of
            Addr Network
_network (ScriptHashObj ScriptHash c
shash) StakeReference c
_stakeref ->
              forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut Addr c
addr MaryValue c
val forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall era.
Era era =>
GenEnv era
-> ScriptHash (EraCrypto era)
-> (Script era, StrictMaybe (DataHash (EraCrypto era)))
findPlutus GenEnv (AlonzoEra c)
genv ScriptHash c
shash
            Addr c
_ -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut Addr c
addr MaryValue c
val forall a. StrictMaybe a
SNothing
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Addr c -> MaryValue c -> AlonzoTxOut (AlonzoEra c)
makeTxOut [Addr (EraCrypto (AlonzoEra c))]
addrs [MaryValue c]
values)

-- | If an Address is script address, we can find a potential data hash for it from
--   genEraTwoPhase3Arg, which contains all known 3 arg plutus scripts in the tests set.
-- If the script has is not in that map, then its data hash is SNothing.
dataFromAddr :: forall c. Mock c => Addr c -> StrictMaybe (DataHash c)
dataFromAddr :: forall c. Mock c => Addr c -> StrictMaybe (DataHash c)
dataFromAddr (Addr Network
_network (ScriptHashObj ScriptHash c
shash) StakeReference c
_stakeref) =
  let f :: TwoPhase3ArgInfo (AlonzoEra c) -> Bool
f TwoPhase3ArgInfo (AlonzoEra c)
info = ScriptHash c
shash forall a. Eq a => a -> a -> Bool
== forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @(AlonzoEra c) (forall era. TwoPhase3ArgInfo era -> Script era
getScript3 @(AlonzoEra c) TwoPhase3ArgInfo (AlonzoEra c)
info)
   in case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find TwoPhase3ArgInfo (AlonzoEra c) -> Bool
f forall era. EraGen era => [TwoPhase3ArgInfo era]
genEraTwoPhase3Arg of
        Just TwoPhase3ArgInfo (AlonzoEra c)
info -> forall a. a -> StrictMaybe a
SJust (forall era. Era era => Data -> DataHash (EraCrypto era)
hashData @(AlonzoEra c) (forall era. TwoPhase3ArgInfo era -> Data
getData3 TwoPhase3ArgInfo (AlonzoEra c)
info))
        Maybe (TwoPhase3ArgInfo (AlonzoEra c))
Nothing -> forall a. StrictMaybe a
SNothing
dataFromAddr Addr c
_ = forall a. StrictMaybe a
SNothing

-- | We can find the data associated with the data hashes in the TxOuts, since
--   genEraTwoPhase3Arg, which contains all known 3 arg plutus scripts stores the data.
dataMapFromTxOut ::
  forall c.
  Mock c =>
  [TxOut (AlonzoEra c)] ->
  TxDats (AlonzoEra c) ->
  TxDats (AlonzoEra c)
dataMapFromTxOut :: forall c.
Mock c =>
[TxOut (AlonzoEra c)]
-> TxDats (AlonzoEra c) -> TxDats (AlonzoEra c)
dataMapFromTxOut [TxOut (AlonzoEra c)]
txouts TxDats (AlonzoEra c)
datahashmap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl TxDats (AlonzoEra c)
-> AlonzoTxOut (AlonzoEra c) -> TxDats (AlonzoEra c)
accum TxDats (AlonzoEra c)
datahashmap [TxOut (AlonzoEra c)]
txouts
  where
    f :: DataHash c -> TwoPhase3ArgInfo (AlonzoEra c) -> Bool
f DataHash c
dhash TwoPhase3ArgInfo (AlonzoEra c)
info = forall era. Era era => Data -> DataHash (EraCrypto era)
hashData @(AlonzoEra c) (forall era. TwoPhase3ArgInfo era -> Data
getData3 TwoPhase3ArgInfo (AlonzoEra c)
info) forall a. Eq a => a -> a -> Bool
== DataHash c
dhash
    accum :: TxDats (AlonzoEra c)
-> AlonzoTxOut (AlonzoEra c) -> TxDats (AlonzoEra c)
accum !TxDats (AlonzoEra c)
ans (AlonzoTxOut Addr (EraCrypto (AlonzoEra c))
_ Value (AlonzoEra c)
_ StrictMaybe (DataHash (EraCrypto (AlonzoEra c)))
SNothing) = TxDats (AlonzoEra c)
ans
    accum ans :: TxDats (AlonzoEra c)
ans@(TxDats' Map (DataHash (EraCrypto (AlonzoEra c))) (Data (AlonzoEra c))
m) (AlonzoTxOut Addr (EraCrypto (AlonzoEra c))
_ Value (AlonzoEra c)
_ (SJust DataHash (EraCrypto (AlonzoEra c))
dhash)) =
      case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (DataHash c -> TwoPhase3ArgInfo (AlonzoEra c) -> Bool
f DataHash (EraCrypto (AlonzoEra c))
dhash) (forall era. EraGen era => [TwoPhase3ArgInfo era]
genEraTwoPhase3Arg @(AlonzoEra c)) of
        Just TwoPhase3ArgInfo (AlonzoEra c)
info -> forall era.
Era era =>
Map (DataHash (EraCrypto era)) (Data era) -> TxDats era
TxDats (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert DataHash (EraCrypto (AlonzoEra c))
dhash (forall era. Era era => Data -> Data era
Data (forall era. TwoPhase3ArgInfo era -> Data
getData3 TwoPhase3ArgInfo (AlonzoEra c)
info)) Map (DataHash (EraCrypto (AlonzoEra c))) (Data (AlonzoEra c))
m)
        Maybe (TwoPhase3ArgInfo (AlonzoEra c))
Nothing -> TxDats (AlonzoEra c)
ans

addMaybeDataHashToTxOut :: Mock c => TxOut (AlonzoEra c) -> TxOut (AlonzoEra c)
addMaybeDataHashToTxOut :: forall c. Mock c => TxOut (AlonzoEra c) -> TxOut (AlonzoEra c)
addMaybeDataHashToTxOut (AlonzoTxOut Addr (EraCrypto (AlonzoEra c))
addr Value (AlonzoEra c)
val StrictMaybe (DataHash (EraCrypto (AlonzoEra c)))
_) = forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut Addr (EraCrypto (AlonzoEra c))
addr Value (AlonzoEra c)
val (forall c. Mock c => Addr c -> StrictMaybe (DataHash c)
dataFromAddr Addr (EraCrypto (AlonzoEra c))
addr)

someLeaf ::
  forall era.
  ( AllegraEraScript era
  , NativeScript era ~ Timelock era
  ) =>
  Proxy era ->
  KeyHash 'Witness (EraCrypto era) ->
  AlonzoScript era
someLeaf :: forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Proxy era -> KeyHash 'Witness (EraCrypto era) -> AlonzoScript era
someLeaf Proxy era
_proxy KeyHash 'Witness (EraCrypto era)
keyHash =
  let
    -- We use KeyHash as a source of entropy for initialization of an StdGen for
    -- generating slot and mode
    (Word64
s, StdGen
g) = forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Word64
0, Word64
199) forall a b. (a -> b) -> a -> b
$ forall x. EncCBOR x => x -> StdGen
mkHashStdGen KeyHash 'Witness (EraCrypto era)
keyHash
    slot :: SlotNo
slot = Word64 -> SlotNo
SlotNo Word64
s
    (Int
mode, StdGen
_) = forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
0 :: Int, Int
2) StdGen
g -- mode==0 is a time leaf,  mode 1 or 2 is a signature leaf
   in
    case Int
mode of
      Int
0 ->
        forall era. Timelock era -> AlonzoScript era
TimelockScript forall a b. (a -> b) -> a -> b
$
          (forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> StrictSeq a
Seq.fromList) [forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart SlotNo
slot, forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire SlotNo
slot]
      Int
_ -> forall era. Timelock era -> AlonzoScript era
TimelockScript forall a b. (a -> b) -> a -> b
$ forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature KeyHash 'Witness (EraCrypto era)
keyHash

-- | given the "txscripts" field of the TxWits, compute the set of languages used in a transaction
langsUsed ::
  AlonzoEraScript era =>
  Map.Map (ScriptHash (EraCrypto era)) (Script era) ->
  Set Language
langsUsed :: forall era.
AlonzoEraScript era =>
Map (ScriptHash (EraCrypto era)) (Script era) -> Set Language
langsUsed Map (ScriptHash (EraCrypto era)) (Script era)
hashScriptMap =
  forall a. Ord a => [a] -> Set a
Set.fromList
    [ forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript
    | Script era
script <- forall k a. Map k a -> [a]
Map.elems Map (ScriptHash (EraCrypto era)) (Script era)
hashScriptMap
    , Just PlutusScript era
plutusScript <- [forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
toPlutusScript Script era
script]
    ]