{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.Constrained.Preds.Universes where

import qualified Cardano.Chain.Common as Byron
import qualified Cardano.Crypto.Signing as Byron
import Cardano.Ledger.Address (Addr (..), BootstrapAddress (..), bootstrapKeyHash)
import Cardano.Ledger.Allegra.Scripts (ValidityInterval (..))
import Cardano.Ledger.Alonzo.TxOut (AlonzoTxOut (..))
import Cardano.Ledger.Babbage.TxOut (BabbageTxOut (..))
import Cardano.Ledger.BaseTypes (
  Network (..),
  SlotNo (..),
  StrictMaybe (..),
  TxIx (..),
  inject,
  mkCertIxPartial,
 )
import qualified Cardano.Ledger.BaseTypes as Utils (Globals (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Governance (GovActionId (..), GovActionIx (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..), Ptr (..), SlotNo32 (..), StakeReference (..))
import Cardano.Ledger.DRep (DRep (..))
import Cardano.Ledger.Keys (coerceKeyRole)
import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness, makeBootstrapWitness)
import Cardano.Ledger.Mary.Value (
  AssetName (..),
  MaryValue (..),
  MultiAsset (..),
  PolicyID (..),
  multiAssetFromList,
 )
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..), dataToBinaryData, hashData)
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.TxIn (TxIn (..))
import Data.Default (Default (def))
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.String (IsString (..))
import Test.Cardano.Ledger.Constrained.Ast
import Test.Cardano.Ledger.Constrained.Classes hiding (genTxOut)
import Test.Cardano.Ledger.Constrained.Combinators (genFromMap, itemFromSet, setSized)
import Test.Cardano.Ledger.Constrained.Env
import Test.Cardano.Ledger.Constrained.Monad (monadTyped)
import Test.Cardano.Ledger.Constrained.Preds.Repl (ReplMode (..), modeRepl)
import Test.Cardano.Ledger.Constrained.Rewrite (standardOrderInfo)
import Test.Cardano.Ledger.Constrained.Scripts (allPlutusScripts, genCoreScript, spendPlutusScripts)
import Test.Cardano.Ledger.Constrained.Solver
import Test.Cardano.Ledger.Constrained.TypeRep
import Test.Cardano.Ledger.Constrained.Utils (testIO)
import Test.Cardano.Ledger.Constrained.Vars
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
import Test.Cardano.Ledger.Generic.Functions (protocolVersion)
import Test.Cardano.Ledger.Generic.GenState (PlutusPurposeTag (..))
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo)
import qualified Test.Cardano.Ledger.Shelley.Utils as Utils
import Test.Tasty (TestTree, defaultMain)
import Test.Tasty.QuickCheck

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

data UnivSize = UnivSize
  { UnivSize -> Int
usNumTxOuts :: Int
  , UnivSize -> Int
usMaxAssets :: Int -- per Policy Id
  , UnivSize -> Int
usMaxPolicyID :: Int -- per MultiAsset
  , UnivSize -> Int
usNumMultiAsset :: Int
  , UnivSize -> Int
usNumPtr :: Int
  , UnivSize -> Int
usNumAddr :: Int
  , UnivSize -> Int
usNumKeys :: Int
  , UnivSize -> Int
usNumPools :: Int
  , UnivSize -> Int
usNumStakeKeys :: Int -- should be less than numKeys
  , UnivSize -> Int
usNumGenesisKeys :: Int -- should be less than numKeys
  , UnivSize -> Int
usNumVoteKeys :: Int -- should be less than numKeys
  , UnivSize -> Int
usNumCredentials :: Int
  , UnivSize -> Int
usNumDatums :: Int
  , UnivSize -> Int
usNumTxIn :: Int
  , UnivSize -> Int
usNumPreUtxo :: Int -- must be smaller than numTxIn
  , UnivSize -> Int
usNumColUtxo :: Int -- max size of the UTxo = numPreUtxo + numColUtxo
  , UnivSize -> Int
usNumDReps :: Int -- Should be less than the number of numCredentials
  , UnivSize -> Int
usMinCerts :: Int
  , UnivSize -> Int
usMaxCerts :: Int
  , UnivSize -> Int
usDatumFreq :: Int
  , UnivSize -> Bool
usGenerateWithdrawals :: Bool
  , UnivSize -> Int
usMinInputs :: Int
  , UnivSize -> Int
usMaxInputs :: Int
  , UnivSize -> Int
usMinCollaterals :: Int
  , UnivSize -> Int
usMaxCollaterals :: Int
  , UnivSize -> Int
usRegKeyFreq :: Int
  , UnivSize -> Int
usUnRegKeyFreq :: Int
  , UnivSize -> Bool
usAllowReRegisterPool :: Bool
  , UnivSize -> Int
usSpendScriptFreq :: Int
  , UnivSize -> Int
usCredScriptFreq :: Int
  }

instance Default UnivSize where
  def :: UnivSize
def =
    UnivSize
      { usNumTxOuts :: Int
usNumTxOuts = Int
100
      , usMaxAssets :: Int
usMaxAssets = Int
9 -- per Policy Id
      , usMaxPolicyID :: Int
usMaxPolicyID = Int
2 -- per MultiAsset
      , usNumMultiAsset :: Int
usNumMultiAsset = Int
10
      , usNumPtr :: Int
usNumPtr = Int
30
      , usNumAddr :: Int
usNumAddr = Int
200
      , usNumKeys :: Int
usNumKeys = Int
50
      , usNumPools :: Int
usNumPools = Int
40
      , usNumStakeKeys :: Int
usNumStakeKeys = Int
10 -- less than numKeys
      , usNumGenesisKeys :: Int
usNumGenesisKeys = Int
20 -- less than numKeys
      , usNumVoteKeys :: Int
usNumVoteKeys = Int
40 -- less than numKeys
      , usNumCredentials :: Int
usNumCredentials = Int
40
      , usNumDatums :: Int
usNumDatums = Int
30
      , usNumTxIn :: Int
usNumTxIn = Int
120
      , usNumPreUtxo :: Int
usNumPreUtxo = Int
100 -- must be smaller than numTxIn
      , usNumColUtxo :: Int
usNumColUtxo = Int
20 -- max size of the UTxo = numPreUtxo + numColUtxo
      , usNumDReps :: Int
usNumDReps = Int
20 -- -- Should be less than the number of numCredentials
      , usMaxCerts :: Int
usMaxCerts = Int
6
      , usMinCerts :: Int
usMinCerts = Int
4
      , usDatumFreq :: Int
usDatumFreq = Int
1
      , usGenerateWithdrawals :: Bool
usGenerateWithdrawals = Bool
True
      , usMinInputs :: Int
usMinInputs = Int
2
      , usMaxInputs :: Int
usMaxInputs = Int
10
      , usMinCollaterals :: Int
usMinCollaterals = Int
2
      , usMaxCollaterals :: Int
usMaxCollaterals = Int
2
      , usAllowReRegisterPool :: Bool
usAllowReRegisterPool = Bool
True
      , usRegKeyFreq :: Int
usRegKeyFreq = Int
1
      , usUnRegKeyFreq :: Int
usUnRegKeyFreq = Int
1
      , usSpendScriptFreq :: Int
usSpendScriptFreq = Int
3
      , usCredScriptFreq :: Int
usCredScriptFreq = Int
1
      }

-- ============================================================
-- Coins

variedCoin :: Gen Coin
variedCoin :: Gen Coin
variedCoin =
  Integer -> Coin
Coin
    (Integer -> Coin) -> Gen Integer -> Gen Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen Integer)] -> Gen Integer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
2, Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
      , (Int
2, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
10))
      , (Int
2, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
11, Integer
100))
      , (Int
2, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
101, Integer
1000))
      , (Int
2, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1001, Integer
10000))
      , (Int
8, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
10001, Integer
100000))
      , (Int
12, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
100001, Integer
1000000))
      ]

noZeroCoin :: Gen Coin
noZeroCoin :: Gen Coin
noZeroCoin =
  Integer -> Coin
Coin
    (Integer -> Coin) -> Gen Integer -> Gen Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen Integer)] -> Gen Integer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
10))
      , (Int
1, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
11, Integer
1000))
      , (Int
1, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1001, Integer
100000))
      , (Int
6, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
100001, Integer
600000))
      , (Int
6, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
600001, Integer
2000000))
      , (Int
6, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
2000001, Integer
4000000))
      ]

-- ===============================================
-- Generating Byron address and their universe

-- | Generate a pair, A Byron address, and the key that can sign it.
genAddrPair :: Network -> Gen (BootstrapAddress, Byron.SigningKey)
genAddrPair :: Network -> Gen (BootstrapAddress, SigningKey)
genAddrPair Network
netwrk = do
  SigningKey
signkey <- Gen SigningKey
genSigningKey
  let verificationKey :: VerificationKey
verificationKey = SigningKey -> VerificationKey
Byron.toVerification SigningKey
signkey
      asd :: AddrSpendingData
asd = VerificationKey -> AddrSpendingData
Byron.VerKeyASD VerificationKey
verificationKey
      byronNetwork :: NetworkMagic
byronNetwork = case Network
netwrk of
        Network
Mainnet -> NetworkMagic
Byron.NetworkMainOrStage
        Network
Testnet -> Word32 -> NetworkMagic
Byron.NetworkTestnet Word32
0
      attrs :: AddrAttributes
attrs =
        Maybe HDAddressPayload -> NetworkMagic -> AddrAttributes
Byron.AddrAttributes
          (HDAddressPayload -> Maybe HDAddressPayload
forall a. a -> Maybe a
Just (ByteString -> HDAddressPayload
Byron.HDAddressPayload ByteString
"a compressed lenna.png"))
          NetworkMagic
byronNetwork
  (BootstrapAddress, SigningKey)
-> Gen (BootstrapAddress, SigningKey)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> BootstrapAddress
BootstrapAddress (AddrSpendingData -> AddrAttributes -> Address
Byron.makeAddress AddrSpendingData
asd AddrAttributes
attrs), SigningKey
signkey)

