{-# 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.Plutus.Context (EraPlutusTxInfo, mkSupportedPlutusScript)
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 (
  AlonzoTxOut (..),
  TxBody (..),
  utxoEntrySize,
 )
import Cardano.Ledger.Alonzo.TxWits (
  AlonzoTxWits (..),
  Redeemers (..),
  TxDats (..),
  unRedeemersL,
 )
import Cardano.Ledger.Alonzo.UTxO (AlonzoScriptsNeeded (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (EncCBOR)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (Credential (..))
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.State (
  EraUTxO (..),
  UTxO (..),
  getScriptsNeeded,
  sumCoinUTxO,
  txInsFilter,
 )
import Cardano.Ledger.TxIn (TxIn)
import Cardano.Ledger.Val (Val (isAdaOnly, (<+>), (<×>)))
import Control.Monad (replicateM)
import Data.Foldable as F
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 ()
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 (alwaysFailsPlutus, alwaysSucceedsPlutus, zeroTestingCostModels)
import Test.Cardano.Ledger.Plutus.Examples
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 :: TxOut AlonzoEra -> Bool
vKeyLockedAdaOnly :: TxOut AlonzoEra -> Bool
vKeyLockedAdaOnly TxOut AlonzoEra
txOut = TxOut AlonzoEra -> Bool
forall era. EraTxOut era => TxOut era -> Bool
vKeyLocked TxOut AlonzoEra
txOut Bool -> Bool -> Bool
&& Value AlonzoEra -> Bool
forall t. Val t => t -> Bool
isAdaOnly (TxOut AlonzoEra
AlonzoTxOut AlonzoEra
txOut AlonzoTxOut AlonzoEra
-> Getting
     (Value AlonzoEra) (AlonzoTxOut AlonzoEra) (Value AlonzoEra)
-> Value AlonzoEra
forall s a. s -> Getting a s a -> a
^. (Value AlonzoEra -> Const (Value AlonzoEra) (Value AlonzoEra))
-> TxOut AlonzoEra -> Const (Value AlonzoEra) (TxOut AlonzoEra)
Getting (Value AlonzoEra) (AlonzoTxOut AlonzoEra) (Value AlonzoEra)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut AlonzoEra) (Value AlonzoEra)
valueTxOutL)

phase2scripts3Arg :: EraPlutusTxInfo 'PlutusV1 era => [TwoPhase3ArgInfo era]
phase2scripts3Arg :: forall era. EraPlutusTxInfo 'PlutusV1 era => [TwoPhase3ArgInfo era]
phase2scripts3Arg =
  [ PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (forall (l :: Language). Nat -> Plutus l
alwaysSucceedsPlutus @'PlutusV1 Nat
3))
      (Integer -> Data
P.I Integer
1)
      (Integer -> Data
P.I Integer
1, Nat
bigMem, Nat
bigStep)
      Bool
True
  , PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (SLanguage 'PlutusV1 -> Plutus 'PlutusV1
forall (l :: Language). SLanguage l -> Plutus l
redeemerSameAsDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
9)
      (Integer -> Data
P.I Integer
9, Nat
bigMem, Nat
bigStep)
      Bool
True
  , PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (SLanguage 'PlutusV1 -> Plutus 'PlutusV1
forall (l :: Language). SLanguage l -> Plutus l
evenDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
8)
      (Integer -> Data
P.I Integer
8, Nat
bigMem, Nat
bigStep)
      Bool
True
  , PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (forall (l :: Language). Nat -> Plutus l
alwaysFailsPlutus @'PlutusV1 Nat
3))
      (Integer -> Data
P.I Integer
1)
      (Integer -> Data
P.I Integer
1, Nat
bigMem, Nat
bigStep)
      Bool
False
  , PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (SLanguage 'PlutusV1 -> Plutus 'PlutusV1
forall (l :: Language). SLanguage l -> Plutus l
purposeIsWellformedWithDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
3)
      (Integer -> Data
P.I Integer
4, Nat
bigMem, Nat
bigStep)
      Bool
True
  , PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (SLanguage 'PlutusV1 -> Plutus 'PlutusV1
forall (l :: Language). SLanguage l -> Plutus l
datumIsWellformed SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
5)
      (Integer -> Data
P.I Integer
6, Nat
bigMem, Nat
bigStep)
      Bool
True
  , PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (SLanguage 'PlutusV1 -> Plutus 'PlutusV1
forall (l :: Language). SLanguage l -> Plutus l
inputsOutputsAreNotEmptyWithDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
7)
      (Integer -> Data
P.I Integer
9, Nat
bigMem, Nat
bigStep)
      Bool
True
  ]
  where
    mkTwoPhase3ArgInfo :: PlutusScript era
-> Data -> (Data, Nat, Nat) -> Bool -> TwoPhase3ArgInfo era
mkTwoPhase3ArgInfo PlutusScript era
plutusScript =
      let script :: Script era
script = PlutusScript era -> Script era
forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript PlutusScript era
plutusScript
       in Script era
-> ScriptHash
-> Data
-> (Data, Nat, Nat)
-> Bool
-> TwoPhase3ArgInfo era
forall era.
Script era
-> ScriptHash
-> Data
-> (Data, Nat, Nat)
-> Bool
-> TwoPhase3ArgInfo era
TwoPhase3ArgInfo Script era
script (Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script)

phase2scripts2Arg :: EraPlutusTxInfo 'PlutusV1 era => [TwoPhase2ArgInfo era]
phase2scripts2Arg :: forall era. EraPlutusTxInfo 'PlutusV1 era => [TwoPhase2ArgInfo era]
phase2scripts2Arg =
  [ PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (forall (l :: Language). Nat -> Plutus l
alwaysSucceedsPlutus @'PlutusV1 Nat
2))
      (Integer -> Data
P.I Integer
1, Nat
bigMem, Nat
bigStep)
      Bool
True
  , PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (SLanguage 'PlutusV1 -> Plutus 'PlutusV1
forall (l :: Language). SLanguage l -> Plutus l
evenRedeemerNoDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
14, Nat
bigMem, Nat
bigStep)
      Bool
