{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Ledger.Examples.AlonzoBBODY (tests) where

import Cardano.Crypto.Hash.Class (sizeHash)
import Cardano.Ledger.Address (Addr (..), RewardAccount (..))
import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyPredFailure (..))
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.TxWits (Redeemers (..))
import Cardano.Ledger.BHeaderView (BHeaderView (..))
import Cardano.Ledger.BaseTypes (
  BlocksMade (..),
  Network (..),
  StrictMaybe (..),
  natVersion,
  textToUrl,
 )
import Cardano.Ledger.Block (Block (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Rules (ConwayCertsPredFailure (..), ConwayLedgerPredFailure (..))
import qualified Cardano.Ledger.Conway.Rules as Conway (
  ConwayBbodyPredFailure (..),
  ConwayCertPredFailure (..),
 )
import Cardano.Ledger.Credential (
  Credential (..),
  StakeCredential,
  StakeReference (..),
 )
import Cardano.Ledger.Crypto
import Cardano.Ledger.Keys (
  KeyRole (..),
  coerceKeyRole,
  hashKey,
  hashVerKeyVRF,
 )
import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..))
import Cardano.Ledger.Plutus.Data (Data (..), hashData)
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.PoolParams (PoolMetadata (..))
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.Shelley.API (
  CertState (..),
  DState (..),
  GenDelegs (..),
  LedgerState (..),
  PoolParams (..),
  ProtVer (..),
  UTxO (..),
 )
import Cardano.Ledger.Shelley.Core hiding (TranslationError)
import Cardano.Ledger.Shelley.LedgerState (smartUTxOState)
import Cardano.Ledger.Shelley.Rules (
  ShelleyBbodyPredFailure (..),
  ShelleyBbodyState (..),
  ShelleyDelegsPredFailure (..),
  ShelleyDelplPredFailure (..),
  ShelleyLedgerPredFailure (..),
  ShelleyLedgersPredFailure (..),
  ShelleyPoolPredFailure (..),
 )
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.UMap (UView (RewDepUView))
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.Val (inject, (<->))
import Cardano.Slotting.Slot (SlotNo (..))
import Control.State.Transition.Extended (STS (..))
import qualified Data.ByteString as BS (replicate)
import Data.Default.Class (Default (..))
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
import qualified Data.Sequence.Strict as StrictSeq
import qualified PlutusLedgerApi.V1 as PV1
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkWitnessVKey)
import Test.Cardano.Ledger.Examples.AlonzoValidTxUTXOW (mkSingleRedeemer)
import Test.Cardano.Ledger.Examples.STSTestUtils (
  alwaysFailsHash,
  alwaysSucceedsHash,
  initUTxO,
  mkGenesisTxIn,
  mkTxDats,
  someAddr,
  someKeys,
  someScriptAddr,
  testBBODY,
  trustMeP,
 )
import Test.Cardano.Ledger.Generic.Fields (
  PParamsField (..),
  TxBodyField (..),
  TxField (..),
  TxOutField (..),
  WitnessesField (..),
 )
import Test.Cardano.Ledger.Generic.GenState (PlutusPurposeTag (..))
import Test.Cardano.Ledger.Generic.PrettyCore ()
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Generic.Scriptic (
  HasTokens (..),
  PostShelley,
  Scriptic (..),
  after,
  matchkey,
 )
import Test.Cardano.Ledger.Generic.Updaters
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
import Test.Cardano.Ledger.Shelley.Utils (
  RawSeed (..),
  mkKeyPair,
  mkVRFKeyPair,
 )
import Test.Cardano.Protocol.TPraos.Create (VRFKeyPair (..))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Generic Tests, testing Alonzo PredicateFailures, in postAlonzo eras."
    [ forall era.
(HasTokens era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era), EraSegWits era, Reflect era,
 State (EraRule "LEDGERS" era) ~ LedgerState era) =>
Proof era -> TestTree
alonzoBBODYexamplesP Proof (AlonzoEra StandardCrypto)
Alonzo
    , forall era.
(HasTokens era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era), EraSegWits era, Reflect era,
 State (EraRule "LEDGERS" era) ~ LedgerState era) =>
Proof era -> TestTree
alonzoBBODYexamplesP Proof (BabbageEra StandardCrypto)
Babbage
    , forall era.
(HasTokens era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era), EraSegWits era, Reflect era,
 State (EraRule "LEDGERS" era) ~ LedgerState era) =>
Proof era -> TestTree
alonzoBBODYexamplesP Proof (ConwayEra StandardCrypto)
Conway
    ]

alonzoBBODYexamplesP ::
  forall era.
  ( HasTokens era
  , PostShelley era
  , Value era ~ MaryValue (EraCrypto era)
  , EraSegWits era
  , Reflect era
  , State (EraRule "LEDGERS" era) ~ LedgerState era
  ) =>
  Proof era ->
  TestTree