-- | Generate a Map, that maps the Hash of a Byron address to a pair of
--   the actual Byron address and the key that can sign it.
genByronUniv :: Network -> Gen (Map (KeyHash 'Payment) (Addr, Byron.SigningKey))
genByronUniv :: Network -> Gen (Map (KeyHash 'Payment) (Addr, SigningKey))
genByronUniv Network
netwrk = do
  [(BootstrapAddress, SigningKey)]
list <- Int
-> Gen (BootstrapAddress, SigningKey)
-> Gen [(BootstrapAddress, SigningKey)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
50 (Network -> Gen (BootstrapAddress, SigningKey)
genAddrPair Network
netwrk)
  Map (KeyHash 'Payment) (Addr, SigningKey)
-> Gen (Map (KeyHash 'Payment) (Addr, SigningKey))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (KeyHash 'Payment) (Addr, SigningKey)
 -> Gen (Map (KeyHash 'Payment) (Addr, SigningKey)))
-> Map (KeyHash 'Payment) (Addr, SigningKey)
-> Gen (Map (KeyHash 'Payment) (Addr, SigningKey))
forall a b. (a -> b) -> a -> b
$
    [(KeyHash 'Payment, (Addr, SigningKey))]
-> Map (KeyHash 'Payment) (Addr, SigningKey)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      (((BootstrapAddress, SigningKey)
 -> (KeyHash 'Payment, (Addr, SigningKey)))
-> [(BootstrapAddress, SigningKey)]
-> [(KeyHash 'Payment, (Addr, SigningKey))]
forall a b. (a -> b) -> [a] -> [b]
List.map (\(BootstrapAddress
addr, SigningKey
signkey) -> (BootstrapAddress -> KeyHash 'Payment
bootstrapKeyHash BootstrapAddress
addr, (BootstrapAddress -> Addr
AddrBootstrap BootstrapAddress
addr, SigningKey
signkey))) [(BootstrapAddress, SigningKey)]
list)

-- | Given a list of Byron addresses, compute BootStrap witnesses of all of those addresses
--   Can only be used with StandardCrypto
bootWitness ::
  Hash HASH EraIndependentTxBody ->
  [BootstrapAddress] ->
  Map (KeyHash 'Payment) (Addr, Byron.SigningKey) ->
  Set BootstrapWitness
bootWitness :: Hash HASH EraIndependentTxBody
-> [BootstrapAddress]
-> Map (KeyHash 'Payment) (Addr, SigningKey)
-> Set BootstrapWitness
bootWitness Hash HASH EraIndependentTxBody
hash [BootstrapAddress]
bootaddrs Map (KeyHash 'Payment) (Addr, SigningKey)
byronuniv = (Set BootstrapWitness -> BootstrapAddress -> Set BootstrapWitness)
-> Set BootstrapWitness
-> [BootstrapAddress]
-> Set BootstrapWitness
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Set BootstrapWitness -> BootstrapAddress -> Set BootstrapWitness
accum Set BootstrapWitness
forall a. Set a
Set.empty [BootstrapAddress]
bootaddrs
  where
    accum :: Set BootstrapWitness -> BootstrapAddress -> Set BootstrapWitness
accum Set BootstrapWitness
ans bootaddr :: BootstrapAddress
bootaddr@(BootstrapAddress Address
a) = case KeyHash 'Payment
-> Map (KeyHash 'Payment) (Addr, SigningKey)
-> Maybe (Addr, SigningKey)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (BootstrapAddress -> KeyHash 'Payment
bootstrapKeyHash BootstrapAddress
bootaddr) Map (KeyHash 'Payment) (Addr, SigningKey)
byronuniv of
      Just (AddrBootstrap BootstrapAddress
_, SigningKey
signkey) ->
        BootstrapWitness -> Set BootstrapWitness -> Set BootstrapWitness
forall a. Ord a => a -> Set a -> Set a
Set.insert (Hash HASH EraIndependentTxBody
-> SigningKey -> Attributes AddrAttributes -> BootstrapWitness
makeBootstrapWitness Hash HASH EraIndependentTxBody
hash SigningKey
signkey (Address -> Attributes AddrAttributes
Byron.addrAttributes Address
a)) Set BootstrapWitness
ans
      Maybe (Addr, SigningKey)
_ -> Set BootstrapWitness
ans

-- ==================
-- Datums

-- | The universe of non-empty Datums. i.e. There are no NoDatum Datums in this list
genDatums :: UnivSize -> Int -> Map DataHash (Data era) -> Gen [Datum era]
genDatums :: forall era.
UnivSize -> Int -> Map DataHash (Data era) -> Gen [Datum era]
genDatums UnivSize
sizes Int
n Map DataHash (Data era)
datauniv = Int -> Gen (Datum era) -> Gen [Datum era]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (UnivSize -> Map DataHash (Data era) -> Gen (Datum era)
forall era. UnivSize -> Map DataHash (Data era) -> Gen (Datum era)
genDatum UnivSize
sizes Map DataHash (Data era)
datauniv)

-- | Only generate non-empty Datums. I.e. There are no NoDatum Datums generated.
genDatum :: UnivSize -> Map DataHash (Data era) -> Gen (Datum era)
genDatum :: forall era. UnivSize -> Map DataHash (Data era) -> Gen (Datum era)
genDatum UnivSize {Int
usDatumFreq :: UnivSize -> Int
usDatumFreq :: Int
usDatumFreq} Map DataHash (Data era)
datauniv =
  [(Int, Gen (Datum era))] -> Gen (Datum era)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, DataHash -> Datum era
forall era. DataHash -> Datum era
DatumHash (DataHash -> Datum era)
-> ((DataHash, Data era) -> DataHash)
-> (DataHash, Data era)
-> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataHash, Data era) -> DataHash
forall a b. (a, b) -> a
fst ((DataHash, Data era) -> Datum era)
-> Gen (DataHash, Data era) -> Gen (Datum era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Map DataHash (Data era) -> Gen (DataHash, Data era)
forall k a. [String] -> Map k a -> Gen (k, a)
genFromMap [String
"from genDatums DatumHash case"] Map DataHash (Data era)
datauniv)
    ,
      ( Int
usDatumFreq
      , BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> ((DataHash, Data era) -> BinaryData era)
-> (DataHash, Data era)
-> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> BinaryData era)
-> ((DataHash, Data era) -> Data era)
-> (DataHash, Data era)
-> BinaryData era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataHash, Data era) -> Data era
forall a b. (a, b) -> b
snd
          ((DataHash, Data era) -> Datum era)
-> Gen (DataHash, Data era) -> Gen (Datum era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Map DataHash (Data era) -> Gen (DataHash, Data era)
forall k a. [String] -> Map k a -> Gen (k, a)
genFromMap [String
"from genDatums Datum case"] Map DataHash (Data era)
datauniv
      )
    ]

-- ==============
-- TxOuts
-- ==============

genTxOut ::
  Reflect era =>
  UnivSize ->
  (Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era)) ->
  Proof era ->
  Coin ->
  Set Addr ->
  Map ScriptHash (ScriptF era) ->
  Map ScriptHash (ScriptF era) ->
  Map DataHash (Data era) ->
  Gen (TxOut era)
genTxOut :: forall era.
Reflect era =>
UnivSize
-> (Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era))
-> Proof era
-> Coin
-> Set Addr
-> Map ScriptHash (ScriptF era)
-> Map ScriptHash (ScriptF era)
-> Map DataHash (Data era)
-> Gen (TxOut era)
genTxOut UnivSize
sizes Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era)
genvalue Proof era
p Coin
c Set Addr
addruniv Map ScriptHash (ScriptF era)
scriptuniv Map ScriptHash (ScriptF era)
spendscriptuniv Map DataHash (Data era)
datauniv =
  case Proof era -> TxOutWit era
forall era. Proof era -> TxOutWit era
whichTxOut Proof era
p of
    TxOutWit era
TxOutShelleyToMary ->
      Addr -> Value era -> ShelleyTxOut era
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut (Addr -> Value era -> ShelleyTxOut era)
-> Gen Addr -> Gen (Value era -> ShelleyTxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Set Addr -> Gen Addr
forall t. [String] -> Set t -> Gen t
pick1 [String
"genTxOut ShelleyToMary Addr"] Set Addr
addruniv Gen (Value era -> ShelleyTxOut era)
-> Gen (Value era) -> Gen (ShelleyTxOut era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era)
genvalue Coin
c Map ScriptHash (ScriptF era)
scriptuniv
    TxOutWit era
TxOutAlonzoToAlonzo -> do
      Addr
addr <- [String] -> Set Addr -> Gen Addr
forall t. [String] -> Set t -> Gen t
pick1 [String
"genTxOut AlonzoToAlonzo Addr"] Set Addr
addruniv
      Value era
v <- Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era)
genvalue Coin
c Map ScriptHash (ScriptF era)
scriptuniv
      case Addr
addr of
        AddrBootstrap BootstrapAddress
_ -> AlonzoTxOut era -> Gen (AlonzoTxOut era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
AlonzoTxOut Addr
addr Value era
v StrictMaybe DataHash
forall a. StrictMaybe a
SNothing)
        Addr Network
_ PaymentCredential
paycred StakeReference
_ ->
          if PaymentCredential -> Map ScriptHash (ScriptF era) -> Bool
forall era.
EraScript era =>
PaymentCredential -> Map ScriptHash (ScriptF era) -> Bool
needsDatum PaymentCredential
paycred Map ScriptHash (ScriptF era)
spendscriptuniv
            then
              Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
AlonzoTxOut Addr
addr Value era
v (StrictMaybe DataHash -> AlonzoTxOut era)
-> ((DataHash, Data era) -> StrictMaybe DataHash)
-> (DataHash, Data era)
-> AlonzoTxOut era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataHash -> StrictMaybe DataHash
forall a. a -> StrictMaybe a
SJust (DataHash -> StrictMaybe DataHash)
-> ((DataHash, Data era) -> DataHash)
-> (DataHash, Data era)
-> StrictMaybe DataHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataHash, Data era) -> DataHash
forall a b. (a, b) -> a
fst
                ((DataHash, Data era) -> AlonzoTxOut era)
-> Gen (DataHash, Data era) -> Gen (AlonzoTxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Map DataHash (Data era) -> Gen (DataHash, Data era)
forall k a. [String] -> Map k a -> Gen (k, a)
genFromMap [String
"from genTxOut, AlonzoToAlonzo, needsDatum case"] Map DataHash (Data era)
datauniv
            else AlonzoTxOut era -> Gen (AlonzoTxOut era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
AlonzoTxOut Addr
addr Value era
v StrictMaybe DataHash
forall a. StrictMaybe a
SNothing)
    TxOutWit era
TxOutBabbageToConway -> do
      Addr
addr <- [String] -> Set Addr -> Gen Addr
forall t. [String] -> Set t -> Gen t
pick1 [String
"genTxOut BabbageToConway Addr"] Set Addr
addruniv
      Value era
v <- Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era)
genvalue Coin
c Map ScriptHash (ScriptF era)
scriptuniv
      (ScriptF Proof era
_ Script era
refscript) <- (ScriptHash, ScriptF era) -> ScriptF era
forall a b. (a, b) -> b
snd ((ScriptHash, ScriptF era) -> ScriptF era)
-> Gen (ScriptHash, ScriptF era) -> Gen (ScriptF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
-> Map ScriptHash (ScriptF era) -> Gen (ScriptHash, ScriptF era)
forall k a. [String] -> Map k a -> Gen (k, a)
genFromMap [String
"genTxOut, BabbageToConway, refscript case"] Map ScriptHash (ScriptF era)
scriptuniv
      StrictMaybe (Script era)
maybescript <- [StrictMaybe (Script era)] -> Gen (StrictMaybe (Script era))
forall a. HasCallStack => [a] -> Gen a
elements [StrictMaybe (Script era)
forall a. StrictMaybe a
SNothing, Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust Script era
refscript]
      case Addr
addr of
        AddrBootstrap BootstrapAddress
_ -> BabbageTxOut era -> Gen (BabbageTxOut era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BabbageTxOut era -> Gen (BabbageTxOut era))
-> BabbageTxOut era -> Gen (BabbageTxOut era)
forall a b. (a -> b) -> a -> b
$ Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value era
v Datum era
forall era. Datum era
NoDatum StrictMaybe (Script era)
maybescript
        Addr Network
_ PaymentCredential
paycred StakeReference
_ ->
          if PaymentCredential -> Map ScriptHash (ScriptF era) -> Bool
forall era.
EraScript era =>
PaymentCredential -> Map ScriptHash (ScriptF era) -> Bool
needsDatum PaymentCredential
paycred Map ScriptHash (ScriptF era)
spendscriptuniv
            then Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value era
v (Datum era -> StrictMaybe (Script era) -> BabbageTxOut era)
-> Gen (Datum era)
-> Gen (StrictMaybe (Script era) -> BabbageTxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnivSize -> Map DataHash (Data era) -> Gen (Datum era)
forall era. UnivSize -> Map DataHash (Data era) -> Gen (Datum era)
genDatum UnivSize
sizes Map DataHash (Data era)
datauniv Gen (StrictMaybe (Script era) -> BabbageTxOut era)
-> Gen (StrictMaybe (Script era)) -> Gen (BabbageTxOut era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe (Script era) -> Gen (StrictMaybe (Script era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe (Script era)
maybescript
            else BabbageTxOut era -> Gen (BabbageTxOut era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BabbageTxOut era -> Gen (BabbageTxOut era))
-> BabbageTxOut era -> Gen (BabbageTxOut era)
forall a b. (a -> b) -> a -> b
$ Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value era
v Datum era
forall era. Datum era
NoDatum StrictMaybe (Script era)
maybescript

needsDatum ::
  EraScript era =>
  Credential 'Payment ->
  Map ScriptHash (ScriptF era) ->
  Bool
needsDatum :: forall era.
EraScript era =>
PaymentCredential -> Map ScriptHash (ScriptF era) -> Bool
needsDatum (ScriptHashObj ScriptHash
hash) Map ScriptHash (ScriptF era)
spendScriptUniv = case ScriptHash -> Map ScriptHash (ScriptF era) -> Maybe (ScriptF era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash
hash Map ScriptHash (ScriptF era)
spendScriptUniv of
  Maybe (ScriptF era)
Nothing -> Bool
False
  Just (ScriptF Proof era
_ Script era
script) -> Bool -> Bool
not (Script era -> Bool
forall era. EraScript era => Script era -> Bool
isNativeScript Script era
script)
needsDatum PaymentCredential
_ Map ScriptHash (ScriptF era)
_ = Bool
False

genTxOuts ::
  Reflect era =>
  UnivSize ->
  (Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era)) ->
  Proof era ->
  Int ->
  Set Addr ->
  Map ScriptHash (ScriptF era) ->
  Map ScriptHash (ScriptF era) ->
  Map DataHash (Data era) ->
  Gen [TxOutF era]
genTxOuts :: forall era.
Reflect era =>
UnivSize
-> (Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era))
-> Proof era
-> Int
-> Set Addr
-> Map ScriptHash (ScriptF era)
-> Map ScriptHash (ScriptF era)
-> Map DataHash (Data era)
-> Gen [TxOutF era]
genTxOuts UnivSize
sizes Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era)
genvalue Proof era
p Int
ntxouts Set Addr
addruniv Map ScriptHash (ScriptF era)
scriptuniv Map ScriptHash (ScriptF era)
spendscriptuniv Map DataHash (Data era)
datauniv = do
  let genOne :: Gen (TxOut era)
genOne = do
        Coin
c <- Gen Coin
noZeroCoin
        UnivSize
-> (Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era))
-> Proof era
-> Coin
-> Set Addr
-> Map ScriptHash (ScriptF era)
-> Map ScriptHash (ScriptF era)
-> Map DataHash (Data era)
-> Gen (TxOut era)
forall era.
Reflect era =>
UnivSize
-> (Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era))
-> Proof era
-> Coin
-> Set Addr
-> Map ScriptHash (ScriptF era)
-> Map ScriptHash (ScriptF era)
-> Map DataHash (Data era)
-> Gen (TxOut era)
genTxOut UnivSize
sizes Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era)
genvalue Proof era
p Coin
c Set Addr
addruniv Map ScriptHash (ScriptF era)
scriptuniv Map ScriptHash (ScriptF era)
spendscriptuniv Map DataHash (Data era)
datauniv
  Int -> Gen (TxOutF era) -> Gen [TxOutF era]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
ntxouts (Proof era -> TxOut era -> TxOutF era
forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
p (TxOut era -> TxOutF era) -> Gen (TxOut era) -> Gen (TxOutF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxOut era)
genOne)

-- ==================================================================
-- MultiAssets

genMultiAssetTriple ::
  Map.Map ScriptHash (ScriptF era) ->
  Set AssetName ->
  Gen Integer ->
  Gen (PolicyID, AssetName, Integer)
genMultiAssetTriple :: forall era.
Map ScriptHash (ScriptF era)
-> Set AssetName
-> Gen Integer
-> Gen (PolicyID, AssetName, Integer)
genMultiAssetTriple Map ScriptHash (ScriptF era)
scriptMap Set AssetName
assetSet Gen Integer
genAmount =
  (,,)
    (PolicyID
 -> AssetName -> Integer -> (PolicyID, AssetName, Integer))
-> Gen PolicyID
-> Gen (AssetName -> Integer -> (PolicyID, AssetName, Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ScriptHash -> PolicyID
PolicyID (ScriptHash -> PolicyID)
-> ((ScriptHash, ScriptF era) -> ScriptHash)
-> (ScriptHash, ScriptF era)
-> PolicyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScriptHash, ScriptF era) -> ScriptHash
forall a b. (a, b) -> a
fst ((ScriptHash, ScriptF era) -> PolicyID)
-> Gen (ScriptHash, ScriptF era) -> Gen PolicyID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String]
-> Map ScriptHash (ScriptF era) -> Gen (ScriptHash, ScriptF era)
forall k a. [String] -> Map k a -> Gen (k, a)
genFromMap [] Map ScriptHash (ScriptF era)
scriptMap))
    Gen (AssetName -> Integer -> (PolicyID, AssetName, Integer))
-> Gen AssetName -> Gen (Integer -> (PolicyID, AssetName, Integer))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((AssetName, Set AssetName) -> AssetName
forall a b. (a, b) -> a
fst ((AssetName, Set AssetName) -> AssetName)
-> Gen (AssetName, Set AssetName) -> Gen AssetName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String] -> Set AssetName -> Gen (AssetName, Set AssetName)
forall a. [String] -> Set a -> Gen (a, Set a)
itemFromSet [] Set AssetName
assetSet))
    Gen (Integer -> (PolicyID, AssetName, Integer))
-> Gen Integer -> Gen (PolicyID, AssetName, Integer)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
genAmount

-- ===================================================================
-- Helper functions in the Gen monad.

pick1 :: [String] -> Set t -> Gen t
pick1 :: forall t. [String] -> Set t -> Gen t
pick1 [String]
msgs Set t
s = (t, Set t) -> t
forall a b. (a, b) -> a
fst ((t, Set t) -> t) -> Gen (t, Set t) -> Gen t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Set t -> Gen (t, Set t)
forall a. [String] -> Set a -> Gen (a, Set a)
itemFromSet (String
"from pick1" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs) Set t
s

makeHashScriptMap ::
  Reflect era =>
  Proof era ->
  Int ->
  PlutusPurposeTag ->
  Map (KeyHash 'Witness) (KeyPair 'Witness) ->
  ValidityInterval ->
  Gen (Map ScriptHash (ScriptF era))
makeHashScriptMap :: forall era.
Reflect era =>
Proof era
-> Int
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Map ScriptHash (ScriptF era))
makeHashScriptMap Proof era
p Int
size PlutusPurposeTag
tag Map (KeyHash 'Witness) (KeyPair 'Witness)
m ValidityInterval
vi = do
  let genOne :: PlutusPurposeTag -> Gen (Script era)
genOne PlutusPurposeTag
Spending =
        -- Make an effort to get as many plutus scripts as possible (in Eras that support plutus)
        case Proof era -> ScriptWit era
forall era. Proof era -> ScriptWit era
whichScript Proof era
p of
          ScriptWit era
ScriptShelleyToShelley -> Proof era
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Script era)
forall era.
Proof era
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Script era)
genCoreScript Proof era
p PlutusPurposeTag
Spending Map (KeyHash 'Witness) (KeyPair 'Witness)
m ValidityInterval
vi
          ScriptWit era
ScriptAllegraToMary -> Proof era
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Script era)
forall era.
Proof era
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Script era)
genCoreScript Proof era
p PlutusPurposeTag
Spending Map (KeyHash 'Witness) (KeyPair 'Witness)
m ValidityInterval
vi
          ScriptWit era
ScriptAlonzoToConway ->
            [Gen (AlonzoScript era)] -> Gen (AlonzoScript era)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
              [ (IsValid, AlonzoScript era) -> AlonzoScript era
forall a b. (a, b) -> b
snd ((IsValid, AlonzoScript era) -> AlonzoScript era)
-> ((ScriptHash, (IsValid, AlonzoScript era))
    -> (IsValid, AlonzoScript era))
-> (ScriptHash, (IsValid, AlonzoScript era))
-> AlonzoScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScriptHash, (IsValid, AlonzoScript era))
-> (IsValid, AlonzoScript era)
forall a b. (a, b) -> b
snd ((ScriptHash, (IsValid, AlonzoScript era)) -> AlonzoScript era)
-> Gen (ScriptHash, (IsValid, AlonzoScript era))
-> Gen (AlonzoScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
-> Map ScriptHash (IsValid, AlonzoScript era)
-> Gen (ScriptHash, (IsValid, AlonzoScript era))
forall k a. [String] -> Map k a -> Gen (k, a)
genFromMap [] (Proof era -> Map ScriptHash (IsValid, Script era)
forall era.
Reflect era =>
Proof era -> Map ScriptHash (IsValid, Script era)
spendPlutusScripts Proof era
p)
              , Proof era
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Script era)
forall era.
Proof era
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Script era)
genCoreScript Proof era
p PlutusPurposeTag
Spending Map (KeyHash 'Witness) (KeyPair 'Witness)
m ValidityInterval
vi
              ]
      genOne PlutusPurposeTag
t = Proof era
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Script era)
forall era.
Proof era
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Script era)
genCoreScript Proof era
p PlutusPurposeTag
t Map (KeyHash 'Witness) (KeyPair 'Witness)
m ValidityInterval
vi
  [Script era]
scs <- Int -> Gen (Script era) -> Gen [Script era]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
size (PlutusPurposeTag -> Gen (Script era)
genOne PlutusPurposeTag
tag)
  Map ScriptHash (ScriptF era) -> Gen (Map ScriptHash (ScriptF era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ScriptHash (ScriptF era)
 -> Gen (Map ScriptHash (ScriptF era)))
-> Map ScriptHash (ScriptF era)
-> Gen (Map ScriptHash (ScriptF era))
forall a b. (a -> b) -> a -> b
$ [(ScriptHash, ScriptF era)] -> Map ScriptHash (ScriptF era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ScriptHash, ScriptF era)] -> Map ScriptHash (ScriptF era))
-> [(ScriptHash, ScriptF era)] -> Map ScriptHash (ScriptF era)
forall a b. (a -> b) -> a -> b
$ (Script era -> (ScriptHash, ScriptF era))
-> [Script era] -> [(ScriptHash, ScriptF era)]
forall a b. (a -> b) -> [a] -> [b]
map (\Script era
x -> (Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
x, Proof era -> Script era -> ScriptF era
forall era. Proof era -> Script era -> ScriptF era
ScriptF Proof era
p Script era
x)) [Script era]
scs

genDataWits ::
  Era era =>
  Proof era ->
  Int ->
  Gen (Map DataHash (Data era))
genDataWits :: forall era.
Era era =>
Proof era -> Int -> Gen (Map DataHash (Data era))
genDataWits Proof era
_p Int
size = do
  [Data era]
scs <- Int -> Gen (Data era) -> Gen [Data era]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
size Gen (Data era)
forall a. Arbitrary a => Gen a
arbitrary
  Map DataHash (Data era) -> Gen (Map DataHash (Data era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map DataHash (Data era) -> Gen (Map DataHash (Data era)))
-> Map DataHash (Data era) -> Gen (Map DataHash (Data era))
forall a b. (a -> b) -> a -> b
$ [(DataHash, Data era)] -> Map DataHash (Data era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(DataHash, Data era)] -> Map DataHash (Data era))
-> [(DataHash, Data era)] -> Map DataHash (Data era)
forall a b. (a -> b) -> a -> b
$ (Data era -> (DataHash, Data era))
-> [Data era] -> [(DataHash, Data era)]
forall a b. (a -> b) -> [a] -> [b]
map (\Data era
x -> (Data era -> DataHash
forall era. Data era -> DataHash
hashData Data era
x, Data era
x)) [Data era]
scs

--  This universe must not use Byron Addresses in Babbage and Conway, as Byron Addresses
--  do not play well with plutusScripts in those eras.
genAddrWith ::
  Proof era ->
  Network ->
  Set (Credential 'Payment) ->
  Set Ptr ->
  Set (Credential 'Staking) ->
  Map (KeyHash 'Payment) (Addr, Byron.SigningKey) -> -- The Byron Addresss Universe
  Gen Addr
genAddrWith :: forall era.
Proof era
-> Network
-> Set PaymentCredential
-> Set Ptr
-> Set (Credential 'Staking)
-> Map (KeyHash 'Payment) (Addr, SigningKey)
-> Gen Addr
genAddrWith Proof era
proof Network
net Set PaymentCredential
ps Set Ptr
ptrss Set (Credential 'Staking)
cs Map (KeyHash 'Payment) (Addr, SigningKey)
byronMap =
  case Proof era -> TxOutWit era
forall era. Proof era -> TxOutWit era
whichTxOut Proof era
proof of
    TxOutWit era
TxOutBabbageToConway -> Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
net (PaymentCredential -> StakeReference -> Addr)
-> Gen PaymentCredential -> Gen (StakeReference -> Addr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Set PaymentCredential -> Gen PaymentCredential
forall t. [String] -> Set t -> Gen t
pick1 [String
"from genPayCred ScriptHashObj"] Set PaymentCredential
ps Gen (StakeReference -> Addr) -> Gen StakeReference -> Gen Addr
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proof era
-> Set Ptr -> Set (Credential 'Staking) -> Gen StakeReference
forall era.
Proof era
-> Set Ptr -> Set (Credential 'Staking) -> Gen StakeReference
genStakeRefWith Proof era
proof Set Ptr
ptrss Set (Credential 'Staking)
cs
    TxOutWit era
_ ->
      [(Int, Gen Addr)] -> Gen Addr
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
        [ (Int
8, Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
net (PaymentCredential -> StakeReference -> Addr)
-> Gen PaymentCredential -> Gen (StakeReference -> Addr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Set PaymentCredential -> Gen PaymentCredential
forall t. [String] -> Set t -> Gen t
pick1 [String
"from genPayCred ScriptHashObj"] Set PaymentCredential
ps Gen (StakeReference -> Addr) -> Gen StakeReference -> Gen Addr
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proof era
-> Set Ptr -> Set (Credential 'Staking) -> Gen StakeReference
forall era.
Proof era
-> Set Ptr -> Set (Credential 'Staking) -> Gen StakeReference
genStakeRefWith Proof era
proof Set Ptr
ptrss Set (Credential 'Staking)
cs)
        , (Int
2, (Addr, SigningKey) -> Addr
forall a b. (a, b) -> a
fst ((Addr, SigningKey) -> Addr)
-> ((KeyHash 'Payment, (Addr, SigningKey)) -> (Addr, SigningKey))
-> (KeyHash 'Payment, (Addr, SigningKey))
-> Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHash 'Payment, (Addr, SigningKey)) -> (Addr, SigningKey)
forall a b. (a, b) -> b
snd ((KeyHash 'Payment, (Addr, SigningKey)) -> Addr)
-> Gen (KeyHash 'Payment, (Addr, SigningKey)) -> Gen Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
-> Map (KeyHash 'Payment) (Addr, SigningKey)
-> Gen (KeyHash 'Payment, (Addr, SigningKey))
forall k a. [String] -> Map k a -> Gen (k, a)
genFromMap [String
"from byronAddrUniv"] Map (KeyHash 'Payment) (Addr, SigningKey)
byronMap) -- This generates a known Byron Address
        ]

genPtr :: SlotNo -> Gen Ptr
genPtr :: SlotNo -> Gen Ptr
genPtr (SlotNo Word64
n) =
  SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr
    (SlotNo32 -> TxIx -> CertIx -> Ptr)
-> Gen SlotNo32 -> Gen (TxIx -> CertIx -> Ptr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> SlotNo32
SlotNo32 (Word32 -> SlotNo32) -> Gen Word32 -> Gen SlotNo32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
0, Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n))
    Gen (TxIx -> CertIx -> Ptr) -> Gen TxIx -> Gen (CertIx -> Ptr)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word16 -> TxIx
TxIx (Word16 -> TxIx) -> Gen Word16 -> Gen TxIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16, Word16) -> Gen Word16
forall a. Random a => (a, a) -> Gen a
choose (Word16
0, Word16
10))
    Gen (CertIx -> Ptr) -> Gen CertIx -> Gen Ptr
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HasCallStack => Integer -> CertIx
Integer -> CertIx
mkCertIxPartial (Integer -> CertIx) -> Gen Integer -> Gen CertIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
20))

genStakeRefWith ::
  forall era.
  Proof era ->
  Set Ptr ->
  Set (Credential 'Staking) ->
  Gen StakeReference
genStakeRefWith :: forall era.
Proof era
-> Set Ptr -> Set (Credential 'Staking) -> Gen StakeReference
genStakeRefWith Proof era
proof Set Ptr
ps Set (Credential 'Staking)
cs =
  [(Int, Gen StakeReference)] -> Gen StakeReference
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
80, Credential 'Staking -> StakeReference
StakeRefBase (Credential 'Staking -> StakeReference)
-> Gen (Credential 'Staking) -> Gen StakeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Set (Credential 'Staking) -> Gen (Credential 'Staking)
forall t. [String] -> Set t -> Gen t
pick1 [String
"from genStakeRefWith StakeRefBase"] Set (Credential 'Staking)
cs)
    ,
      ( if Proof era -> ProtVer
forall era. Proof era -> ProtVer
protocolVersion Proof era
proof ProtVer -> ProtVer -> Bool
forall a. Ord a => a -> a -> Bool
>= Proof ConwayEra -> ProtVer
forall era. Proof era -> ProtVer
protocolVersion Proof ConwayEra
Conway then Int
0 else Int
5
      , Ptr -> StakeReference
StakeRefPtr (Ptr -> StakeReference) -> Gen Ptr -> Gen StakeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Set Ptr -> Gen Ptr
forall t. [String] -> Set t -> Gen t
pick1 [String
"from genStakeRefWith StakeRefPtr"] Set Ptr
ps
      )
    , (Int
15, StakeReference -> Gen StakeReference
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeReference
StakeRefNull)
    ]

noScripts :: Proof era -> Addr -> Bool
noScripts :: forall era. Proof era -> Addr -> Bool
noScripts Proof era
_ (Addr Network
_ (ScriptHashObj ScriptHash
_) StakeReference
_) = Bool
False
noScripts Proof era
_ (Addr Network
_ PaymentCredential
_ (StakeRefBase (ScriptHashObj ScriptHash
_))) = Bool
False
noScripts Proof era
_ (AddrBootstrap BootstrapAddress
_) = Bool
False
noScripts Proof era
_ Addr
_ = Bool
True

-- | Make some candidate DReps. The 'Always...' and one from each Credential.
genDReps :: Set (Credential 'Staking) -> Gen [DRep]
genDReps :: Set (Credential 'Staking) -> Gen [DRep]
genDReps Set (Credential 'Staking)
creds =
  [DRep] -> Gen [DRep]
forall a. [a] -> Gen [a]
shuffle
    ( (Credential 'Staking -> DRep) -> [Credential 'Staking] -> [DRep]
forall a b. (a -> b) -> [a] -> [b]
map (Credential 'DRepRole -> DRep
DRepCredential (Credential 'DRepRole -> DRep)
-> (Credential 'Staking -> Credential 'DRepRole)
-> Credential 'Staking
-> DRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking -> Credential 'DRepRole
forall (r :: KeyRole) (r' :: KeyRole).
Credential r -> Credential r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole) (Set (Credential 'Staking) -> [Credential 'Staking]
forall a. Set a -> [a]
Set.toList Set (Credential 'Staking)
creds)
        [DRep] -> [DRep] -> [DRep]
forall a. [a] -> [a] -> [a]
++ [DRep
DRepAlwaysAbstain, DRep
DRepAlwaysNoConfidence]
    )

genDRepsT ::
  UnivSize ->
  Term era (Set (Credential 'Staking)) ->
  Target era (Gen (Set DRep))
genDRepsT :: forall era.
UnivSize
-> Term era (Set (Credential 'Staking))
-> Target era (Gen (Set DRep))
genDRepsT UnivSize
sizes Term era (Set (Credential 'Staking))
creds = String
-> (Set (Credential 'Staking) -> Gen (Set DRep))
-> RootTarget
     era Void (Set (Credential 'Staking) -> Gen (Set DRep))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"listToSet" (\Set (Credential 'Staking)
cs -> ([DRep] -> Set DRep
forall a. Ord a => [a] -> Set a
Set.fromList ([DRep] -> Set DRep) -> ([DRep] -> [DRep]) -> [DRep] -> Set DRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [DRep] -> [DRep]
forall a. Int -> [a] -> [a]
take (UnivSize -> Int
usNumDReps UnivSize
sizes)) ([DRep] -> Set DRep) -> Gen [DRep] -> Gen (Set DRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (Credential 'Staking) -> Gen [DRep]
genDReps Set (Credential 'Staking)
cs) RootTarget era Void (Set (Credential 'Staking) -> Gen (Set DRep))
-> Term era (Set (Credential 'Staking))
-> Target era (Gen (Set DRep))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (Credential 'Staking))
creds

-- ======================================================================
-- Reusable Targets. First order representations of functions for use in
-- building 'Target's. We will apply these to Term variables,
-- (using  (:$) and (^$)) to indicate how to construct a random values assigned
-- to those variables. By convention we name these "functional" targets by
-- post-fixing their names with a captial "T". These may be a bit more
-- prescriptive rather than descriptive, but you do what you have to do.

txOutT :: Reflect era => Proof era -> Addr -> Coin -> TxOutF era
txOutT :: forall era. Reflect era => Proof era -> Addr -> Coin -> TxOutF era
txOutT Proof era
p Addr
x Coin
c = Proof era -> TxOut era -> TxOutF era
forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
p (Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
x (Coin -> Value era
forall t s. Inject t s => t -> s
inject Coin
c))

-- | The collateral consists only of VKey addresses
--   and the collateral outputs in the UTxO do not contain any non-ADA part
colTxOutT :: EraTxOut era => Proof era -> Set Addr -> Gen (TxOutF era)
colTxOutT :: forall era.
EraTxOut era =>
Proof era -> Set Addr -> Gen (TxOutF era)
colTxOutT Proof era
p Set Addr
noScriptAddr =
  Proof era -> TxOut era -> TxOutF era
forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
p
    (TxOut era -> TxOutF era) -> Gen (TxOut era) -> Gen (TxOutF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Addr -> Value era -> TxOut era)
-> Gen Addr -> Gen (Value era -> TxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Set Addr -> Gen Addr
forall t. [String] -> Set t -> Gen t
pick1 [String
"from colTxOutT noScriptAddr"] Set Addr
noScriptAddr Gen (Value era -> TxOut era) -> Gen (Value era) -> Gen (TxOut era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Gen Coin -> Gen (Value era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Coin
noZeroCoin))

-- | The collateral consists only of VKey addresses
--   and the collateral outputs in the UTxO do not contain any non-ADA part
colTxOutSetT :: EraTxOut era => Proof era -> Set Addr -> Gen (Set (TxOutF era))
colTxOutSetT :: forall era.
EraTxOut era =>
Proof era -> Set Addr -> Gen (Set (TxOutF era))
colTxOutSetT Proof era
p Set Addr
noScriptAddr = (Gen (Set (TxOutF era)) -> Addr -> Gen (Set (TxOutF era)))
-> Gen (Set (TxOutF era)) -> Set Addr -> Gen (Set (TxOutF era))
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Gen (Set (TxOutF era)) -> Addr -> Gen (Set (TxOutF era))
accum (Set (TxOutF era) -> Gen (Set (TxOutF era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (TxOutF era)
forall a. Set a
Set.empty) Set Addr
noScriptAddr
  where
    accum :: Gen (Set (TxOutF era)) -> Addr -> Gen (Set (TxOutF era))
accum Gen (Set (TxOutF era))
ansM Addr
addr = do
      Coin
c <- Gen Coin
noZeroCoin
      TxOutF era -> Set (TxOutF era) -> Set (TxOutF era)
forall a. Ord a => a -> Set a -> Set a
Set.insert (Proof era -> TxOut era -> TxOutF era
forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
p (Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
addr (Coin -> Value era
forall t s. Inject t s => t -> s
inject Coin
c))) (Set (TxOutF era) -> Set (TxOutF era))
-> Gen (Set (TxOutF era)) -> Gen (Set (TxOutF era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (TxOutF era))
ansM

scriptHashObjT :: Term era ScriptHash -> Target era (Credential k)
scriptHashObjT :: forall era (k :: KeyRole).
Term era ScriptHash -> Target era (Credential k)
scriptHashObjT Term era ScriptHash
x = String
-> (ScriptHash -> Credential k)
-> RootTarget era Void (ScriptHash -> Credential k)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"ScriptHashObj" ScriptHash -> Credential k
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj RootTarget era Void (ScriptHash -> Credential k)
-> Term era ScriptHash -> Target era (Credential k)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era ScriptHash
x

keyHashObjT ::
  Term era (KeyHash 'Witness) -> Target era (Credential k)
keyHashObjT :: forall era (k :: KeyRole).
Term era (KeyHash 'Witness) -> Target era (Credential k)
keyHashObjT Term era (KeyHash 'Witness)
x = String
-> (KeyHash 'Witness -> Credential k)
-> RootTarget era Void (KeyHash 'Witness -> Credential k)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"KeyHashObj" (KeyHash k -> Credential k
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash k -> Credential k)
-> (KeyHash 'Witness -> KeyHash k)
-> KeyHash 'Witness
-> Credential k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Witness -> KeyHash k
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole) RootTarget era Void (KeyHash 'Witness -> Credential k)
-> Term era (KeyHash 'Witness) -> Target era (Credential k)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (KeyHash 'Witness)
x

makeValidityT ::
  Term era SlotNo -> Term era SlotNo -> Term era SlotNo -> Target era ValidityInterval
makeValidityT :: forall era.
Term era SlotNo
-> Term era SlotNo
-> Term era SlotNo
-> Target era ValidityInterval
makeValidityT Term era SlotNo
begin Term era SlotNo
current Term era SlotNo
end =
  String
-> (SlotNo -> SlotNo -> SlotNo -> ValidityInterval)
-> RootTarget
     era Void (SlotNo -> SlotNo -> SlotNo -> ValidityInterval)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr
    String
"(-i)x(+j)"
    (\SlotNo
beginD SlotNo
x SlotNo
endD -> StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust (SlotNo
x SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
- SlotNo
beginD)) (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust (SlotNo
x SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ SlotNo
endD)))
    RootTarget
  era Void (SlotNo -> SlotNo -> SlotNo -> ValidityInterval)
-> Term era SlotNo
-> Target era (SlotNo -> SlotNo -> ValidityInterval)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era SlotNo
begin
    Target era (SlotNo -> SlotNo -> ValidityInterval)
-> Term era SlotNo -> Target era (SlotNo -> ValidityInterval)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era SlotNo
current
    Target era (SlotNo -> ValidityInterval)
-> Term era SlotNo -> Target era ValidityInterval
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era SlotNo
end

ptrUnivT :: Int -> Term era SlotNo -> Target era (Gen (Set Ptr))
ptrUnivT :: forall era. Int -> Term era SlotNo -> Target era (Gen (Set Ptr))
ptrUnivT Int
nptrs Term era SlotNo
x = String
-> (Gen Ptr -> Gen (Set Ptr))
-> RootTarget era Void (Gen Ptr -> Gen (Set Ptr))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"" ([String] -> Int -> Gen Ptr -> Gen (Set Ptr)
forall a. Ord a => [String] -> Int -> Gen a -> Gen (Set a)
setSized [String
"From init ptruniv"] Int
nptrs) RootTarget era Void (Gen Ptr -> Gen (Set Ptr))
-> RootTarget era Void (Gen Ptr)
-> RootTarget era Void (Gen (Set Ptr))
forall era root a t.
RootTarget era root (a -> t)
-> RootTarget era root a -> RootTarget era root t
:$ (String
-> (SlotNo -> Gen Ptr) -> RootTarget era Void (SlotNo -> Gen Ptr)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"" SlotNo -> Gen Ptr
genPtr RootTarget era Void (SlotNo -> Gen Ptr)
-> Term era SlotNo -> RootTarget era Void (Gen Ptr)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era SlotNo
x)

addrUnivT ::
  Proof era ->
  Int ->
  Term era Network ->
  Term era (Set (Credential 'Payment)) ->
  Term era (Set Ptr) ->
  Term era (Set (Credential 'Staking)) ->
  Term era (Map (KeyHash 'Payment) (Addr, Byron.SigningKey)) ->
  Target era (Gen (Set Addr))
addrUnivT :: forall era.
Proof era
-> Int
-> Term era Network
-> Term era (Set PaymentCredential)
-> Term era (Set Ptr)
-> Term era (Set (Credential 'Staking))
-> Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
-> Target era (Gen (Set Addr))
addrUnivT Proof era
p Int
naddr Term era Network
net Term era (Set PaymentCredential)
ps Term era (Set Ptr)
pts Term era (Set (Credential 'Staking))
cs Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
byronAddrUnivT =
  String
-> (Gen Addr -> Gen (Set Addr))
-> RootTarget era Void (Gen Addr -> Gen (Set Addr))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"" ([String] -> Int -> Gen Addr -> Gen (Set Addr)
forall a. Ord a => [String] -> Int -> Gen a -> Gen (Set a)
setSized [String
"From addrUnivT"] Int
naddr)
    RootTarget era Void (Gen Addr -> Gen (Set Addr))
-> RootTarget era Void (Gen Addr)
-> RootTarget era Void (Gen (Set Addr))
forall era root a t.
RootTarget era root (a -> t)
-> RootTarget era root a -> RootTarget era root t
:$ (String
-> (Network
    -> Set PaymentCredential
    -> Set Ptr
    -> Set (Credential 'Staking)
    -> Map (KeyHash 'Payment) (Addr, SigningKey)
    -> Gen Addr)
-> RootTarget
     era
     Void
     (Network
      -> Set PaymentCredential
      -> Set Ptr
      -> Set (Credential 'Staking)
      -> Map (KeyHash 'Payment) (Addr, SigningKey)
      -> Gen Addr)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"genAddrWith" (Proof era
-> Network
-> Set PaymentCredential
-> Set Ptr
-> Set (Credential 'Staking)
-> Map (KeyHash 'Payment) (Addr, SigningKey)
-> Gen Addr
forall era.
Proof era
-> Network
-> Set PaymentCredential
-> Set Ptr
-> Set (Credential 'Staking)
-> Map (KeyHash 'Payment) (Addr, SigningKey)
-> Gen Addr
genAddrWith Proof era
p) RootTarget
  era
  Void
  (Network
   -> Set PaymentCredential
   -> Set Ptr
   -> Set (Credential 'Staking)
   -> Map (KeyHash 'Payment) (Addr, SigningKey)
   -> Gen Addr)
-> Term era Network
-> Target
     era
     (Set PaymentCredential
      -> Set Ptr
      -> Set (Credential 'Staking)
      -> Map (KeyHash 'Payment) (Addr, SigningKey)
      -> Gen Addr)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era Network
net Target
  era
  (Set PaymentCredential
   -> Set Ptr
   -> Set (Credential 'Staking)
   -> Map (KeyHash 'Payment) (Addr, SigningKey)
   -> Gen Addr)
-> Term era (Set PaymentCredential)
-> Target
     era
     (Set Ptr
      -> Set (Credential 'Staking)
      -> Map (KeyHash 'Payment) (Addr, SigningKey)
      -> Gen Addr)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set PaymentCredential)
ps Target
  era
  (Set Ptr
   -> Set (Credential 'Staking)
   -> Map (KeyHash 'Payment) (Addr, SigningKey)
   -> Gen Addr)
-> Term era (Set Ptr)
-> Target
     era
     (Set (Credential 'Staking)
      -> Map (KeyHash 'Payment) (Addr, SigningKey) -> Gen Addr)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set Ptr)
pts Target
  era
  (Set (Credential 'Staking)
   -> Map (KeyHash 'Payment) (Addr, SigningKey) -> Gen Addr)
-> Term era (Set (Credential 'Staking))
-> Target
     era (Map (KeyHash 'Payment) (Addr, SigningKey) -> Gen Addr)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (Credential 'Staking))
cs Target era (Map (KeyHash 'Payment) (Addr, SigningKey) -> Gen Addr)
-> Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
-> RootTarget era Void (Gen Addr)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
byronAddrUnivT)

makeHashScriptMapT ::
  Proof era ->
  Int ->
  PlutusPurposeTag ->
  Term era (Map (KeyHash 'Witness) (KeyPair 'Witness)) ->
  Term era ValidityInterval ->
  Target era (Gen (Map ScriptHash (ScriptF era)))
makeHashScriptMapT :: forall era.
Proof era
-> Int
-> PlutusPurposeTag
-> Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era ValidityInterval
-> Target era (Gen (Map ScriptHash (ScriptF era)))
makeHashScriptMapT Proof era
p Int
size PlutusPurposeTag
tag Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
m Term era ValidityInterval
vi =
  String
-> (Map (KeyHash 'Witness) (KeyPair 'Witness)
    -> ValidityInterval -> Gen (Map ScriptHash (ScriptF era)))
-> RootTarget
     era
     Void
     (Map (KeyHash 'Witness) (KeyPair 'Witness)
      -> ValidityInterval -> Gen (Map ScriptHash (ScriptF era)))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr
    String
"makeHashScriptMap"
    ((Reflect era =>
 Proof era
 -> Int
 -> PlutusPurposeTag
 -> Map (KeyHash 'Witness) (KeyPair 'Witness)
 -> ValidityInterval
 -> Gen (Map ScriptHash (ScriptF era)))
-> Proof era
-> Int
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Map ScriptHash (ScriptF era))
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era =>
Proof era
-> Int
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Map ScriptHash (ScriptF era))
Proof era
-> Int
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Map ScriptHash (ScriptF era))
forall era.
Reflect era =>
Proof era
-> Int
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Map ScriptHash (ScriptF era))
makeHashScriptMap Proof era
p Int
size PlutusPurposeTag
tag)
    RootTarget
  era
  Void
  (Map (KeyHash 'Witness) (KeyPair 'Witness)
   -> ValidityInterval -> Gen (Map ScriptHash (ScriptF era)))
-> Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Target
     era (ValidityInterval -> Gen (Map ScriptHash (ScriptF era)))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
m
    Target era (ValidityInterval -> Gen (Map ScriptHash (ScriptF era)))
-> Term era ValidityInterval
-> Target era (Gen (Map ScriptHash (ScriptF era)))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era ValidityInterval
vi

cast :: forall k. Set (KeyHash 'Witness) -> Set (KeyHash k)
cast :: forall (k :: KeyRole). Set (KeyHash 'Witness) -> Set (KeyHash k)
cast Set (KeyHash 'Witness)
x = (KeyHash 'Witness -> KeyHash k)
-> Set (KeyHash 'Witness) -> Set (KeyHash k)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\KeyHash 'Witness
kh -> forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole @KeyHash @'Witness KeyHash 'Witness
kh) Set (KeyHash 'Witness)
x

-- TODO make some Script Credentials in addition to Key credentials
castCredCold :: Set (KeyHash 'Witness) -> Set (Credential 'ColdCommitteeRole)
castCredCold :: Set (KeyHash 'Witness) -> Set (Credential 'ColdCommitteeRole)
castCredCold = (KeyHash 'Witness -> Credential 'ColdCommitteeRole)
-> Set (KeyHash 'Witness) -> Set (Credential 'ColdCommitteeRole)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Credential 'Witness -> Credential 'ColdCommitteeRole
forall (r :: KeyRole) (r' :: KeyRole).
Credential r -> Credential r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (Credential 'Witness -> Credential 'ColdCommitteeRole)
-> (KeyHash 'Witness -> Credential 'Witness)
-> KeyHash 'Witness
-> Credential 'ColdCommitteeRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Witness -> Credential 'Witness
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj)

castCredHot :: Set (KeyHash 'Witness) -> Set (Credential 'HotCommitteeRole)
castCredHot :: Set (KeyHash 'Witness) -> Set (Credential 'HotCommitteeRole)
castCredHot = (KeyHash 'Witness -> Credential 'HotCommitteeRole)
-> Set (KeyHash 'Witness) -> Set (Credential 'HotCommitteeRole)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Credential 'Witness -> Credential 'HotCommitteeRole
forall (r :: KeyRole) (r' :: KeyRole).
Credential r -> Credential r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (Credential 'Witness -> Credential 'HotCommitteeRole)
-> (KeyHash 'Witness -> Credential 'Witness)
-> KeyHash 'Witness
-> Credential 'HotCommitteeRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Witness -> Credential 'Witness
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj)

txinToGovactionId :: TxIn -> GovActionId
txinToGovactionId :: TxIn -> GovActionId
txinToGovactionId (TxIn TxId
idx (TxIx Word16
n)) = TxId -> GovActionIx -> GovActionId
GovActionId TxId
idx (Word16 -> GovActionIx
GovActionIx (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n))

-- =================================================================
-- Using constraints to generate the Universes

universePreds :: Reflect era => UnivSize -> Proof era -> [Pred era]
universePreds :: forall era. Reflect era => UnivSize -> Proof era -> [Pred era]
universePreds UnivSize
size Proof era
p =
  [ Term era Size -> Term era SlotNo -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
100 Int
500) Term era SlotNo
forall era. Era era => Term era SlotNo
currentSlot
  , Term era Size -> Term era SlotNo -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
30) Term era SlotNo
forall era. Era era => Term era SlotNo
beginSlotDelta -- Note that (currentSlot - beginSlotDelta) is aways positive
  , Term era Size -> Term era SlotNo -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
900 Int
1000) Term era SlotNo
forall era. Era era => Term era SlotNo
endSlotDelta -- Note each block may have spacing of 2-4 blocks,
  -- So for a Trace of length at most 300, we need at least 900 slots on average
  , Term era Size -> Term era [KeyPair 'Witness] -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Term era Size
forall era. Era era => Int -> Term era Size
ExactSize (UnivSize -> Int
usNumKeys UnivSize
size)) Term era [KeyPair 'Witness]
keypairs
  , Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall era.
Era era =>
Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
keymapUniv Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> RootTarget era Void (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> ([KeyPair 'Witness]
    -> Map (KeyHash 'Witness) (KeyPair 'Witness))
-> RootTarget
     era
     Void
     ([KeyPair 'Witness] -> Map (KeyHash 'Witness) (KeyPair 'Witness))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"xx" (\[KeyPair 'Witness]
s -> [(KeyHash 'Witness, KeyPair 'Witness)]
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((KeyPair 'Witness -> (KeyHash 'Witness, KeyPair 'Witness))
-> [KeyPair 'Witness] -> [(KeyHash 'Witness, KeyPair 'Witness)]
forall a b. (a -> b) -> [a] -> [b]
map (\KeyPair 'Witness
x -> (VKey 'Witness -> KeyHash 'Witness
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (KeyPair 'Witness -> VKey 'Witness
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Witness
x), KeyPair 'Witness
x)) [KeyPair 'Witness]
s)) RootTarget
  era
  Void
  ([KeyPair 'Witness] -> Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era [KeyPair 'Witness]
-> RootTarget era Void (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era [KeyPair 'Witness]
keypairs)
  , Term era Size -> Term era (Set (KeyHash 'Witness)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Term era Size
forall era. Era era => Int -> Term era Size
ExactSize (UnivSize -> Int
usNumPools UnivSize
size)) Term era (Set (KeyHash 'Witness))
prePoolUniv
  , Term era (Set (KeyHash 'Witness))
-> Term era (Set (KeyHash 'Witness)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset Term era (Set (KeyHash 'Witness))
prePoolUniv (Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era (Set (KeyHash 'Witness))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall era.
Era era =>
Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
keymapUniv)
  , Term era (Set (KeyHash 'StakePool))
forall era. Era era => Term era (Set (KeyHash 'StakePool))
poolHashUniv Term era (Set (KeyHash 'StakePool))
-> RootTarget era Void (Set (KeyHash 'StakePool)) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Set (KeyHash 'Witness) -> Set (KeyHash 'StakePool))
-> RootTarget
     era Void (Set (KeyHash 'Witness) -> Set (KeyHash 'StakePool))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"WitnessToStakePool" Set (KeyHash 'Witness) -> Set (KeyHash 'StakePool)
forall (k :: KeyRole). Set (KeyHash 'Witness) -> Set (KeyHash k)
cast RootTarget
  era Void (Set (KeyHash 'Witness) -> Set (KeyHash 'StakePool))
-> Term era (Set (KeyHash 'Witness))
-> RootTarget era Void (Set (KeyHash 'StakePool))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (KeyHash 'Witness))
prePoolUniv)
  , Term era Size -> Term era (Set (KeyHash 'Witness)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Term era Size
forall era. Era era => Int -> Term era Size
ExactSize (UnivSize -> Int
usNumStakeKeys UnivSize
size)) Term era (Set (KeyHash 'Witness))
preStakeUniv
  , Term era (Set (KeyHash 'Witness))
-> Term era (Set (KeyHash 'Witness)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset Term era (Set (KeyHash 'Witness))
preStakeUniv (Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era (Set (KeyHash 'Witness))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall era.
Era era =>
Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
keymapUniv)
  , Term era (Set (KeyHash 'Staking))
forall era. Era era => Term era (Set (KeyHash 'Staking))
stakeHashUniv Term era (Set (KeyHash 'Staking))
-> RootTarget era Void (Set (KeyHash 'Staking)) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Set (KeyHash 'Witness) -> Set (KeyHash 'Staking))
-> RootTarget
     era Void (Set (KeyHash 'Witness) -> Set (KeyHash 'Staking))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"WitnessToStaking" Set (KeyHash 'Witness) -> Set (KeyHash 'Staking)
forall (k :: KeyRole). Set (KeyHash 'Witness) -> Set (KeyHash k)
cast RootTarget
  era Void (Set (KeyHash 'Witness) -> Set (KeyHash 'Staking))
-> Term era (Set (KeyHash 'Witness))
-> RootTarget era Void (Set (KeyHash 'Staking))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (KeyHash 'Witness))
preStakeUniv)
  , Term era (Set (KeyHash 'DRepRole))
forall era. Era era => Term era (Set (KeyHash 'DRepRole))
drepHashUniv Term era (Set (KeyHash 'DRepRole))
-> RootTarget era Void (Set (KeyHash 'DRepRole)) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Set (KeyHash 'Witness) -> Set (KeyHash 'DRepRole))
-> RootTarget
     era Void (Set (KeyHash 'Witness) -> Set (KeyHash 'DRepRole))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"WitnessToDRepRole" Set (KeyHash 'Witness) -> Set (KeyHash 'DRepRole)
forall (k :: KeyRole). Set (KeyHash 'Witness) -> Set (KeyHash k)
cast RootTarget
  era Void (Set (KeyHash 'Witness) -> Set (KeyHash 'DRepRole))
-> Term era (Set (KeyHash 'Witness))
-> RootTarget era Void (Set (KeyHash 'DRepRole))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (KeyHash 'Witness))
preStakeUniv)
  , Term era Size -> Term era (Set (KeyHash 'Witness)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Term era Size
forall era. Era era => Int -> Term era Size
ExactSize (UnivSize -> Int
usNumGenesisKeys UnivSize
size)) Term era (Set (KeyHash 'Witness))
preGenesisUniv
  , Term era (Set (KeyHash 'Witness))
-> Term era (Set (KeyHash 'Witness)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset Term era (Set (KeyHash 'Witness))
preGenesisUniv (Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era (Set (KeyHash 'Witness))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall era.
Era era =>
Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
keymapUniv)
  , Term era (Set (KeyHash 'Genesis))
preGenesisDom Term era (Set (KeyHash 'Genesis))
-> RootTarget era Void (Set (KeyHash 'Genesis)) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Set (KeyHash 'Witness) -> Set (KeyHash 'Genesis))
-> RootTarget
     era Void (Set (KeyHash 'Witness) -> Set (KeyHash 'Genesis))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"WitnessToGenesis" Set (KeyHash 'Witness) -> Set (KeyHash 'Genesis)
forall (k :: KeyRole). Set (KeyHash 'Witness) -> Set (KeyHash k)
cast RootTarget
  era Void (Set (KeyHash 'Witness) -> Set (KeyHash 'Genesis))
-> Term era (Set (KeyHash 'Witness))
-> RootTarget era Void (Set (KeyHash 'Genesis))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (KeyHash 'Witness))
preGenesisUniv)
  , Term era (Set (KeyHash 'Genesis))
preGenesisDom Term era (Set (KeyHash 'Genesis))
-> Term era (Set (KeyHash 'Genesis)) -> Pred era
forall a era. Eq a => Term era a -> Term era a -> Pred era
:=: (Term era (Map (KeyHash 'Genesis) GenDelegPair)
-> Term era (Set (KeyHash 'Genesis))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'Genesis) GenDelegPair)
forall era.
Era era =>
Term era (Map (KeyHash 'Genesis) GenDelegPair)
genesisHashUniv)
  , Term era Size -> Term era (Set (KeyHash 'Witness)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Term era Size
forall era. Era era => Int -> Term era Size
ExactSize (UnivSize -> Int
usNumVoteKeys UnivSize
size)) Term era (Set (KeyHash 'Witness))
preVoteUniv
  , Term era (Set (KeyHash 'Witness))
-> Term era (Set (KeyHash 'Witness)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset Term era (Set (KeyHash 'Witness))
preVoteUniv (Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era (Set (KeyHash 'Witness))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall era.
Era era =>
Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
keymapUniv)
  , Term era (Set (Credential 'ColdCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole))
voteCredUniv Term era (Set (Credential 'ColdCommitteeRole))
-> RootTarget era Void (Set (Credential 'ColdCommitteeRole))
-> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Set (KeyHash 'Witness) -> Set (Credential 'ColdCommitteeRole))
-> RootTarget
     era
     Void
     (Set (KeyHash 'Witness) -> Set (Credential 'ColdCommitteeRole))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"WitnessToStakePool" Set (KeyHash 'Witness) -> Set (Credential 'ColdCommitteeRole)
castCredCold RootTarget
  era
  Void
  (Set (KeyHash 'Witness) -> Set (Credential 'ColdCommitteeRole))
-> Term era (Set (KeyHash 'Witness))
-> RootTarget era Void (Set (Credential 'ColdCommitteeRole))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (KeyHash 'Witness))
preVoteUniv)
  , Term era Size -> Term era (Set TxIn) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Term era Size
forall era. Era era => Int -> Term era Size
ExactSize (UnivSize -> Int
usNumTxIn UnivSize
size)) Term era (Set TxIn)
forall era. Era era => Term era (Set TxIn)
txinUniv
  , Direct (Term era TxIn) -> Term era (Set TxIn) -> Pred era
forall a era.
Ord a =>
Direct (Term era a) -> Term era (Set a) -> Pred era
Member (Term era TxIn -> Direct (Term era TxIn)
forall a b. b -> Either a b
Right Term era TxIn
forall era. Era era => Term era TxIn
feeTxIn) Term era (Set TxIn)
forall era. Era era => Term era (Set TxIn)
txinUniv
  , Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
govActionIdUniv Term era (Set GovActionId)
-> RootTarget era Void (Set GovActionId) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Set TxIn -> Set GovActionId)
-> RootTarget era Void (Set TxIn -> Set GovActionId)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"TxIn-to-GovActionId" ((TxIn -> GovActionId) -> Set TxIn -> Set GovActionId
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TxIn -> GovActionId
txinToGovactionId) RootTarget era Void (Set TxIn -> Set GovActionId)
-> Term era (Set TxIn) -> RootTarget era Void (Set GovActionId)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set TxIn)
forall era. Era era => Term era (Set TxIn)
txinUniv)
  , Term era ValidityInterval
forall era. Era era => Term era ValidityInterval
validityInterval Term era ValidityInterval
-> RootTarget era Void ValidityInterval -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: Term era SlotNo
-> Term era SlotNo
-> Term era SlotNo
-> RootTarget era Void ValidityInterval
forall era.
Term era SlotNo
-> Term era SlotNo
-> Term era SlotNo
-> Target era ValidityInterval
makeValidityT Term era SlotNo
forall era. Era era => Term era SlotNo
beginSlotDelta Term era SlotNo
forall era. Era era => Term era SlotNo
currentSlot Term era SlotNo
forall era. Era era => Term era SlotNo
endSlotDelta
  , Term era Size
-> Term era [Credential 'Staking]
-> [(Int, Target era (Credential 'Staking), [Pred era])]
-> Pred era
forall era t.
(Era era, Eq t) =>
Term era Size
-> Term era [t] -> [(Int, Target era t, [Pred era])] -> Pred era
Choose
      (Int -> Term era Size
forall era. Era era => Int -> Term era Size
ExactSize (UnivSize -> Int
usNumCredentials UnivSize
size))
      Term era [Credential 'Staking]
credList
      [
        ( UnivSize -> Int
usCredScriptFreq UnivSize
size
        , Term era ScriptHash -> Target era (Credential 'Staking)
forall era (k :: KeyRole).
Term era ScriptHash -> Target era (Credential k)
scriptHashObjT Term era ScriptHash
scripthash
        , [Direct (Term era ScriptHash)
-> Term era (Set ScriptHash) -> Pred era
forall a era.
Ord a =>
Direct (Term era a) -> Term era (Set a) -> Pred era
Member (Term era ScriptHash -> Direct (Term era ScriptHash)
forall a b. a -> Either a b
Left Term era ScriptHash
scripthash) (Term era (Map ScriptHash (ScriptF era))
-> Term era (Set ScriptHash)
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom (Proof era -> Term era (Map ScriptHash (ScriptF era))
forall era.
Era era =>
Proof era -> Term era (Map ScriptHash (ScriptF era))
nonSpendScriptUniv Proof era
p))]
        )
      , (Int
1, Term era (KeyHash 'Witness) -> Target era (Credential 'Staking)
forall era (k :: KeyRole).
Term era (KeyHash 'Witness) -> Target era (Credential k)
keyHashObjT Term era (KeyHash 'Witness)
keyhash, [Direct (Term era (KeyHash 'Witness))
-> Term era (Set (KeyHash 'Witness)) -> Pred era
forall a era.
Ord a =>
Direct (Term era a) -> Term era (Set a) -> Pred era
Member (Term era (KeyHash 'Witness) -> Direct (Term era (KeyHash 'Witness))
forall a b. a -> Either a b
Left Term era (KeyHash 'Witness)
keyhash) (Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era (Set (KeyHash 'Witness))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall era.
Era era =>
Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
keymapUniv)])
      ]
  , Term era (Set (Credential 'Staking))
forall era. Era era => Term era (Set (Credential 'Staking))
credsUniv Term era (Set (Credential 'Staking))
-> RootTarget era Void (Set (Credential 'Staking)) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: Term era [Credential 'Staking]
-> RootTarget era Void (Set (Credential 'Staking))
forall x era. Ord x => Term era [x] -> Target era (Set x)
listToSetTarget Term era [Credential 'Staking]
credList
  , Term era (Map ScriptHash (ScriptF era))
-> RootTarget era Void (Gen (Map ScriptHash (ScriptF era)))
-> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom (Proof era -> Term era (Map ScriptHash (ScriptF era))
forall era.
Era era =>
Proof era -> Term era (Map ScriptHash (ScriptF era))
spendscriptUniv Proof era
p) (Proof era
-> Int
-> PlutusPurposeTag
-> Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era ValidityInterval
-> RootTarget era Void (Gen (Map ScriptHash (ScriptF era)))
forall era.
Proof era
-> Int
-> PlutusPurposeTag
-> Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era ValidityInterval
-> Target era (Gen (Map ScriptHash (ScriptF era)))
makeHashScriptMapT Proof era
p Int
25 PlutusPurposeTag
Spending Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall era.
Era era =>
Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
keymapUniv Term era ValidityInterval
forall era. Era era => Term era ValidityInterval
validityInterval)
  , Term era (Map ScriptHash (ScriptF era))
-> RootTarget era Void (Gen (Map ScriptHash (ScriptF era)))
-> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom (Proof era -> Term era (Map ScriptHash (ScriptF era))
forall era.
Era era =>
Proof era -> Term era (Map ScriptHash (ScriptF era))
nonSpendScriptUniv Proof era
p) (Proof era
-> Int
-> PlutusPurposeTag
-> Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era ValidityInterval
-> RootTarget era Void (Gen (Map ScriptHash (ScriptF era)))
forall era.
Proof era
-> Int
-> PlutusPurposeTag
-> Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era ValidityInterval
-> Target era (Gen (Map ScriptHash (ScriptF era)))
makeHashScriptMapT Proof era
p Int
25 PlutusPurposeTag
Certifying Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall era.
Era era =>
Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
keymapUniv Term era ValidityInterval
forall era. Era era => Term era ValidityInterval
validityInterval)
  , Proof era -> Term era (Map ScriptHash (ScriptF era))
forall era.
Era era =>
Proof era -> Term era (Map ScriptHash (ScriptF era))
allScriptUniv Proof era
p Term era (Map ScriptHash (ScriptF era))
-> RootTarget era Void (Map ScriptHash (ScriptF era)) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Map ScriptHash (ScriptF era)
    -> Map ScriptHash (ScriptF era) -> Map ScriptHash (ScriptF era))
-> RootTarget
     era
     Void
     (Map ScriptHash (ScriptF era)
      -> Map ScriptHash (ScriptF era) -> Map ScriptHash (ScriptF era))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"union" Map ScriptHash (ScriptF era)
-> Map ScriptHash (ScriptF era) -> Map ScriptHash (ScriptF era)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union RootTarget
  era
  Void
  (Map ScriptHash (ScriptF era)
   -> Map ScriptHash (ScriptF era) -> Map ScriptHash (ScriptF era))
-> Term era (Map ScriptHash (ScriptF era))
-> Target
     era (Map ScriptHash (ScriptF era) -> Map ScriptHash (ScriptF era))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (Proof era -> Term era (Map ScriptHash (ScriptF era))
forall era.
Era era =>
Proof era -> Term era (Map ScriptHash (ScriptF era))
spendscriptUniv Proof era
p) Target
  era (Map ScriptHash (ScriptF era) -> Map ScriptHash (ScriptF era))
-> Term era (Map ScriptHash (ScriptF era))
-> RootTarget era Void (Map ScriptHash (ScriptF era))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (Proof era -> Term era (Map ScriptHash (ScriptF era))
forall era.
Era era =>
Proof era -> Term era (Map ScriptHash (ScriptF era))
nonSpendScriptUniv Proof era
p))
  , Term era Size
-> Term era [PaymentCredential]
-> [(Int, Target era PaymentCredential, [Pred era])]
-> Pred era
forall era t.
(Era era, Eq t) =>
Term era Size
-> Term era [t] -> [(Int, Target era t, [Pred era])] -> Pred era
Choose
      (Int -> Term era Size
forall era. Era era => Int -> Term era Size
ExactSize Int
70)
      Term era [PaymentCredential]
spendcredList
      [
        ( UnivSize -> Int
usSpendScriptFreq UnivSize
size
        , Term era ScriptHash -> Target era PaymentCredential
forall era (k :: KeyRole).
Term era ScriptHash -> Target era (Credential k)
scriptHashObjT Term era ScriptHash
scripthash
        , [Direct (Term era ScriptHash)
-> Term era (Set ScriptHash) -> Pred era
forall a era.
Ord a =>
Direct (Term era a) -> Term era (Set a) -> Pred era
Member (Term era ScriptHash -> Direct (Term era ScriptHash)
forall a b. a -> Either a b
Left Term era ScriptHash
scripthash) (Term era (Map ScriptHash (ScriptF era))
-> Term era (Set ScriptHash)
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom (Proof era -> Term era (Map ScriptHash (ScriptF era))
forall era.
Era era =>
Proof era -> Term era (Map ScriptHash (ScriptF era))
spendscriptUniv Proof era
p))]
        )
      , (Int
2, Term era (KeyHash 'Witness) -> Target era PaymentCredential
forall era (k :: KeyRole).
Term era (KeyHash 'Witness) -> Target era (Credential k)
keyHashObjT Term era (KeyHash 'Witness)
keyhash, [Direct (Term era (KeyHash 'Witness))
-> Term era (Set (KeyHash 'Witness)) -> Pred era
forall a era.
Ord a =>
Direct (Term era a) -> Term era (Set a) -> Pred era
Member (Term era (KeyHash 'Witness) -> Direct (Term era (KeyHash 'Witness))
forall a b. a -> Either a b
Left Term era (KeyHash 'Witness)
keyhash) (Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Term era (Set (KeyHash 'Witness))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall era.
Era era =>
Term era (Map (KeyHash 'Witness) (KeyPair 'Witness))
keymapUniv)])
      ]
  , Term era (Set PaymentCredential)
forall era. Era era => Term era (Set PaymentCredential)
spendCredsUniv Term era (Set PaymentCredential)
-> RootTarget era Void (Set PaymentCredential) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: Term era [PaymentCredential]
-> RootTarget era Void (Set PaymentCredential)
forall x era. Ord x => Term era [x] -> Target era (Set x)
listToSetTarget Term era [PaymentCredential]
spendcredList
  , Term era EpochNo
forall era. Era era => Term era EpochNo
currentEpoch Term era EpochNo -> RootTarget era Void EpochNo -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (SlotNo -> EpochNo) -> RootTarget era Void (SlotNo -> EpochNo)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"epochFromSlotNo" SlotNo -> EpochNo
epochFromSlotNo RootTarget era Void (SlotNo -> EpochNo)
-> Term era SlotNo -> RootTarget era Void EpochNo
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era SlotNo
forall era. Era era => Term era SlotNo
currentSlot)
  , Term era (Map DataHash (Data era))
-> RootTarget era Void (Gen (Map DataHash (Data era))) -> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom Term era (Map DataHash (Data era))
forall era. Era era => Term era (Map DataHash (Data era))
dataUniv (String
-> (Int -> Gen (Map DataHash (Data era)))
-> RootTarget era Void (Int -> Gen (Map DataHash (Data era)))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"dataWits" (Proof era -> Int -> Gen (Map DataHash (Data era))
forall era.
Era era =>
Proof era -> Int -> Gen (Map DataHash (Data era))
genDataWits Proof era
p) RootTarget era Void (Int -> Gen (Map DataHash (Data era)))
-> Term era Int
-> RootTarget era Void (Gen (Map DataHash (Data era)))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (Rep era Int -> Int -> Term era Int
forall era t. Rep era t -> t -> Term era t
Lit Rep era Int
forall era. Rep era Int
IntR Int
30))
  , Term era [Datum era]
-> RootTarget era Void (Gen [Datum era]) -> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom Term era [Datum era]
forall era. Era era => Term era [Datum era]
datumsUniv (String
-> (Map DataHash (Data era) -> Gen [Datum era])
-> RootTarget era Void (Map DataHash (Data era) -> Gen [Datum era])
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"genDatums" (UnivSize -> Int -> Map DataHash (Data era) -> Gen [Datum era]
forall era.
UnivSize -> Int -> Map DataHash (Data era) -> Gen [Datum era]
genDatums UnivSize
size (UnivSize -> Int
usNumDatums UnivSize
size)) RootTarget era Void (Map DataHash (Data era) -> Gen [Datum era])
-> Term era (Map DataHash (Data era))
-> RootTarget era Void (Gen [Datum era])
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Map DataHash (Data era))
forall era. Era era => Term era (Map DataHash (Data era))
dataUniv)
  , -- 'network' is set by testGlobals which contains 'Testnet'
    Term era Network
forall era. Era era => Term era Network
network Term era Network -> RootTarget era Void Network -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: Network -> RootTarget era Void Network
forall t era. t -> Target era t
constTarget (Globals -> Network
Utils.networkId Globals
Utils.testGlobals)
  , Term era (Set Ptr)
-> RootTarget era Void (Gen (Set Ptr)) -> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom Term era (Set Ptr)
forall era. Era era => Term era (Set Ptr)
ptrUniv (Int -> Term era SlotNo -> RootTarget era Void (Gen (Set Ptr))
forall era. Int -> Term era SlotNo -> Target era (Gen (Set Ptr))
ptrUnivT (UnivSize -> Int
usNumPtr UnivSize
size) Term era SlotNo
forall era. Era era => Term era SlotNo
currentSlot)
  , Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
-> RootTarget
     era Void (Gen (Map (KeyHash 'Payment) (Addr, SigningKey)))
-> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
forall era.
Era era =>
Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
byronAddrUniv (String
-> (Network -> Gen (Map (KeyHash 'Payment) (Addr, SigningKey)))
-> RootTarget
     era
     Void
     (Network -> Gen (Map (KeyHash 'Payment) (Addr, SigningKey)))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"byronUniv" Network -> Gen (Map (KeyHash 'Payment) (Addr, SigningKey))
genByronUniv RootTarget
  era
  Void
  (Network -> Gen (Map (KeyHash 'Payment) (Addr, SigningKey)))
-> Term era Network
-> RootTarget
     era Void (Gen (Map (KeyHash 'Payment) (Addr, SigningKey)))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era Network
forall era. Era era => Term era Network
network)
  , Term era (Set Addr)
-> RootTarget era Void (Gen (Set Addr)) -> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom
      Term era (Set Addr)
forall era. Era era => Term era (Set Addr)
addrUniv
      (Proof era
-> Int
-> Term era Network
-> Term era (Set PaymentCredential)
-> Term era (Set Ptr)
-> Term era (Set (Credential 'Staking))
-> Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
-> RootTarget era Void (Gen (Set Addr))
forall era.
Proof era
-> Int
-> Term era Network
-> Term era (Set PaymentCredential)
-> Term era (Set Ptr)
-> Term era (Set (Credential 'Staking))
-> Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
-> Target era (Gen (Set Addr))
addrUnivT Proof era
p (UnivSize -> Int
usNumAddr UnivSize
size) Term era Network
forall era. Era era => Term era Network
network Term era (Set PaymentCredential)
forall era. Era era => Term era (Set PaymentCredential)
spendCredsUniv Term era (Set Ptr)
forall era. Era era => Term era (Set Ptr)
ptrUniv Term era (Set (Credential 'Staking))
forall era. Era era => Term era (Set (Credential 'Staking))
credsUniv Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
forall era.
Era era =>
Term era (Map (KeyHash 'Payment) (Addr, SigningKey))
byronAddrUniv)
  , Term era [MultiAsset]
-> RootTarget era Void (Gen [MultiAsset]) -> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom
      Term era [MultiAsset]
forall era. Era era => Term era [MultiAsset]
multiAssetUniv
      (String
-> (Map ScriptHash (ScriptF era) -> Gen [MultiAsset])
-> RootTarget
     era Void (Map ScriptHash (ScriptF era) -> Gen [MultiAsset])
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"multiAsset" (Int -> Gen MultiAsset -> Gen [MultiAsset]
forall a. Int -> Gen a -> Gen [a]
vectorOf (UnivSize -> Int
usNumMultiAsset UnivSize
size) (Gen MultiAsset -> Gen [MultiAsset])
-> (Map ScriptHash (ScriptF era) -> Gen MultiAsset)
-> Map ScriptHash (ScriptF era)
-> Gen [MultiAsset]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnivSize -> Map ScriptHash (ScriptF era) -> Gen MultiAsset
forall era.
UnivSize -> Map ScriptHash (ScriptF era) -> Gen MultiAsset
multiAsset UnivSize
size) RootTarget
  era Void (Map ScriptHash (ScriptF era) -> Gen [MultiAsset])
-> Term era (Map ScriptHash (ScriptF era))
-> RootTarget era Void (Gen [MultiAsset])
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (Proof era -> Term era (Map ScriptHash (ScriptF era))
forall era.
Era era =>
Proof era -> Term era (Map ScriptHash (ScriptF era))
nonSpendScriptUniv Proof era
p))
  , Term era [TxOutF era]
-> RootTarget era Void (Gen [TxOutF era]) -> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom
      Term era [TxOutF era]
preTxoutUniv
      ( String
-> (Set Addr
    -> Map ScriptHash (ScriptF era)
    -> Map ScriptHash (ScriptF era)
    -> Map DataHash (Data era)
    -> Gen [TxOutF era])
-> RootTarget
     era
     Void
     (Set Addr
      -> Map ScriptHash (ScriptF era)
      -> Map ScriptHash (ScriptF era)
      -> Map DataHash (Data era)
      -> Gen [TxOutF era])
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"genTxOuts" (UnivSize
-> (Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era))
-> Proof era
-> Int
-> Set Addr
-> Map ScriptHash (ScriptF era)
-> Map ScriptHash (ScriptF era)
-> Map DataHash (Data era)
-> Gen [TxOutF era]
forall era.
Reflect era =>
UnivSize
-> (Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era))
-> Proof era
-> Int
-> Set Addr
-> Map ScriptHash (ScriptF era)
-> Map ScriptHash (ScriptF era)
-> Map DataHash (Data era)
-> Gen [TxOutF era]
genTxOuts UnivSize
size (UnivSize
-> Proof era
-> Coin
-> Map ScriptHash (ScriptF era)
-> Gen (Value era)
forall era.
UnivSize
-> Proof era
-> Coin
-> Map ScriptHash (ScriptF era)
-> Gen (Value era)
genValueF UnivSize
size Proof era
p) Proof era
p (UnivSize -> Int
usNumTxOuts UnivSize
size))
          RootTarget
  era
  Void
  (Set Addr
   -> Map ScriptHash (ScriptF era)
   -> Map ScriptHash (ScriptF era)
   -> Map DataHash (Data era)
   -> Gen [TxOutF era])
-> Term era (Set Addr)
-> Target
     era
     (Map ScriptHash (ScriptF era)
      -> Map ScriptHash (ScriptF era)
      -> Map DataHash (Data era)
      -> Gen [TxOutF era])
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set Addr)
forall era. Era era => Term era (Set Addr)
addrUniv
          Target
  era
  (Map ScriptHash (ScriptF era)
   -> Map ScriptHash (ScriptF era)
   -> Map DataHash (Data era)
   -> Gen [TxOutF era])
-> Term era (Map ScriptHash (ScriptF era))
-> Target
     era
     (Map ScriptHash (ScriptF era)
      -> Map DataHash (Data era) -> Gen [TxOutF era])
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (Proof era -> Term era (Map ScriptHash (ScriptF era))
forall era.
Era era =>
Proof era -> Term era (Map ScriptHash (ScriptF era))
nonSpendScriptUniv Proof era
p)
          Target
  era
  (Map ScriptHash (ScriptF era)
   -> Map DataHash (Data era) -> Gen [TxOutF era])
-> Term era (Map ScriptHash (ScriptF era))
-> Target era (Map DataHash (Data era) -> Gen [TxOutF era])
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (Proof era -> Term era (Map ScriptHash (ScriptF era))
forall era.
Era era =>
Proof era -> Term era (Map ScriptHash (ScriptF era))
spendscriptUniv Proof era
p)
          Target era (Map DataHash (Data era) -> Gen [TxOutF era])
-> Term era (Map DataHash (Data era))
-> RootTarget era Void (Gen [TxOutF era])
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Map DataHash (Data era))
forall era. Era era => Term era (Map DataHash (Data era))
dataUniv
      )
  , Term era (Set (TxOutF era))
-> RootTarget era Void (Gen (Set (TxOutF era))) -> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom
      (Proof era -> Term era (Set (TxOutF era))
forall era. Era era => Proof era -> Term era (Set (TxOutF era))
colTxoutUniv Proof era
p)
      ( String
-> (Set Addr -> Gen (Set (TxOutF era)))
-> RootTarget era Void (Set Addr -> Gen (Set (TxOutF era)))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr
          String
"colTxOutUniv"
          (\Set Addr
x -> Proof era -> Set Addr -> Gen (Set (TxOutF era))
forall era.
EraTxOut era =>
Proof era -> Set Addr -> Gen (Set (TxOutF era))
colTxOutSetT Proof era
p ((Addr -> Bool) -> Set Addr -> Set Addr
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Proof era -> Addr -> Bool
forall era. Proof era -> Addr -> Bool
noScripts Proof era
p) Set Addr
x))
          RootTarget era Void (Set Addr -> Gen (Set (TxOutF era)))
-> Term era (Set Addr)
-> RootTarget era Void (Gen (Set (TxOutF era)))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set Addr)
forall era. Era era => Term era (Set Addr)
addrUniv
      )
  , Term era (Set DRep)
-> RootTarget era Void (Gen (Set DRep)) -> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom Term era (Set DRep)
forall era. Era era => Term era (Set DRep)
drepUniv (UnivSize
-> Term era (Set (Credential 'Staking))
-> RootTarget era Void (Gen (Set DRep))
forall era.
UnivSize
-> Term era (Set (Credential 'Staking))
-> Target era (Gen (Set DRep))
genDRepsT UnivSize
size Term era (Set (Credential 'Staking))
forall era. Era era => Term era (Set (Credential 'Staking))
credsUniv)
  , Term era (Set PaymentCredential)
forall era. Era era => Term era (Set PaymentCredential)
payUniv Term era (Set PaymentCredential)
-> Term era (Set PaymentCredential) -> Pred era
forall a era. Eq a => Term era a -> Term era a -> Pred era
:=: Term era (Set PaymentCredential)
forall era. Era era => Term era (Set PaymentCredential)
spendCredsUniv
  , Term era (Set (Credential 'DRepRole))
forall era. Era era => Term era (Set (Credential 'DRepRole))
voteUniv Term era (Set (Credential 'DRepRole))
-> RootTarget era Void (Set (Credential 'DRepRole)) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Set (Credential 'Staking) -> Set (Credential 'DRepRole))
-> RootTarget
     era Void (Set (Credential 'Staking) -> Set (Credential 'DRepRole))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"coerce" ((Credential 'Staking -> Credential 'DRepRole)
-> Set (Credential 'Staking) -> Set (Credential 'DRepRole)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Credential 'Staking -> Credential 'DRepRole
stakeToDRepRole) RootTarget
  era Void (Set (Credential 'Staking) -> Set (Credential 'DRepRole))
-> Term era (Set (Credential 'Staking))
-> RootTarget era Void (Set (Credential 'DRepRole))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (Credential 'Staking))
forall era. Era era => Term era (Set (Credential 'Staking))
credsUniv)
  , Term era (Set (Credential 'HotCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'HotCommitteeRole))
hotCommitteeCredsUniv Term era (Set (Credential 'HotCommitteeRole))
-> RootTarget era Void (Set (Credential 'HotCommitteeRole))
-> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Set (Credential 'Staking)
    -> Set (Credential 'HotCommitteeRole))
-> RootTarget
     era
     Void
     (Set (Credential 'Staking) -> Set (Credential 'HotCommitteeRole))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"coerce" ((Credential 'Staking -> Credential 'HotCommitteeRole)
-> Set (Credential 'Staking) -> Set (Credential 'HotCommitteeRole)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Credential 'Staking -> Credential 'HotCommitteeRole
stakeToHotCommittee) RootTarget
  era
  Void
  (Set (Credential 'Staking) -> Set (Credential 'HotCommitteeRole))
-> Term era (Set (Credential 'Staking))
-> RootTarget era Void (Set (Credential 'HotCommitteeRole))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (Credential 'Staking))
forall era. Era era => Term era (Set (Credential 'Staking))
credsUniv)
  , Term era (Set (Credential 'ColdCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole))
coldCommitteeCredsUniv Term era (Set (Credential 'ColdCommitteeRole))
-> RootTarget era Void (Set (Credential 'ColdCommitteeRole))
-> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Set (Credential 'Staking)
    -> Set (Credential 'ColdCommitteeRole))
-> RootTarget
     era
     Void
     (Set (Credential 'Staking) -> Set (Credential 'ColdCommitteeRole))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"coerce" ((Credential 'Staking -> Credential 'ColdCommitteeRole)
-> Set (Credential 'Staking) -> Set (Credential 'ColdCommitteeRole)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Credential 'Staking -> Credential 'ColdCommitteeRole
stakeToColdCommittee) RootTarget
  era
  Void
  (Set (Credential 'Staking) -> Set (Credential 'ColdCommitteeRole))
-> Term era (Set (Credential 'Staking))
-> RootTarget era Void (Set (Credential 'ColdCommitteeRole))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (Credential 'Staking))
forall era. Era era => Term era (Set (Credential 'Staking))
credsUniv)
  , Term era Coin
forall era. Era era => Term era Coin
bigCoin Term era Coin -> RootTarget era Void Coin -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: Coin -> RootTarget era Void Coin
forall t era. t -> Target era t
constTarget (Integer -> Coin
Coin Integer
2000000)
  , Term era (TxOutF era)
-> RootTarget era Void (Gen (TxOutF era)) -> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom
      Term era (TxOutF era)
forall era. Reflect era => Term era (TxOutF era)
feeTxOut
      ( String
-> (Set Addr -> Coin -> Gen (TxOutF era))
-> RootTarget era Void (Set Addr -> Coin -> Gen (TxOutF era))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr
          String
"txout"
          ( \Set Addr
a Coin
c ->
              Proof era -> Addr -> Coin -> TxOutF era
forall era. Reflect era => Proof era -> Addr -> Coin -> TxOutF era
txOutT Proof era
p
                (Addr -> Coin -> TxOutF era)
-> Gen Addr -> Gen (Coin -> TxOutF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Set Addr -> Gen Addr
forall t. [String] -> Set t -> Gen t
pick1 [String
"from feeTxOut on (filter nocripts addrUniv)"] ((Addr -> Bool) -> Set Addr -> Set Addr
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Proof era -> Addr -> Bool
forall era. Proof era -> Addr -> Bool
noScripts Proof era
p) Set Addr
a)
                Gen (Coin -> TxOutF era) -> Gen Coin -> Gen (TxOutF era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Coin -> Gen Coin
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Coin
c
          )
          RootTarget era Void (Set Addr -> Coin -> Gen (TxOutF era))
-> Term era (Set Addr) -> Target era (Coin -> Gen (TxOutF era))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set Addr)
forall era. Era era => Term era (Set Addr)
addrUniv
          Target era (Coin -> Gen (TxOutF era))
-> Term era Coin -> RootTarget era Void (Gen (TxOutF era))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era Coin
forall era. Era era => Term era Coin
bigCoin
      )
  , Proof era -> Term era (Set (TxOutF era))
forall era. Era era => Proof era -> Term era (Set (TxOutF era))
txoutUniv Proof era
p
      Term era (Set (TxOutF era))
-> RootTarget era Void (Set (TxOutF era)) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: ( String
-> (TxOutF era
    -> [TxOutF era] -> Set (TxOutF era) -> Set (TxOutF era))
-> RootTarget
     era
     Void
     (TxOutF era
      -> [TxOutF era] -> Set (TxOutF era) -> Set (TxOutF era))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr
               String
"insert"
               (\TxOutF era
x [TxOutF era]
y Set (TxOutF era)
_z -> TxOutF era -> Set (TxOutF era) -> Set (TxOutF era)
forall a. Ord a => a -> Set a -> Set a
Set.insert TxOutF era
x {- (Set.union z -} ([TxOutF era] -> Set (TxOutF era)
forall a. Ord a => [a] -> Set a
Set.fromList [TxOutF era]
y)) -- )
               RootTarget
  era
  Void
  (TxOutF era
   -> [TxOutF era] -> Set (TxOutF era) -> Set (TxOutF era))
-> Term era (TxOutF era)
-> Target
     era ([TxOutF era] -> Set (TxOutF era) -> Set (TxOutF era))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (TxOutF era)
forall era. Reflect era => Term era (TxOutF era)
feeTxOut
               Target era ([TxOutF era] -> Set (TxOutF era) -> Set (TxOutF era))
-> Term era [TxOutF era]
-> Target era (Set (TxOutF era) -> Set (TxOutF era))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era [TxOutF era]
preTxoutUniv
               Target era (Set (TxOutF era) -> Set (TxOutF era))
-> Term era (Set (TxOutF era))
-> RootTarget era Void (Set (TxOutF era))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (Proof era -> Term era (Set (TxOutF era))
forall era. Era era => Proof era -> Term era (Set (TxOutF era))
colTxoutUniv Proof era
p)
           )
  , Term era (Map ScriptHash (IsValid, ScriptF era))
forall era.
Reflect era =>
Term era (Map ScriptHash (IsValid, ScriptF era))
plutusUniv Term era (Map ScriptHash (IsValid, ScriptF era))
-> RootTarget era Void (Map ScriptHash (IsValid, ScriptF era))
-> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: Map ScriptHash (IsValid, ScriptF era)
-> RootTarget era Void (Map ScriptHash (IsValid, ScriptF era))
forall t era. t -> Target era t
constTarget (((IsValid, Script era) -> (IsValid, ScriptF era))
-> Map ScriptHash (IsValid, Script era)
-> Map ScriptHash (IsValid, ScriptF era)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(IsValid
x, Script era
y) -> (IsValid
x, Proof era -> Script era -> ScriptF era
forall era. Proof era -> Script era -> ScriptF era
ScriptF Proof era
p Script era
y)) (Proof era -> Map ScriptHash (IsValid, Script era)
forall era.
Reflect era =>
Proof era -> Map ScriptHash (IsValid, Script era)
allPlutusScripts Proof era
p))
  , Term era (Map ScriptHash (IsValid, ScriptF era))
forall era.
Reflect era =>
Term era (Map ScriptHash (IsValid, ScriptF era))
spendPlutusUniv Term era (Map ScriptHash (IsValid, ScriptF era))
-> RootTarget era Void (Map ScriptHash (IsValid, ScriptF era))
-> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: Map ScriptHash (IsValid, ScriptF era)
-> RootTarget era Void (Map ScriptHash (IsValid, ScriptF era))
forall t era. t -> Target era t
constTarget (((IsValid, Script era) -> (IsValid, ScriptF era))
-> Map ScriptHash (IsValid, Script era)
-> Map ScriptHash (IsValid, ScriptF era)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(IsValid
x, Script era
y) -> (IsValid
x, Proof era -> Script era -> ScriptF era
forall era. Proof era -> Script era -> ScriptF era
ScriptF Proof era
p Script era
y)) (Proof era -> Map ScriptHash (IsValid, Script era)
forall era.
Reflect era =>
Proof era -> Map ScriptHash (IsValid, Script era)
spendPlutusScripts Proof era
p))
  ]
  where
    credList :: Term era [Credential 'Staking]
credList = V era [Credential 'Staking] -> Term era [Credential 'Staking]
forall era t. V era t -> Term era t
Var (String
-> Rep era [Credential 'Staking]
-> Access era Any [Credential 'Staking]
-> V era [Credential 'Staking]
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"credList" (Rep era (Credential 'Staking) -> Rep era [Credential 'Staking]
forall era a. Rep era a -> Rep era [a]
ListR Rep era (Credential 'Staking)
forall era. Era era => Rep era (Credential 'Staking)
CredR) Access era Any [Credential 'Staking]
forall era s t. Access era s t
No)
    spendcredList :: Term era [PaymentCredential]
spendcredList = V era [PaymentCredential] -> Term era [PaymentCredential]
forall era t. V era t -> Term era t
Var (String
-> Rep era [PaymentCredential]
-> Access era Any [PaymentCredential]
-> V era [PaymentCredential]
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"spendcred.list" (Rep era PaymentCredential -> Rep era [PaymentCredential]
forall era a. Rep era a -> Rep era [a]
ListR Rep era PaymentCredential
forall era. Era era => Rep era PaymentCredential
PCredR) Access era Any [PaymentCredential]
forall era s t. Access era s t
No)
    keyhash :: Term era (KeyHash 'Witness)
keyhash = V era (KeyHash 'Witness) -> Term era (KeyHash 'Witness)
forall era t. V era t -> Term era t
Var (String
-> Rep era (KeyHash 'Witness)
-> Access era Any (KeyHash 'Witness)
-> V era (KeyHash 'Witness)
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"keyhash" Rep era (KeyHash 'Witness)
forall era. Era era => Rep era (KeyHash 'Witness)
WitHashR Access era Any (KeyHash 'Witness)
forall era s t. Access era s t
No)
    scripthash :: Term era ScriptHash
scripthash = V era ScriptHash -> Term era ScriptHash
forall era t. V era t -> Term era t
Var (String
-> Rep era ScriptHash
-> Access era Any ScriptHash
-> V era ScriptHash
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"scripthash" Rep era ScriptHash
forall era. Era era => Rep era ScriptHash
ScriptHashR Access era Any ScriptHash
forall era s t. Access era s t
No)
    preTxoutUniv :: Term era [TxOutF era]
preTxoutUniv = V era [TxOutF era] -> Term era [TxOutF era]
forall era t. V era t -> Term era t
Var (String
-> Rep era [TxOutF era]
-> Access era Any [TxOutF era]
-> V era [TxOutF era]
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"preTxoutUniv" (Rep era (TxOutF era) -> Rep era [TxOutF era]
forall era a. Rep era a -> Rep era [a]
ListR (Proof era -> Rep era (TxOutF era)
forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR Proof era
p)) Access era Any [TxOutF era]
forall era s t. Access era s t
No)
    keypairs :: Term era [KeyPair 'Witness]
keypairs = V era [KeyPair 'Witness] -> Term era [KeyPair 'Witness]
forall era t. V era t -> Term era t
Var (String
-> Rep era [KeyPair 'Witness]
-> Access era Any [KeyPair 'Witness]
-> V era [KeyPair 'Witness]
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"keypairs" (Rep era (KeyPair 'Witness) -> Rep era [KeyPair 'Witness]
forall era a. Rep era a -> Rep era [a]
ListR Rep era (KeyPair 'Witness)
forall era. Era era => Rep era (KeyPair 'Witness)
KeyPairR) Access era Any [KeyPair 'Witness]
forall era s t. Access era s t
No)
    prePoolUniv :: Term era (Set (KeyHash 'Witness))
prePoolUniv = V era (Set (KeyHash 'Witness)) -> Term era (Set (KeyHash 'Witness))
forall era t. V era t -> Term era t
Var (String
-> Rep era (Set (KeyHash 'Witness))
-> Access era Any (Set (KeyHash 'Witness))
-> V era (Set (KeyHash 'Witness))
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"prePoolUniv" (Rep era (KeyHash 'Witness) -> Rep era (Set (KeyHash 'Witness))
forall a era. Ord a => Rep era a -> Rep era (Set a)
SetR Rep era (KeyHash 'Witness)
forall era. Era era => Rep era (KeyHash 'Witness)
WitHashR) Access era Any (Set (KeyHash 'Witness))
forall era s t. Access era s t
No)
    preStakeUniv :: Term era (Set (KeyHash 'Witness))
preStakeUniv = V era (Set (KeyHash 'Witness)) -> Term era (Set (KeyHash 'Witness))
forall era t. V era t -> Term era t
Var (String
-> Rep era (Set (KeyHash 'Witness))
-> Access era Any (Set (KeyHash 'Witness))
-> V era (Set (KeyHash 'Witness))
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"preStakeUniv" (Rep era (KeyHash 'Witness) -> Rep era (Set (KeyHash 'Witness))
forall a era. Ord a => Rep era a -> Rep era (Set a)
SetR Rep era (KeyHash 'Witness)
forall era. Era era => Rep era (KeyHash 'Witness)
WitHashR) Access era Any (Set (KeyHash 'Witness))
forall era s t. Access era s t
No)
    preGenesisUniv :: Term era (Set (KeyHash 'Witness))
preGenesisUniv = V era (Set (KeyHash 'Witness)) -> Term era (Set (KeyHash 'Witness))
forall era t. V era t -> Term era t
Var (String
-> Rep era (Set (KeyHash 'Witness))
-> Access era Any (Set (KeyHash 'Witness))
-> V era (Set (KeyHash 'Witness))
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"preGenesisUniv" (Rep era (KeyHash 'Witness) -> Rep era (Set (KeyHash 'Witness))
forall a era. Ord a => Rep era a -> Rep era (Set a)
SetR Rep era (KeyHash 'Witness)
forall era. Era era => Rep era (KeyHash 'Witness)
WitHashR) Access era Any (Set (KeyHash 'Witness))
forall era s t. Access era s t
No)
    preGenesisDom :: Term era (Set (KeyHash 'Genesis))
preGenesisDom = V era (Set (KeyHash 'Genesis)) -> Term era (Set (KeyHash 'Genesis))
forall era t. V era t -> Term era t
Var (String
-> Rep era (Set (KeyHash 'Genesis))
-> Access era Any (Set (KeyHash 'Genesis))
-> V era (Set (KeyHash 'Genesis))
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"preGenesisDom" (Rep era (KeyHash 'Genesis) -> Rep era (Set (KeyHash 'Genesis))
forall a era. Ord a => Rep era a -> Rep era (Set a)
SetR Rep era (KeyHash 'Genesis)
forall era. Era era => Rep era (KeyHash 'Genesis)
GenHashR) Access era Any (Set (KeyHash 'Genesis))
forall era s t. Access era s t
No)
    preVoteUniv :: Term era (Set (KeyHash 'Witness))
preVoteUniv = V era (Set (KeyHash 'Witness)) -> Term era (Set (KeyHash 'Witness))
forall era t. V era t -> Term era t
Var (String
-> Rep era (Set (KeyHash 'Witness))
-> Access era Any (Set (KeyHash 'Witness))
-> V era (Set (KeyHash 'Witness))
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"preVoteUniv" (Rep era (KeyHash 'Witness) -> Rep era (Set (KeyHash 'Witness))
forall a era. Ord a => Rep era a -> Rep era (Set a)
SetR Rep era (KeyHash 'Witness)
forall era. Era era => Rep era (KeyHash 'Witness)
WitHashR) Access era Any (Set (KeyHash 'Witness))
forall era s t. Access era s t
No)

multiAsset :: UnivSize -> Map.Map ScriptHash (ScriptF era) -> Gen MultiAsset
multiAsset :: forall era.
UnivSize -> Map ScriptHash (ScriptF era) -> Gen MultiAsset
multiAsset UnivSize
size Map ScriptHash (ScriptF era)
scripts = do
  let assets :: Set AssetName
assets =
        [AssetName] -> Set AssetName
forall a. Ord a => [a] -> Set a
Set.fromList [ShortByteString -> AssetName
AssetName (String -> ShortByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show (Int
n :: Int) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Asset")) | Int
n <- [Int
0 .. (UnivSize -> Int
usMaxAssets UnivSize
size)]]
  Int
n <- [Int] -> Gen Int
forall a. HasCallStack => [a] -> Gen a
elements [Int
0 .. (UnivSize -> Int
usMaxPolicyID UnivSize
size)]
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then MultiAsset -> Gen MultiAsset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultiAsset
forall a. Monoid a => a
mempty -- About 1/3 of the list will be the empty MA
    else do
      -- So lots of duplicates, but we want to choose the empty MA, 1/3 of the time.
      [(PolicyID, AssetName, Integer)]
xs <- Int
-> Gen (PolicyID, AssetName, Integer)
-> Gen [(PolicyID, AssetName, Integer)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (Map ScriptHash (ScriptF era)
-> Set AssetName
-> Gen Integer
-> Gen (PolicyID, AssetName, Integer)
forall era.
Map ScriptHash (ScriptF era)
-> Set AssetName
-> Gen Integer
-> Gen (PolicyID, AssetName, Integer)
genMultiAssetTriple Map ScriptHash (ScriptF era)
scripts Set AssetName
assets ((Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
100)))
      MultiAsset -> Gen MultiAsset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultiAsset -> Gen MultiAsset) -> MultiAsset -> Gen MultiAsset
forall a b. (a -> b) -> a -> b
$ [(PolicyID, AssetName, Integer)] -> MultiAsset
multiAssetFromList [(PolicyID, AssetName, Integer)]
xs

genValueF :: UnivSize -> Proof era -> Coin -> Map ScriptHash (ScriptF era) -> Gen (Value era)
genValueF :: forall era.
UnivSize
-> Proof era
-> Coin
-> Map ScriptHash (ScriptF era)
-> Gen (Value era)
genValueF UnivSize
size Proof era
proof Coin
c Map ScriptHash (ScriptF era)
scripts = case Proof era -> ValueWit era
forall era. Proof era -> ValueWit era
whichValue Proof era
proof of
  ValueWit era
ValueShelleyToAllegra -> Coin -> Gen Coin
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Coin
c
  ValueWit era
ValueMaryToConway -> Coin -> MultiAsset -> MaryValue
MaryValue Coin
c (MultiAsset -> MaryValue) -> Gen MultiAsset -> Gen MaryValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnivSize -> Map ScriptHash (ScriptF era) -> Gen MultiAsset
forall era.
UnivSize -> Map ScriptHash (ScriptF era) -> Gen MultiAsset
multiAsset UnivSize
size Map ScriptHash (ScriptF era)
scripts

stakeToDRepRole :: Credential 'Staking -> Credential 'DRepRole
stakeToDRepRole :: Credential 'Staking -> Credential 'DRepRole
stakeToDRepRole = Credential 'Staking -> Credential 'DRepRole
forall (r :: KeyRole) (r' :: KeyRole).
Credential r -> Credential r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole

stakeToHotCommittee :: Credential 'Staking -> Credential 'HotCommitteeRole
stakeToHotCommittee :: Credential 'Staking -> Credential 'HotCommitteeRole
stakeToHotCommittee = Credential 'Staking -> Credential 'HotCommitteeRole
forall (r :: KeyRole) (r' :: KeyRole).
Credential r -> Credential r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole

stakeToColdCommittee :: Credential 'Staking -> Credential 'ColdCommitteeRole
stakeToColdCommittee :: Credential 'Staking -> Credential 'ColdCommitteeRole
stakeToColdCommittee = Credential 'Staking -> Credential 'ColdCommitteeRole
forall (r :: KeyRole) (r' :: KeyRole).
Credential r -> Credential r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole

solveUniv :: Reflect era => UnivSize -> Proof era -> Gen (Subst era)
solveUniv :: forall era. Reflect era => UnivSize -> Proof era -> Gen (Subst era)
solveUniv UnivSize
size Proof era
proof = do
  Proof era
-> OrderInfo -> [Pred era] -> Subst era -> Gen (Subst era)
forall era.
Era era =>
Proof era
-> OrderInfo -> [Pred era] -> Subst era -> Gen (Subst era)
toolChainSub Proof era
proof OrderInfo
standardOrderInfo (UnivSize -> Proof era -> [Pred era]
forall era. Reflect era => UnivSize -> Proof era -> [Pred era]
universePreds UnivSize
size Proof era
proof) Subst era
forall era. Subst era
emptySubst

universeStage ::
  Reflect era =>
  UnivSize ->
  Proof era ->
  Subst era ->
  Gen (Subst era)
universeStage :: forall era.
Reflect era =>
UnivSize -> Proof era -> Subst era -> Gen (Subst era)
universeStage UnivSize
size Proof era
proof = Proof era
-> OrderInfo -> [Pred era] -> Subst era -> Gen (Subst era)
forall era.
Era era =>
Proof era
-> OrderInfo -> [Pred era] -> Subst era -> Gen (Subst era)
toolChainSub Proof era
proof OrderInfo
standardOrderInfo (UnivSize -> Proof era -> [Pred era]
forall era. Reflect era => UnivSize -> Proof era -> [Pred era]
universePreds UnivSize
size Proof era
proof)

demo :: ReplMode -> IO ()
demo :: ReplMode -> IO ()
demo ReplMode
mode = do
  let proof :: Proof ShelleyEra
proof = Proof ShelleyEra
Shelley
  Subst ShelleyEra
subst <- Gen (Subst ShelleyEra) -> IO (Subst ShelleyEra)
forall a. Gen a -> IO a
generate (UnivSize
-> Proof ShelleyEra -> Subst ShelleyEra -> Gen (Subst ShelleyEra)
forall era.
Reflect era =>
UnivSize -> Proof era -> Subst era -> Gen (Subst era)
universeStage UnivSize
forall a. Default a => a
def Proof ShelleyEra
proof Subst ShelleyEra
forall era. Subst era
emptySubst)
  if ReplMode
mode ReplMode -> ReplMode -> Bool
forall a. Eq a => a -> a -> Bool
== ReplMode
Interactive
    then String -> IO ()
putStrLn String
"\n" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn (Subst ShelleyEra -> String
forall a. Show a => a -> String
show Subst ShelleyEra
subst)
    else () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Env ShelleyEra
env <- Typed (Env ShelleyEra) -> IO (Env ShelleyEra)
forall (m :: * -> *) t. (HasCallStack, Monad m) => Typed t -> m t
monadTyped (Subst ShelleyEra -> Env ShelleyEra -> Typed (Env ShelleyEra)
forall era. Subst era -> Env era -> Typed (Env era)
substToEnv Subst ShelleyEra
subst Env ShelleyEra
forall era. Env era
emptyEnv)
  ReplMode -> Proof ShelleyEra -> Env ShelleyEra -> String -> IO ()
forall era. ReplMode -> Proof era -> Env era -> String -> IO ()
modeRepl ReplMode
mode Proof ShelleyEra
proof Env ShelleyEra
env String
""

demoTest :: TestTree
demoTest :: TestTree
demoTest = String -> IO () -> TestTree
forall a. String -> IO a -> TestTree
testIO String
"Testing Universe Stage" (ReplMode -> IO ()
demo ReplMode
CI)

main :: IO ()
main :: IO ()
main = TestTree -> IO ()
defaultMain (TestTree -> IO ()) -> TestTree -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> TestTree
forall a. String -> IO a -> TestTree
testIO String
"Testing Universe Stage" (ReplMode -> IO ()
demo ReplMode
Interactive)