{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Test.Cardano.Ledger.Mary.Examples.MultiAssets
-- Description : Multi-Assets Examples
--
-- Examples demonstrating the use of multi-assets.
module Test.Cardano.Ledger.Mary.Examples.MultiAssets (
  multiAssetsExample,
) where

import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure (..))
import Cardano.Ledger.Allegra.Scripts (
  Timelock (..),
  pattern RequireTimeExpire,
  pattern RequireTimeStart,
 )
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Mary.Core
import Cardano.Ledger.Mary.State
import Cardano.Ledger.Mary.Value (
  AssetName (..),
  MaryValue (..),
  MultiAsset (..),
  PolicyID (..),
 )
import Cardano.Ledger.Shelley.API (LedgerEnv (..), ShelleyLEDGER)
import Cardano.Ledger.Shelley.Rules (ShelleyLedgerPredFailure (..), ShelleyUtxowPredFailure (..))
import Cardano.Ledger.Shelley.Scripts (
  pattern RequireAllOf,
  pattern RequireSignature,
 )
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (addrWits)
import Cardano.Ledger.Slot (SlotNo (..))
import Cardano.Ledger.TxIn (TxId, TxIn (..), mkTxInPartial)
import Cardano.Ledger.Val ((<+>), (<->))
import qualified Cardano.Ledger.Val as Val
import Control.Exception (ErrorCall (ErrorCall), evaluate, try)
import Control.State.Transition.Extended (PredicateFailure)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import GHC.Exts (fromString)
import Lens.Micro
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkWitnessesVKey)
import Test.Cardano.Ledger.Mary.Examples (testMaryNoDelegLEDGER)
import qualified Test.Cardano.Ledger.Mary.Examples.Cast as Cast
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, assertFailure, testCase)

------------------------------
-- Set Up the Initial State --
------------------------------

aliceInitCoin :: Coin
aliceInitCoin :: Coin
aliceInitCoin = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
10_000_000_000_000_000

bobInitCoin :: Coin
bobInitCoin :: Coin
bobInitCoin = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
1_000_000_000_000_000

unboundedInterval :: ValidityInterval
unboundedInterval :: ValidityInterval
unboundedInterval = StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing

bootstrapTxId :: TxId
bootstrapTxId :: TxId
bootstrapTxId = TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txb
  where
    txb :: TxBody MaryEra
    txb :: TxBody MaryEra
txb = TxBody MaryEra
forall era. EraTxBody era => TxBody era
mkBasicTxBody

initUTxO :: UTxO MaryEra
initUTxO :: UTxO MaryEra
initUTxO =
  Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut MaryEra) -> UTxO MaryEra)
-> Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall a b. (a -> b) -> a -> b
$
    [(TxIn, ShelleyTxOut MaryEra)] -> Map TxIn (ShelleyTxOut MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
0, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
aliceInitCoin))
      , (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
1, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr (Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
bobInitCoin))
      ]

pp :: PParams MaryEra
pp :: PParams MaryEra
pp =
  PParams MaryEra
forall era. EraPParams era => PParams era
emptyPParams
    PParams MaryEra
-> (PParams MaryEra -> PParams MaryEra) -> PParams MaryEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams MaryEra -> Identity (PParams MaryEra)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams MaryEra) Coin
ppMinFeeAL ((Coin -> Identity Coin)
 -> PParams MaryEra -> Identity (PParams MaryEra))
-> Coin -> PParams MaryEra -> PParams MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
0
    PParams MaryEra
-> (PParams MaryEra -> PParams MaryEra) -> PParams MaryEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams MaryEra -> Identity (PParams MaryEra)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams MaryEra) Coin
ppMinFeeBL ((Coin -> Identity Coin)
 -> PParams MaryEra -> Identity (PParams MaryEra))
-> Coin -> PParams MaryEra -> PParams MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1
    PParams MaryEra
-> (PParams MaryEra -> PParams MaryEra) -> PParams MaryEra
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams MaryEra -> Identity (PParams MaryEra)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams MaryEra) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams MaryEra -> Identity (PParams MaryEra))
-> Word32 -> PParams MaryEra -> PParams MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
16384
    PParams MaryEra
-> (PParams MaryEra -> PParams MaryEra) -> PParams MaryEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams MaryEra -> Identity (PParams MaryEra)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams MaryEra) Coin
ppMinUTxOValueL ((Coin -> Identity Coin)
 -> PParams MaryEra -> Identity (PParams MaryEra))
-> Coin -> PParams MaryEra -> PParams MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100

ledgerEnv :: SlotNo -> LedgerEnv MaryEra
ledgerEnv :: SlotNo -> LedgerEnv MaryEra
ledgerEnv SlotNo
s = SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams MaryEra
-> ChainAccountState
-> LedgerEnv MaryEra
forall era.
SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams era
-> ChainAccountState
-> LedgerEnv era
LedgerEnv SlotNo
s Maybe EpochNo
forall a. Maybe a
Nothing TxIx
forall a. Bounded a => a
minBound PParams MaryEra
pp (Coin -> Coin -> ChainAccountState
ChainAccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0))

feeEx :: Coin
feeEx :: Coin
feeEx = Integer -> Coin
Coin Integer
3

-- These examples do not use several of the transaction components,
-- so we can simplify building them.
makeMaryTxBody ::
  [TxIn] ->
  [ShelleyTxOut MaryEra] ->
  ValidityInterval ->
  MultiAsset ->
  TxBody MaryEra
makeMaryTxBody :: [TxIn]
-> [ShelleyTxOut MaryEra]
-> ValidityInterval
-> MultiAsset
-> TxBody MaryEra
makeMaryTxBody [TxIn]
ins [ShelleyTxOut MaryEra]
outs ValidityInterval
interval MultiAsset
minted =
  TxBody MaryEra
forall era. EraTxBody era => TxBody era
mkBasicTxBody
    TxBody MaryEra
-> (TxBody MaryEra -> TxBody MaryEra) -> TxBody MaryEra
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody MaryEra -> Identity (TxBody MaryEra)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody MaryEra) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody MaryEra -> Identity (TxBody MaryEra))
-> Set TxIn -> TxBody MaryEra -> TxBody MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxIn]
ins
    TxBody MaryEra
-> (TxBody MaryEra -> TxBody MaryEra) -> TxBody MaryEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut MaryEra) -> Identity (StrictSeq (TxOut MaryEra)))
-> TxBody MaryEra -> Identity (TxBody MaryEra)
(StrictSeq (ShelleyTxOut MaryEra)
 -> Identity (StrictSeq (ShelleyTxOut MaryEra)))
-> TxBody MaryEra -> Identity (TxBody MaryEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody MaryEra) (StrictSeq (TxOut MaryEra))
outputsTxBodyL ((StrictSeq (ShelleyTxOut MaryEra)
  -> Identity (StrictSeq (ShelleyTxOut MaryEra)))
 -> TxBody MaryEra -> Identity (TxBody MaryEra))
-> StrictSeq (ShelleyTxOut MaryEra)
-> TxBody MaryEra
-> TxBody MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ShelleyTxOut MaryEra] -> StrictSeq (ShelleyTxOut MaryEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [ShelleyTxOut MaryEra]
outs
    TxBody MaryEra
-> (TxBody MaryEra -> TxBody MaryEra) -> TxBody MaryEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody MaryEra -> Identity (TxBody MaryEra)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody MaryEra) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> TxBody MaryEra -> Identity (TxBody MaryEra))
-> Coin -> TxBody MaryEra -> TxBody MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
feeEx
    TxBody MaryEra