alonzoBBODYexamplesP :: forall era.
(HasTokens era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era), EraSegWits era, Reflect era,
 State (EraRule "LEDGERS" era) ~ LedgerState era) =>
Proof era -> TestTree
alonzoBBODYexamplesP Proof era
proof =
  TestName -> [TestTree] -> TestTree
testGroup
    (forall a. Show a => a -> TestName
show Proof era
proof forall a. [a] -> [a] -> [a]
++ TestName
" BBODY examples")
    [ TestName -> Assertion -> TestTree
testCase TestName
"eight plutus scripts cases" forall a b. (a -> b) -> a -> b
$
        forall era.
(Reflect era, HasCallStack) =>
WitRule "BBODY" era
-> ShelleyBbodyState era
-> Block (BHeaderView (EraCrypto era)) era
-> Either
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
     (ShelleyBbodyState era)
-> PParams era
-> Assertion
testBBODY
          (forall e. Proof e -> WitRule "BBODY" e
BBODY Proof era
proof)
          (forall era.
(EraTxOut era, PostShelley era, EraGov era,
 State (EraRule "LEDGERS" era) ~ LedgerState era) =>
Proof era -> UTxO era -> ShelleyBbodyState era
initialBBodyState Proof era
proof (forall era.
(EraTxOut era, PostShelley era) =>
Proof era -> UTxO era
initUTxO Proof era
proof))
          (forall era.
(GoodCrypto (EraCrypto era), HasTokens era, Scriptic era,
 EraSegWits era, Value era ~ MaryValue (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Block (BHeaderView (EraCrypto era)) era
testAlonzoBlock Proof era
proof)
          (forall a b. b -> Either a b
Right (forall era.
(GoodCrypto (EraCrypto era), HasTokens era, PostShelley era,
 EraTxBody era, Value era ~ MaryValue (EraCrypto era), EraGov era,
 State (EraRule "LEDGERS" era) ~ LedgerState era,
 ShelleyEraTxCert era) =>
Proof era -> ShelleyBbodyState era
testBBodyState Proof era
proof))
          (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
proof)
    , TestName -> Assertion -> TestTree
testCase TestName
"block with bad pool md hash in tx" forall a b. (a -> b) -> a -> b
$
        forall era.
(Reflect era, HasCallStack) =>
WitRule "BBODY" era
-> ShelleyBbodyState era
-> Block (BHeaderView (EraCrypto era)) era
-> Either
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
     (ShelleyBbodyState era)
-> PParams era
-> Assertion
testBBODY
          (forall e. Proof e -> WitRule "BBODY" e
BBODY Proof era
proof)
          (forall era.
(EraTxOut era, PostShelley era, EraGov era,
 State (EraRule "LEDGERS" era) ~ LedgerState era) =>
Proof era -> UTxO era -> ShelleyBbodyState era
initialBBodyState Proof era
proof (forall era.
(EraTxOut era, PostShelley era) =>
Proof era -> UTxO era
initUTxO Proof era
proof))
          (forall era.
GoodCrypto (EraCrypto era) =>
Proof era -> Block (BHeaderView (EraCrypto era)) era
testAlonzoBadPMDHBlock Proof era
proof)
          (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> PredicateFailure (EraRule "BBODY" era)
makeTooBig Proof era
proof)
          (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
proof)
    ]

initialBBodyState ::
  ( EraTxOut era
  , PostShelley era
  , EraGov era
  , State (EraRule "LEDGERS" era) ~ LedgerState era
  ) =>
  Proof era ->
  UTxO era ->
  ShelleyBbodyState era
initialBBodyState :: forall era.
(EraTxOut era, PostShelley era, EraGov era,
 State (EraRule "LEDGERS" era) ~ LedgerState era) =>
Proof era -> UTxO era -> ShelleyBbodyState era
initialBBodyState Proof era
pf UTxO era
utxo =
  forall era.
State (EraRule "LEDGERS" era)
-> BlocksMade (EraCrypto era) -> ShelleyBbodyState era
BbodyState (forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState era
initialUtxoSt CertState era
dpstate) (forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade forall a. Monoid a => a
mempty)
  where
    initialUtxoSt :: UTxOState era
initialUtxoSt =
      forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
utxo (forall a. Compactible a => CompactForm a -> a
UM.fromCompact CompactForm Coin
successDeposit) (Integer -> Coin
Coin Integer
0) forall a. Default a => a
def forall a. Monoid a => a
mempty
    dpstate :: CertState era
dpstate =
      forall a. Default a => a
def
        { certDState :: DState era
certDState =
            DState
              { dsUnified :: UMap (EraCrypto era)
dsUnified =
                  forall k v c. k -> v -> UView c k v -> UMap c
UM.insert
                    (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf)
                    (CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (Word64 -> CompactForm Coin
UM.CompactCoin Word64
1000) CompactForm Coin
successDeposit)
                    (forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView forall c. UMap c
UM.empty)
              , dsFutureGenDelegs :: Map (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
dsFutureGenDelegs = forall k a. Map k a
Map.empty
              , dsGenDelegs :: GenDelegs (EraCrypto era)
dsGenDelegs = forall c. Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
GenDelegs forall k a. Map k a
Map.empty
              , dsIRewards :: InstantaneousRewards (EraCrypto era)
dsIRewards = forall a. Default a => a
def
              }
        }

testAlonzoBlock ::
  ( GoodCrypto (EraCrypto era)
  , HasTokens era
  , Scriptic era
  , EraSegWits era
  , Value era ~ MaryValue (EraCrypto era)
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  Block (BHeaderView (EraCrypto era)) era
testAlonzoBlock :: forall era.
(GoodCrypto (EraCrypto era), HasTokens era, Scriptic era,
 EraSegWits era, Value era ~ MaryValue (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Block (BHeaderView (EraCrypto era)) era
testAlonzoBlock Proof era
pf =
  forall era.
EraSegWits era =>
[Tx era] -> Block (BHeaderView (EraCrypto era)) era
makeNaiveBlock
    [ forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingTx Proof era
pf
    , forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
False forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
notValidatingTx Proof era
pf
    , forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingTxWithWithdrawal Proof era
pf
    , forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
False forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
notValidatingTxWithWithdrawal Proof era
pf
    , forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
validatingTxWithCert Proof era
pf
    , forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
False forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
notValidatingTxWithCert Proof era
pf
    , forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, HasTokens era, EraTx era,
 GoodCrypto (EraCrypto era),
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> Tx era
validatingTxWithMint Proof era
pf
    , forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
False forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, HasTokens era, EraTx era,
 GoodCrypto (EraCrypto era),
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> Tx era
notValidatingTxWithMint Proof era
pf
    ]

testAlonzoBadPMDHBlock ::
  GoodCrypto (EraCrypto era) => Proof era -> Block (BHeaderView (EraCrypto era)) era
testAlonzoBadPMDHBlock :: forall era.
GoodCrypto (EraCrypto era) =>
Proof era -> Block (BHeaderView (EraCrypto era)) era
testAlonzoBadPMDHBlock pf :: Proof era
pf@Proof era
Alonzo = forall era.
EraSegWits era =>
[Tx era] -> Block (BHeaderView (EraCrypto era)) era
makeNaiveBlock [forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTxBody era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
poolMDHTooBigTx Proof era
pf]
testAlonzoBadPMDHBlock pf :: Proof era
pf@Proof era
Babbage = forall era.
EraSegWits era =>
[Tx era] -> Block (BHeaderView (EraCrypto era)) era
makeNaiveBlock [forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTxBody era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
poolMDHTooBigTx Proof era
pf]
testAlonzoBadPMDHBlock pf :: Proof era
pf@Proof era
Conway = forall era.
EraSegWits era =>
[Tx era] -> Block (BHeaderView (EraCrypto era)) era
makeNaiveBlock [forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTxBody era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
poolMDHTooBigTx Proof era
pf]
testAlonzoBadPMDHBlock Proof era
other = forall a. HasCallStack => TestName -> a
error (TestName
"testAlonzoBadPMDHBlock does not work in era " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Proof era
other)

-- ============================== DATA ===============================

someDatum :: Era era => Data era
someDatum :: forall era. Era era => Data era
someDatum = forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123)

anotherDatum :: Era era => Data era
anotherDatum :: forall era. Era era => Data era
anotherDatum = forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0)

validatingTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
validatingTx :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf]
        , forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data era
someDatum]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
        ]
    ]

