{-# 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, Tx (..))
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),
  ScriptIntegrity (..),
  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 (..), CompactForm (..))
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.Alonzo.ImpTest (computeScriptIntegrity)
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, zeroTestingCostModel)
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 (Witness, (><))

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

-- | 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
  ans <- Gen (Maybe (TwoPhase2ArgInfo AlonzoEra))
forall era.
EraPlutusTxInfo 'PlutusV1 era =>
Gen (Maybe (TwoPhase2ArgInfo era))
genPlutus2Arg
  case 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
      count <- (Integer, Integer) -> Gen Integer
forall a. Enum a => (a, a) -> Gen a
chooseEnum (Integer
1, Integer
10)
      let assetname = ShortByteString -> AssetName
AssetName ShortByteString
"purple"
      pure (multiAssetFromList [(PolicyID shash, assetname, count)] <> startvalue, [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
  maybeAux <- forall era.
EraGen era =>
Constants -> Gen (StrictMaybe (TxAuxData era))
genEraAuxiliaryData @MaryEra Constants
constants
  pure $
    fmap
      (\(AllegraTxAuxData Map Word64 Metadatum
x StrictSeq (NativeScript 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
NativeScript AlonzoEra -> AlonzoScript AlonzoEra
forall era. NativeScript era -> AlonzoScript era
NativeScript (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)
StrictSeq (NativeScript MaryEra)
y))
      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
_ (NativeScript NativeScript 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
NativeScript 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
_ (NativeScript NativeScript AlonzoEra
_) = Bool
True
  isOnePhase Proxy AlonzoEra
_ (PlutusScript PlutusScript AlonzoEra
_) = Bool
False
  quantify :: Proxy AlonzoEra
-> Script AlonzoEra -> Quantifier (Script AlonzoEra)
quantify Proxy AlonzoEra
_ (NativeScript NativeScript 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
NativeScript AlonzoEra -> AlonzoScript AlonzoEra
forall era. NativeScript era -> AlonzoScript era
NativeScript (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
NativeScript 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
NativeScript AlonzoEra -> AlonzoScript AlonzoEra
forall era. NativeScript era -> AlonzoScript era
NativeScript (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
AlonzoScript AlonzoEra -> NativeScript AlonzoEra
forall era. AlonzoScript era -> NativeScript era
unTime) Quantifier (Script AlonzoEra)
Quantifier (AlonzoScript AlonzoEra)
quant)

unTime :: AlonzoScript era -> NativeScript era
unTime :: forall era. AlonzoScript era -> NativeScript era
unTime (NativeScript NativeScript era
x) = NativeScript era
x
unTime (PlutusScript PlutusScript era
_) = String -> NativeScript era
forall a. HasCallStack => String -> a
error String
"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 TopTx 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 TopTx 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
  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)]
  startvalue <- genMint
  (minted, plutusScripts) <- genAlonzoMint startvalue
  let (minted2, txouts2) = case addTokens (Proxy @AlonzoEra) mempty pparams minted 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 = (Map PolicyID (NativeScript AlonzoEra)
forall era. AllegraEraScript era => Map PolicyID (NativeScript era)
policyIndex Map PolicyID (NativeScript AlonzoEra)
-> PolicyID -> NativeScript AlonzoEra
forall k a. Ord k => Map k a -> k -> a
Map.!) (PolicyID -> NativeScript AlonzoEra)
-> [PolicyID] -> [NativeScript 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 = (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 <- genValidityInterval currentslot
  return
    ( AlonzoTxBody
        input
        (Set.filter (okAsCollateral utxo) input) -- Set.empty -- collateral -- TODO do something better here (use genenv ?)
        txouts3
        certs
        withdrawals
        fee
        validityInterval -- (ValidityInterval SNothing SNothing) -- (ValidityInterval low high)
        updates
        -- reqSignerHashes
        Set.empty -- TODO do something better here
        minted2
        -- scriptIntegrityHash starts out with empty Redeemers,
        -- as Remdeemers are added it is recomputed in updateEraTxBody
        ( SJust . hashScriptIntegrity @AlonzoEra $
            ScriptIntegrity (Redeemers Map.empty) (TxDats Map.empty) Set.empty
        )
        auxDHash
        netid
    , List.map NativeScript scriptsFromPolicies <> plutusScripts
    )

genSlotAfter :: SlotNo -> Gen SlotNo
genSlotAfter :: SlotNo -> Gen SlotNo
genSlotAfter SlotNo
currentSlot = do
  ttl <- Nat -> Nat -> Gen Nat
genNatural Nat
50 Nat
100
  pure $ currentSlot + SlotNo (fromIntegral 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
  maryPPUpdate <-
    forall era.
(AtMostEra "Mary" era, AtMostEra "Alonzo" era,
 AtMostEra "Babbage" era, 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 (CompactForm Coin)
dappMinUTxOValue = Word64 -> CompactForm Coin
CompactCoin Word64
100}) PParams AlonzoEra
pp
  coinPerWord <- genM (CoinPerWord . Coin <$> choose (1, 5))
  let 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)
  prices <- genM (Prices <$> genPrice <*> genPrice)
  maxTxExUnits <- genM genMaxTxExUnits
  maxBlockExUnits <- genM 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
  maxValSize <- genM (genNatural 4000 5000)
  let alonzoUpgrade =
        UpgradeAlonzoPParams
          { uappCoinsPerUTxOWord :: HKD StrictMaybe CoinPerWord
uappCoinsPerUTxOWord = StrictMaybe CoinPerWord
HKD StrictMaybe CoinPerWord
coinPerWord
          , uappPlutusV1CostModel :: HKD StrictMaybe CostModel
uappPlutusV1CostModel = CostModel -> StrictMaybe CostModel
forall a. a -> StrictMaybe a
SJust (CostModel -> StrictMaybe CostModel)
-> CostModel -> StrictMaybe CostModel
forall a b. (a -> b) -> a -> b
$ HasCallStack => Language -> CostModel
Language -> CostModel
zeroTestingCostModel 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
          }
  pure $ upgradePParamsUpdate alonzoUpgrade 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).
  maryPP' <- forall era.
(EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) =>
Constants -> Gen (PParams era)
Shelley.genPParams @MaryEra Constants
constants
  let 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 = NonNegativeInterval -> NonNegativeInterval -> Prices
Prices NonNegativeInterval
forall a. Bounded a => a
minBound NonNegativeInterval
forall a. Bounded a => a
minBound
  coinPerWord <- CoinPerWord . Coin <$> choose (1, 5)
  -- prices <- Prices <$> (Coin <$> choose (100, 5000)) <*> (Coin <$> choose (100, 5000))
  maxTxExUnits <- genMaxTxExUnits
  maxBlockExUnits <- genMaxBlockExUnits
  maxValSize <- genNatural 4000 10000 -- This can't be too small. Shelley uses Hard coded 4000
  let alonzoUpgrade =
        UpgradeAlonzoPParams
          { uappCoinsPerUTxOWord :: HKD Identity CoinPerWord
uappCoinsPerUTxOWord = CoinPerWord
HKD Identity CoinPerWord
coinPerWord
          , uappPlutusV1CostModel :: HKD Identity CostModel
uappPlutusV1CostModel = HasCallStack => Language -> CostModel
Language -> CostModel
zeroTestingCostModel 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
          }
  pure $ upgradePParams alonzoUpgrade 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 at least 20 of our 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
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) (Nat
30 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
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) (Nat
30 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 at least 20 of our 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
20 Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
* 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) (Nat
20 Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
* Nat
30 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
20 Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
* 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) (Nat
20 Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
* Nat
30 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 TopTx 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 TopTx 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 TopTx AlonzoEra, [Script AlonzoEra])
genAlonzoTxBody
  updateEraTxBody :: UTxO AlonzoEra
-> PParams AlonzoEra
-> TxWits AlonzoEra
-> TxBody TopTx AlonzoEra
-> Coin
-> Set TxIn
-> TxOut AlonzoEra
-> TxBody TopTx AlonzoEra
updateEraTxBody UTxO AlonzoEra
utxo PParams AlonzoEra
pp TxWits AlonzoEra
wits TxBody TopTx AlonzoEra
txb Coin
coinx Set TxIn
txin TxOut AlonzoEra
txout =
    TxBody TopTx AlonzoEra
txb
      { atbInputs = newInputs
      , atbCollateral = newCollaterals
      , atbTxFee = coinx
      , atbOutputs = newOutputs
      , -- The wits may have changed, recompute the scriptIntegrityHash.
        atbScriptIntegrityHash =
          hashScriptIntegrity
            <$> computeScriptIntegrity
              pp
              utxo
              (mkBasicTx txb & witsTxL .~ wits)
      }
    where
      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 TopTx AlonzoEra -> Set TxIn
atbInputs TxBody TopTx AlonzoEra
txb Set TxIn -> Set TxIn -> Set TxIn
forall a. Semigroup a => a -> a -> a
<> Set TxIn
txin
      newOutputs :: StrictSeq (AlonzoTxOut AlonzoEra)
newOutputs = TxBody TopTx AlonzoEra -> StrictSeq (TxOut AlonzoEra)
atbOutputs TxBody TopTx AlonzoEra
txb StrictSeq (AlonzoTxOut AlonzoEra)
-> AlonzoTxOut AlonzoEra -> StrictSeq (AlonzoTxOut AlonzoEra)
forall a. StrictSeq a -> a -> StrictSeq a
:|> TxOut AlonzoEra
AlonzoTxOut AlonzoEra
txout

  addInputs :: TxBody TopTx AlonzoEra -> Set TxIn -> TxBody TopTx AlonzoEra
addInputs TxBody TopTx AlonzoEra
txb Set TxIn
txin = TxBody TopTx 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 TopTx AlonzoEra, ScriptInfo AlonzoEra)
-> Set (WitVKey Witness)
-> Map ScriptHash (Script AlonzoEra)
-> TxWits AlonzoEra
genEraTxWits (UTxO AlonzoEra
utxo, TxBody TopTx 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 TopTx AlonzoEra
txbody TxBody TopTx AlonzoEra
-> Getting (Set TxIn) (TxBody TopTx AlonzoEra) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx AlonzoEra) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l 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 (t :: TxLevel).
EraUTxO era =>
UTxO era -> TxBody t era -> ScriptsNeeded era
getScriptsNeeded @AlonzoEra UTxO AlonzoEra
utxo TxBody TopTx 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 TopTx AlonzoEra
-> TxWits AlonzoEra
-> StrictMaybe (TxAuxData AlonzoEra)
-> Tx TopTx AlonzoEra
constructTx TxBody TopTx AlonzoEra
bod TxWits AlonzoEra
wit StrictMaybe (TxAuxData AlonzoEra)
auxdata = AlonzoTx TopTx AlonzoEra -> Tx TopTx AlonzoEra
forall (l :: TxLevel). AlonzoTx l AlonzoEra -> Tx l AlonzoEra
MkAlonzoTx (AlonzoTx TopTx AlonzoEra -> Tx TopTx AlonzoEra)
-> AlonzoTx TopTx AlonzoEra -> Tx TopTx AlonzoEra
forall a b. (a -> b) -> a -> b
$ TxBody TopTx AlonzoEra
-> TxWits AlonzoEra
-> IsValid
-> StrictMaybe (TxAuxData AlonzoEra)
-> AlonzoTx TopTx AlonzoEra
forall era.
TxBody TopTx era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx TopTx era
AlonzoTx TxBody TopTx 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 TopTx AlonzoEra
-> Gen (Tx TopTx AlonzoEra)
genEraDone UTxO AlonzoEra
utxo PParams AlonzoEra
pp Tx TopTx AlonzoEra
tx =
    let theFee :: Coin
theFee = Tx TopTx AlonzoEra
tx Tx TopTx AlonzoEra
-> Getting Coin (Tx TopTx AlonzoEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx AlonzoEra -> Const Coin (TxBody TopTx AlonzoEra))
-> Tx TopTx AlonzoEra -> Const Coin (Tx TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l AlonzoEra) (TxBody l AlonzoEra)
bodyTxL ((TxBody TopTx AlonzoEra -> Const Coin (TxBody TopTx AlonzoEra))
 -> Tx TopTx AlonzoEra -> Const Coin (Tx TopTx AlonzoEra))
-> ((Coin -> Const Coin Coin)
    -> TxBody TopTx AlonzoEra -> Const Coin (TxBody TopTx AlonzoEra))
-> Getting Coin (Tx TopTx AlonzoEra) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody TopTx AlonzoEra -> Const Coin (TxBody TopTx AlonzoEra)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx AlonzoEra) Coin
feeTxBodyL -- Coin supplied to pay fees
        minimumFee :: Coin