-> (TxBody MaryEra -> TxBody MaryEra) -> TxBody MaryEra
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> TxBody MaryEra -> Identity (TxBody MaryEra)
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody MaryEra) ValidityInterval
vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> TxBody MaryEra -> Identity (TxBody MaryEra))
-> ValidityInterval -> TxBody MaryEra -> TxBody MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
interval
    TxBody MaryEra
-> (TxBody MaryEra -> TxBody MaryEra) -> TxBody MaryEra
forall a b. a -> (a -> b) -> b
& (MultiAsset -> Identity MultiAsset)
-> TxBody MaryEra -> Identity (TxBody MaryEra)
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody MaryEra) MultiAsset
mintTxBodyL ((MultiAsset -> Identity MultiAsset)
 -> TxBody MaryEra -> Identity (TxBody MaryEra))
-> MultiAsset -> TxBody MaryEra -> TxBody MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
minted

policyFailure ::
  PolicyID -> Either (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra))) (UTxO MaryEra)
policyFailure :: PolicyID
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
policyFailure PolicyID
p =
  NonEmpty (ShelleyLedgerPredFailure MaryEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
NonEmpty (ShelleyLedgerPredFailure MaryEra)
-> Either
     (NonEmpty (ShelleyLedgerPredFailure MaryEra)) (UTxO MaryEra)
forall a b. a -> Either a b
Left (NonEmpty (ShelleyLedgerPredFailure MaryEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
      (UTxO MaryEra))
-> (Set ScriptHash -> NonEmpty (ShelleyLedgerPredFailure MaryEra))
-> Set ScriptHash
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure MaryEra
-> NonEmpty (ShelleyLedgerPredFailure MaryEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure MaryEra
 -> NonEmpty (ShelleyLedgerPredFailure MaryEra))
-> (Set ScriptHash -> ShelleyLedgerPredFailure MaryEra)
-> Set ScriptHash
-> NonEmpty (ShelleyLedgerPredFailure MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "UTXOW" MaryEra)
-> ShelleyLedgerPredFailure MaryEra
ShelleyUtxowPredFailure MaryEra -> ShelleyLedgerPredFailure MaryEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (ShelleyUtxowPredFailure MaryEra
 -> ShelleyLedgerPredFailure MaryEra)
-> (Set ScriptHash -> ShelleyUtxowPredFailure MaryEra)
-> Set ScriptHash
-> ShelleyLedgerPredFailure MaryEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ScriptHash -> ShelleyUtxowPredFailure MaryEra
forall era. Set ScriptHash -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW (Set ScriptHash
 -> Either
      (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
      (UTxO MaryEra))
-> Set ScriptHash
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
forall a b. (a -> b) -> a -> b
$ ScriptHash -> Set ScriptHash
forall a. a -> Set a
Set.singleton (PolicyID -> ScriptHash
policyID PolicyID
p)

outTooBigFailure ::
  ShelleyTxOut MaryEra -> Either (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra))) (UTxO MaryEra)
outTooBigFailure :: ShelleyTxOut MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
outTooBigFailure ShelleyTxOut MaryEra
out =
  NonEmpty (ShelleyLedgerPredFailure MaryEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
NonEmpty (ShelleyLedgerPredFailure MaryEra)
-> Either
     (NonEmpty (ShelleyLedgerPredFailure MaryEra)) (UTxO MaryEra)
forall a b. a -> Either a b
Left (NonEmpty (ShelleyLedgerPredFailure MaryEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
      (UTxO MaryEra))
-> (AllegraUtxoPredFailure MaryEra
    -> NonEmpty (ShelleyLedgerPredFailure MaryEra))
-> AllegraUtxoPredFailure MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure MaryEra
-> NonEmpty (ShelleyLedgerPredFailure MaryEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure MaryEra
 -> NonEmpty (ShelleyLedgerPredFailure MaryEra))
-> (AllegraUtxoPredFailure MaryEra
    -> ShelleyLedgerPredFailure MaryEra)
-> AllegraUtxoPredFailure MaryEra
-> NonEmpty (ShelleyLedgerPredFailure MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "UTXOW" MaryEra)
-> ShelleyLedgerPredFailure MaryEra
ShelleyUtxowPredFailure MaryEra -> ShelleyLedgerPredFailure MaryEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (ShelleyUtxowPredFailure MaryEra
 -> ShelleyLedgerPredFailure MaryEra)
-> (AllegraUtxoPredFailure MaryEra
    -> ShelleyUtxowPredFailure MaryEra)
-> AllegraUtxoPredFailure MaryEra
-> ShelleyLedgerPredFailure MaryEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "UTXO" MaryEra)
-> ShelleyUtxowPredFailure MaryEra
AllegraUtxoPredFailure MaryEra -> ShelleyUtxowPredFailure MaryEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
UtxoFailure (AllegraUtxoPredFailure MaryEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
      (UTxO MaryEra))
-> AllegraUtxoPredFailure MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
forall a b. (a -> b) -> a -> b
$ [TxOut MaryEra] -> AllegraUtxoPredFailure MaryEra
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputTooBigUTxO [TxOut MaryEra
ShelleyTxOut MaryEra
out]

----------------------------------------------------
-- Introduce a new Token Bundle, Purple Tokens
--
-- Variables ending with SimpleExN (for a numeral N)
-- refer to this example.
----------------------------------------------------

-- This is the most lax policy possible, requiring no authorization at all.
purplePolicy :: Timelock MaryEra
purplePolicy :: Timelock MaryEra
purplePolicy = StrictSeq (NativeScript MaryEra) -> NativeScript MaryEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf ([Timelock MaryEra] -> StrictSeq (Timelock MaryEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [])

purplePolicyId :: PolicyID
purplePolicyId :: PolicyID
purplePolicyId = ScriptHash -> PolicyID
PolicyID (ScriptHash -> PolicyID) -> ScriptHash -> PolicyID
forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @MaryEra Timelock MaryEra
Script MaryEra
purplePolicy

plum :: AssetName
plum :: AssetName
plum = ShortByteString -> AssetName
AssetName ShortByteString
"plum"

amethyst :: AssetName
amethyst :: AssetName
amethyst = ShortByteString -> AssetName
AssetName ShortByteString
"amethyst"

------------------------
-- Mint Purple Tokens --
------------------------

mintSimpleEx1 :: MultiAsset
mintSimpleEx1 :: MultiAsset
mintSimpleEx1 =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
    PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
purplePolicyId ([(AssetName, Integer)] -> Map AssetName Integer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AssetName
plum, Integer
13), (AssetName
amethyst, Integer
2)])

aliceCoinSimpleEx1 :: Coin
aliceCoinSimpleEx1 :: Coin
aliceCoinSimpleEx1 = Coin
aliceInitCoin Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeEx

tokensSimpleEx1 :: MaryValue
tokensSimpleEx1 :: MaryValue
tokensSimpleEx1 = Coin -> MultiAsset -> MaryValue
MaryValue Coin
forall a. Monoid a => a
mempty MultiAsset
mintSimpleEx1 MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
<+> Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinSimpleEx1

-- Mint a purple token bundle, consisting of thirteen plums and two amethysts.
-- Give the bundle to Alice.
txbodySimpleEx1 :: TxBody MaryEra
txbodySimpleEx1 :: TxBody MaryEra
txbodySimpleEx1 =
  [TxIn]
-> [ShelleyTxOut MaryEra]
-> ValidityInterval
-> MultiAsset
-> TxBody MaryEra
makeMaryTxBody
    [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
0]
    [Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr Value MaryEra
MaryValue
tokensSimpleEx1]
    ValidityInterval
unboundedInterval
    MultiAsset
mintSimpleEx1

txSimpleEx1 :: ShelleyTx MaryEra
txSimpleEx1 :: ShelleyTx MaryEra
txSimpleEx1 =
  TxBody MaryEra -> Tx MaryEra
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody MaryEra
txbodySimpleEx1
    ShelleyTx MaryEra
-> (ShelleyTx MaryEra -> ShelleyTx MaryEra) -> ShelleyTx MaryEra
forall a b. a -> (a -> b) -> b
& (TxWits MaryEra -> Identity (TxWits MaryEra))
-> Tx MaryEra -> Identity (Tx MaryEra)
(TxWits MaryEra -> Identity (TxWits MaryEra))
-> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx MaryEra) (TxWits MaryEra)
witsTxL ((TxWits MaryEra -> Identity (TxWits MaryEra))
 -> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra))