validatingBody :: (Scriptic era, EraTxBody era) => Proof era -> TxBody era
validatingBody :: forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
1]
    , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
11]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. EraTxOut era => Proof era -> TxOut era
validatingTxOut Proof era
pf]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash
        ( forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash
            Proof era
pf
            (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
            [Language
PlutusV1]
            (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf)
            (forall era. Era era => Data era -> TxDats era
mkTxDats forall era. Era era => Data era
someDatum)
        )
    ]

validatingRedeemers :: Era era => Proof era -> Redeemers era
validatingRedeemers :: forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Spending (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

validatingTxOut :: EraTxOut era => Proof era -> TxOut era
validatingTxOut :: forall era. EraTxOut era => Proof era -> TxOut era
validatingTxOut Proof era
pf = forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]

notValidatingTx ::
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
notValidatingTx :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
notValidatingTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body TxBody era
notValidatingBody
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
notValidatingBody) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
0 Proof era
pf]
        , forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data era
anotherDatum]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
notValidatingRedeemers
        ]
    ]
  where
    notValidatingBody :: TxBody era
notValidatingBody =
      forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
2]
        , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
12]
        , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2995)]]
        , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash
            ( forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash
                Proof era
pf
                (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
                [Language
PlutusV1]
                Redeemers era
notValidatingRedeemers
                (forall era. Era era => Data era -> TxDats era
mkTxDats forall era. Era era => Data era
anotherDatum)
            )
        ]
    notValidatingRedeemers :: Redeemers era