True
  , PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (forall (l :: Language). Nat -> Plutus l
alwaysFailsPlutus @'PlutusV1 Nat
2))
      (Integer -> Data
P.I Integer
1, Nat
bigMem, Nat
bigStep)
      Bool
False
  , PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (SLanguage 'PlutusV1 -> Plutus 'PlutusV1
forall (l :: Language). SLanguage l -> Plutus l
purposeIsWellformedNoDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
14, Nat
bigMem, Nat
bigStep)
      Bool
True
  , PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo
      (Plutus 'PlutusV1 -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (SLanguage 'PlutusV1 -> Plutus 'PlutusV1
forall (l :: Language). SLanguage l -> Plutus l
inputsOutputsAreNotEmptyNoDatum SLanguage 'PlutusV1
SPlutusV1))
      (Integer -> Data
P.I Integer
15, Nat
bigMem, Nat
bigStep)
      Bool
True
  ]
  where
    mkTwoPhase2ArgInfo :: PlutusScript era
-> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
mkTwoPhase2ArgInfo PlutusScript era
plutusScript =
      let script :: Script era
script = PlutusScript era -> Script era
forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript PlutusScript era
plutusScript
       in Script era
-> ScriptHash -> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
forall era.
Script era
-> ScriptHash -> (Data, Nat, Nat) -> Bool -> TwoPhase2ArgInfo era
TwoPhase2ArgInfo Script era
script (Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script)

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

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

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

-- | Gen a Mint value in the Alonzo Era, with a 10% chance that it includes an AlonzoScript
genAlonzoMint :: MultiAsset -> Gen (MultiAsset, [AlonzoScript AlonzoEra])
genAlonzoMint :: MultiAsset -> Gen (MultiAsset, [AlonzoScript AlonzoEra])
genAlonzoMint MultiAsset
startvalue = do
  Maybe (TwoPhase2ArgInfo AlonzoEra)
ans <- Gen (Maybe (TwoPhase2ArgInfo AlonzoEra))
forall era.
EraPlutusTxInfo 'PlutusV1 era =>
Gen (Maybe (TwoPhase2ArgInfo era))
genPlutus2Arg
  case Maybe (TwoPhase2ArgInfo AlonzoEra)
ans of
    Maybe (TwoPhase2ArgInfo AlonzoEra)
Nothing -> (MultiAsset, [AlonzoScript AlonzoEra])
-> Gen (MultiAsset, [AlonzoScript AlonzoEra])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultiAsset
startvalue, [])
    Just (TwoPhase2ArgInfo Script AlonzoEra
script ScriptHash
shash (Data, Nat, Nat)
_ Bool
_) -> do
      Integer
count <- (Integer, Integer) -> Gen Integer
forall a. Enum a => (a, a) -> Gen a
chooseEnum (Integer
1, Integer
10)
      let assetname :: AssetName
assetname = ShortByteString -> AssetName
AssetName ShortByteString
"purple"
      (MultiAsset, [AlonzoScript AlonzoEra])