-> TxWits MaryEra -> ShelleyTx MaryEra -> ShelleyTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxWits MaryEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits MaryEra) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Set (WitVKey 'Witness) -> TxWits MaryEra -> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey 'Witness)
atw TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Timelock MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
(Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Script MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits MaryEra) (Map ScriptHash (Script MaryEra))
scriptTxWitsL ((Map ScriptHash (Script MaryEra)
  -> Identity (Map ScriptHash (Timelock MaryEra)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Map ScriptHash (Timelock MaryEra)
-> TxWits MaryEra
-> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map ScriptHash (Timelock MaryEra)
stw)
  where
    atw :: Set (WitVKey 'Witness)
atw = SafeHash EraIndependentTxBody
-> [KeyPair 'Witness] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (TxBody MaryEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody MaryEra
txbodySimpleEx1) [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    stw :: Map ScriptHash (Timelock MaryEra)
stw = [(ScriptHash, Timelock MaryEra)]
-> Map ScriptHash (Timelock MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PolicyID -> ScriptHash
policyID PolicyID
purplePolicyId, Timelock MaryEra
purplePolicy)]

expectedUTxOSimpleEx1 :: UTxO MaryEra
expectedUTxOSimpleEx1 :: UTxO MaryEra
expectedUTxOSimpleEx1 =
  Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut MaryEra) -> UTxO MaryEra)
-> Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall a b. (a -> b) -> a -> b
$
    [(TxIn, ShelleyTxOut MaryEra)] -> Map TxIn (ShelleyTxOut MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodySimpleEx1) Integer
0, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr Value MaryEra
MaryValue
tokensSimpleEx1)
      , (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
1, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr (Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
bobInitCoin))
      ]

----------------------------
-- Transfer Purple Tokens --
----------------------------

minUtxoSimpleEx2 :: Coin
minUtxoSimpleEx2 :: Coin
minUtxoSimpleEx2 = Integer -> Coin
Coin Integer
117

aliceCoinsSimpleEx2 :: Coin
aliceCoinsSimpleEx2 :: Coin
aliceCoinsSimpleEx2 = Coin
aliceCoinSimpleEx1 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> (Coin
feeEx Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
minUtxoSimpleEx2)

aliceTokensSimpleEx2 :: MaryValue
aliceTokensSimpleEx2 :: MaryValue
aliceTokensSimpleEx2 =
  Coin -> MultiAsset -> MaryValue
MaryValue Coin
aliceCoinsSimpleEx2 (MultiAsset -> MaryValue) -> MultiAsset -> MaryValue
forall a b. (a -> b) -> a -> b
$
    Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
      PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
purplePolicyId ([(AssetName, Integer)] -> Map AssetName Integer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AssetName
plum, Integer
8), (AssetName
amethyst, Integer
2)])

bobTokensSimpleEx2 :: MaryValue
bobTokensSimpleEx2 :: MaryValue
bobTokensSimpleEx2 =
  Coin -> MultiAsset -> MaryValue
MaryValue Coin
minUtxoSimpleEx2 (MultiAsset -> MaryValue) -> MultiAsset -> MaryValue
forall a b. (a -> b) -> a -> b
$
    Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
      PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
purplePolicyId (AssetName -> Integer -> Map AssetName Integer
forall k a. k -> a -> Map k a
Map.singleton AssetName
plum Integer
5)

-- Alice gives five plums to Bob.
txbodySimpleEx2 :: TxBody MaryEra
txbodySimpleEx2 :: TxBody MaryEra
txbodySimpleEx2 =
  [TxIn]
-> [ShelleyTxOut MaryEra]
-> ValidityInterval
-> MultiAsset
-> TxBody MaryEra
makeMaryTxBody
    [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodySimpleEx1) Integer
0]
    [ Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr Value MaryEra
MaryValue
aliceTokensSimpleEx2
    , Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr Value MaryEra
MaryValue
bobTokensSimpleEx2
    ]
    ValidityInterval
unboundedInterval
    MultiAsset
forall a. Monoid a => a
mempty

txSimpleEx2 :: ShelleyTx MaryEra
txSimpleEx2 :: ShelleyTx MaryEra
txSimpleEx2 =
  TxBody MaryEra -> Tx MaryEra
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody MaryEra
txbodySimpleEx2
    ShelleyTx MaryEra
-> (ShelleyTx MaryEra -> ShelleyTx MaryEra) -> ShelleyTx MaryEra
forall a b. a -> (a -> b) -> b
& (TxWits MaryEra -> Identity (TxWits MaryEra))
-> Tx MaryEra -> Identity (Tx MaryEra)
(TxWits MaryEra -> Identity (TxWits MaryEra))
-> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx MaryEra) (TxWits MaryEra)
witsTxL ((TxWits MaryEra -> Identity (TxWits MaryEra))
 -> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra))
-> TxWits MaryEra -> ShelleyTx MaryEra -> ShelleyTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxWits MaryEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits MaryEra) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Set (WitVKey 'Witness) -> TxWits MaryEra -> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey 'Witness)
atw)
  where
    atw :: Set (WitVKey 'Witness)
atw = SafeHash EraIndependentTxBody
-> [KeyPair 'Witness] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (TxBody MaryEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody MaryEra
txbodySimpleEx2) [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]

expectedUTxOSimpleEx2 :: UTxO MaryEra
expectedUTxOSimpleEx2 :: UTxO MaryEra
expectedUTxOSimpleEx2 =
  Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut MaryEra) -> UTxO MaryEra)
-> Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall a b. (a -> b) -> a -> b
$
    [(TxIn, ShelleyTxOut MaryEra)] -> Map TxIn (ShelleyTxOut MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodySimpleEx2) Integer
0, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr Value MaryEra
MaryValue
aliceTokensSimpleEx2)
      , (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodySimpleEx2) Integer
1, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr Value MaryEra
MaryValue
bobTokensSimpleEx2)
      , (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
1, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr (Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
bobInitCoin))
      ]

------------------------------------------------------------
-- Introduce a new Token Bundle, Tokens With a Time Range
--
-- Variables ending with TimeExN (for a numeral N)
-- refer to this example.
------------------------------------------------------------

beforeStart :: SlotNo
beforeStart :: SlotNo
beforeStart = Word64 -> SlotNo
SlotNo Word64
12