notValidatingRedeemers = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Spending (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
1))

validatingTxWithWithdrawal ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
validatingTxWithWithdrawal :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingTxWithWithdrawal Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingBodyWithWithdrawal Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingBodyWithWithdrawal Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingWithWithdrawalRedeemers Proof era
pf
        ]
    ]

validatingBodyWithWithdrawal :: (EraTxBody era, Scriptic era) => Proof era -> TxBody era
validatingBodyWithWithdrawal :: forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingBodyWithWithdrawal Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
5]
    , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
15]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. EraTxOut era => Proof era -> TxOut era
validatingTxWithWithdrawalOut Proof era
pf]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals'
        ( forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. k -> a -> Map k a
Map.singleton
              (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf))
              (Integer -> Coin
Coin Integer
1000)
        )
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash
        ( forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash
            Proof era
pf
            (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
            [Language
PlutusV1]
            (forall era. Era era => Proof era -> Redeemers era
validatingWithWithdrawalRedeemers Proof era
pf)
            forall a. Monoid a => a
mempty
        )
    ]

validatingWithWithdrawalRedeemers :: Era era => Proof era -> Redeemers era
validatingWithWithdrawalRedeemers :: forall era. Era era => Proof era -> Redeemers era
validatingWithWithdrawalRedeemers Proof era
pf = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Rewarding (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

validatingTxWithWithdrawalOut :: EraTxOut era => Proof era -> TxOut era
validatingTxWithWithdrawalOut :: forall era. EraTxOut era => Proof era -> TxOut era
validatingTxWithWithdrawalOut Proof era
pf = forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1995)]

notValidatingTxWithWithdrawal ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
notValidatingTxWithWithdrawal :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
notValidatingTxWithWithdrawal Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body TxBody era
notValidatingBodyWithWithdrawal
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
notValidatingBodyWithWithdrawal) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
notValidatingRedeemers
        ]
    ]
  where
    notValidatingBodyWithWithdrawal :: TxBody era
notValidatingBodyWithWithdrawal =
      forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
6]
        , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
16]
        , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1995)]]
        , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals'
            ( forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$
                forall k a. k -> a -> Map k a
Map.singleton
                  (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredFail Proof era
pf))
                  (Integer -> Coin
Coin Integer
1000)
            )
        , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] Redeemers era
notValidatingRedeemers forall a. Monoid a => a
mempty)
        ]
    notValidatingRedeemers :: Redeemers era
notValidatingRedeemers = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Rewarding (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0))

validatingTxWithCert ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  Tx era
validatingTxWithCert :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
validatingTxWithCert Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingBodyWithCert Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingBodyWithCert Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemrsWithCert Proof era
pf
        ]
    ]

validatingBodyWithCert ::
  (Scriptic era, EraTxBody era, ShelleyEraTxCert era) => Proof era -> TxBody era
validatingBodyWithCert :: forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingBodyWithCert Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
3]
    , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
13]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. EraTxOut era => Proof era -> TxOut era
validatingTxWithCertOut Proof era
pf]
    , forall era. [TxCert era] -> TxBodyField era
Certs' [forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf)]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemrsWithCert Proof era
pf) forall a. Monoid a => a
mempty)
    ]

validatingRedeemrsWithCert :: Era era => Proof era -> Redeemers era
validatingRedeemrsWithCert :: forall era. Era era => Proof era -> Redeemers era
validatingRedeemrsWithCert Proof era
pf = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Certifying (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

validatingTxWithCertOut :: EraTxOut era => Proof era -> TxOut era
validatingTxWithCertOut :: forall era. EraTxOut era => Proof era -> TxOut era
validatingTxWithCertOut Proof era
pf =
  forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
    Proof era
pf
    [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf)
    , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
995 forall a. Semigroup a => a -> a -> a
<> forall a. Compactible a => CompactForm a -> a
UM.fromCompact CompactForm Coin
successDeposit)
    ]

notValidatingTxWithCert ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  Tx era
notValidatingTxWithCert :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
notValidatingTxWithCert Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body TxBody era
notValidatingBodyWithCert
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
notValidatingBodyWithCert) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
notValidatingRedeemersWithCert
        ]
    ]
  where
    notValidatingBodyWithCert :: TxBody era