-> Gen (MultiAsset, [AlonzoScript AlonzoEra])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(PolicyID, AssetName, Integer)] -> MultiAsset
multiAssetFromList [(ScriptHash -> PolicyID
PolicyID ScriptHash
shash, AssetName
assetname, Integer
count)] MultiAsset -> MultiAsset -> MultiAsset
forall a. Semigroup a => a -> a -> a
<> MultiAsset
startvalue, [Script AlonzoEra
AlonzoScript AlonzoEra
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 = (,) (a -> b -> (a, b)) -> Gen a -> Gen (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
x Gen (b -> (a, b)) -> Gen b -> Gen (a, b)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen b
y

genPlutusData :: Gen P.Data
genPlutusData :: Gen Data
genPlutusData = Int -> Gen Data -> Gen Data
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
5 ((Int -> Gen Data) -> Gen Data
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen Data
forall {t}. Integral t => t -> Gen Data
gendata)
  where
    gendata :: t -> Gen Data
gendata t
n
      | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0 =
          [Gen Data] -> Gen Data
forall a. HasCallStack => [Gen a] -> Gen a
oneof
            [ Integer -> Data
P.I (Integer -> Data) -> Gen Integer -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
            , ByteString -> Data
P.B (ByteString -> Data) -> Gen ByteString -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary
            , [(Data, Data)] -> Data
P.Map ([(Data, Data)] -> Data) -> Gen [(Data, Data)] -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Data, Data) -> Gen [(Data, Data)]
forall a. Gen a -> Gen [a]
listOf (Gen Data -> Gen Data -> Gen (Data, Data)
forall a b. Gen a -> Gen b -> Gen (a, b)
genPair (t -> Gen Data
gendata (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2)) (t -> Gen Data
gendata (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2)))
            , Integer -> [Data] -> Data
P.Constr (Integer -> [Data] -> Data) -> Gen Integer -> Gen ([Data] -> Data)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary Gen ([Data] -> Data) -> Gen [Data] -> Gen Data
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Data -> Gen [Data]
forall a. Gen a -> Gen [a]
listOf (t -> Gen Data
gendata (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2))
            , [Data] -> Data
P.List ([Data] -> Data) -> Gen [Data] -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Data -> Gen [Data]
forall a. Gen a -> Gen [a]
listOf (t -> Gen Data
gendata (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2))
            ]
    gendata t
_ = [Gen Data] -> Gen Data
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Integer -> Data
P.I (Integer -> Data) -> Gen Integer -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary, ByteString -> Data
P.B (ByteString -> Data) -> Gen ByteString -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
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 =
  [(Int, Gen (Set a))] -> Gen (Set a)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, Set a -> Gen (Set a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
forall a. Set a
Set.empty)
    , (Int
2, [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> Gen [a] -> Gen (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen a] -> Gen [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Gen a
gen])
    , (Int
1, [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> Gen [a] -> Gen (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen a] -> Gen [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Gen a
gen, Gen a
gen])
    ]

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

instance ScriptClass AlonzoEra where
  basescript :: Proxy AlonzoEra -> KeyHash 'Witness -> Script AlonzoEra
basescript = Proxy AlonzoEra -> KeyHash 'Witness -> Script AlonzoEra
Proxy AlonzoEra -> KeyHash 'Witness -> AlonzoScript AlonzoEra
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
Proxy era -> KeyHash 'Witness -> AlonzoScript era
someLeaf
  isKey :: Proxy AlonzoEra -> Script AlonzoEra -> Maybe (KeyHash 'Witness)
isKey Proxy AlonzoEra
_ (TimelockScript Timelock AlonzoEra
x) = Proxy MaryEra -> Script MaryEra -> Maybe (KeyHash 'Witness)
forall era.
ScriptClass era =>
Proxy era -> Script era -> Maybe (KeyHash 'Witness)
isKey (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @MaryEra) (Script MaryEra -> Maybe (KeyHash 'Witness))
-> Script MaryEra -> Maybe (KeyHash 'Witness)
forall a b. (a -> b) -> a -> b
$ Timelock AlonzoEra -> Timelock MaryEra
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock Timelock AlonzoEra
x
  isKey Proxy AlonzoEra
_ (PlutusScript PlutusScript AlonzoEra
_) = Maybe (KeyHash 'Witness)
forall a. Maybe a
Nothing
  isOnePhase :: Proxy AlonzoEra -> Script AlonzoEra -> Bool
isOnePhase Proxy AlonzoEra
_ (TimelockScript Timelock AlonzoEra
_) = Bool
True
  isOnePhase Proxy AlonzoEra
_ (PlutusScript PlutusScript AlonzoEra
_) = Bool
False
  quantify :: Proxy AlonzoEra
-> Script AlonzoEra -> Quantifier (Script AlonzoEra)
quantify Proxy AlonzoEra
_ (TimelockScript Timelock AlonzoEra
x) = (Timelock MaryEra -> AlonzoScript AlonzoEra)
-> Quantifier (Timelock MaryEra)
-> Quantifier (AlonzoScript AlonzoEra)
forall a b. (a -> b) -> Quantifier a -> Quantifier b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Timelock AlonzoEra -> AlonzoScript AlonzoEra
forall era. Timelock era -> AlonzoScript era
TimelockScript (Timelock AlonzoEra -> AlonzoScript AlonzoEra)
-> (Timelock MaryEra -> Timelock AlonzoEra)
-> Timelock MaryEra
-> AlonzoScript AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timelock MaryEra -> Timelock AlonzoEra
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock) (Proxy MaryEra -> Script MaryEra -> Quantifier (Script MaryEra)
forall era.
ScriptClass era =>
Proxy era -> Script era -> Quantifier (Script era)
quantify (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @MaryEra) (Timelock AlonzoEra -> Timelock MaryEra
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock Timelock AlonzoEra
x))
  quantify Proxy AlonzoEra
_ Script AlonzoEra
x = AlonzoScript AlonzoEra -> Quantifier (AlonzoScript AlonzoEra)
forall t. t -> Quantifier t
Leaf Script AlonzoEra
AlonzoScript AlonzoEra
x
  unQuantify :: Proxy AlonzoEra
-> Quantifier (Script AlonzoEra) -> Script AlonzoEra
unQuantify Proxy AlonzoEra
_ Quantifier (Script AlonzoEra)
quant =
    Timelock AlonzoEra -> Script AlonzoEra
Timelock AlonzoEra -> AlonzoScript AlonzoEra
forall era. Timelock era -> AlonzoScript era
TimelockScript (Timelock AlonzoEra -> Script AlonzoEra)
-> (Timelock MaryEra -> Timelock AlonzoEra)
-> Timelock MaryEra
-> Script AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timelock MaryEra -> Timelock AlonzoEra
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock (Timelock MaryEra -> Script AlonzoEra)
-> Timelock MaryEra -> Script AlonzoEra
forall a b. (a -> b) -> a -> b
$
      Proxy MaryEra -> Quantifier (Script MaryEra) -> Script MaryEra
forall era.
ScriptClass era =>
Proxy era -> Quantifier (Script era) -> Script era
unQuantify (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @MaryEra) ((AlonzoScript AlonzoEra -> Timelock MaryEra)
-> Quantifier (AlonzoScript AlonzoEra)
-> Quantifier (Timelock MaryEra)
forall a b. (a -> b) -> Quantifier a -> Quantifier b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Timelock AlonzoEra -> Timelock MaryEra
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock (Timelock AlonzoEra -> Timelock MaryEra)
-> (AlonzoScript AlonzoEra -> Timelock AlonzoEra)
-> AlonzoScript AlonzoEra
-> Timelock MaryEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoScript AlonzoEra -> Timelock AlonzoEra
forall era. AlonzoScript era -> Timelock era
unTime) Quantifier (Script AlonzoEra)
Quantifier (AlonzoScript AlonzoEra)
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
_) = [Char] -> Timelock era
forall a. HasCallStack => [Char] -> a
error [Char]
"Plutus in Timelock"

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

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

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

-- | Gen an Alonzo PParamsUpdate, by adding to a Shelley PParamsData
genAlonzoPParamsUpdate ::
  Constants ->
  PParams AlonzoEra ->
  Gen (PParamsUpdate AlonzoEra)
genAlonzoPParamsUpdate :: Constants -> PParams AlonzoEra -> Gen (PParamsUpdate AlonzoEra)
genAlonzoPParamsUpdate Constants
constants PParams AlonzoEra
pp = do
  PParamsUpdate MaryEra
maryPPUpdate <-
    forall era.
(ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8,
 EraPParams era) =>
Constants -> PParams era -> Gen (PParamsUpdate era)
genShelleyPParamsUpdate @MaryEra Constants
constants (PParams MaryEra -> Gen (PParamsUpdate MaryEra))
-> PParams MaryEra -> Gen (PParamsUpdate MaryEra)
forall a b. (a -> b) -> a -> b
$
      DowngradePParams Identity AlonzoEra
-> PParams AlonzoEra -> PParams (PreviousEra AlonzoEra)
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
pp
  StrictMaybe CoinPerWord
coinPerWord <- Gen CoinPerWord -> Gen (StrictMaybe CoinPerWord)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Coin -> CoinPerWord
CoinPerWord (Coin -> CoinPerWord)
-> (Integer -> Coin) -> Integer -> CoinPerWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> CoinPerWord) -> Gen Integer -> Gen CoinPerWord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
5))
  let genPrice :: Gen NonNegativeInterval
genPrice = Rational -> NonNegativeInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> NonNegativeInterval)
-> (Integer -> Rational) -> Integer -> NonNegativeInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
100) (Integer -> NonNegativeInterval)
-> Gen Integer -> Gen NonNegativeInterval
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
200)
  StrictMaybe Prices
prices <- Gen Prices -> Gen (StrictMaybe Prices)
forall a. Gen a -> Gen (StrictMaybe a)
genM (NonNegativeInterval -> NonNegativeInterval -> Prices
Prices (NonNegativeInterval -> NonNegativeInterval -> Prices)
-> Gen NonNegativeInterval -> Gen (NonNegativeInterval -> Prices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NonNegativeInterval
genPrice Gen (NonNegativeInterval -> Prices)
-> Gen NonNegativeInterval -> Gen Prices
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NonNegativeInterval
genPrice)
  StrictMaybe ExUnits
maxTxExUnits <- Gen ExUnits -> Gen (StrictMaybe ExUnits)
forall a. Gen a -> Gen (StrictMaybe a)
genM Gen ExUnits
genMaxTxExUnits
  StrictMaybe ExUnits
maxBlockExUnits <- Gen ExUnits -> Gen (StrictMaybe ExUnits)
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 Nat
maxValSize <- Gen Nat -> Gen (StrictMaybe Nat)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Nat -> Nat -> Gen Nat
genNatural Nat
4000 Nat
5000)
  let alonzoUpgrade :: UpgradeAlonzoPParams StrictMaybe
alonzoUpgrade =
        UpgradeAlonzoPParams
          { uappCoinsPerUTxOWord :: HKD StrictMaybe CoinPerWord
uappCoinsPerUTxOWord = StrictMaybe CoinPerWord
HKD StrictMaybe CoinPerWord
coinPerWord
          , uappCostModels :: HKD StrictMaybe CostModels
uappCostModels = CostModels -> StrictMaybe CostModels
forall a. a -> StrictMaybe a
SJust (CostModels -> StrictMaybe CostModels)
-> CostModels -> StrictMaybe CostModels
forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
[Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1]
          , uappPrices :: HKD StrictMaybe Prices
uappPrices = StrictMaybe Prices
HKD StrictMaybe Prices
prices
          , uappMaxTxExUnits :: HKD StrictMaybe ExUnits
uappMaxTxExUnits = StrictMaybe ExUnits
HKD StrictMaybe ExUnits
maxTxExUnits
          , uappMaxBlockExUnits :: HKD StrictMaybe ExUnits
uappMaxBlockExUnits = StrictMaybe ExUnits
HKD StrictMaybe ExUnits
maxBlockExUnits
          , uappMaxValSize :: HKD StrictMaybe Nat
uappMaxValSize = StrictMaybe Nat
HKD StrictMaybe Nat
maxValSize
          , uappCollateralPercentage :: HKD StrictMaybe Nat
uappCollateralPercentage = Nat -> StrictMaybe Nat
forall a. a -> StrictMaybe a
SJust Nat
25 -- percent of fee in collateral
          , uappMaxCollateralInputs :: HKD StrictMaybe Nat
uappMaxCollateralInputs = Nat -> StrictMaybe Nat
forall a. a -> StrictMaybe a
SJust Nat
100 -- max number of inputs in collateral
          }
  PParamsUpdate AlonzoEra -> Gen (PParamsUpdate AlonzoEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParamsUpdate AlonzoEra -> Gen (PParamsUpdate AlonzoEra))
-> PParamsUpdate AlonzoEra -> Gen (PParamsUpdate AlonzoEra)
forall a b. (a -> b) -> a -> b
$ UpgradePParams StrictMaybe AlonzoEra
-> PParamsUpdate (PreviousEra AlonzoEra) -> PParamsUpdate AlonzoEra
forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams StrictMaybe era
-> PParamsUpdate (PreviousEra era) -> PParamsUpdate era
upgradePParamsUpdate UpgradePParams StrictMaybe AlonzoEra
UpgradeAlonzoPParams StrictMaybe
alonzoUpgrade PParamsUpdate (PreviousEra AlonzoEra)
PParamsUpdate MaryEra
maryPPUpdate

genAlonzoPParams ::
  Constants ->
  Gen (PParams AlonzoEra)
genAlonzoPParams :: Constants -> Gen (PParams AlonzoEra)
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
maryPP' <- forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
Constants -> Gen (PParams era)
Shelley.genPParams @MaryEra Constants
constants
  let maryPP :: PParams MaryEra
maryPP = PParams MaryEra
maryPP' PParams MaryEra
-> (PParams MaryEra -> PParams MaryEra) -> PParams MaryEra
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer)
-> PParams MaryEra -> Identity (PParams MaryEra)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams MaryEra) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams MaryEra -> Identity (PParams MaryEra))
-> ProtVer -> PParams MaryEra -> PParams MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version -> Nat -> ProtVer
ProtVer (forall (v :: Nat). (KnownNat v, 0 <= v, v <= MaxVersion) => Version
natVersion @5) Nat
0
      prices :: Prices
