{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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 (RewardAccount (..))
import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyPredFailure (..))
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.TxWits (AlonzoEraTxWits (..), 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,
 )
import Cardano.Ledger.Keys (coerceKeyRole)
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.Shelley.API (
  GenDelegs (..),
  LedgerState (..),
  PoolParams (..),
  ProtVer (..),
 )
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.State
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.Protocol.Crypto (hashVerKeyVRF)
import Cardano.Slotting.Slot (SlotNo (..))
import Control.State.Transition.Extended (STS (..))
import qualified Data.ByteString as BS (replicate)
import Data.Data (Proxy (..))
import Data.Default (Default (..))
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
import qualified Data.Sequence.Strict as StrictSeq
import Lens.Micro ((&), (.~))
import qualified PlutusLedgerApi.V1 as PV1
import Test.Cardano.Ledger.Conway.Era
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkWitnessVKey)
import Test.Cardano.Ledger.Examples.STSTestUtils (
  alwaysFailsHash,
  alwaysSucceedsHash,
  initUTxO,
  mkGenesisTxIn,
  mkSingleRedeemer,
  mkTxDats,
  someAddr,
  someKeys,
  someScriptAddr,
  testBBODY,
  trustMeP,
 )
import Test.Cardano.Ledger.Generic.Fields (
  PParamsField (..),
  TxBodyField (..),
  TxOutField (..),
 )
import Test.Cardano.Ledger.Generic.GenState (PlutusPurposeTag (..))
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.ConcreteCryptoTypes (MockCrypto)
import Test.Cardano.Ledger.Shelley.Utils (
  RawSeed (..),
  mkKeyPair,
  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."
    [ Proof AlonzoEra -> TestTree
forall era.
(HasTokens era, PostShelley era, Value era ~ MaryValue,
 Reflect era, State (EraRule "LEDGERS" era) ~ LedgerState era,
 AlonzoEraTest era) =>
Proof era -> TestTree
alonzoBBODYexamplesP Proof AlonzoEra
Alonzo
    , Proof BabbageEra -> TestTree
forall era.
(HasTokens era, PostShelley era, Value era ~ MaryValue,
 Reflect era, State (EraRule "LEDGERS" era) ~ LedgerState era,
 AlonzoEraTest era) =>
Proof era -> TestTree
alonzoBBODYexamplesP Proof BabbageEra
Babbage
    , Proof ConwayEra -> TestTree
forall era.
(HasTokens era, PostShelley era, Value era ~ MaryValue,
 Reflect era, State (EraRule "LEDGERS" era) ~ LedgerState era,
 AlonzoEraTest era) =>
Proof era -> TestTree
alonzoBBODYexamplesP Proof ConwayEra
Conway
    ]

alonzoBBODYexamplesP ::
  forall era.
  ( HasTokens era
  , PostShelley era
  , Value era ~ MaryValue
  , Reflect era
  , State (EraRule "LEDGERS" era) ~ LedgerState era
  , AlonzoEraTest era
  ) =>
  Proof era ->
  TestTree
alonzoBBODYexamplesP :: forall era.
(HasTokens era, PostShelley era, Value era ~ MaryValue,
 Reflect era, State (EraRule "LEDGERS" era) ~ LedgerState era,
 AlonzoEraTest era) =>
Proof era -> TestTree
alonzoBBODYexamplesP Proof era
proof =
  TestName -> [TestTree] -> TestTree
testGroup
    (Proof era -> TestName
forall a. Show a => a -> TestName
show Proof era
proof TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
" BBODY examples")
    [ TestName -> Assertion -> TestTree
testCase TestName
"eight plutus scripts cases" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        WitRule "BBODY" era
-> ShelleyBbodyState era
-> Block BHeaderView era
-> Either
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
     (ShelleyBbodyState era)
-> PParams era
-> Assertion
forall era.
(HasCallStack, EraTest era, Reflect era) =>
WitRule "BBODY" era
-> ShelleyBbodyState era
-> Block BHeaderView era
-> Either
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
     (ShelleyBbodyState era)
-> PParams era
-> Assertion
testBBODY
          (Proof era -> WitRule "BBODY" era
forall e. Proof e -> WitRule "BBODY" e
BBODY Proof era
proof)
          (Proof era -> UTxO era -> ShelleyBbodyState era
forall era.
(EraTxOut era, PostShelley era, EraGov era, EraStake era,
 State (EraRule "LEDGERS" era) ~ LedgerState era,
 EraCertState era) =>
Proof era -> UTxO era -> ShelleyBbodyState era
initialBBodyState Proof era
proof (Proof era -> UTxO era
forall era.
(EraTxOut era, PostShelley era) =>
Proof era -> UTxO era
initUTxO Proof era
proof))
          (Proof era -> Block BHeaderView era
forall era.
(HasTokens era, Scriptic era, EraSegWits era,
 Value era ~ MaryValue, ShelleyEraTxCert era,
 AlonzoEraTxWits era) =>
Proof era -> Block BHeaderView era
testAlonzoBlock Proof era
proof)
          (ShelleyBbodyState era
-> Either
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
     (ShelleyBbodyState era)
forall a b. b -> Either a b
Right (Proof era -> ShelleyBbodyState era
forall era.
(HasTokens era, PostShelley era, EraTxBody era,
 Value era ~ MaryValue, EraGov era, EraStake era,
 State (EraRule "LEDGERS" era) ~ LedgerState era,
 ShelleyEraTxCert era, EraCertState era) =>
Proof era -> ShelleyBbodyState era
testBBodyState Proof era
proof))
          (Proof era -> PParams era
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        WitRule "BBODY" era
-> ShelleyBbodyState era
-> Block BHeaderView era
-> Either
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
     (ShelleyBbodyState era)
-> PParams era
-> Assertion
forall era.
(HasCallStack, EraTest era, Reflect era) =>
WitRule "BBODY" era
-> ShelleyBbodyState era
-> Block BHeaderView era
-> Either
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
     (ShelleyBbodyState era)
-> PParams era
-> Assertion
testBBODY
          (Proof era -> WitRule "BBODY" era
forall e. Proof e -> WitRule "BBODY" e
BBODY Proof era
proof)
          (Proof era -> UTxO era -> ShelleyBbodyState era
forall era.
(EraTxOut era, PostShelley era, EraGov era, EraStake era,
 State (EraRule "LEDGERS" era) ~ LedgerState era,
 EraCertState era) =>
Proof era -> UTxO era -> ShelleyBbodyState era
initialBBodyState Proof era
proof (Proof era -> UTxO era
forall era.
(EraTxOut era, PostShelley era) =>
Proof era -> UTxO era
initUTxO Proof era
proof))
          (Proof era -> Block BHeaderView era
forall era. Proof era -> Block BHeaderView era
testAlonzoBadPMDHBlock Proof era
proof)
          (NonEmpty (PredicateFailure (EraRule "BBODY" era))
-> Either
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
     (ShelleyBbodyState era)
forall a b. a -> Either a b
Left (NonEmpty (PredicateFailure (EraRule "BBODY" era))
 -> Either
      (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
      (ShelleyBbodyState era))
-> (PredicateFailure (EraRule "BBODY" era)
    -> NonEmpty (PredicateFailure (EraRule "BBODY" era)))
-> PredicateFailure (EraRule "BBODY" era)
-> Either
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
     (ShelleyBbodyState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "BBODY" era)
-> NonEmpty (PredicateFailure (EraRule "BBODY" era))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PredicateFailure (EraRule "BBODY" era)
 -> Either
      (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
      (ShelleyBbodyState era))
-> PredicateFailure (EraRule "BBODY" era)
-> Either
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
     (ShelleyBbodyState era)
forall a b. (a -> b) -> a -> b
$ Proof era -> PredicateFailure (EraRule "BBODY" era)
forall era. Proof era -> PredicateFailure (EraRule "BBODY" era)
makeTooBig Proof era
proof)
          (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
proof)
    ]

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

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

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

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

someDatum :: Era era => Data era
someDatum :: forall era. Era era => Data era
someDatum = Data -> Data era
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 = Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0)

validatingTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  Tx era
validatingTx :: forall era.
(Scriptic era, EraTx era, AlonzoEraTxWits era) =>
Proof era -> Tx era
validatingTx Proof era
pf =
  let
    script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf
   in
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (Proof era -> TxBody era
forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf)
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (Proof era -> TxBody era
forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf)) (Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Map ScriptHash (Script era)
     -> Identity (Map ScriptHash (Script era)))
    -> TxWits era -> Identity (TxWits era))