startInterval :: SlotNo
startInterval :: SlotNo
startInterval = Word64 -> SlotNo
SlotNo Word64
13

stopInterval :: SlotNo
stopInterval :: SlotNo
stopInterval = Word64 -> SlotNo
SlotNo Word64
19

afterStop :: SlotNo
afterStop :: SlotNo
afterStop = Word64 -> SlotNo
SlotNo Word64
20

boundedTimePolicy :: Timelock MaryEra
boundedTimePolicy :: Timelock MaryEra
boundedTimePolicy =
  StrictSeq (NativeScript MaryEra) -> NativeScript MaryEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf
    ( [Timelock MaryEra] -> StrictSeq (Timelock MaryEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ SlotNo -> NativeScript MaryEra
forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart SlotNo
startInterval
        , SlotNo -> NativeScript MaryEra
forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire SlotNo
stopInterval
        ]
    )

boundedTimePolicyId :: PolicyID
boundedTimePolicyId :: PolicyID
boundedTimePolicyId = ScriptHash -> PolicyID
PolicyID (ScriptHash -> PolicyID) -> ScriptHash -> PolicyID
forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @MaryEra Timelock MaryEra
Script MaryEra
boundedTimePolicy

tokenTimeEx :: AssetName
tokenTimeEx :: AssetName
tokenTimeEx = ShortByteString -> AssetName
AssetName ShortByteString
"tokenTimeEx"

------------------------------------
-- Mint Bounded Time Range Tokens --
------------------------------------

mintTimeEx1 :: MultiAsset
mintTimeEx1 :: MultiAsset
mintTimeEx1 =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
    PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
boundedTimePolicyId (AssetName -> Integer -> Map AssetName Integer
forall k a. k -> a -> Map k a
Map.singleton AssetName
tokenTimeEx Integer
1)

aliceCoinsTimeEx1 :: Coin
aliceCoinsTimeEx1 :: Coin
aliceCoinsTimeEx1 = Coin
aliceInitCoin Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeEx

tokensTimeEx1 :: MaryValue
tokensTimeEx1 :: MaryValue
tokensTimeEx1 = Coin -> MultiAsset -> MaryValue
MaryValue Coin
forall a. Monoid a => a
mempty MultiAsset
mintTimeEx1 MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
<+> Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinsTimeEx1

-- Mint tokens
txbodyTimeEx1 :: StrictMaybe SlotNo -> StrictMaybe SlotNo -> TxBody MaryEra
txbodyTimeEx1 :: StrictMaybe SlotNo -> StrictMaybe SlotNo -> TxBody MaryEra
txbodyTimeEx1 StrictMaybe SlotNo
s StrictMaybe SlotNo
e =
  [TxIn]
-> [ShelleyTxOut MaryEra]
-> ValidityInterval
-> MultiAsset
-> TxBody MaryEra
makeMaryTxBody
    [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
0]
    [Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr Value MaryEra
MaryValue
tokensTimeEx1]
    (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
s StrictMaybe SlotNo
e)
    MultiAsset
mintTimeEx1

txbodyTimeEx1Valid :: TxBody MaryEra
txbodyTimeEx1Valid :: TxBody MaryEra
txbodyTimeEx1Valid = StrictMaybe SlotNo -> StrictMaybe SlotNo -> TxBody MaryEra
txbodyTimeEx1 (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
startInterval) (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
stopInterval)

txTimeEx1 :: TxBody MaryEra -> ShelleyTx MaryEra
txTimeEx1 :: TxBody MaryEra -> ShelleyTx MaryEra
txTimeEx1 TxBody MaryEra
txbody =
  TxBody MaryEra -> Tx MaryEra
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody MaryEra
txbody
    ShelleyTx MaryEra
-> (ShelleyTx MaryEra -> ShelleyTx MaryEra) -> ShelleyTx MaryEra
forall a b. a -> (a -> b) -> b
& (TxWits MaryEra -> Identity (TxWits MaryEra))
-> Tx MaryEra -> Identity (Tx MaryEra)
(TxWits MaryEra -> Identity (TxWits MaryEra))
-> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx MaryEra) (TxWits MaryEra)
witsTxL ((TxWits MaryEra -> Identity (TxWits MaryEra))
 -> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra))
-> TxWits MaryEra -> ShelleyTx MaryEra -> ShelleyTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxWits MaryEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits MaryEra) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Set (WitVKey 'Witness) -> TxWits MaryEra -> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey 'Witness)
atw TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Timelock MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
(Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Script MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits MaryEra) (Map ScriptHash (Script MaryEra))
scriptTxWitsL ((Map ScriptHash (Script MaryEra)
  -> Identity (Map ScriptHash (Timelock MaryEra)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Map ScriptHash (Timelock MaryEra)
-> TxWits MaryEra
-> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map ScriptHash (Timelock MaryEra)
stw)
  where
    atw :: Set (WitVKey 'Witness)
atw = SafeHash EraIndependentTxBody
-> [KeyPair 'Witness] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (TxBody MaryEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody MaryEra
txbody) [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    stw :: Map ScriptHash (Timelock MaryEra)
stw = [(ScriptHash, Timelock MaryEra)]
-> Map ScriptHash (Timelock MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PolicyID -> ScriptHash
policyID PolicyID
boundedTimePolicyId, Timelock MaryEra
boundedTimePolicy)]

txTimeEx1Valid :: ShelleyTx MaryEra
txTimeEx1Valid :: ShelleyTx MaryEra
txTimeEx1Valid = TxBody MaryEra -> ShelleyTx MaryEra
txTimeEx1 TxBody MaryEra
txbodyTimeEx1Valid

txTimeEx1InvalidLHSfixed :: ShelleyTx MaryEra
txTimeEx1InvalidLHSfixed :: ShelleyTx MaryEra
txTimeEx1InvalidLHSfixed = TxBody MaryEra -> ShelleyTx MaryEra
txTimeEx1 (TxBody MaryEra -> ShelleyTx MaryEra)
-> TxBody MaryEra -> ShelleyTx MaryEra
forall a b. (a -> b) -> a -> b
$ StrictMaybe SlotNo -> StrictMaybe SlotNo -> TxBody MaryEra
txbodyTimeEx1 (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
beforeStart) (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
stopInterval)

txTimeEx1InvalidLHSopen :: ShelleyTx MaryEra
txTimeEx1InvalidLHSopen :: ShelleyTx MaryEra
txTimeEx1InvalidLHSopen = TxBody MaryEra -> ShelleyTx MaryEra
txTimeEx1 (TxBody MaryEra -> ShelleyTx MaryEra)
-> TxBody MaryEra -> ShelleyTx MaryEra
forall a b. (a -> b) -> a -> b
$ StrictMaybe SlotNo -> StrictMaybe SlotNo -> TxBody MaryEra
txbodyTimeEx1 StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
stopInterval)

txTimeEx1InvalidRHSfixed :: ShelleyTx MaryEra
txTimeEx1InvalidRHSfixed :: ShelleyTx MaryEra
txTimeEx1InvalidRHSfixed = TxBody MaryEra -> ShelleyTx MaryEra
txTimeEx1 (TxBody MaryEra -> ShelleyTx MaryEra)
-> TxBody MaryEra -> ShelleyTx MaryEra
forall a b. (a -> b) -> a -> b
$ StrictMaybe SlotNo -> StrictMaybe SlotNo -> TxBody MaryEra
txbodyTimeEx1 (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
startInterval) (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
afterStop)

txTimeEx1InvalidRHSopen :: ShelleyTx MaryEra
txTimeEx1InvalidRHSopen :: ShelleyTx MaryEra
txTimeEx1InvalidRHSopen = TxBody MaryEra -> ShelleyTx MaryEra
txTimeEx1 (TxBody MaryEra -> ShelleyTx MaryEra)
-> TxBody MaryEra -> ShelleyTx MaryEra
forall a b. (a -> b) -> a -> b
$ StrictMaybe SlotNo -> StrictMaybe SlotNo -> TxBody MaryEra
txbodyTimeEx1 (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
startInterval) StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing

expectedUTxOTimeEx1 :: UTxO MaryEra
expectedUTxOTimeEx1 :: UTxO MaryEra
expectedUTxOTimeEx1 =
  Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut MaryEra) -> UTxO MaryEra)
-> Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall a b. (a -> b) -> a -> b
$
    [(TxIn, ShelleyTxOut MaryEra)] -> Map TxIn (ShelleyTxOut MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodyTimeEx1Valid) Integer
0, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr Value MaryEra
MaryValue
tokensTimeEx1)
      , (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
1, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr (Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
bobInitCoin))
      ]

----------------------------------------
-- Transfer Bounded Time Range Tokens --
----------------------------------------

mintTimeEx2 :: Coin
mintTimeEx2 :: Coin
mintTimeEx2 = Integer -> Coin
Coin Integer
120

bobTokensTimeEx2 :: MaryValue
bobTokensTimeEx2 :: MaryValue
bobTokensTimeEx2 =
  Coin -> MultiAsset -> MaryValue
MaryValue Coin
mintTimeEx2 (MultiAsset -> MaryValue) -> MultiAsset -> MaryValue
forall a b. (a -> b) -> a -> b
$
    Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
      PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
boundedTimePolicyId (AssetName -> Integer -> Map AssetName Integer
forall k a. k -> a -> Map k a
Map.singleton AssetName
tokenTimeEx Integer
1)

aliceCoinsTimeEx2 :: Coin
aliceCoinsTimeEx2 :: Coin
aliceCoinsTimeEx2 = Coin
aliceCoinSimpleEx1 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> (Coin
feeEx Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
mintTimeEx2)

-- Alice gives one token to Bob
txbodyTimeEx2 :: TxBody MaryEra
txbodyTimeEx2 :: TxBody MaryEra
txbodyTimeEx2 =
  [TxIn]
-> [ShelleyTxOut MaryEra]
-> ValidityInterval
-> MultiAsset
-> TxBody MaryEra
makeMaryTxBody
    [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodyTimeEx1Valid) Integer
0]
    [ Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinsTimeEx2)
    , Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr Value MaryEra
MaryValue
bobTokensTimeEx2
    ]
    ValidityInterval
unboundedInterval
    MultiAsset
forall a. Monoid a => a
mempty

txTimeEx2 :: ShelleyTx MaryEra
txTimeEx2 :: ShelleyTx MaryEra
txTimeEx2 =
  TxBody MaryEra
-> TxWits MaryEra
-> StrictMaybe (TxAuxData MaryEra)
-> ShelleyTx MaryEra
forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody MaryEra
txbodyTimeEx2
    ShelleyTxWits MaryEra
forall a. Monoid a => a
mempty
      { addrWits =
          mkWitnessesVKey (hashAnnotated txbodyTimeEx2) [asWitness Cast.alicePay]
      }
    StrictMaybe (AllegraTxAuxData MaryEra)
StrictMaybe (TxAuxData MaryEra)
forall a. StrictMaybe a
SNothing

expectedUTxOTimeEx2 :: UTxO MaryEra
expectedUTxOTimeEx2 :: UTxO MaryEra
expectedUTxOTimeEx2 =
  Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut MaryEra) -> UTxO MaryEra)
-> Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall a b. (a -> b) -> a -> b
$
    [(TxIn, ShelleyTxOut MaryEra)] -> Map TxIn (ShelleyTxOut MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [
        ( HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodyTimeEx2) Integer
0
        , Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinsTimeEx2)
        )
      , (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodyTimeEx2) Integer
1, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr Value MaryEra
MaryValue
bobTokensTimeEx2)
      , (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
1, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr (Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
bobInitCoin))
      ]

--------------------------------------------------------------
-- Introduce a new Token Bundle, Tokens only Alice can mint
--
-- Variables ending with SingExN (for a numeral N)
-- refer to this example.
--------------------------------------------------------------

alicePolicy :: Timelock MaryEra
alicePolicy :: Timelock MaryEra
alicePolicy = KeyHash 'Witness -> Timelock MaryEra
KeyHash 'Witness -> NativeScript MaryEra
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature (KeyHash 'Witness -> Timelock MaryEra)
-> (KeyPair 'Payment -> KeyHash 'Witness)
-> KeyPair 'Payment
-> Timelock MaryEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Payment -> KeyHash 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyHash 'Payment -> KeyHash 'Witness)
-> (KeyPair 'Payment -> KeyHash 'Payment)
-> KeyPair 'Payment
-> KeyHash 'Witness
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 -> Timelock MaryEra)
-> KeyPair 'Payment -> Timelock MaryEra
forall a b. (a -> b) -> a -> b
$ KeyPair 'Payment
Cast.alicePay

alicePolicyId :: PolicyID
alicePolicyId :: PolicyID
alicePolicyId = ScriptHash -> PolicyID
PolicyID (ScriptHash -> PolicyID) -> ScriptHash -> PolicyID
forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @MaryEra Timelock MaryEra
Script MaryEra
alicePolicy

tokenSingWitEx1 :: AssetName
tokenSingWitEx1 :: AssetName
tokenSingWitEx1 = ShortByteString -> AssetName
AssetName ShortByteString
"tokenSingWitEx1"

-----------------------
-- Mint Alice Tokens --
-----------------------

mintSingWitEx1 :: MultiAsset
mintSingWitEx1 :: MultiAsset
mintSingWitEx1 =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
    PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
alicePolicyId (AssetName -> Integer -> Map AssetName Integer
forall k a. k -> a -> Map k a
Map.singleton AssetName
tokenSingWitEx1 Integer
17)

bobCoinsSingWitEx1 :: Coin
bobCoinsSingWitEx1 :: Coin
bobCoinsSingWitEx1 = Coin
bobInitCoin Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeEx

tokensSingWitEx1 :: MaryValue
tokensSingWitEx1 :: MaryValue
tokensSingWitEx1 = Coin -> MultiAsset -> MaryValue
MaryValue Coin
forall a. Monoid a => a
mempty MultiAsset
mintSingWitEx1 MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
<+> Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
bobCoinsSingWitEx1

-- Bob pays the fees, but only alice can witness the minting
txbodySingWitEx1 :: TxBody MaryEra
txbodySingWitEx1 :: TxBody MaryEra
txbodySingWitEx1 =
  [TxIn]
-> [ShelleyTxOut MaryEra]
-> ValidityInterval
-> MultiAsset
-> TxBody MaryEra
makeMaryTxBody
    [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
1]
    [Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr Value MaryEra
MaryValue
tokensSingWitEx1]
    ValidityInterval
unboundedInterval
    MultiAsset
mintSingWitEx1

txSingWitEx1Valid :: ShelleyTx MaryEra
txSingWitEx1Valid :: ShelleyTx MaryEra
txSingWitEx1Valid =
  TxBody MaryEra -> Tx MaryEra
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody MaryEra
txbodySingWitEx1
    ShelleyTx MaryEra