notValidatingBodyWithCert =
      forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
4]
        , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
14]
        , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
995)]]
        , forall era. [TxCert era] -> TxBodyField era
Certs' [forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredFail Proof era
pf)]
        , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] Redeemers era
notValidatingRedeemersWithCert forall a. Monoid a => a
mempty)
        ]
    notValidatingRedeemersWithCert :: Redeemers era
notValidatingRedeemersWithCert = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Certifying (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0))

validatingTxWithMint ::
  forall era.
  ( Scriptic era
  , HasTokens era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
validatingTxWithMint :: forall era.
(Scriptic era, HasTokens era, EraTx era,
 GoodCrypto (EraCrypto era),
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> Tx era
validatingTxWithMint Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxBody era
validatingBodyWithMint Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxBody era
validatingBodyWithMint Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemersWithMint Proof era
pf
        ]
    ]

validatingBodyWithMint ::
  (HasTokens era, EraTxBody era, Scriptic era, Value era ~ MaryValue (EraCrypto era)) =>
  Proof era ->
  TxBody era
validatingBodyWithMint :: forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxBody era
validatingBodyWithMint Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
7]
    , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
17]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era.
(HasTokens era, EraTxOut era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxOut era
validatingTxWithMintOut Proof era
pf]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era. MultiAsset (EraCrypto era) -> TxBodyField era
Mint (forall era.
(Scriptic era, HasTokens era) =>
Proof era -> MultiAsset (EraCrypto era)
multiAsset Proof era
pf)
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemersWithMint Proof era
pf) forall a. Monoid a => a
mempty)
    ]

validatingRedeemersWithMint :: Era era => Proof era -> Redeemers era
validatingRedeemersWithMint :: forall era. Era era => Proof era -> Redeemers era
validatingRedeemersWithMint Proof era
pf = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Minting (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

multiAsset :: forall era. (Scriptic era, HasTokens era) => Proof era -> MultiAsset (EraCrypto era)
multiAsset :: forall era.
(Scriptic era, HasTokens era) =>
Proof era -> MultiAsset (EraCrypto era)
multiAsset Proof era
pf = forall era.
HasTokens era =>
Integer -> Script era -> MultiAsset (EraCrypto era)
forge @era Integer
1 (forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf)

validatingTxWithMintOut ::
  forall era.
  ( HasTokens era
  , EraTxOut era
  , Scriptic era
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  Proof era ->
  TxOut era
validatingTxWithMintOut :: forall era.
(HasTokens era, EraTxOut era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxOut era
validatingTxWithMintOut Proof era
pf =
  forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
995) (forall era.
(Scriptic era, HasTokens era) =>
Proof era -> MultiAsset (EraCrypto era)
multiAsset Proof era
pf))]

notValidatingTxWithMint ::
  forall era.
  ( Scriptic era
  , HasTokens era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
notValidatingTxWithMint :: forall era.
(Scriptic era, HasTokens era, EraTx era,
 GoodCrypto (EraCrypto era),
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> Tx era
notValidatingTxWithMint Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body TxBody era
notValidatingBodyWithMint
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
notValidatingBodyWithMint) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
notValidatingRedeemersWithMint
        ]
    ]
  where
    notValidatingBodyWithMint :: TxBody era
notValidatingBodyWithMint =
      forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
8]
        , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
18]
        , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Integer -> Coin
Coin Integer
995) MultiAsset (EraCrypto era)
ma)]]
        , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , forall era. MultiAsset (EraCrypto era) -> TxBodyField era
Mint MultiAsset (EraCrypto era)
ma
        , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] Redeemers era
notValidatingRedeemersWithMint forall a. Monoid a => a
mempty)
        ]
    notValidatingRedeemersWithMint :: Redeemers era
notValidatingRedeemersWithMint = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Minting (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0))
    ma :: MultiAsset (EraCrypto era)
ma = forall era.
HasTokens era =>
Integer -> Script era -> MultiAsset (EraCrypto era)
forge @era Integer
1 (forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf)

poolMDHTooBigTx ::
  forall era.
  ( Scriptic era
  , EraTxBody era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
poolMDHTooBigTx :: forall era.
(Scriptic era, EraTxBody era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
poolMDHTooBigTx Proof era
pf =
  -- Note that the UTXOW rule will no trigger the expected predicate failure,
  -- since it is checked in the POOL rule. BBODY will trigger it, however.
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body TxBody era
poolMDHTooBigTxBody
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
poolMDHTooBigTxBody) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        ]
    ]
  where
    poolMDHTooBigTxBody :: TxBody era
poolMDHTooBigTxBody =
      forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
3]
        , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
995 forall t. Val t => t -> t -> t
<-> Coin
poolDeposit)]]
        , forall era. [TxCert era] -> TxBodyField era