-> (Map ScriptHash (Script era)
    -> Identity (Map ScriptHash (Script era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> Tx era -> Identity (Tx era))
-> Map ScriptHash (Script era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((TxDats era -> Identity (TxDats era))
    -> TxWits era -> Identity (TxWits era))
-> (TxDats era -> Identity (TxDats era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats era -> Identity (TxDats era))
-> TxWits era -> Identity (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Identity (TxDats era))
 -> Tx era -> Identity (Tx era))
-> TxDats era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (TxDats era)
Data era
forall era. Era era => Data era
someDatum]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
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 =
  Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1]
    , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
11]
    , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> TxOut era
forall era. EraTxOut era => Proof era -> TxOut era
validatingTxOut Proof era
pf]
    , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash
        ( Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash
            Proof era
pf
            (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
            [Item [Language]
Language
PlutusV1]
            (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf)
            (Data era -> TxDats era
forall era. Era era => Data era -> TxDats era
mkTxDats Data era
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 = Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Spending (Data -> Data era
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 = Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]

notValidatingTx ::
  ( Scriptic era
  , EraTx era
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  Tx era
notValidatingTx :: forall era.
(Scriptic era, EraTx era, AlonzoEraTxWits era) =>
Proof era -> Tx era
notValidatingTx Proof era
pf =
  let
    script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
0 Proof era
pf
   in
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
notValidatingBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
notValidatingBody) (Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Map ScriptHash (Script era)
     -> Identity (Map ScriptHash (Script era)))
    -> TxWits era -> Identity (TxWits era))
-> (Map ScriptHash (Script era)
    -> Identity (Map ScriptHash (Script era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> Tx era -> Identity (Tx era))
-> Map ScriptHash (Script era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((TxDats era -> Identity (TxDats era))
    -> TxWits era -> Identity (TxWits era))
-> (TxDats era -> Identity (TxDats era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats era -> Identity (TxDats era))
-> TxWits era -> Identity (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Identity (TxDats era))
 -> Tx era -> Identity (Tx era))
-> TxDats era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (TxDats era)
Data era
forall era. Era era => Data era
anotherDatum]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
notValidatingRedeemers
  where
    notValidatingBody :: TxBody era
notValidatingBody =
      Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
2]
        , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
12]
        , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2995)]]
        , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash
            ( Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash
                Proof era
pf
                (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
                [Item [Language]
Language
PlutusV1]
                Redeemers era
notValidatingRedeemers
                (Data era -> TxDats era
forall era. Era era => Data era -> TxDats era
mkTxDats Data era
forall era. Era era => Data era
anotherDatum)
            )
        ]
    notValidatingRedeemers :: Redeemers era
notValidatingRedeemers = Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Spending (Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
1))

validatingTxWithWithdrawal ::
  forall era.
  ( Scriptic era
  , EraTx era
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  Tx era
validatingTxWithWithdrawal :: forall era.
(Scriptic era, EraTx era, AlonzoEraTxWits era) =>
Proof era -> Tx era
validatingTxWithWithdrawal Proof era
pf =
  let
    script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf
   in
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (Proof era -> TxBody era
forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingBodyWithWithdrawal Proof era
pf)
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL
        ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (Proof era -> TxBody era
forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingBodyWithWithdrawal Proof era
pf)) (Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Map ScriptHash (Script era)
     -> Identity (Map ScriptHash (Script era)))
    -> TxWits era -> Identity (TxWits era))
