{-# 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.Crypto (StandardCrypto)
import Cardano.Ledger.Keys (asWitness, hashKey)
import Cardano.Ledger.Mary (Mary)
import Cardano.Ledger.Mary.Core
import Cardano.Ledger.Mary.Value (
  AssetName (..),
  MaryValue (..),
  MultiAsset (..),
  PolicyID (..),
 )
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.Shelley.API (LedgerEnv (..), ShelleyLEDGER)
import Cardano.Ledger.Shelley.LedgerState (AccountState (..))
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.UTxO (UTxO (..))
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 forall a b. (a -> b) -> a -> b
$ Integer
10_000_000_000_000_000

bobInitCoin :: Coin
bobInitCoin :: Coin
bobInitCoin = Integer -> Coin
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 forall a. StrictMaybe a
SNothing forall a. StrictMaybe a
SNothing

bootstrapTxId :: TxId StandardCrypto
bootstrapTxId :: TxId StandardCrypto
bootstrapTxId = forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody (MaryEra StandardCrypto)
txb
  where
    txb :: TxBody Mary
    txb :: TxBody (MaryEra StandardCrypto)
txb = forall era. EraTxBody era => TxBody era
mkBasicTxBody

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

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

ledgerEnv :: SlotNo -> LedgerEnv Mary
ledgerEnv :: SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv SlotNo
s = forall era.
SlotNo
-> TxIx -> PParams era -> AccountState -> Bool -> LedgerEnv era
LedgerEnv SlotNo
s forall a. Bounded a => a
minBound PParams (MaryEra StandardCrypto)
pp (Coin -> Coin -> AccountState
AccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0)) Bool
False

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 StandardCrypto] ->
  [ShelleyTxOut Mary] ->
  ValidityInterval ->
  MultiAsset StandardCrypto ->
  TxBody Mary
makeMaryTxBody :: [TxIn StandardCrypto]
-> [ShelleyTxOut (MaryEra StandardCrypto)]
-> ValidityInterval
-> MultiAsset StandardCrypto
-> TxBody (MaryEra StandardCrypto)
makeMaryTxBody [TxIn StandardCrypto]
ins [ShelleyTxOut (MaryEra StandardCrypto)]
outs ValidityInterval
interval MultiAsset StandardCrypto
minted =
  forall era. EraTxBody era => TxBody era
mkBasicTxBody
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Ord a => [a] -> Set a
Set.fromList [TxIn StandardCrypto]
ins
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> StrictSeq a
StrictSeq.fromList [ShelleyTxOut (MaryEra StandardCrypto)]
outs
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
feeEx
    forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
interval
    forall a b. a -> (a -> b) -> b
& forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset StandardCrypto
minted

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

outTooBigFailure ::
  ShelleyTxOut Mary -> Either (NonEmpty (PredicateFailure (ShelleyLEDGER Mary))) (UTxO Mary)