-> (ShelleyTx MaryEra -> ShelleyTx MaryEra) -> ShelleyTx MaryEra
forall a b. a -> (a -> b) -> b
& (TxWits MaryEra -> Identity (TxWits MaryEra))
-> Tx MaryEra -> Identity (Tx MaryEra)
(TxWits MaryEra -> Identity (TxWits MaryEra))
-> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx MaryEra) (TxWits MaryEra)
witsTxL ((TxWits MaryEra -> Identity (TxWits MaryEra))
 -> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra))
-> TxWits MaryEra -> ShelleyTx MaryEra -> ShelleyTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxWits MaryEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits MaryEra) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Set (WitVKey 'Witness) -> TxWits MaryEra -> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey 'Witness)
atw TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Timelock MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
(Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Script MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits MaryEra) (Map ScriptHash (Script MaryEra))
scriptTxWitsL ((Map ScriptHash (Script MaryEra)
  -> Identity (Map ScriptHash (Timelock MaryEra)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Map ScriptHash (Timelock MaryEra)
-> TxWits MaryEra
-> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map ScriptHash (Timelock MaryEra)
stw)
  where
    atw :: Set (WitVKey 'Witness)
atw = SafeHash EraIndependentTxBody
-> [KeyPair 'Witness] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (TxBody MaryEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody MaryEra
txbodySingWitEx1) [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay, KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    stw :: Map ScriptHash (Timelock MaryEra)
stw = [(ScriptHash, Timelock MaryEra)]
-> Map ScriptHash (Timelock MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PolicyID -> ScriptHash
policyID PolicyID
alicePolicyId, Timelock MaryEra
alicePolicy)]

expectedUTxOSingWitEx1 :: UTxO MaryEra
expectedUTxOSingWitEx1 :: UTxO MaryEra
expectedUTxOSingWitEx1 =
  Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut MaryEra) -> UTxO MaryEra)
-> Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall a b. (a -> b) -> a -> b
$
    [(TxIn, ShelleyTxOut MaryEra)] -> Map TxIn (ShelleyTxOut MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodySingWitEx1) Integer
0, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr Value MaryEra
MaryValue
tokensSingWitEx1)
      , (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
0, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
aliceInitCoin))
      ]

txSingWitEx1Invalid :: ShelleyTx MaryEra
txSingWitEx1Invalid :: ShelleyTx MaryEra
txSingWitEx1Invalid =
  TxBody MaryEra -> Tx MaryEra
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody MaryEra
txbodySingWitEx1
    ShelleyTx MaryEra
-> (ShelleyTx MaryEra -> ShelleyTx MaryEra) -> ShelleyTx MaryEra
forall a b. a -> (a -> b) -> b
& (TxWits MaryEra -> Identity (TxWits MaryEra))
-> Tx MaryEra -> Identity (Tx MaryEra)
(TxWits MaryEra -> Identity (TxWits MaryEra))
-> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx MaryEra) (TxWits MaryEra)
witsTxL ((TxWits MaryEra -> Identity (TxWits MaryEra))
 -> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra))
-> TxWits MaryEra -> ShelleyTx MaryEra -> ShelleyTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxWits MaryEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits MaryEra) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Set (WitVKey 'Witness) -> TxWits MaryEra -> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey 'Witness)
atw TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Timelock MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
(Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Script MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits MaryEra) (Map ScriptHash (Script MaryEra))
scriptTxWitsL ((Map ScriptHash (Script MaryEra)
  -> Identity (Map ScriptHash (Timelock MaryEra)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Map ScriptHash (Timelock MaryEra)
-> TxWits MaryEra
-> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map ScriptHash (Timelock MaryEra)
stw)
  where
    atw :: Set (WitVKey 'Witness)
atw = SafeHash EraIndependentTxBody
-> [KeyPair 'Witness] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (TxBody MaryEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody MaryEra
txbodySingWitEx1) [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    stw :: Map ScriptHash (Timelock MaryEra)
stw = [(ScriptHash, Timelock MaryEra)]
-> Map ScriptHash (Timelock MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PolicyID -> ScriptHash
policyID PolicyID
alicePolicyId, Timelock MaryEra
alicePolicy)]

------------------------
-- Mint Negative Values
--
-- Variables ending with NegExN (for a numeral N)
-- refer to this example. We assume that the simple
-- tokens in the SimpleEx1 example have been minted
-- and we use expectedUTxOSimpleEx1 as our starting
-- state.
------------------------

-- Mint negative valued tokens
mintNegEx1 :: MultiAsset
mintNegEx1 :: MultiAsset
mintNegEx1 =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
    PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
purplePolicyId (AssetName -> Integer -> Map AssetName Integer
forall k a. k -> a -> Map k a
Map.singleton AssetName
plum (-Integer
8))

aliceTokensNegEx1 :: MaryValue
aliceTokensNegEx1 :: MaryValue
aliceTokensNegEx1 =
  Coin -> MultiAsset -> MaryValue
MaryValue (Coin
aliceCoinsSimpleEx2 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeEx) (MultiAsset -> MaryValue) -> MultiAsset -> MaryValue
forall a b. (a -> b) -> a -> b
$
    Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
      PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
purplePolicyId (AssetName -> Integer -> Map AssetName Integer
forall k a. k -> a -> Map k a
Map.singleton AssetName
amethyst Integer
2)

txbodyNegEx1 :: TxBody MaryEra
txbodyNegEx1 :: TxBody MaryEra
txbodyNegEx1 =
  [TxIn]
-> [ShelleyTxOut MaryEra]
-> ValidityInterval
-> MultiAsset
-> TxBody MaryEra
makeMaryTxBody
    [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodySimpleEx2) Integer
0]
    [Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr Value MaryEra
MaryValue
aliceTokensNegEx1]
    ValidityInterval
unboundedInterval
    MultiAsset
mintNegEx1

txNegEx1 :: ShelleyTx MaryEra
txNegEx1 :: ShelleyTx MaryEra
txNegEx1 =
  TxBody MaryEra -> Tx MaryEra
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody MaryEra
txbodyNegEx1
    ShelleyTx MaryEra
-> (ShelleyTx MaryEra -> ShelleyTx MaryEra) -> ShelleyTx MaryEra
forall a b. a -> (a -> b) -> b
& (TxWits MaryEra -> Identity (TxWits MaryEra))
-> Tx MaryEra -> Identity (Tx MaryEra)
(TxWits MaryEra -> Identity (TxWits MaryEra))
-> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx MaryEra) (TxWits MaryEra)
witsTxL ((TxWits MaryEra -> Identity (TxWits MaryEra))
 -> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra))