-> (Map ScriptHash (Script era)
    -> Identity (Map ScriptHash (Script era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> Tx era -> Identity (Tx era))
-> Map ScriptHash (Script era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
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 =
  Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
5]
    , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
15]
    , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> TxOut era
forall era. EraTxOut era => Proof era -> TxOut era
validatingTxWithWithdrawalOut Proof era
pf]
    , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , Withdrawals -> TxBodyField era
forall era. Withdrawals -> TxBodyField era
Withdrawals'
        ( Map RewardAccount Coin -> Withdrawals
Withdrawals (Map RewardAccount Coin -> Withdrawals)
-> Map RewardAccount Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$
            RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton
              (Network -> StakeCredential -> RewardAccount
RewardAccount Network
Testnet (Proof era -> StakeCredential
forall era. Scriptic era => Proof era -> StakeCredential
scriptStakeCredSuceed Proof era
pf))
              (Integer -> Coin
Coin Integer
1000)
        )
    , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash
        ( Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash
            Proof era
pf
            (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
            [Item [Language]
Language
PlutusV1]
            (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingWithWithdrawalRedeemers Proof era
pf)
            TxDats era
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 = Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Rewarding (Data -> Data era
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 = Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1995)]

notValidatingTxWithWithdrawal ::
  forall era.
  ( Scriptic era
  , EraTx era
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  Tx era
notValidatingTxWithWithdrawal :: forall era.
(Scriptic era, EraTx era, AlonzoEraTxWits era) =>
Proof era -> Tx era
notValidatingTxWithWithdrawal Proof era
pf =
  let
    script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf
   in
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
notValidatingBodyWithWithdrawal
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL
        ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
notValidatingBodyWithWithdrawal) (Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Map ScriptHash (Script era)
     -> Identity (Map ScriptHash (Script era)))
    -> TxWits era -> Identity (TxWits era))
-> (Map ScriptHash (Script era)
    -> Identity (Map ScriptHash (Script era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> Tx era -> Identity (Tx era))
-> Map ScriptHash (Script era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
notValidatingRedeemers
  where
    notValidatingBodyWithWithdrawal :: TxBody era
notValidatingBodyWithWithdrawal =
      Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
6]
        , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
16]
        , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1995)]]
        , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , Withdrawals -> TxBodyField era
forall era. Withdrawals -> TxBodyField era
Withdrawals'
            ( Map RewardAccount Coin -> Withdrawals
Withdrawals (Map RewardAccount Coin -> Withdrawals)
-> Map RewardAccount Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$
                RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton
                  (Network -> StakeCredential -> RewardAccount
RewardAccount Network
Testnet (Proof era -> StakeCredential
forall era. Scriptic era => Proof era -> StakeCredential
scriptStakeCredFail Proof era
pf))
                  (Integer -> Coin
Coin Integer
1000)
            )
        , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV1] Redeemers era
notValidatingRedeemers TxDats era
forall a. Monoid a => a
mempty)
        ]
    notValidatingRedeemers :: Redeemers era
notValidatingRedeemers = Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Rewarding (Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0))

validatingTxWithCert ::
  forall era.
  ( Scriptic era
  , EraTx era
  , ShelleyEraTxCert era
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  Tx era
validatingTxWithCert :: forall era.
(Scriptic era, EraTx era, ShelleyEraTxCert era,
 AlonzoEraTxWits era) =>
Proof era -> Tx era
validatingTxWithCert Proof era
pf =
  let
    script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf
   in
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (Proof era -> TxBody era
forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingBodyWithCert Proof era
pf)
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (Proof era -> TxBody era
forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingBodyWithCert Proof era
pf)) (Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Map ScriptHash (Script era)
     -> Identity (Map ScriptHash (Script era)))
    -> TxWits era -> Identity (TxWits era))
-> (Map ScriptHash (Script era)
    -> Identity (Map ScriptHash (Script era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> Tx era -> Identity (Tx era))
-> Map ScriptHash (Script era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
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 =
  Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
3]
    , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
13]
    , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> TxOut era
forall era. EraTxOut era => Proof era -> TxOut era
validatingTxWithCertOut Proof era
pf]
    , [TxCert era] -> TxBodyField era
forall era. [TxCert era] -> TxBodyField era
Certs' [StakeCredential -> TxCert era
forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
UnRegTxCert (Proof era -> StakeCredential
forall era. Scriptic era => Proof era -> StakeCredential
scriptStakeCredSuceed Proof era
pf)]
    , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV1] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemrsWithCert Proof era
pf) TxDats era
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 = Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Certifying (Data -> Data era
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 =
  Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
    Proof era
pf
    [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf)
    , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
995 Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
UM.fromCompact CompactForm Coin
successDeposit)
    ]

notValidatingTxWithCert ::
  forall era.
  ( Scriptic era
  , EraTx era
  , ShelleyEraTxCert era
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  Tx era
notValidatingTxWithCert :: forall era.
(Scriptic era, EraTx era, ShelleyEraTxCert era,
 AlonzoEraTxWits era) =>
Proof era -> Tx era
notValidatingTxWithCert Proof era
pf =
  let
    script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf
   in
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
notValidatingBodyWithCert
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
notValidatingBodyWithCert) (Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Map ScriptHash (Script era)
     -> Identity (Map ScriptHash (Script era)))
    -> TxWits era -> Identity (TxWits era))
-> (Map ScriptHash (Script era)
    -> Identity (Map ScriptHash (Script era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> Tx era -> Identity (Tx era))
-> Map ScriptHash (Script era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
notValidatingRedeemersWithCert
  where
    notValidatingBodyWithCert :: TxBody era
notValidatingBodyWithCert =
      Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
4]
        , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
14]
        , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
995)]]
        , [TxCert era] -> TxBodyField era
forall era. [TxCert era] -> TxBodyField era
Certs' [StakeCredential -> TxCert era
forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
UnRegTxCert (Proof era -> StakeCredential
forall era. Scriptic era => Proof era -> StakeCredential
scriptStakeCredFail Proof era
pf)]
        , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV1] Redeemers era