prices = NonNegativeInterval -> NonNegativeInterval -> Prices
Prices NonNegativeInterval
forall a. Bounded a => a
minBound NonNegativeInterval
forall a. Bounded a => a
minBound
  CoinPerWord
coinPerWord <- Coin -> CoinPerWord
CoinPerWord (Coin -> CoinPerWord)
-> (Integer -> Coin) -> Integer -> CoinPerWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> CoinPerWord) -> Gen Integer -> Gen CoinPerWord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
5)
  -- prices <- Prices <$> (Coin <$> choose (100, 5000)) <*> (Coin <$> choose (100, 5000))
  ExUnits
maxTxExUnits <- Gen ExUnits
genMaxTxExUnits
  ExUnits
maxBlockExUnits <- Gen ExUnits
genMaxBlockExUnits
  Nat
maxValSize <- Nat -> Nat -> Gen Nat
genNatural Nat
4000 Nat
10000 -- This can't be too small. Shelley uses Hard coded 4000
  let alonzoUpgrade :: UpgradeAlonzoPParams Identity
alonzoUpgrade =
        UpgradeAlonzoPParams
          { uappCoinsPerUTxOWord :: HKD Identity CoinPerWord
uappCoinsPerUTxOWord = CoinPerWord
HKD Identity CoinPerWord
coinPerWord
          , uappCostModels :: HKD Identity CostModels
uappCostModels = HasCallStack => [Language] -> CostModels
[Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1]
          , uappPrices :: HKD Identity Prices
uappPrices = Prices
HKD Identity Prices
prices
          , uappMaxTxExUnits :: HKD Identity ExUnits
uappMaxTxExUnits = ExUnits
HKD Identity ExUnits
maxTxExUnits
          , uappMaxBlockExUnits :: HKD Identity ExUnits
uappMaxBlockExUnits = ExUnits
HKD Identity ExUnits
maxBlockExUnits
          , uappMaxValSize :: HKD Identity Nat
uappMaxValSize = Nat
HKD Identity Nat
maxValSize
          , uappCollateralPercentage :: HKD Identity Nat
uappCollateralPercentage = Nat
HKD Identity Nat
25 -- percent of fee in collateral
          , uappMaxCollateralInputs :: HKD Identity Nat
uappMaxCollateralInputs = Nat
HKD Identity Nat
100 -- max number of inputs in collateral
          }
  PParams AlonzoEra -> Gen (PParams AlonzoEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams AlonzoEra -> Gen (PParams AlonzoEra))