-> TxWits MaryEra -> ShelleyTx MaryEra -> ShelleyTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxWits MaryEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits MaryEra) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Set (WitVKey 'Witness) -> TxWits MaryEra -> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey 'Witness)
atw TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Timelock MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
(Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Script MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits MaryEra) (Map ScriptHash (Script MaryEra))
scriptTxWitsL ((Map ScriptHash (Script MaryEra)
  -> Identity (Map ScriptHash (Timelock MaryEra)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Map ScriptHash (Timelock MaryEra)
-> TxWits MaryEra
-> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map ScriptHash (Timelock MaryEra)
stw)
  where
    atw :: Set (WitVKey 'Witness)
atw = SafeHash EraIndependentTxBody
-> [KeyPair 'Witness] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (TxBody MaryEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody MaryEra
txbodyNegEx1) [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    stw :: Map ScriptHash (Timelock MaryEra)
stw = [(ScriptHash, Timelock MaryEra)]
-> Map ScriptHash (Timelock MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PolicyID -> ScriptHash
policyID PolicyID
purplePolicyId, Timelock MaryEra
purplePolicy)]

initialUTxONegEx1 :: UTxO MaryEra
initialUTxONegEx1 :: UTxO MaryEra
initialUTxONegEx1 = UTxO MaryEra
expectedUTxOSimpleEx2

expectedUTxONegEx1 :: UTxO MaryEra
expectedUTxONegEx1 :: UTxO MaryEra
expectedUTxONegEx1 =
  Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut MaryEra) -> UTxO MaryEra)
-> Map TxIn (TxOut MaryEra) -> UTxO MaryEra
forall a b. (a -> b) -> a -> b
$
    [(TxIn, ShelleyTxOut MaryEra)] -> Map TxIn (ShelleyTxOut MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodyNegEx1) Integer
0, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr Value MaryEra
MaryValue
aliceTokensNegEx1)
      , (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
1, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr (Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
bobInitCoin))
      , (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodySimpleEx2) Integer
1, Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.bobAddr Value MaryEra
MaryValue
bobTokensSimpleEx2)
      ]

--
-- Now attempt to produce negative outputs
--

mintNegEx2 :: MultiAsset
mintNegEx2 :: MultiAsset
mintNegEx2 =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
    PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
purplePolicyId (AssetName -> Integer -> Map AssetName Integer
forall k a. k -> a -> Map k a
Map.singleton AssetName
plum (-Integer
9))

aliceTokensNegEx2 :: MaryValue
aliceTokensNegEx2 :: MaryValue
aliceTokensNegEx2 =
  Coin -> MultiAsset -> MaryValue
MaryValue (Coin
aliceCoinsSimpleEx2 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
feeEx) (MultiAsset -> MaryValue) -> MultiAsset -> MaryValue
forall a b. (a -> b) -> a -> b
$
    Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
      PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
purplePolicyId ([(AssetName, Integer)] -> Map AssetName Integer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AssetName
plum, -Integer
1), (AssetName
amethyst, Integer
2)])

-- Mint negative valued tokens
txbodyNegEx2 :: TxBody MaryEra
txbodyNegEx2 :: TxBody MaryEra
txbodyNegEx2 =
  [TxIn]
-> [ShelleyTxOut MaryEra]
-> ValidityInterval
-> MultiAsset
-> TxBody MaryEra
makeMaryTxBody
    [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (TxBody MaryEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody MaryEra
txbodySimpleEx2) Integer
0]
    [Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr Value MaryEra
MaryValue
aliceTokensNegEx2]
    ValidityInterval
unboundedInterval
    MultiAsset
mintNegEx2

testNegEx2 :: Assertion
testNegEx2 :: Assertion
testNegEx2 = do
  Either ErrorCall Bool
r <- IO Bool -> IO (Either ErrorCall Bool)
forall e a. Exception e => IO a -> IO (Either e a)
try (Bool -> IO Bool
forall a. a -> IO a
evaluate (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TxBody MaryEra
txbodyNegEx2 TxBody MaryEra -> TxBody MaryEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody MaryEra
txbodyNegEx2)
  case Either ErrorCall Bool
r of
    Left (ErrorCall String
_) -> () -> Assertion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Right Bool
_ -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure String
"constructed negative ShelleyTxOut Value"

--
-- Create a Value that is too big
--

minUtxoBigEx :: Coin
minUtxoBigEx :: Coin
minUtxoBigEx = Integer -> Coin
Coin Integer
50000

smallValue :: MultiAsset
smallValue :: MultiAsset
smallValue =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
    PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
purplePolicyId ([(AssetName, Integer)] -> Map AssetName Integer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AssetName
plum, Integer
13), (AssetName
amethyst, Integer
2)])

smallOut :: ShelleyTxOut MaryEra
smallOut :: ShelleyTxOut MaryEra
smallOut =
  Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Value MaryEra -> ShelleyTxOut MaryEra)
-> Value MaryEra -> ShelleyTxOut MaryEra
forall a b. (a -> b) -> a -> b
$
    Coin -> MultiAsset -> MaryValue
MaryValue Coin
forall a. Monoid a => a
mempty MultiAsset
smallValue
      MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
<+> Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject (Coin
aliceInitCoin Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> (Coin
feeEx Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
minUtxoBigEx))

numAssets :: Int
numAssets :: Int
numAssets = Int
1000

bigValue :: MultiAsset
bigValue :: MultiAsset
bigValue =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Map PolicyID (Map AssetName Integer) -> MultiAsset
forall a b. (a -> b) -> a -> b
$
    PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton
      PolicyID
purplePolicyId
      ([(AssetName, Integer)] -> Map AssetName Integer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(AssetName, Integer)] -> Map AssetName Integer)
-> [(AssetName, Integer)] -> Map AssetName Integer
forall a b. (a -> b) -> a -> b
$ (Int -> (AssetName, Integer)) -> [Int] -> [(AssetName, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> (ShortByteString -> AssetName
AssetName (ShortByteString -> AssetName)
-> (String -> ShortByteString) -> String -> AssetName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortByteString
forall a. IsString a => String -> a
fromString (String -> AssetName) -> String -> AssetName
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
x, Integer
1)) [Int
1 .. Int
numAssets])

bigOut :: ShelleyTxOut MaryEra
bigOut :: ShelleyTxOut MaryEra
bigOut = Addr -> Value MaryEra -> ShelleyTxOut MaryEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
Cast.aliceAddr (Value MaryEra -> ShelleyTxOut MaryEra)
-> Value MaryEra -> ShelleyTxOut MaryEra
forall a b. (a -> b) -> a -> b
$ Coin -> MultiAsset -> MaryValue
MaryValue Coin
forall a. Monoid a => a
mempty MultiAsset
bigValue MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
<+> Coin -> MaryValue
forall t s. Inject t s => t -> s
Val.inject Coin
minUtxoBigEx

txbodyWithBigValue :: TxBody MaryEra
txbodyWithBigValue :: TxBody MaryEra
txbodyWithBigValue =
  [TxIn]
-> [ShelleyTxOut MaryEra]
-> ValidityInterval
-> MultiAsset
-> TxBody MaryEra
makeMaryTxBody
    [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
bootstrapTxId Integer
0]
    [ShelleyTxOut MaryEra
smallOut, ShelleyTxOut MaryEra
bigOut]
    ValidityInterval
unboundedInterval
    (MultiAsset
bigValue MultiAsset -> MultiAsset -> MultiAsset
forall a. Semigroup a => a -> a -> a
<> MultiAsset
smallValue)

txBigValue :: ShelleyTx MaryEra
txBigValue :: ShelleyTx MaryEra
txBigValue =
  TxBody MaryEra -> Tx MaryEra
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody MaryEra
txbodyWithBigValue
    ShelleyTx MaryEra
-> (ShelleyTx MaryEra -> ShelleyTx MaryEra) -> ShelleyTx MaryEra
forall a b. a -> (a -> b) -> b
& (TxWits MaryEra -> Identity (TxWits MaryEra))
-> Tx MaryEra -> Identity (Tx MaryEra)
(TxWits MaryEra -> Identity (TxWits MaryEra))
-> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx MaryEra) (TxWits MaryEra)
witsTxL ((TxWits MaryEra -> Identity (TxWits MaryEra))
 -> ShelleyTx MaryEra -> Identity (ShelleyTx MaryEra))