notValidatingRedeemersWithCert TxDats era
forall a. Monoid a => a
mempty)
        ]
    notValidatingRedeemersWithCert :: Redeemers era
notValidatingRedeemersWithCert = Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Certifying (Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0))

validatingTxWithMint ::
  forall era.
  ( Scriptic era
  , HasTokens era
  , EraTx era
  , Value era ~ MaryValue
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  Tx era
validatingTxWithMint :: forall era.
(Scriptic era, HasTokens era, EraTx era, Value era ~ MaryValue,
 AlonzoEraTxWits era) =>
Proof era -> Tx era
validatingTxWithMint Proof era
pf =
  let
    script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf
   in
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (Proof era -> TxBody era
forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue) =>
Proof era -> TxBody era
validatingBodyWithMint Proof era
pf)
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (Proof era -> TxBody era
forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue) =>
Proof era -> TxBody era
validatingBodyWithMint Proof era
pf)) (Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Map ScriptHash (Script era)
     -> Identity (Map ScriptHash (Script era)))
    -> TxWits era -> Identity (TxWits era))
-> (Map ScriptHash (Script era)
    -> Identity (Map ScriptHash (Script era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> Tx era -> Identity (Tx era))
-> Map ScriptHash (Script era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemersWithMint Proof era
pf

validatingBodyWithMint ::
  (HasTokens era, EraTxBody era, Scriptic era, Value era ~ MaryValue) =>
  Proof era ->
  TxBody era
validatingBodyWithMint :: forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue) =>
Proof era -> TxBody era
validatingBodyWithMint Proof era
pf =
  Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
7]
    , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
17]
    , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> TxOut era
forall era.
(HasTokens era, Scriptic era, Value era ~ MaryValue) =>
Proof era -> TxOut era
validatingTxWithMintOut Proof era
pf]
    , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , MultiAsset -> TxBodyField era
forall era. MultiAsset -> TxBodyField era
Mint (Proof era -> MultiAsset
forall era.
(Scriptic era, HasTokens era) =>
Proof era -> MultiAsset
multiAsset Proof era
pf)
    , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV1] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemersWithMint Proof era
pf) TxDats era
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 = Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Minting (Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

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

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

notValidatingTxWithMint ::
  forall era.
  ( Scriptic era
  , HasTokens era
  , EraTx era
  , Value era ~ MaryValue
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  Tx era
notValidatingTxWithMint :: forall era.
(Scriptic era, HasTokens era, EraTx era, Value era ~ MaryValue,
 AlonzoEraTxWits era) =>
Proof era -> Tx era
notValidatingTxWithMint Proof era
pf =
  let
    script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf
   in
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
notValidatingBodyWithMint
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
notValidatingBodyWithMint) (Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Map ScriptHash (Script era)
     -> Identity (Map ScriptHash (Script era)))
    -> TxWits era -> Identity (TxWits era))
-> (Map ScriptHash (Script era)
    -> Identity (Map ScriptHash (Script era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> Tx era -> Identity (Tx era))
-> Map ScriptHash (Script era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
notValidatingRedeemersWithMint
  where
    notValidatingBodyWithMint :: TxBody era
notValidatingBodyWithMint =
      Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
8]
        , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
18]
        , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> MultiAsset -> MaryValue
MaryValue (Integer -> Coin
Coin Integer
995) MultiAsset
ma)]]
        , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , MultiAsset -> TxBodyField era
forall era. MultiAsset -> TxBodyField era
Mint MultiAsset
ma
        , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV1] Redeemers era
notValidatingRedeemersWithMint TxDats era
forall a. Monoid a => a
mempty)
        ]
    notValidatingRedeemersWithMint :: Redeemers era
notValidatingRedeemersWithMint = Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Minting (Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0))
    ma :: MultiAsset
ma = forall era. HasTokens era => Integer -> Script era -> MultiAsset
forge @era Integer
1 (Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf)

poolMDHTooBigTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  ) =>
  Proof era ->
  Tx era
poolMDHTooBigTx :: forall era. (Scriptic era, EraTx 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.
  TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
poolMDHTooBigTxBody
    Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
poolMDHTooBigTxBody) (Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)]
  where
    poolMDHTooBigTxBody :: TxBody era
poolMDHTooBigTxBody =
      Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
3]
        , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
995 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
poolDeposit)]]
        , [TxCert era] -> TxBodyField era
forall era. [TxCert era] -> TxBodyField era
Certs' [PoolParams -> TxCert era
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
poolParams]
        , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        ]
      where
        tooManyBytes :: ByteString