-> PParams AlonzoEra -> Gen (PParams AlonzoEra)
forall a b. (a -> b) -> a -> b
$ UpgradePParams Identity AlonzoEra
-> PParams (PreviousEra AlonzoEra) -> PParams AlonzoEra
forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams Identity era
-> PParams (PreviousEra era) -> PParams era
upgradePParams UpgradePParams Identity AlonzoEra
UpgradeAlonzoPParams Identity
alonzoUpgrade PParams (PreviousEra AlonzoEra)
PParams MaryEra
maryPP

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

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

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

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

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

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

  addInputs :: TxBody AlonzoEra -> Set TxIn -> TxBody AlonzoEra
addInputs TxBody AlonzoEra
txb Set TxIn
txin = TxBody AlonzoEra
txb {atbInputs = atbInputs txb <> txin}

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

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

  genEraGoodTxOut :: TxOut AlonzoEra -> Bool
genEraGoodTxOut = TxOut AlonzoEra -> Bool
vKeyLockedAdaOnly

  genEraScriptCost :: PParams AlonzoEra -> Script AlonzoEra -> Coin
genEraScriptCost PParams AlonzoEra
pp Script AlonzoEra
script =
    if Script AlonzoEra -> Bool
forall era. AlonzoEraScript era => Script era -> Bool
isPlutusScript Script AlonzoEra
script
      then case (TwoPhase3ArgInfo AlonzoEra -> Bool)
-> [TwoPhase3ArgInfo AlonzoEra]
-> Maybe (TwoPhase3ArgInfo AlonzoEra)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\TwoPhase3ArgInfo AlonzoEra
info -> forall era. TwoPhase3ArgInfo era -> Script era
getScript3 @AlonzoEra TwoPhase3ArgInfo AlonzoEra
info AlonzoScript AlonzoEra -> AlonzoScript AlonzoEra -> Bool
forall a. Eq a => a -> a -> Bool
== Script AlonzoEra
AlonzoScript AlonzoEra
script) [TwoPhase3ArgInfo AlonzoEra]
forall era. EraGen era => [TwoPhase3ArgInfo era]
genEraTwoPhase3Arg of
        Just (TwoPhase3ArgInfo Script AlonzoEra
_script ScriptHash
_hash Data
inputdata (Data
rdmr, Nat
mems, Nat
steps) Bool
_succeed) ->
          Prices -> ExUnits -> Coin
txscriptfee (PParams AlonzoEra
pp PParams AlonzoEra
-> Getting Prices (PParams AlonzoEra) Prices -> Prices
forall s a. s -> Getting a s a -> a
^. Getting Prices (PParams AlonzoEra) Prices
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams AlonzoEra) Prices
ppPricesL) (Nat -> Nat -> ExUnits
ExUnits Nat
mems Nat
steps)
            Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Integer -> PParams AlonzoEra -> (Data, ExUnits) -> Coin
forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
10 PParams AlonzoEra
pp (Data
rdmr, Nat -> Nat -> ExUnits
ExUnits Nat
mems Nat
steps) -- Extra 10 for the RdmrPtr
            Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Integer -> PParams AlonzoEra -> Data -> Coin
forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
32 PParams AlonzoEra
pp Data
inputdata -- Extra 32 for the hash
            Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Integer -> PParams AlonzoEra -> AlonzoScript AlonzoEra -> Coin
forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
0 PParams AlonzoEra
pp Script AlonzoEra
AlonzoScript AlonzoEra
script
        Maybe (TwoPhase3ArgInfo AlonzoEra)
Nothing -> Integer -> PParams AlonzoEra -> AlonzoScript AlonzoEra -> Coin
forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
0 PParams AlonzoEra
pp Script AlonzoEra
AlonzoScript AlonzoEra
script
      else Integer -> PParams AlonzoEra -> AlonzoScript AlonzoEra -> Coin
forall era t.
(EraPParams era, EncCBOR t) =>
Integer -> PParams era -> t -> Coin
storageCost Integer
0 PParams AlonzoEra
pp Script AlonzoEra
AlonzoScript AlonzoEra
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 instance.
  genEraDone :: UTxO AlonzoEra
-> PParams AlonzoEra -> Tx AlonzoEra -> Gen (Tx AlonzoEra)
genEraDone UTxO AlonzoEra
utxo PParams AlonzoEra
pp Tx AlonzoEra
tx =
    let theFee :: Coin