minimumFee = forall era (t :: TxLevel).
EraUTxO era =>
PParams era -> Tx t era -> UTxO era -> Coin
getMinFeeTxUtxo @AlonzoEra PParams AlonzoEra
pp Tx TopTx 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 TopTx AlonzoEra -> ScriptsNeeded AlonzoEra
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> TxBody t era -> ScriptsNeeded era
forall (t :: TxLevel).
UTxO AlonzoEra -> TxBody t AlonzoEra -> ScriptsNeeded AlonzoEra
getScriptsNeeded UTxO AlonzoEra
utxo (Tx TopTx AlonzoEra
tx Tx TopTx AlonzoEra
-> Getting
     (TxBody TopTx AlonzoEra)
     (Tx TopTx AlonzoEra)
     (TxBody TopTx AlonzoEra)
-> TxBody TopTx AlonzoEra
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx AlonzoEra)
  (Tx TopTx AlonzoEra)
  (TxBody TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l AlonzoEra) (TxBody l AlonzoEra)
bodyTxL)
        oldScriptWits :: Map ScriptHash (Script AlonzoEra)
oldScriptWits = Tx TopTx AlonzoEra
tx Tx TopTx AlonzoEra
-> Getting
     (Map ScriptHash (Script AlonzoEra))
     (Tx TopTx 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 TopTx AlonzoEra
-> Const (Map ScriptHash (Script AlonzoEra)) (Tx TopTx AlonzoEra)
(AlonzoTxWits AlonzoEra
 -> Const
      (Map ScriptHash (Script AlonzoEra)) (AlonzoTxWits AlonzoEra))
-> Tx TopTx AlonzoEra
-> Const (Map ScriptHash (Script AlonzoEra)) (Tx TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l AlonzoEra) (TxWits AlonzoEra)
witsTxL ((AlonzoTxWits AlonzoEra
  -> Const
       (Map ScriptHash (Script AlonzoEra)) (AlonzoTxWits AlonzoEra))
 -> Tx TopTx AlonzoEra
 -> Const (Map ScriptHash (Script AlonzoEra)) (Tx TopTx AlonzoEra))
-> ((Map ScriptHash (Script AlonzoEra)
     -> Const
          (Map ScriptHash (Script AlonzoEra))
          (Map ScriptHash (Script AlonzoEra)))
    -> AlonzoTxWits AlonzoEra
    -> Const
         (Map ScriptHash (Script AlonzoEra)) (AlonzoTxWits AlonzoEra))
-> Getting
     (Map ScriptHash (Script AlonzoEra))
     (Tx TopTx 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)
(Map ScriptHash (Script AlonzoEra)
 -> Const
      (Map ScriptHash (Script AlonzoEra))
      (Map ScriptHash (Script AlonzoEra)))
-> AlonzoTxWits AlonzoEra
-> Const
     (Map ScriptHash (Script AlonzoEra)) (AlonzoTxWits 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 Tx TopTx AlonzoEra -> Gen (Tx TopTx AlonzoEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx TopTx AlonzoEra
tx
              else String -> Gen (Tx TopTx AlonzoEra)
forall a. String -> a
tracedDiscard (String -> Gen (Tx TopTx AlonzoEra))
-> String -> Gen (Tx TopTx AlonzoEra)
forall a b. (a -> b) -> a -> b
$ String
"Random extra scriptwitness: genEraDone: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Map ScriptHash (Script AlonzoEra) -> String
forall a. Show a => a -> String
show Map ScriptHash (Script AlonzoEra)
newWits
          else String -> Gen (Tx TopTx AlonzoEra)
forall a. String -> a
tracedDiscard (String -> Gen (Tx TopTx AlonzoEra))
-> String -> Gen (Tx TopTx AlonzoEra)
forall a b. (a -> b) -> a -> b
$ String
"MinFee violation: genEraDone: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall a. Show a => a -> String
show Coin
theFee

  genEraTweakBlock :: PParams AlonzoEra
-> Seq (Tx TopTx AlonzoEra) -> Gen (Seq (Tx TopTx AlonzoEra))
genEraTweakBlock PParams AlonzoEra
pp Seq (Tx TopTx AlonzoEra)
txns =
    let txTotal, ppMax :: ExUnits
        txTotal :: ExUnits
txTotal = (Tx TopTx AlonzoEra -> ExUnits)
-> Seq (Tx TopTx 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 TopTx AlonzoEra -> ExUnits
forall era (l :: TxLevel).
(EraTx era, AlonzoEraTxWits era) =>
Tx l era -> ExUnits
totExUnits Seq (Tx TopTx 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 (Tx TopTx AlonzoEra) -> Gen (Seq (Tx TopTx AlonzoEra))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq (Tx TopTx AlonzoEra)
txns
          else
            String -> Gen (Seq (Tx TopTx AlonzoEra))
forall a. String -> a
tracedDiscard (String -> Gen (Seq (Tx TopTx AlonzoEra)))
-> String -> Gen (Seq (Tx TopTx AlonzoEra))
forall a b. (a -> b) -> a -> b
$
              String
"TotExUnits violation: genEraTweakBlock: "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ExUnits' Nat -> String
forall a. Show a => a -> String
show (ExUnits -> ExUnits' Nat
unWrapExUnits ExUnits
txTotal)
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" instead of "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ExUnits' Nat -> String
forall a. Show a => a -> String
show (ExUnits -> ExUnits' Nat
unWrapExUnits ExUnits
ppMax)

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

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

sumCollateral :: (EraTx era, AlonzoEraTxBody era) => Tx TopTx era -> UTxO era -> Coin
sumCollateral :: forall era.
(EraTx era, AlonzoEraTxBody era) =>
Tx TopTx era -> UTxO era -> Coin
sumCollateral Tx TopTx 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 TopTx era
tx Tx TopTx era
-> Getting (Set TxIn) (Tx TopTx era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const (Set TxIn) (TxBody TopTx era))
-> Tx TopTx era -> Const (Set TxIn) (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const (Set TxIn) (TxBody TopTx era))
 -> Tx TopTx era -> Const (Set TxIn) (Tx TopTx era))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody TopTx era -> Const (Set TxIn) (TxBody TopTx era))
-> Getting (Set TxIn) (Tx TopTx era) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody TopTx era -> Const (Set TxIn) (TxBody TopTx era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody TopTx era) (Set TxIn)
Lens' (TxBody TopTx 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, HasCallStack) =>
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
    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
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
    pure (zipWith makeTxOut addrs 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 a g. (UniformRange a, RandomGen g) => (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 a g. (UniformRange a, RandomGen g) => (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 ->
        NativeScript era -> AlonzoScript era
forall era. NativeScript era -> AlonzoScript era
NativeScript (NativeScript era -> AlonzoScript era)
-> NativeScript 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
_ -> NativeScript era -> AlonzoScript era
forall era. NativeScript era -> AlonzoScript era
NativeScript (NativeScript era -> AlonzoScript era)
-> NativeScript 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]
    ]