tooManyBytes = Int -> Word8 -> ByteString
BS.replicate (Int
hashsize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
0
        poolParams :: PoolParams
poolParams =
          PoolParams
            { ppId :: KeyHash 'StakePool
ppId = KeyHash 'Payment -> KeyHash 'StakePool
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash 'Payment -> KeyHash 'StakePool)
-> (KeyPair 'Payment -> KeyHash 'Payment)
-> KeyPair 'Payment
-> KeyHash 'StakePool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> KeyHash 'Payment)
-> (KeyPair 'Payment -> VKey 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey (KeyPair 'Payment -> KeyHash 'StakePool)
-> KeyPair 'Payment -> KeyHash 'StakePool
forall a b. (a -> b) -> a -> b
$ Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf
            , ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf =
                forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @MockCrypto (VerKeyVRF FakeVRF -> VRFVerKeyHash 'StakePoolVRF)
-> (RawSeed -> VerKeyVRF FakeVRF)
-> RawSeed
-> VRFVerKeyHash 'StakePoolVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey @MockCrypto (VRFKeyPair MockCrypto -> VerKeyVRF FakeVRF)
-> (RawSeed -> VRFKeyPair MockCrypto)
-> RawSeed
-> VerKeyVRF FakeVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Crypto c => RawSeed -> VRFKeyPair c
mkVRFKeyPair @MockCrypto (RawSeed -> VRFVerKeyHash 'StakePoolVRF)
-> RawSeed -> VRFVerKeyHash 'StakePoolVRF
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 = UnitInterval
forall a. Bounded a => a
minBound
            , ppRewardAccount :: RewardAccount
ppRewardAccount = Network -> StakeCredential -> RewardAccount
RewardAccount Network
Testnet (Proof era -> StakeCredential
forall era. Scriptic era => Proof era -> StakeCredential
scriptStakeCredSuceed Proof era
pf)
            , ppOwners :: Set (KeyHash 'Staking)
ppOwners = Set (KeyHash 'Staking)
forall a. Monoid a => a
mempty
            , ppRelays :: StrictSeq StakePoolRelay
ppRelays = StrictSeq StakePoolRelay
forall a. Monoid a => a
mempty
            , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata = PoolMetadata -> StrictMaybe PoolMetadata
forall a. a -> StrictMaybe a
SJust (PoolMetadata -> StrictMaybe PoolMetadata)
-> PoolMetadata -> StrictMaybe PoolMetadata
forall a b. (a -> b) -> a -> b
$ Url -> ByteString -> PoolMetadata
PoolMetadata (Maybe Url -> Url
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Url -> Url) -> Maybe Url -> Url
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 Text
"") ByteString
tooManyBytes
            }

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

testBBodyState ::
  forall era.
  ( HasTokens era
  , PostShelley era
  , EraTxBody era
  , Value era ~ MaryValue
  , EraGov era
  , EraStake era
  , State (EraRule "LEDGERS" era) ~ LedgerState era
  , ShelleyEraTxCert era
  , EraCertState era
  ) =>
  Proof era ->
  ShelleyBbodyState era
testBBodyState :: forall era.
(HasTokens era, PostShelley era, EraTxBody era,
 Value era ~ MaryValue, EraGov era, EraStake era,
 State (EraRule "LEDGERS" era) ~ LedgerState era,
 ShelleyEraTxCert era, EraCertState era) =>
Proof era -> ShelleyBbodyState era
testBBodyState Proof era
pf =
  let utxo :: UTxO era
utxo =
        Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$
          [(TxIn, TxOut era)] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (TxId -> TxIx -> TxIn
TxIn (TxBody era -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody (Proof era -> TxBody era
forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf)) TxIx
forall a. Bounded a => a
minBound, Proof era -> TxOut era
forall era. EraTxOut era => Proof era -> TxOut era
validatingTxOut Proof era
pf)
            , (TxId -> TxIx -> TxIn
TxIn (TxBody era -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody (Proof era -> TxBody era
forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingBodyWithCert Proof era
pf)) TxIx
forall a. Bounded a => a
minBound, Proof era -> TxOut era
forall era. EraTxOut era => Proof era -> TxOut era
validatingTxWithCertOut Proof era
pf)
            , (TxId -> TxIx -> TxIn
TxIn (TxBody era -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody (Proof era -> TxBody era
forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingBodyWithWithdrawal Proof era
pf)) TxIx
forall a. Bounded a => a
minBound, Proof era -> TxOut era
forall era. EraTxOut era => Proof era -> TxOut era
validatingTxWithWithdrawalOut Proof era
pf)
            , (TxId -> TxIx -> TxIn
TxIn (TxBody era -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody (Proof era -> TxBody era
forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue) =>
Proof era -> TxBody era
validatingBodyWithMint Proof era
pf)) TxIx
forall a. Bounded a => a
minBound, Proof era -> TxOut era
forall era.
(HasTokens era, Scriptic era, Value era ~ MaryValue) =>
Proof era -> TxOut era
validatingTxWithMintOut Proof era
pf)
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
11, Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5)])
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
2, TxOut era
alwaysFailsOutput)
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
13, Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5)])
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
4, Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1000)])
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
15, Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5)])
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
6, Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1000)])
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
17, Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5)])
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
8, Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1000)])
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
100, TxOut era
timelockOut)
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
101, TxOut era
unspendableOut)
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
102, TxOut era
alwaysSucceedsOutputV1)
            , (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
103, TxOut era
nonScriptOutWithDatum)
            ]
      alwaysFailsOutput :: TxOut era
alwaysFailsOutput =
        Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
          Proof era
pf
          [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Script era -> Addr
forall era. Scriptic era => Script era -> Addr
someScriptAddr (Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
0 Proof era
pf))
          , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3000)
          , [DataHash] -> TxOutField era
forall era. [DataHash] -> TxOutField era
DHash' [Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
anotherDatum @era]
          ]
      timelockOut :: TxOut era
timelockOut = Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Addr
timelockAddr, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1)]
      timelockAddr :: Addr
timelockAddr = ScriptHash -> KeyPair 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr ScriptHash
timelockHash (KeyPair 'Staking -> Addr) -> KeyPair 'Staking -> Addr
forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' @'Staking (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
2)
        where
          timelockHash :: ScriptHash
timelockHash = forall era. EraScript era => Script era -> ScriptHash
hashScript @era (Script era -> ScriptHash) -> Script era -> ScriptHash
forall a b. (a -> b) -> a -> b
$ NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript era -> Script era) -> NativeScript era -> Script era
forall a b. (a -> b) -> a -> b
$ [Proof era -> NativeScript era] -> Proof era -> NativeScript era
forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
allOf [Int -> Proof era -> NativeScript era
forall era. Scriptic era => Int -> Proof era -> NativeScript era
matchkey Int
1, Int -> Proof era -> NativeScript era
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 =
        Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
          Proof era
pf
          [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Script era -> Addr
forall era. Scriptic era => Script era -> Addr
someScriptAddr (Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
          , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
          ]
      alwaysSucceedsOutputV1 :: TxOut era
alwaysSucceedsOutputV1 =
        Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
          Proof era
pf
          [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Script era -> Addr
forall era. Scriptic era => Script era -> Addr
someScriptAddr (Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
          , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
          , [DataHash] -> TxOutField era
forall era. [DataHash] -> TxOutField era
DHash' [Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
someDatum @era]
          ]
      nonScriptOutWithDatum :: TxOut era
nonScriptOutWithDatum =
        Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
          Proof era
pf
          [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf)
          , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1221)
          , [DataHash] -> TxOutField era
forall era. [DataHash] -> TxOutField era
DHash' [Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
someDatum @era]
          ]
      poolID :: KeyHash kd