theFee = Tx AlonzoEra
AlonzoTx AlonzoEra
tx AlonzoTx AlonzoEra
-> Getting Coin (AlonzoTx AlonzoEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody AlonzoEra -> Const Coin (TxBody AlonzoEra))
-> Tx AlonzoEra -> Const Coin (Tx AlonzoEra)
(TxBody AlonzoEra -> Const Coin (TxBody AlonzoEra))
-> AlonzoTx AlonzoEra -> Const Coin (AlonzoTx AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx AlonzoEra) (TxBody AlonzoEra)
bodyTxL ((TxBody AlonzoEra -> Const Coin (TxBody AlonzoEra))
 -> AlonzoTx AlonzoEra -> Const Coin (AlonzoTx AlonzoEra))
-> ((Coin -> Const Coin Coin)
    -> TxBody AlonzoEra -> Const Coin (TxBody AlonzoEra))
-> Getting Coin (AlonzoTx AlonzoEra) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody AlonzoEra -> Const Coin (TxBody AlonzoEra)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody AlonzoEra) Coin
feeTxBodyL -- Coin supplied to pay fees
        minimumFee :: Coin
minimumFee = forall era.
EraUTxO era =>
PParams era -> Tx era -> UTxO era -> Coin
getMinFeeTxUtxo @AlonzoEra PParams AlonzoEra
pp Tx AlonzoEra
tx UTxO AlonzoEra
utxo
        neededHashes :: Set ScriptHash
neededHashes = ScriptsNeeded AlonzoEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (ScriptsNeeded AlonzoEra -> Set ScriptHash)
-> ScriptsNeeded AlonzoEra -> Set ScriptHash
forall a b. (a -> b) -> a -> b
$ UTxO AlonzoEra -> TxBody AlonzoEra -> ScriptsNeeded AlonzoEra
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded UTxO AlonzoEra
utxo (Tx AlonzoEra
AlonzoTx AlonzoEra
tx AlonzoTx AlonzoEra
-> Getting
     (TxBody AlonzoEra) (AlonzoTx AlonzoEra) (TxBody AlonzoEra)
-> TxBody AlonzoEra
forall s a. s -> Getting a s a -> a
^. (TxBody AlonzoEra -> Const (TxBody AlonzoEra) (TxBody AlonzoEra))
-> Tx AlonzoEra -> Const (TxBody AlonzoEra) (Tx AlonzoEra)
Getting (TxBody AlonzoEra) (AlonzoTx AlonzoEra) (TxBody AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx AlonzoEra) (TxBody AlonzoEra)
bodyTxL)
        oldScriptWits :: Map ScriptHash (Script AlonzoEra)
oldScriptWits = Tx AlonzoEra
AlonzoTx AlonzoEra
tx AlonzoTx AlonzoEra
-> Getting
     (Map ScriptHash (Script AlonzoEra))
     (AlonzoTx AlonzoEra)
     (Map ScriptHash (Script AlonzoEra))
-> Map ScriptHash (Script AlonzoEra)
forall s a. s -> Getting a s a -> a
^. (TxWits AlonzoEra
 -> Const (Map ScriptHash (Script AlonzoEra)) (TxWits AlonzoEra))
-> Tx AlonzoEra
-> Const (Map ScriptHash (Script AlonzoEra)) (Tx AlonzoEra)
(TxWits AlonzoEra
 -> Const (Map ScriptHash (Script AlonzoEra)) (TxWits AlonzoEra))
-> AlonzoTx AlonzoEra
-> Const (Map ScriptHash (Script AlonzoEra)) (AlonzoTx AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx AlonzoEra) (TxWits AlonzoEra)
witsTxL ((TxWits AlonzoEra
  -> Const (Map ScriptHash (Script AlonzoEra)) (TxWits AlonzoEra))
 -> AlonzoTx AlonzoEra
 -> Const (Map ScriptHash (Script AlonzoEra)) (AlonzoTx AlonzoEra))
-> ((Map ScriptHash (Script AlonzoEra)
     -> Const
          (Map ScriptHash (Script AlonzoEra))
          (Map ScriptHash (Script AlonzoEra)))
    -> TxWits AlonzoEra
    -> Const (Map ScriptHash (Script AlonzoEra)) (TxWits AlonzoEra))
-> Getting
     (Map ScriptHash (Script AlonzoEra))
     (AlonzoTx AlonzoEra)
     (Map ScriptHash (Script AlonzoEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script AlonzoEra)
 -> Const
      (Map ScriptHash (Script AlonzoEra))
      (Map ScriptHash (Script AlonzoEra)))
-> TxWits AlonzoEra
-> Const (Map ScriptHash (Script AlonzoEra)) (TxWits AlonzoEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits AlonzoEra) (Map ScriptHash (Script AlonzoEra))
scriptTxWitsL
        newWits :: Map ScriptHash (Script AlonzoEra)
newWits = Map ScriptHash (Script AlonzoEra)
oldScriptWits Map ScriptHash (Script AlonzoEra)
-> Set ScriptHash -> Map ScriptHash (Script AlonzoEra)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set ScriptHash
neededHashes
     in if Coin
minimumFee Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
theFee
          then
            if Map ScriptHash (Script AlonzoEra)
oldScriptWits Map ScriptHash (Script AlonzoEra)
-> Map ScriptHash (Script AlonzoEra) -> Bool
forall a. Eq a => a -> a -> Bool
== Map ScriptHash (Script AlonzoEra)
newWits
              then AlonzoTx AlonzoEra -> Gen (AlonzoTx AlonzoEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx AlonzoEra
AlonzoTx AlonzoEra
tx
              else [Char] -> Gen (Tx AlonzoEra)
forall a. [Char] -> a
tracedDiscard ([Char] -> Gen (Tx AlonzoEra)) -> [Char] -> Gen (Tx AlonzoEra)
forall a b. (a -> b) -> a -> b
$ [Char]
"Random extra scriptwitness: genEraDone: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Map ScriptHash (Script AlonzoEra) -> [Char]
forall a. Show a => a -> [Char]
show Map ScriptHash (Script AlonzoEra)
newWits
          else [Char] -> Gen (Tx AlonzoEra)
forall a. [Char] -> a
tracedDiscard ([Char] -> Gen (Tx AlonzoEra)) -> [Char] -> Gen (Tx AlonzoEra)
forall a b. (a -> b) -> a -> b
$ [Char]
"MinFee violation: genEraDone: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Coin -> [Char]
forall a. Show a => a -> [Char]
show Coin
theFee

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

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

  feeOrCollateral :: Tx AlonzoEra -> UTxO AlonzoEra -> Coin
feeOrCollateral Tx AlonzoEra
tx UTxO AlonzoEra
utxo =
    case Tx AlonzoEra
AlonzoTx AlonzoEra
tx AlonzoTx AlonzoEra
-> Getting IsValid (AlonzoTx AlonzoEra) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. (IsValid -> Const IsValid IsValid)
-> Tx AlonzoEra -> Const IsValid (Tx AlonzoEra)
Getting IsValid (AlonzoTx AlonzoEra) IsValid
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx AlonzoEra) IsValid
isValidTxL of
      IsValid Bool