-> TxWits MaryEra -> ShelleyTx MaryEra -> ShelleyTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxWits MaryEra
forall era. EraTxWits era => TxWits era
mkBasicTxWits TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits MaryEra) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Set (WitVKey 'Witness) -> TxWits MaryEra -> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey 'Witness)
atw TxWits MaryEra
-> (TxWits MaryEra -> TxWits MaryEra) -> TxWits MaryEra
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Timelock MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
(Map ScriptHash (Script MaryEra)
 -> Identity (Map ScriptHash (Script MaryEra)))
-> TxWits MaryEra -> Identity (TxWits MaryEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits MaryEra) (Map ScriptHash (Script MaryEra))
scriptTxWitsL ((Map ScriptHash (Script MaryEra)
  -> Identity (Map ScriptHash (Timelock MaryEra)))
 -> TxWits MaryEra -> Identity (TxWits MaryEra))
-> Map ScriptHash (Timelock MaryEra)
-> TxWits MaryEra
-> TxWits MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map ScriptHash (Timelock MaryEra)
stw)
  where
    atw :: Set (WitVKey 'Witness)
atw = SafeHash EraIndependentTxBody
-> [KeyPair 'Witness] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (TxBody MaryEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody MaryEra
txbodyWithBigValue) [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    stw :: Map ScriptHash (Timelock MaryEra)
stw = [(ScriptHash, Timelock MaryEra)]
-> Map ScriptHash (Timelock MaryEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PolicyID -> ScriptHash
policyID PolicyID
purplePolicyId, Timelock MaryEra
purplePolicy)]

--
-- Multi-Assets Test Group
--

multiAssetsExample :: TestTree
multiAssetsExample :: TestTree
multiAssetsExample =
  String -> [TestTree] -> TestTree
testGroup
    String
"multi-assets"
    [ String -> [TestTree] -> TestTree
testGroup
        String
"simple"
        [ String -> Assertion -> TestTree
testCase String
"minting" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
initUTxO
              ShelleyTx MaryEra
txSimpleEx1
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv (SlotNo -> LedgerEnv MaryEra) -> SlotNo -> LedgerEnv MaryEra
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
0)
              (UTxO MaryEra
-> Either
     (NonEmpty (ShelleyLedgerPredFailure MaryEra)) (UTxO MaryEra)
forall a b. b -> Either a b
Right UTxO MaryEra
expectedUTxOSimpleEx1)
        , String -> Assertion -> TestTree
testCase String
"transfer" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
expectedUTxOSimpleEx1
              ShelleyTx MaryEra
txSimpleEx2
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv (SlotNo -> LedgerEnv MaryEra) -> SlotNo -> LedgerEnv MaryEra
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
1)
              (UTxO MaryEra
-> Either
     (NonEmpty (ShelleyLedgerPredFailure MaryEra)) (UTxO MaryEra)
forall a b. b -> Either a b
Right UTxO MaryEra
expectedUTxOSimpleEx2)
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"bounded time interval"
        [ String -> Assertion -> TestTree
testCase String
"minting, valid" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
initUTxO
              ShelleyTx MaryEra
txTimeEx1Valid
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv SlotNo
startInterval)
              (UTxO MaryEra
-> Either
     (NonEmpty (ShelleyLedgerPredFailure MaryEra)) (UTxO MaryEra)
forall a b. b -> Either a b
Right UTxO MaryEra
expectedUTxOTimeEx1)
        , String -> Assertion -> TestTree
testCase String
"minting, invalid LHS too small" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
initUTxO
              ShelleyTx MaryEra
txTimeEx1InvalidLHSfixed
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv SlotNo
startInterval)
              (PolicyID
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
policyFailure PolicyID
boundedTimePolicyId)
        , String -> Assertion -> TestTree
testCase String
"minting, invalid LHS unspecified" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
initUTxO
              ShelleyTx MaryEra
txTimeEx1InvalidLHSopen
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv SlotNo
startInterval)
              (PolicyID
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
policyFailure PolicyID
boundedTimePolicyId)
        , String -> Assertion -> TestTree
testCase String
"minting, invalid RHS too big" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
initUTxO
              ShelleyTx MaryEra
txTimeEx1InvalidRHSfixed
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv SlotNo
startInterval)
              (PolicyID
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
policyFailure PolicyID
boundedTimePolicyId)
        , String -> Assertion -> TestTree
testCase String
"minting, invalid RHS unspecified" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
initUTxO
              ShelleyTx MaryEra
txTimeEx1InvalidRHSopen
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv SlotNo
startInterval)
              (PolicyID
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
policyFailure PolicyID
boundedTimePolicyId)
        , String -> Assertion -> TestTree
testCase String
"transfer, after minting period" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
expectedUTxOTimeEx1
              ShelleyTx MaryEra
txTimeEx2
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv SlotNo
afterStop)
              (UTxO MaryEra
-> Either
     (NonEmpty (ShelleyLedgerPredFailure MaryEra)) (UTxO MaryEra)
forall a b. b -> Either a b
Right UTxO MaryEra
expectedUTxOTimeEx2)
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"single key"
        [ String -> Assertion -> TestTree
testCase String
"minting, valid" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
initUTxO
              ShelleyTx MaryEra
txSingWitEx1Valid
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv (SlotNo -> LedgerEnv MaryEra) -> SlotNo -> LedgerEnv MaryEra
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
0)
              (UTxO MaryEra
-> Either
     (NonEmpty (ShelleyLedgerPredFailure MaryEra)) (UTxO MaryEra)
forall a b. b -> Either a b
Right UTxO MaryEra
expectedUTxOSingWitEx1)
        , String -> Assertion -> TestTree
testCase String
"minting, invalid no mint signature" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
initUTxO
              ShelleyTx MaryEra
txSingWitEx1Invalid
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv (SlotNo -> LedgerEnv MaryEra) -> SlotNo -> LedgerEnv MaryEra
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
0)
              (PolicyID
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
policyFailure PolicyID
alicePolicyId)
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"negative minting"
        [ String -> Assertion -> TestTree
testCase String
"remove assets" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
              UTxO MaryEra
initialUTxONegEx1
              ShelleyTx MaryEra
txNegEx1
              (SlotNo -> LedgerEnv MaryEra
ledgerEnv (SlotNo -> LedgerEnv MaryEra) -> SlotNo -> LedgerEnv MaryEra
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
3)
              (UTxO MaryEra
-> Either
     (NonEmpty (ShelleyLedgerPredFailure MaryEra)) (UTxO MaryEra)
forall a b. b -> Either a b
Right UTxO MaryEra
expectedUTxONegEx1)
        , String -> Assertion -> TestTree
testCase String
"no negative outputs" Assertion
testNegEx2
        ]
    , String -> Assertion -> TestTree
testCase String
"value too big" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        HasCallStack =>
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
UTxO MaryEra
-> ShelleyTx MaryEra
-> LedgerEnv MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
-> Assertion
testMaryNoDelegLEDGER
          UTxO MaryEra
initUTxO
          ShelleyTx MaryEra
txBigValue
          (SlotNo -> LedgerEnv MaryEra
ledgerEnv (SlotNo -> LedgerEnv MaryEra) -> SlotNo -> LedgerEnv MaryEra
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
0)
          (ShelleyTxOut MaryEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra)))
     (UTxO MaryEra)
outTooBigFailure ShelleyTxOut MaryEra
bigOut)
    ]