poolID = VKey kd -> KeyHash kd
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey kd -> KeyHash kd)
-> (KeyPair 'BlockIssuer -> VKey kd)
-> KeyPair 'BlockIssuer
-> KeyHash kd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair kd -> VKey kd
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey (KeyPair kd -> VKey kd)
-> (KeyPair 'BlockIssuer -> KeyPair kd)
-> KeyPair 'BlockIssuer
-> VKey kd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'BlockIssuer -> KeyPair kd
forall (r :: KeyRole) (r' :: KeyRole). KeyPair r -> KeyPair r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyPair 'BlockIssuer -> KeyHash kd)
-> KeyPair 'BlockIssuer -> KeyHash kd
forall a b. (a -> b) -> a -> b
$ KeyPair 'BlockIssuer
coldKeys
      example1UtxoSt :: UTxOState era
example1UtxoSt =
        PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
forall era.
EraStake era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
utxo Coin
totalDeposits (Integer -> Coin
Coin Integer
40) GovState era
forall a. Default a => a
def Coin
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 State (EraRule "LEDGERS" era)
-> BlocksMade -> ShelleyBbodyState era
forall era.
State (EraRule "LEDGERS" era)
-> BlocksMade -> ShelleyBbodyState era
BbodyState
        (UTxOState era -> CertState era -> LedgerState era
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState era
example1UtxoSt CertState era
forall a. Default a => a
def)
        (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade (Map (KeyHash 'StakePool) Natural -> BlocksMade)
-> Map (KeyHash 'StakePool) Natural -> BlocksMade
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> Natural -> Map (KeyHash 'StakePool) Natural
forall k a. k -> a -> Map k a
Map.singleton KeyHash 'StakePool
forall {kd :: KeyRole}. KeyHash kd
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 =
  ShelleyBbodyPredFailure AlonzoEra
-> PredicateFailure (EraRule "BBODY" era)
ShelleyBbodyPredFailure AlonzoEra
-> AlonzoBbodyPredFailure AlonzoEra
forall era.
ShelleyBbodyPredFailure era -> AlonzoBbodyPredFailure era
ShelleyInAlonzoBbodyPredFailure
    (ShelleyBbodyPredFailure AlonzoEra
 -> PredicateFailure (EraRule "BBODY" era))
-> (ShelleyPoolPredFailure AlonzoEra
    -> ShelleyBbodyPredFailure AlonzoEra)
-> ShelleyPoolPredFailure AlonzoEra
-> PredicateFailure (EraRule "BBODY" era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "LEDGERS" AlonzoEra)
-> ShelleyBbodyPredFailure AlonzoEra
ShelleyLedgersPredFailure AlonzoEra
-> ShelleyBbodyPredFailure AlonzoEra
forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
LedgersFailure
    (ShelleyLedgersPredFailure AlonzoEra
 -> ShelleyBbodyPredFailure AlonzoEra)
-> (ShelleyPoolPredFailure AlonzoEra
    -> ShelleyLedgersPredFailure AlonzoEra)
-> ShelleyPoolPredFailure AlonzoEra
-> ShelleyBbodyPredFailure AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "LEDGER" AlonzoEra)
-> ShelleyLedgersPredFailure AlonzoEra
ShelleyLedgerPredFailure AlonzoEra
-> ShelleyLedgersPredFailure AlonzoEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
    (ShelleyLedgerPredFailure AlonzoEra
 -> ShelleyLedgersPredFailure AlonzoEra)
-> (ShelleyPoolPredFailure AlonzoEra
    -> ShelleyLedgerPredFailure AlonzoEra)
-> ShelleyPoolPredFailure AlonzoEra
-> ShelleyLedgersPredFailure AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "DELEGS" AlonzoEra)
-> ShelleyLedgerPredFailure AlonzoEra
ShelleyDelegsPredFailure AlonzoEra
-> ShelleyLedgerPredFailure AlonzoEra
forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure
    (ShelleyDelegsPredFailure AlonzoEra
 -> ShelleyLedgerPredFailure AlonzoEra)
-> (ShelleyPoolPredFailure AlonzoEra
    -> ShelleyDelegsPredFailure AlonzoEra)
-> ShelleyPoolPredFailure AlonzoEra
-> ShelleyLedgerPredFailure AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "DELPL" AlonzoEra)
-> ShelleyDelegsPredFailure AlonzoEra
ShelleyDelplPredFailure AlonzoEra
-> ShelleyDelegsPredFailure AlonzoEra
forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure
    (ShelleyDelplPredFailure AlonzoEra
 -> ShelleyDelegsPredFailure AlonzoEra)
-> (ShelleyPoolPredFailure AlonzoEra
    -> ShelleyDelplPredFailure AlonzoEra)
-> ShelleyPoolPredFailure AlonzoEra
-> ShelleyDelegsPredFailure AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "POOL" AlonzoEra)
-> ShelleyDelplPredFailure AlonzoEra
ShelleyPoolPredFailure AlonzoEra
-> ShelleyDelplPredFailure AlonzoEra
forall era.
PredicateFailure (EraRule "POOL" era)
-> ShelleyDelplPredFailure era
PoolFailure
    (ShelleyPoolPredFailure AlonzoEra
 -> PredicateFailure (EraRule "BBODY" era))
-> ShelleyPoolPredFailure AlonzoEra
-> PredicateFailure (EraRule "BBODY" era)
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> Int -> ShelleyPoolPredFailure AlonzoEra
forall era. KeyHash 'StakePool -> Int -> ShelleyPoolPredFailure era
PoolMedataHashTooBig (KeyHash 'Payment -> KeyHash 'StakePool
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash 'Payment -> KeyHash 'StakePool)
-> (KeyPair 'Payment -> KeyHash 'Payment)
-> KeyPair 'Payment
-> KeyHash 'StakePool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> KeyHash 'Payment)
-> (KeyPair 'Payment -> VKey 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey (KeyPair 'Payment -> KeyHash 'StakePool)
-> KeyPair 'Payment -> KeyHash 'StakePool
forall a b. (a -> b) -> a -> b
$ Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
proof) (Int
hashsize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
makeTooBig proof :: Proof era
proof@Proof era
Babbage =
  ShelleyBbodyPredFailure BabbageEra
-> PredicateFailure (EraRule "BBODY" era)
ShelleyBbodyPredFailure BabbageEra
-> AlonzoBbodyPredFailure BabbageEra
forall era.
ShelleyBbodyPredFailure era -> AlonzoBbodyPredFailure era
ShelleyInAlonzoBbodyPredFailure
    (ShelleyBbodyPredFailure BabbageEra
 -> PredicateFailure (EraRule "BBODY" era))
-> (ShelleyPoolPredFailure BabbageEra
    -> ShelleyBbodyPredFailure BabbageEra)
-> ShelleyPoolPredFailure BabbageEra
-> PredicateFailure (EraRule "BBODY" era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "LEDGERS" BabbageEra)
-> ShelleyBbodyPredFailure BabbageEra
ShelleyLedgersPredFailure BabbageEra
-> ShelleyBbodyPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
LedgersFailure
    (ShelleyLedgersPredFailure BabbageEra
 -> ShelleyBbodyPredFailure BabbageEra)
-> (ShelleyPoolPredFailure BabbageEra
    -> ShelleyLedgersPredFailure BabbageEra)
-> ShelleyPoolPredFailure BabbageEra
-> ShelleyBbodyPredFailure BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "LEDGER" BabbageEra)
-> ShelleyLedgersPredFailure BabbageEra
ShelleyLedgerPredFailure BabbageEra
-> ShelleyLedgersPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
    (ShelleyLedgerPredFailure BabbageEra
 -> ShelleyLedgersPredFailure BabbageEra)
-> (ShelleyPoolPredFailure BabbageEra
    -> ShelleyLedgerPredFailure BabbageEra)
-> ShelleyPoolPredFailure BabbageEra
-> ShelleyLedgersPredFailure BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "DELEGS" BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra
ShelleyDelegsPredFailure BabbageEra
-> ShelleyLedgerPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure
    (ShelleyDelegsPredFailure BabbageEra
 -> ShelleyLedgerPredFailure BabbageEra)
-> (ShelleyPoolPredFailure BabbageEra
    -> ShelleyDelegsPredFailure BabbageEra)
-> ShelleyPoolPredFailure BabbageEra
-> ShelleyLedgerPredFailure BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "DELPL" BabbageEra)
-> ShelleyDelegsPredFailure BabbageEra
ShelleyDelplPredFailure BabbageEra
-> ShelleyDelegsPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure
    (ShelleyDelplPredFailure BabbageEra
 -> ShelleyDelegsPredFailure BabbageEra)
-> (ShelleyPoolPredFailure BabbageEra
    -> ShelleyDelplPredFailure BabbageEra)
-> ShelleyPoolPredFailure BabbageEra
-> ShelleyDelegsPredFailure BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "POOL" BabbageEra)
-> ShelleyDelplPredFailure BabbageEra
ShelleyPoolPredFailure BabbageEra
-> ShelleyDelplPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "POOL" era)
-> ShelleyDelplPredFailure era
PoolFailure
    (ShelleyPoolPredFailure BabbageEra
 -> PredicateFailure (EraRule "BBODY" era))