outTooBigFailure :: ShelleyTxOut (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
outTooBigFailure ShelleyTxOut (MaryEra StandardCrypto)
out =
  forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
UtxoFailure forall a b. (a -> b) -> a -> b
$ forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputTooBigUTxO [ShelleyTxOut (MaryEra StandardCrypto)
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 Mary
purplePolicy :: Timelock (MaryEra StandardCrypto)
purplePolicy = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
StrictSeq.fromList [])

purplePolicyId :: PolicyID StandardCrypto
purplePolicyId :: PolicyID StandardCrypto
purplePolicyId = forall c. ScriptHash c -> PolicyID c
PolicyID forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @Mary Timelock (MaryEra StandardCrypto)
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 StandardCrypto
mintSimpleEx1 :: MultiAsset StandardCrypto
mintSimpleEx1 =
  forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$
    forall k a. k -> a -> Map k a
Map.singleton PolicyID StandardCrypto
purplePolicyId (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 forall t. Val t => t -> t -> t
<-> Coin
feeEx

tokensSimpleEx1 :: MaryValue StandardCrypto
tokensSimpleEx1 :: MaryValue StandardCrypto
tokensSimpleEx1 = forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue forall a. Monoid a => a
mempty MultiAsset StandardCrypto
mintSimpleEx1 forall t. Val t => t -> t -> t
<+> 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 Mary
txbodySimpleEx1 :: TxBody (MaryEra StandardCrypto)
txbodySimpleEx1 =
  [TxIn StandardCrypto]
-> [ShelleyTxOut (MaryEra StandardCrypto)]
-> ValidityInterval
-> MultiAsset StandardCrypto
-> TxBody (MaryEra StandardCrypto)
makeMaryTxBody
    [forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial TxId StandardCrypto
bootstrapTxId Integer
0]
    [forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.aliceAddr MaryValue StandardCrypto
tokensSimpleEx1]
    ValidityInterval
unboundedInterval
    MultiAsset StandardCrypto
mintSimpleEx1

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

expectedUTxOSimpleEx1 :: UTxO Mary
expectedUTxOSimpleEx1 :: UTxO (MaryEra StandardCrypto)
expectedUTxOSimpleEx1 =
  forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody (MaryEra StandardCrypto)
txbodySimpleEx1) Integer
0, forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.aliceAddr MaryValue StandardCrypto
tokensSimpleEx1)
      , (forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial TxId StandardCrypto
bootstrapTxId Integer
1, forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.bobAddr (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 forall t. Val t => t -> t -> t
<-> (Coin
feeEx forall t. Val t => t -> t -> t
<+> Coin
minUtxoSimpleEx2)

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

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

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

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

expectedUTxOSimpleEx2 :: UTxO Mary
expectedUTxOSimpleEx2 :: UTxO (MaryEra StandardCrypto)
expectedUTxOSimpleEx2 =
  forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody (MaryEra StandardCrypto)
txbodySimpleEx2) Integer
0, forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.aliceAddr MaryValue StandardCrypto
aliceTokensSimpleEx2)
      , (forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody (MaryEra StandardCrypto)
txbodySimpleEx2) Integer
1, forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.bobAddr MaryValue StandardCrypto
bobTokensSimpleEx2)
      , (forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial TxId StandardCrypto
bootstrapTxId Integer
1, forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.bobAddr (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 Mary
boundedTimePolicy :: Timelock (MaryEra StandardCrypto)
boundedTimePolicy =
  forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf
    ( forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart SlotNo
startInterval
        , forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire SlotNo
stopInterval
        ]
    )

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

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

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

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

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

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

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

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

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

txTimeEx1Valid :: ShelleyTx Mary
txTimeEx1Valid :: ShelleyTx (MaryEra StandardCrypto)
txTimeEx1Valid = TxBody (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
txTimeEx1 TxBody (MaryEra StandardCrypto)
txbodyTimeEx1Valid

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

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

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

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

expectedUTxOTimeEx1 :: UTxO Mary
expectedUTxOTimeEx1 :: UTxO (MaryEra StandardCrypto)
expectedUTxOTimeEx1 =
  forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody (MaryEra StandardCrypto)
txbodyTimeEx1Valid) Integer
0, forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.aliceAddr MaryValue StandardCrypto
tokensTimeEx1)
      , (forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial TxId StandardCrypto
bootstrapTxId Integer
1, forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.bobAddr (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 StandardCrypto
bobTokensTimeEx2 :: MaryValue StandardCrypto
bobTokensTimeEx2 =
  forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue Coin
mintTimeEx2 forall a b. (a -> b) -> a -> b
$
    forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$
      forall k a. k -> a -> Map k a
Map.singleton PolicyID StandardCrypto
boundedTimePolicyId (forall k a. k -> a -> Map k a
Map.singleton AssetName
tokenTimeEx Integer
1)

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

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

txTimeEx2 :: ShelleyTx Mary
txTimeEx2 :: ShelleyTx (MaryEra StandardCrypto)
txTimeEx2 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody (MaryEra StandardCrypto)
txbodyTimeEx2
    forall a. Monoid a => a
mempty
      { addrWits :: Set (WitVKey 'Witness (EraCrypto (MaryEra StandardCrypto)))
addrWits =
          forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> [KeyPair kr c] -> Set (WitVKey 'Witness c)
mkWitnessesVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody (MaryEra StandardCrypto)
txbodyTimeEx2) [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness KeyPair 'Payment StandardCrypto
Cast.alicePay]
      }
    forall a. StrictMaybe a
SNothing

expectedUTxOTimeEx2 :: UTxO Mary
expectedUTxOTimeEx2 :: UTxO (MaryEra StandardCrypto)
expectedUTxOTimeEx2 =
  forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [
        ( forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody (MaryEra StandardCrypto)
txbodyTimeEx2) Integer
0
        , forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.aliceAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceCoinsTimeEx2)
        )
      , (forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody (MaryEra StandardCrypto)
txbodyTimeEx2) Integer
1, forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.bobAddr MaryValue StandardCrypto
bobTokensTimeEx2)
      , (forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial TxId StandardCrypto
bootstrapTxId Integer
1, forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.bobAddr (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 Mary
alicePolicy :: Timelock (MaryEra StandardCrypto)
alicePolicy = forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ KeyPair 'Payment StandardCrypto
Cast.alicePay

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

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

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

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

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

tokensSingWitEx1 :: MaryValue StandardCrypto
tokensSingWitEx1 :: MaryValue StandardCrypto
tokensSingWitEx1 = forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue forall a. Monoid a => a
mempty MultiAsset StandardCrypto
mintSingWitEx1 forall t. Val t => t -> t -> t
<+> 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 Mary
txbodySingWitEx1 :: TxBody (MaryEra StandardCrypto)
txbodySingWitEx1 =
  [TxIn StandardCrypto]
-> [ShelleyTxOut (MaryEra StandardCrypto)]
-> ValidityInterval
-> MultiAsset StandardCrypto
-> TxBody (MaryEra StandardCrypto)
makeMaryTxBody
    [forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial TxId StandardCrypto
bootstrapTxId Integer
1]
    [forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.bobAddr MaryValue StandardCrypto
tokensSingWitEx1]
    ValidityInterval
unboundedInterval
    MultiAsset StandardCrypto
mintSingWitEx1

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

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

txSingWitEx1Invalid :: ShelleyTx Mary
txSingWitEx1Invalid :: ShelleyTx (MaryEra StandardCrypto)
txSingWitEx1Invalid =
  forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody (MaryEra StandardCrypto)
txbodySingWitEx1
    forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. EraTxWits era => TxWits era
mkBasicTxWits forall a b. a -> (a -> b) -> b
& forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
addrTxWitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey 'Witness StandardCrypto)
atw forall a b. a -> (a -> b) -> b
& forall era.
EraTxWits era =>
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
scriptTxWitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (ScriptHash StandardCrypto) (Timelock (MaryEra StandardCrypto))
stw)
  where
    atw :: Set (WitVKey 'Witness StandardCrypto)
atw = forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> [KeyPair kr c] -> Set (WitVKey 'Witness c)
mkWitnessesVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody (MaryEra StandardCrypto)
txbodySingWitEx1) [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness KeyPair 'Payment StandardCrypto
Cast.bobPay]
    stw :: Map (ScriptHash StandardCrypto) (Timelock (MaryEra StandardCrypto))
stw = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(forall c. PolicyID c -> ScriptHash c
policyID PolicyID StandardCrypto
alicePolicyId, Timelock (MaryEra StandardCrypto)
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 StandardCrypto
mintNegEx1 :: MultiAsset StandardCrypto
mintNegEx1 =
  forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$
    forall k a. k -> a -> Map k a
Map.singleton PolicyID StandardCrypto
purplePolicyId (forall k a. k -> a -> Map k a
Map.singleton AssetName
plum (-Integer
8))

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

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

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

initialUTxONegEx1 :: UTxO Mary
initialUTxONegEx1 :: UTxO (MaryEra StandardCrypto)
initialUTxONegEx1 = UTxO (MaryEra StandardCrypto)
expectedUTxOSimpleEx2

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

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

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

aliceTokensNegEx2 :: MaryValue StandardCrypto
aliceTokensNegEx2 :: MaryValue StandardCrypto
aliceTokensNegEx2 =
  forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue (Coin
aliceCoinsSimpleEx2 forall t. Val t => t -> t -> t
<-> Coin
feeEx) forall a b. (a -> b) -> a -> b
$
    forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$
      forall k a. k -> a -> Map k a
Map.singleton PolicyID StandardCrypto
purplePolicyId (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 Mary
txbodyNegEx2 :: TxBody (MaryEra StandardCrypto)
txbodyNegEx2 =
  [TxIn StandardCrypto]
-> [ShelleyTxOut (MaryEra StandardCrypto)]
-> ValidityInterval
-> MultiAsset StandardCrypto
-> TxBody (MaryEra StandardCrypto)
makeMaryTxBody
    [forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody (MaryEra StandardCrypto)
txbodySimpleEx2) Integer
0]
    [forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr StandardCrypto
Cast.aliceAddr MaryValue StandardCrypto
aliceTokensNegEx2]
    ValidityInterval
unboundedInterval
    MultiAsset StandardCrypto
mintNegEx2

testNegEx2 :: Assertion
testNegEx2 :: Assertion
testNegEx2 = do
  Either ErrorCall Bool
r <- forall e a. Exception e => IO a -> IO (Either e a)
try (forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ TxBody (MaryEra StandardCrypto)
txbodyNegEx2 forall a. Eq a => a -> a -> Bool
== TxBody (MaryEra StandardCrypto)
txbodyNegEx2)
  case Either ErrorCall Bool
r of
    Left (ErrorCall String
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Right Bool
_ -> 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 StandardCrypto
smallValue :: MultiAsset StandardCrypto
smallValue =
  forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall a b. (a -> b) -> a -> b
$
    forall k a. k -> a -> Map k a
Map.singleton PolicyID StandardCrypto
purplePolicyId (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AssetName
plum, Integer
13), (AssetName
amethyst, Integer
2)])

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

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

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

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

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

txBigValue :: ShelleyTx Mary
txBigValue :: ShelleyTx (MaryEra StandardCrypto)
txBigValue =
  forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody (MaryEra StandardCrypto)
txbodyWithBigValue
    forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. EraTxWits era => TxWits era
mkBasicTxWits forall a b. a -> (a -> b) -> b
& forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
addrTxWitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey 'Witness StandardCrypto)
atw forall a b. a -> (a -> b) -> b
& forall era.
EraTxWits era =>
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
scriptTxWitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (ScriptHash StandardCrypto) (Timelock (MaryEra StandardCrypto))
stw)
  where
    atw :: Set (WitVKey 'Witness StandardCrypto)
atw = forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> [KeyPair kr c] -> Set (WitVKey 'Witness c)
mkWitnessesVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody (MaryEra StandardCrypto)
txbodyWithBigValue) [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness KeyPair 'Payment StandardCrypto
Cast.alicePay]
    stw :: Map (ScriptHash StandardCrypto) (Timelock (MaryEra StandardCrypto))
stw = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(forall c. PolicyID c -> ScriptHash c
policyID PolicyID StandardCrypto
purplePolicyId, Timelock (MaryEra StandardCrypto)
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" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
initUTxO
              ShelleyTx (MaryEra StandardCrypto)
txSimpleEx1
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
0)
              (forall a b. b -> Either a b
Right UTxO (MaryEra StandardCrypto)
expectedUTxOSimpleEx1)
        , String -> Assertion -> TestTree
testCase String
"transfer" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
expectedUTxOSimpleEx1
              ShelleyTx (MaryEra StandardCrypto)
txSimpleEx2
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
1)
              (forall a b. b -> Either a b
Right UTxO (MaryEra StandardCrypto)
expectedUTxOSimpleEx2)
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"bounded time interval"
        [ String -> Assertion -> TestTree
testCase String
"minting, valid" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
initUTxO
              ShelleyTx (MaryEra StandardCrypto)
txTimeEx1Valid
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv SlotNo
startInterval)
              (forall a b. b -> Either a b
Right UTxO (MaryEra StandardCrypto)
expectedUTxOTimeEx1)
        , String -> Assertion -> TestTree
testCase String
"minting, invalid LHS too small" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
initUTxO
              ShelleyTx (MaryEra StandardCrypto)
txTimeEx1InvalidLHSfixed
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv SlotNo
startInterval)
              (PolicyID StandardCrypto
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
policyFailure PolicyID StandardCrypto
boundedTimePolicyId)
        , String -> Assertion -> TestTree
testCase String
"minting, invalid LHS unspecified" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
initUTxO
              ShelleyTx (MaryEra StandardCrypto)
txTimeEx1InvalidLHSopen
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv SlotNo
startInterval)
              (PolicyID StandardCrypto
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
policyFailure PolicyID StandardCrypto
boundedTimePolicyId)
        , String -> Assertion -> TestTree