Certs' [forall era.
EraTxCert era =>
PoolParams (EraCrypto era) -> TxCert era
RegPoolTxCert PoolParams (EraCrypto era)
poolParams]
        , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        ]
      where
        tooManyBytes :: ByteString
tooManyBytes = Int -> Word8 -> ByteString
BS.replicate (forall c. Crypto c => Int
hashsize @(EraCrypto era) forall a. Num a => a -> a -> a
+ Int
1) Word8
0
        poolParams :: PoolParams (EraCrypto era)
poolParams =
          PoolParams
            { ppId :: KeyHash 'StakePool (EraCrypto era)
ppId = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf
            , ppVrf :: Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
ppVrf = forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
hashVerKeyVRF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. VRFKeyPair c -> VerKeyVRF c
vrfVerKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Crypto c => RawSeed -> VRFKeyPair c
mkVRFKeyPair @(EraCrypto era) forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
0
            , ppPledge :: Coin
ppPledge = Integer -> Coin
Coin Integer
0
            , ppCost :: Coin
ppCost = Integer -> Coin
Coin Integer
0
            , ppMargin :: UnitInterval
ppMargin = forall a. Bounded a => a
minBound
            , ppRewardAccount :: RewardAccount (EraCrypto era)
ppRewardAccount = forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf)
            , ppOwners :: Set (KeyHash 'Staking (EraCrypto era))
ppOwners = forall a. Monoid a => a
mempty
            , ppRelays :: StrictSeq StakePoolRelay
ppRelays = forall a. Monoid a => a
mempty
            , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata = forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ Url -> ByteString -> PoolMetadata
PoolMetadata (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 Text
"") ByteString
tooManyBytes
            }

-- ============================== Expected UTXO  ===============================

testBBodyState ::
  forall era.
  ( GoodCrypto (EraCrypto era)
  , HasTokens era
  , PostShelley era
  , EraTxBody era
  , Value era ~ MaryValue (EraCrypto era)
  , EraGov era
  , State (EraRule "LEDGERS" era) ~ LedgerState era
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  ShelleyBbodyState era
testBBodyState :: forall era.
(GoodCrypto (EraCrypto era), HasTokens era, PostShelley era,
 EraTxBody era, Value era ~ MaryValue (EraCrypto era), EraGov era,
 State (EraRule "LEDGERS" era) ~ LedgerState era,
 ShelleyEraTxCert era) =>
Proof era -> ShelleyBbodyState era
testBBodyState Proof era
pf =
  let utxo :: UTxO era
utxo =
        forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$
          forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (forall c. TxId c -> TxIx -> TxIn c
TxIn (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody (forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf)) forall a. Bounded a => a
minBound, forall era. EraTxOut era => Proof era -> TxOut era
validatingTxOut Proof era
pf)
            , (forall c. TxId c -> TxIx -> TxIn c
TxIn (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody (forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingBodyWithCert Proof era
pf)) forall a. Bounded a => a
minBound, forall era. EraTxOut era => Proof era -> TxOut era
validatingTxWithCertOut Proof era
pf)
            , (forall c. TxId c -> TxIx -> TxIn c
TxIn (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody (forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingBodyWithWithdrawal Proof era
pf)) forall a. Bounded a => a
minBound, forall era. EraTxOut era => Proof era -> TxOut era
validatingTxWithWithdrawalOut Proof era
pf)
            , (forall c. TxId c -> TxIx -> TxIn c
TxIn (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody (forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxBody era
validatingBodyWithMint Proof era
pf)) forall a. Bounded a => a
minBound, forall era.
(HasTokens era, EraTxOut era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxOut era
validatingTxWithMintOut Proof era
pf)
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
11, forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5)])
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
2, TxOut era
alwaysFailsOutput)
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
13, forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5)])
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
4, forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1000)])
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
15, forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5)])
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
6, forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1000)])
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
17, forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5)])
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
8, forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1000)])
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
100, TxOut era
timelockOut)
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
101, TxOut era
unspendableOut)
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
102, TxOut era
alwaysSucceedsOutputV1)
            , (forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
103, TxOut era
nonScriptOutWithDatum)
            ]
      alwaysFailsOutput :: TxOut era
alwaysFailsOutput =
        forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
          Proof era
pf
          [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Scriptic era => Script era -> Addr (EraCrypto era)
someScriptAddr (forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
0 Proof era
pf))
          , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3000)
          , forall era. [DataHash (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
anotherDatum @era]
          ]
      timelockOut :: TxOut era
timelockOut = forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ Addr (EraCrypto era)
timelockAddr, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1)]
      timelockAddr :: Addr (EraCrypto era)