-> ShelleyPoolPredFailure BabbageEra
-> PredicateFailure (EraRule "BBODY" era)
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> Int -> ShelleyPoolPredFailure BabbageEra
forall era. KeyHash 'StakePool -> Int -> ShelleyPoolPredFailure era
PoolMedataHashTooBig (KeyHash 'Payment -> KeyHash 'StakePool
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash 'Payment -> KeyHash 'StakePool)
-> (KeyPair 'Payment -> KeyHash 'Payment)
-> KeyPair 'Payment
-> KeyHash 'StakePool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> KeyHash 'Payment)
-> (KeyPair 'Payment -> VKey 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey (KeyPair 'Payment -> KeyHash 'StakePool)
-> KeyPair 'Payment -> KeyHash 'StakePool
forall a b. (a -> b) -> a -> b
$ Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
proof) (Int
hashsize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
makeTooBig proof :: Proof era
proof@Proof era
Conway =
  PredicateFailure (EraRule "LEDGERS" ConwayEra)
-> ConwayBbodyPredFailure ConwayEra
ShelleyLedgersPredFailure ConwayEra
-> PredicateFailure (EraRule "BBODY" era)
forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ConwayBbodyPredFailure era
Conway.LedgersFailure
    (ShelleyLedgersPredFailure ConwayEra
 -> PredicateFailure (EraRule "BBODY" era))
-> (ShelleyPoolPredFailure ConwayEra
    -> ShelleyLedgersPredFailure ConwayEra)
-> ShelleyPoolPredFailure ConwayEra
-> PredicateFailure (EraRule "BBODY" era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "LEDGER" ConwayEra)
-> ShelleyLedgersPredFailure ConwayEra
ConwayLedgerPredFailure ConwayEra
-> ShelleyLedgersPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
    (ConwayLedgerPredFailure ConwayEra
 -> ShelleyLedgersPredFailure ConwayEra)
-> (ShelleyPoolPredFailure ConwayEra
    -> ConwayLedgerPredFailure ConwayEra)
-> ShelleyPoolPredFailure ConwayEra
-> ShelleyLedgersPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "CERTS" ConwayEra)
-> ConwayLedgerPredFailure ConwayEra
ConwayCertsPredFailure ConwayEra
-> ConwayLedgerPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure
    (ConwayCertsPredFailure ConwayEra
 -> ConwayLedgerPredFailure ConwayEra)