testCase String
"minting, invalid RHS too big" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
initUTxO
              ShelleyTx (MaryEra StandardCrypto)
txTimeEx1InvalidRHSfixed
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv SlotNo
startInterval)
              (PolicyID StandardCrypto
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
policyFailure PolicyID StandardCrypto
boundedTimePolicyId)
        , String -> Assertion -> TestTree
testCase String
"minting, invalid RHS unspecified" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
initUTxO
              ShelleyTx (MaryEra StandardCrypto)
txTimeEx1InvalidRHSopen
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv SlotNo
startInterval)
              (PolicyID StandardCrypto
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
policyFailure PolicyID StandardCrypto
boundedTimePolicyId)
        , String -> Assertion -> TestTree
testCase String
"transfer, after minting period" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
expectedUTxOTimeEx1
              ShelleyTx (MaryEra StandardCrypto)
txTimeEx2
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv SlotNo
afterStop)
              (forall a b. b -> Either a b
Right UTxO (MaryEra StandardCrypto)
expectedUTxOTimeEx2)
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"single key"
        [ String -> Assertion -> TestTree
testCase String
"minting, valid" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
initUTxO
              ShelleyTx (MaryEra StandardCrypto)
txSingWitEx1Valid
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
0)
              (forall a b. b -> Either a b
Right UTxO (MaryEra StandardCrypto)
expectedUTxOSingWitEx1)
        , String -> Assertion -> TestTree