True -> Tx AlonzoEra
AlonzoTx AlonzoEra
tx AlonzoTx AlonzoEra
-> Getting Coin (AlonzoTx AlonzoEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody AlonzoEra -> Const Coin (TxBody AlonzoEra))
-> Tx AlonzoEra -> Const Coin (Tx AlonzoEra)
(TxBody AlonzoEra -> Const Coin (TxBody AlonzoEra))
-> AlonzoTx AlonzoEra -> Const Coin (AlonzoTx AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx AlonzoEra) (TxBody AlonzoEra)
bodyTxL ((TxBody AlonzoEra -> Const Coin (TxBody AlonzoEra))
 -> AlonzoTx AlonzoEra -> Const Coin (AlonzoTx AlonzoEra))
-> ((Coin -> Const Coin Coin)
    -> TxBody AlonzoEra -> Const Coin (TxBody AlonzoEra))
-> Getting Coin (AlonzoTx AlonzoEra) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody AlonzoEra -> Const Coin (TxBody AlonzoEra)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody AlonzoEra) Coin
feeTxBodyL
      IsValid Bool
False -> Tx AlonzoEra -> UTxO AlonzoEra -> Coin
forall era.
(EraTx era, AlonzoEraTxBody era) =>
Tx era -> UTxO era -> Coin
sumCollateral Tx AlonzoEra
tx UTxO AlonzoEra
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 =
  UTxO era -> Coin
forall era. EraTxOut era => UTxO era -> Coin
sumCoinUTxO (UTxO era -> Coin) -> UTxO era -> Coin
forall a b. (a -> b) -> a -> b
$ UTxO era -> Set TxIn -> UTxO era
forall era. UTxO era -> Set TxIn -> UTxO era
txInsFilter UTxO era
utxo (Set TxIn -> UTxO era) -> Set TxIn -> UTxO era
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era -> Getting (Set TxIn) (Tx era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const (Set TxIn) (TxBody era))
-> Tx era -> Const (Set TxIn) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const (Set TxIn) (TxBody era))
 -> Tx era -> Const (Set TxIn) (Tx era))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody era -> Const (Set TxIn) (TxBody era))
-> Getting (Set TxIn) (Tx era) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody era -> Const (Set TxIn) (TxBody era)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ forall era t. (Era era, EncCBOR t) => t -> Integer
encodedLen @era t
x) Integer -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL

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

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

instance MinGenTxout AlonzoEra where
  calcEraMinUTxO :: TxOut AlonzoEra -> PParams AlonzoEra -> Coin
calcEraMinUTxO TxOut AlonzoEra
txOut PParams AlonzoEra
pp = TxOut AlonzoEra -> Integer
forall era. AlonzoEraTxOut era => TxOut era -> Integer
utxoEntrySize TxOut AlonzoEra
txOut Integer -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> CoinPerWord -> Coin
unCoinPerWord (PParams AlonzoEra
pp PParams AlonzoEra
-> Getting CoinPerWord (PParams AlonzoEra) CoinPerWord
-> CoinPerWord
forall s a. s -> Getting a s a -> a
^. Getting CoinPerWord (PParams AlonzoEra) CoinPerWord
forall era.
(AlonzoEraPParams era, ExactEra AlonzoEra era) =>
Lens' (PParams era) CoinPerWord
Lens' (PParams AlonzoEra) CoinPerWord
ppCoinsPerUTxOWordL)
  addValToTxOut :: Value AlonzoEra -> TxOut AlonzoEra -> TxOut AlonzoEra
addValToTxOut Value AlonzoEra
v (AlonzoTxOut Addr
a Value AlonzoEra
u StrictMaybe DataHash
_b) = Addr
-> Value AlonzoEra -> StrictMaybe DataHash -> AlonzoTxOut AlonzoEra
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
AlonzoTxOut Addr
a (Value AlonzoEra
MaryValue
v MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
<+> Value AlonzoEra
MaryValue
u) (Addr -> StrictMaybe DataHash
dataFromAddr Addr
a)
  genEraTxOut :: forall c.
GenEnv c AlonzoEra
-> Gen (Value AlonzoEra) -> [Addr] -> Gen [TxOut AlonzoEra]
genEraTxOut GenEnv c AlonzoEra
genv Gen (Value AlonzoEra)
genVal [Addr]
addrs = do
    [MaryValue]
values <- Int -> Gen MaryValue -> Gen [MaryValue]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([Addr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Addr]
addrs) Gen (Value AlonzoEra)
Gen MaryValue
genVal
    let makeTxOut :: Addr -> MaryValue -> AlonzoTxOut AlonzoEra
makeTxOut Addr
addr MaryValue
val =
          case Addr
addr of
            Addr Network
_network (ScriptHashObj ScriptHash
shash) StakeReference
_stakeref ->
              Addr
-> Value AlonzoEra -> StrictMaybe DataHash -> AlonzoTxOut AlonzoEra
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
AlonzoTxOut Addr
addr Value AlonzoEra
MaryValue
val (StrictMaybe DataHash -> AlonzoTxOut AlonzoEra)
-> StrictMaybe DataHash -> AlonzoTxOut AlonzoEra
forall a b. (a -> b) -> a -> b
$ (AlonzoScript AlonzoEra, StrictMaybe DataHash)
-> StrictMaybe DataHash
forall a b. (a, b) -> b
snd ((AlonzoScript AlonzoEra, StrictMaybe DataHash)
 -> StrictMaybe DataHash)