-> (ShelleyPoolPredFailure ConwayEra
    -> ConwayCertsPredFailure ConwayEra)
-> ShelleyPoolPredFailure ConwayEra
-> ConwayLedgerPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "CERT" ConwayEra)
-> ConwayCertsPredFailure ConwayEra
ConwayCertPredFailure ConwayEra -> ConwayCertsPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure
    (ConwayCertPredFailure ConwayEra
 -> ConwayCertsPredFailure ConwayEra)
-> (ShelleyPoolPredFailure ConwayEra
    -> ConwayCertPredFailure ConwayEra)
-> ShelleyPoolPredFailure ConwayEra
-> ConwayCertsPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "POOL" ConwayEra)
-> ConwayCertPredFailure ConwayEra
ShelleyPoolPredFailure ConwayEra -> ConwayCertPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "POOL" era) -> ConwayCertPredFailure era
Conway.PoolFailure
    (ShelleyPoolPredFailure ConwayEra
 -> PredicateFailure (EraRule "BBODY" era))
-> ShelleyPoolPredFailure ConwayEra
-> PredicateFailure (EraRule "BBODY" era)
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> Int -> ShelleyPoolPredFailure ConwayEra
forall era. KeyHash 'StakePool -> Int -> ShelleyPoolPredFailure era
PoolMedataHashTooBig (KeyHash 'Payment -> KeyHash 'StakePool
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash 'Payment -> KeyHash 'StakePool)
-> (KeyPair 'Payment -> KeyHash 'Payment)
-> KeyPair 'Payment
-> KeyHash 'StakePool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> KeyHash 'Payment)
-> (KeyPair 'Payment -> VKey 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey (KeyPair 'Payment -> KeyHash 'StakePool)
-> KeyPair 'Payment -> KeyHash 'StakePool
forall a b. (a -> b) -> a -> b
$ Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
proof) (Int
hashsize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
makeTooBig Proof era
proof = TestName -> PredicateFailure (EraRule "BBODY" era)
forall a. HasCallStack => TestName -> a
error (TestName
"makeTooBig does not work in era " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Proof era -> TestName
forall a. Show a => a -> TestName
show Proof era
proof)

coldKeys :: KeyPair 'BlockIssuer
coldKeys :: KeyPair 'BlockIssuer
coldKeys = VKey 'BlockIssuer -> SignKeyDSIGN DSIGN -> KeyPair 'BlockIssuer
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey 'BlockIssuer
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
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 era
makeNaiveBlock :: forall era. EraSegWits era => [Tx era] -> Block BHeaderView era
makeNaiveBlock [Tx era]
txs = BHeaderView -> TxSeq era -> Block BHeaderView era
forall h era. h -> TxSeq era -> Block h era
Block BHeaderView
bhView TxSeq era
txSeq
  where
    bhView :: BHeaderView
bhView =
      BHeaderView
        { bhviewID :: KeyHash 'BlockIssuer
bhviewID = VKey 'BlockIssuer -> KeyHash 'BlockIssuer
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (KeyPair 'BlockIssuer -> VKey 'BlockIssuer
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'BlockIssuer
coldKeys)
        , bhviewBSize :: Word32
bhviewBSize = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ProtVer -> TxSeq era -> Int
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 HASH EraIndependentBlockBody
bhviewBHash = TxSeq era -> Hash HASH EraIndependentBlockBody
forall era.
EraSegWits era =>
TxSeq era -> Hash HASH EraIndependentBlockBody
hashTxSeq TxSeq era
txSeq
        , bhviewSlot :: SlotNo
bhviewSlot = Word64 -> SlotNo
SlotNo Word64
0
        }
    txSeq :: TxSeq era
txSeq = StrictSeq (Tx era) -> TxSeq era
forall era. EraSegWits era => StrictSeq (Tx era) -> TxSeq era
toTxSeq (StrictSeq (Tx era) -> TxSeq era)
-> StrictSeq (Tx era) -> TxSeq era
forall a b. (a -> b) -> a -> b
$ [Tx era] -> StrictSeq (Tx era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Tx era]
txs

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

scriptStakeCredSuceed :: forall era. Scriptic era => Proof era -> StakeCredential
scriptStakeCredSuceed :: forall era. Scriptic era => Proof era -> StakeCredential
scriptStakeCredSuceed Proof era
pf = ScriptHash -> StakeCredential
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Natural -> Proof era -> ScriptHash
forall era. Scriptic era => Natural -> Proof era -> ScriptHash
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 :: Int
hashsize :: Int
hashsize = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Proxy HASH -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @HASH)

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

defaultPPs :: [PParamsField era]
defaultPPs :: forall era. [PParamsField era]
defaultPPs =
  [ CostModels -> PParamsField era
forall era. CostModels -> PParamsField era
Costmdls (CostModels -> PParamsField era) -> CostModels -> PParamsField era
forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
[Language] -> CostModels
zeroTestingCostModels [Item [Language]
Language
PlutusV1]
  , Natural -> PParamsField era
forall era. Natural -> PParamsField era
MaxValSize Natural
1000000000
  , ExUnits -> PParamsField era
forall era. ExUnits -> PParamsField era
MaxTxExUnits (ExUnits -> PParamsField era) -> ExUnits -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , ExUnits -> PParamsField era
forall era. ExUnits -> PParamsField era
MaxBlockExUnits (ExUnits -> PParamsField era) -> ExUnits -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , ProtVer -> PParamsField era
forall era. ProtVer -> PParamsField era
ProtocolVersion (ProtVer -> PParamsField era) -> ProtVer -> PParamsField era
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
  , Natural -> PParamsField era
forall era. Natural -> PParamsField era
CollateralPercentage Natural
100
  , Coin -> PParamsField era
forall era. Coin -> PParamsField era
KeyDeposit (Integer -> Coin
Coin Integer
2)
  , Coin -> PParamsField era
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 = Proof era -> [PParamsField era] -> PParams era
forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof era
pf [PParamsField era]
forall era. [PParamsField era]
defaultPPs