timelockAddr = forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet Credential 'Payment (EraCrypto era)
pCred StakeReference (EraCrypto era)
sCred
        where
          (SignKeyDSIGN (DSIGN (EraCrypto era))
_ssk, VKey 'Staking (EraCrypto era)
svk) = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> (SignKeyDSIGN (DSIGN c), VKey kd c)
mkKeyPair @(EraCrypto era) (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
2)
          pCred :: Credential 'Payment (EraCrypto era)
pCred = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj ScriptHash (EraCrypto era)
timelockHash
          sCred :: StakeReference (EraCrypto era)
sCred = forall c. StakeCredential c -> StakeReference c
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall a b. (a -> b) -> a -> b
$ VKey 'Staking (EraCrypto era)
svk
          timelockHash :: ScriptHash (EraCrypto era)
timelockHash = forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => NativeScript era -> Script era
fromNativeScript forall a b. (a -> b) -> a -> b
$ forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
allOf [forall era. Scriptic era => Int -> Proof era -> NativeScript era
matchkey Int
1, forall era. PostShelley era => Int -> Proof era -> NativeScript era
after Int
100] Proof era
pf
      -- This output is unspendable since it is locked by a plutus script,
      -- but has no datum hash.
      unspendableOut :: TxOut era
unspendableOut =
        forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
          Proof era
pf
          [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Scriptic era => Script era -> Addr (EraCrypto era)
someScriptAddr (forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
          , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
          ]
      alwaysSucceedsOutputV1 :: TxOut era
alwaysSucceedsOutputV1 =
        forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
          Proof era
pf
          [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Scriptic era => Script era -> Addr (EraCrypto era)
someScriptAddr (forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
          , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
          , forall era. [DataHash (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
someDatum @era]
          ]
      nonScriptOutWithDatum :: TxOut era
nonScriptOutWithDatum =
        forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
          Proof era
pf
          [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf)
          , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1221)
          , forall era. [DataHash (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
someDatum @era]
          ]
      poolID :: KeyHash kd (EraCrypto era)
poolID = forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => KeyPair 'BlockIssuer c
coldKeys
      example1UtxoSt :: UTxOState era
example1UtxoSt =
        forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
utxo Coin
totalDeposits (Integer -> Coin
Coin Integer
40) forall a. Default a => a
def forall a. Monoid a => a
mempty
      -- the default CertState 'def' means that the 'totalDeposits' must be 0
      totalDeposits :: Coin
totalDeposits = Integer -> Coin
Coin Integer
0
   in forall era.
State (EraRule "LEDGERS" era)
-> BlocksMade (EraCrypto era) -> ShelleyBbodyState era
BbodyState
        (forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState era
example1UtxoSt forall a. Default a => a
def)
        (forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton forall {kd :: KeyRole}. KeyHash kd (EraCrypto era)
poolID Natural
1)

-- ============================== Helper functions ===============================

makeTooBig :: Proof era -> PredicateFailure (EraRule "BBODY" era)
makeTooBig :: forall era. Proof era -> PredicateFailure (EraRule "BBODY" era)
makeTooBig proof :: Proof era
proof@Proof era
Alonzo =
  forall era.
ShelleyBbodyPredFailure era -> AlonzoBbodyPredFailure era
ShelleyInAlonzoBbodyPredFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
LedgersFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "POOL" era)
-> ShelleyDelplPredFailure era
PoolFailure
    forall a b. (a -> b) -> a -> b
$ forall era.
KeyHash 'StakePool (EraCrypto era)
-> Int -> ShelleyPoolPredFailure era
PoolMedataHashTooBig (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
proof) (forall c. Crypto c => Int
hashsize @Mock forall a. Num a => a -> a -> a
+ Int
1)
makeTooBig proof :: Proof era
proof@Proof era
Babbage =
  forall era.
ShelleyBbodyPredFailure era -> AlonzoBbodyPredFailure era
ShelleyInAlonzoBbodyPredFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
LedgersFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "POOL" era)
-> ShelleyDelplPredFailure era
PoolFailure
    forall a b. (a -> b) -> a -> b
$ forall era.
KeyHash 'StakePool (EraCrypto era)
-> Int -> ShelleyPoolPredFailure era
PoolMedataHashTooBig (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
proof) (forall c. Crypto c => Int
hashsize @Mock forall a. Num a => a -> a -> a
+ Int
1)
makeTooBig proof :: Proof era
proof@Proof era
Conway =
  forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ConwayBbodyPredFailure era
Conway.LedgersFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "POOL" era) -> ConwayCertPredFailure era
Conway.PoolFailure
    forall a b. (a -> b) -> a -> b
$ forall era.
KeyHash 'StakePool (EraCrypto era)
-> Int -> ShelleyPoolPredFailure era
PoolMedataHashTooBig (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
proof) (forall c. Crypto c => Int
hashsize @Mock forall a. Num a => a -> a -> a
+ Int
1)
makeTooBig Proof era
proof = forall a. HasCallStack => TestName -> a
error (TestName
"makeTooBig does not work in era " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Proof era
proof)