-> (AlonzoScript AlonzoEra, StrictMaybe DataHash)
-> StrictMaybe DataHash
forall a b. (a -> b) -> a -> b
$ GenEnv c AlonzoEra
-> ScriptHash -> (Script AlonzoEra, StrictMaybe DataHash)
forall era c.
GenEnv c era -> ScriptHash -> (Script era, StrictMaybe DataHash)
findPlutus GenEnv c AlonzoEra
genv ScriptHash
shash
            Addr
_ -> Addr
-> Value AlonzoEra -> StrictMaybe DataHash -> AlonzoTxOut AlonzoEra
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
AlonzoTxOut Addr
addr Value AlonzoEra
MaryValue
val StrictMaybe DataHash
forall a. StrictMaybe a
SNothing
    [AlonzoTxOut AlonzoEra] -> Gen [AlonzoTxOut AlonzoEra]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Addr -> MaryValue -> AlonzoTxOut AlonzoEra)
-> [Addr] -> [MaryValue] -> [AlonzoTxOut AlonzoEra]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Addr -> MaryValue -> AlonzoTxOut AlonzoEra
makeTxOut [Addr]
addrs [MaryValue]
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 :: Addr -> StrictMaybe DataHash
dataFromAddr :: Addr -> StrictMaybe DataHash
dataFromAddr (Addr Network
_network (ScriptHashObj ScriptHash
shash) StakeReference
_stakeref) =
  let f :: TwoPhase3ArgInfo AlonzoEra -> Bool
f TwoPhase3ArgInfo AlonzoEra
info = ScriptHash
shash ScriptHash -> ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
== forall era. EraScript era => Script era -> ScriptHash
hashScript @AlonzoEra (forall era. TwoPhase3ArgInfo era -> Script era
getScript3 @AlonzoEra TwoPhase3ArgInfo AlonzoEra
info)
   in case (TwoPhase3ArgInfo AlonzoEra -> Bool)
-> [TwoPhase3ArgInfo AlonzoEra]
-> Maybe (TwoPhase3ArgInfo AlonzoEra)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find TwoPhase3ArgInfo AlonzoEra -> Bool
f [TwoPhase3ArgInfo AlonzoEra]
forall era. EraGen era => [TwoPhase3ArgInfo era]
genEraTwoPhase3Arg of
        Just TwoPhase3ArgInfo AlonzoEra
info -> DataHash -> StrictMaybe DataHash
forall a. a -> StrictMaybe a
SJust (Data -> DataHash
hashData (TwoPhase3ArgInfo AlonzoEra -> Data
forall era. TwoPhase3ArgInfo era -> Data
getData3 TwoPhase3ArgInfo AlonzoEra
info))
        Maybe (TwoPhase3ArgInfo AlonzoEra)
Nothing -> StrictMaybe DataHash
forall a. StrictMaybe a
SNothing
dataFromAddr Addr
_ = StrictMaybe DataHash
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 ::
  [TxOut AlonzoEra] ->
  TxDats AlonzoEra ->
  TxDats AlonzoEra
dataMapFromTxOut :: [TxOut AlonzoEra] -> TxDats AlonzoEra -> TxDats AlonzoEra
dataMapFromTxOut [TxOut AlonzoEra]
txouts TxDats AlonzoEra
datahashmap = (TxDats AlonzoEra -> AlonzoTxOut AlonzoEra -> TxDats AlonzoEra)
-> TxDats AlonzoEra -> [AlonzoTxOut AlonzoEra] -> TxDats AlonzoEra
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' TxDats AlonzoEra -> AlonzoTxOut AlonzoEra -> TxDats AlonzoEra
forall {era} {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Val (Value era), Era era, Era era) =>
TxDats era -> AlonzoTxOut era -> TxDats era
accum TxDats AlonzoEra
datahashmap [TxOut AlonzoEra]
[AlonzoTxOut AlonzoEra]
txouts
  where
    f :: DataHash -> TwoPhase3ArgInfo era -> Bool
f DataHash
dhash TwoPhase3ArgInfo era
info = Data -> DataHash
hashData (TwoPhase3ArgInfo era -> Data
forall era. TwoPhase3ArgInfo era -> Data
getData3 TwoPhase3ArgInfo era
info) DataHash -> DataHash -> Bool
forall a. Eq a => a -> a -> Bool
== DataHash
dhash
    accum :: TxDats era -> AlonzoTxOut era -> TxDats era
accum !TxDats era
ans (AlonzoTxOut Addr
_ Value era
_ StrictMaybe DataHash
SNothing) = TxDats era
ans
    accum ans :: TxDats era
ans@(TxDats Map DataHash (Data era)
m) (AlonzoTxOut Addr
_ Value era
_ (SJust DataHash
dhash)) =
      case (TwoPhase3ArgInfo AlonzoEra -> Bool)
-> [TwoPhase3ArgInfo AlonzoEra]
-> Maybe (TwoPhase3ArgInfo AlonzoEra)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (DataHash -> TwoPhase3ArgInfo AlonzoEra -> Bool
forall {era}. DataHash -> TwoPhase3ArgInfo era -> Bool
f DataHash
dhash) (forall era. EraGen era => [TwoPhase3ArgInfo era]
genEraTwoPhase3Arg @AlonzoEra) of
        Just TwoPhase3ArgInfo AlonzoEra
info -> Map DataHash (Data era) -> TxDats era
forall era. Era era => Map DataHash (Data era) -> TxDats era
TxDats (DataHash
-> Data era -> Map DataHash (Data era) -> Map DataHash (Data era)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert DataHash
dhash (Data -> Data era
forall era. Era era => Data -> Data era
Data (TwoPhase3ArgInfo AlonzoEra -> Data
forall era. TwoPhase3ArgInfo era -> Data
getData3 TwoPhase3ArgInfo AlonzoEra
info)) Map DataHash (Data era)
m)
        Maybe (TwoPhase3ArgInfo AlonzoEra)
Nothing -> TxDats era
ans

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

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

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