testCase String
"minting, invalid no mint signature" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
initUTxO
              ShelleyTx (MaryEra StandardCrypto)
txSingWitEx1Invalid
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
0)
              (PolicyID StandardCrypto
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
policyFailure PolicyID StandardCrypto
alicePolicyId)
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"negative minting"
        [ String -> Assertion -> TestTree
testCase String
"remove assets" forall a b. (a -> b) -> a -> b
$
            HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
              UTxO (MaryEra StandardCrypto)
initialUTxONegEx1
              ShelleyTx (MaryEra StandardCrypto)
txNegEx1
              (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
3)
              (forall a b. b -> Either a b
Right UTxO (MaryEra StandardCrypto)
expectedUTxONegEx1)
        , String -> Assertion -> TestTree
testCase String
"no negative outputs" Assertion
testNegEx2
        ]
    , String -> Assertion -> TestTree
testCase String
"value too big" forall a b. (a -> b) -> a -> b
$
        HasCallStack =>
UTxO (MaryEra StandardCrypto)
-> ShelleyTx (MaryEra StandardCrypto)
-> LedgerEnv (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
-> Assertion
testMaryNoDelegLEDGER
          UTxO (MaryEra StandardCrypto)
initUTxO
          ShelleyTx (MaryEra StandardCrypto)
txBigValue
          (SlotNo -> LedgerEnv (MaryEra StandardCrypto)
ledgerEnv forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
0)
          (ShelleyTxOut (MaryEra StandardCrypto)
-> Either
     (NonEmpty
        (PredicateFailure (ShelleyLEDGER (MaryEra StandardCrypto))))
     (UTxO (MaryEra StandardCrypto))
outTooBigFailure ShelleyTxOut (MaryEra StandardCrypto)
bigOut)
    ]