coldKeys :: Crypto c => KeyPair 'BlockIssuer c
coldKeys :: forall c. Crypto c => KeyPair 'BlockIssuer c
coldKeys = forall (kd :: KeyRole) c.
VKey kd c -> SignKeyDSIGN (DSIGN c) -> KeyPair kd c
KeyPair forall {kd :: KeyRole}. VKey kd c
vk SignKeyDSIGN (DSIGN c)
sk
  where
    (SignKeyDSIGN (DSIGN c)
sk, VKey kd c
vk) = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> (SignKeyDSIGN (DSIGN c), VKey kd c)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
2 Word64
3 Word64
2 Word64
1)

makeNaiveBlock ::
  forall era. EraSegWits era => [Tx era] -> Block (BHeaderView (EraCrypto era)) era
makeNaiveBlock :: forall era.
EraSegWits era =>
[Tx era] -> Block (BHeaderView (EraCrypto era)) era
makeNaiveBlock [Tx era]
txs = forall h era. h -> TxSeq era -> Block h era
UnsafeUnserialisedBlock BHeaderView (EraCrypto era)
bhView TxSeq era
txSeq
  where
    bhView :: BHeaderView (EraCrypto era)
bhView =
      BHeaderView
        { bhviewID :: KeyHash 'BlockIssuer (EraCrypto era)
bhviewID = forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey (forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall c. Crypto c => KeyPair 'BlockIssuer c
coldKeys)
        , bhviewBSize :: Word32
bhviewBSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall era. EraSegWits era => ProtVer -> TxSeq era -> Int
bBodySize (Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Natural
0) TxSeq era
txSeq
        , bhviewHSize :: Int
bhviewHSize = Int
0
        , bhviewBHash :: Hash (EraCrypto era) EraIndependentBlockBody
bhviewBHash = forall era.
EraSegWits era =>
TxSeq era -> Hash (HASH (EraCrypto era)) EraIndependentBlockBody
hashTxSeq TxSeq era
txSeq
        , bhviewSlot :: SlotNo
bhviewSlot = Word64 -> SlotNo
SlotNo Word64
0
        }
    txSeq :: TxSeq era
txSeq = forall era. EraSegWits era => StrictSeq (Tx era) -> TxSeq era
toTxSeq forall a b. (a -> b) -> a -> b
$ forall a. [a] -> StrictSeq a
StrictSeq.fromList [Tx era]
txs

scriptStakeCredFail :: forall era. Scriptic era => Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredFail :: forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredFail Proof era
pf = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj (forall era.
Scriptic era =>
Natural -> Proof era -> ScriptHash (EraCrypto era)
alwaysFailsHash Natural
1 Proof era
pf)

scriptStakeCredSuceed :: forall era. Scriptic era => Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed :: forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj (forall era.
Scriptic era =>
Natural -> Proof era -> ScriptHash (EraCrypto era)
alwaysSucceedsHash Natural
2 Proof era
pf)

-- | The deposit made when 'scriptStakeCredSuceed' was registered. It is also
--   The Refund when 'scriptStakeCredSuceed' is de-registered.
successDeposit :: UM.CompactForm Coin
successDeposit :: CompactForm Coin
successDeposit = Word64 -> CompactForm Coin
UM.CompactCoin Word64
7

hashsize :: forall c. Crypto c => Int
hashsize :: forall c. Crypto c => Int
hashsize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash ([] @(HASH c))

-- ============================== PParams ===============================

defaultPPs :: [PParamsField era]
defaultPPs :: forall era. [PParamsField era]
defaultPPs =
  [ forall era. CostModels -> PParamsField era
Costmdls forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1]
  , forall era. Natural -> PParamsField era
MaxValSize Natural
1000000000
  , forall era. ExUnits -> PParamsField era
MaxTxExUnits forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , forall era. ExUnits -> PParamsField era
MaxBlockExUnits forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , forall era. ProtVer -> PParamsField era
ProtocolVersion forall a b. (a -> b) -> a -> b
$ Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @5) Natural
0
  , forall era. Natural -> PParamsField era
CollateralPercentage Natural
100
  , forall era. Coin -> PParamsField era
KeyDeposit (Integer -> Coin
Coin Integer
2)
  , forall era. Coin -> PParamsField era
PoolDeposit Coin
poolDeposit
  ]

poolDeposit :: Coin
poolDeposit :: Coin
poolDeposit = Integer -> Coin
Coin Integer
5

pp :: EraPParams era => Proof era -> PParams era
pp :: forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf = forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof era
pf forall era. [PParamsField era]
defaultPPs