{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Test.Cardano.Ledger.ShelleyMA.Serialisation.Golden.Encoding (goldenEncodingTests) where
import Cardano.Ledger.Address (Addr (..), RewardAccount (..))
import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Allegra.Scripts (
AllegraEraScript,
Timelock (..),
pattern RequireTimeExpire,
pattern RequireTimeStart,
)
import Cardano.Ledger.Allegra.TxAuxData (pattern AllegraTxAuxData)
import Cardano.Ledger.Allegra.TxBody (AllegraTxBody (..))
import Cardano.Ledger.BaseTypes (Network (..), StrictMaybe (..))
import Cardano.Ledger.Binary (ToCBOR)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Mary.Core
import Cardano.Ledger.Mary.TxBody (MaryTxBody (..))
import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..))
import Cardano.Ledger.Shelley.PParams (
Update,
pattern ProposedPPUpdates,
pattern Update,
)
import Cardano.Ledger.Shelley.Scripts (
ShelleyEraScript,
pattern RequireAllOf,
pattern RequireAnyOf,
pattern RequireMOf,
pattern RequireSignature,
)
import qualified Cardano.Ledger.Shelley.TxAuxData as TxAuxData
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Slot (EpochNo (..), SlotNo (..))
import Cardano.Ledger.TxIn (mkTxInPartial)
import qualified Cardano.Ledger.Val as Val
import Codec.CBOR.Encoding (Tokens (..))
import qualified Data.ByteString.Short as SBS
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Lens.Micro
import Test.Cardano.Ledger.Binary.RoundTrip (roundTripCborRangeFailureExpectation)
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
import Test.Cardano.Ledger.Shelley.Serialisation.GoldenUtils (
ToTokens (..),
checkEncodingCBOR,
checkEncodingCBORAnnotated,
checkEncodingCBORDecodeFailure,
)
import Test.Cardano.Ledger.Shelley.Utils (RawSeed (..), mkGenKey, mkKeyPair)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, testCase)
policy1 :: ShelleyEraScript era => NativeScript era
policy1 :: forall era. ShelleyEraScript era => NativeScript era
policy1 = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> StrictSeq a
StrictSeq.fromList forall a b. (a -> b) -> a -> b
$ []
policyID1 :: PolicyID
policyID1 :: PolicyID
policyID1 = ScriptHash -> PolicyID
PolicyID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => Script era -> ScriptHash
hashScript @AllegraEra forall a b. (a -> b) -> a -> b
$ forall era. ShelleyEraScript era => NativeScript era
policy1
policyID2 :: PolicyID
policyID2 :: PolicyID
policyID2 = ScriptHash -> PolicyID
PolicyID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => Script era -> ScriptHash
hashScript @AllegraEra forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> StrictSeq a
StrictSeq.fromList forall a b. (a -> b) -> a -> b
$ []
assetName1 :: SBS.ShortByteString
assetName1 :: ShortByteString
assetName1 = ShortByteString
"a1"
assetName2 :: SBS.ShortByteString
assetName2 :: ShortByteString
assetName2 = ShortByteString
"a2"
assetName3 :: SBS.ShortByteString
assetName3 :: ShortByteString
assetName3 = ShortByteString
"a3"
testGKeyHash :: KeyHash 'Genesis
testGKeyHash :: KeyHash 'Genesis
testGKeyHash = forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkGenKey forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
0
testAddrE :: Addr
testAddrE :: Addr
testAddrE =
Network -> PaymentCredential -> StakeReference -> Addr
Addr
Network
Testnet
(forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
1))
StakeReference
StakeRefNull
testKeyHash :: KeyHash 'Staking
testKeyHash :: KeyHash 'Staking
testKeyHash = forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
2)
testStakeCred :: Credential 'Staking
testStakeCred :: Credential 'Staking
testStakeCred = forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
3)
testUpdate ::
forall era.
EraPParams era =>
Update era
testUpdate :: forall era. EraPParams era => Update era
testUpdate =
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update
( forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates
( forall k a. k -> a -> Map k a
Map.singleton
KeyHash 'Genesis
testGKeyHash
(forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuNOptL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust Word16
100)
)
)
(Word64 -> EpochNo
EpochNo Word64
0)
scriptGoldenTest :: forall era. (AllegraEraScript era, ToCBOR (NativeScript era)) => TestTree
scriptGoldenTest :: forall era.
(AllegraEraScript era, ToCBOR (NativeScript era)) =>
TestTree
scriptGoldenTest =
let kh0 :: KeyHash 'Witness
kh0 = forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkGenKey forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
0 :: KeyHash 'Witness
kh1 :: KeyHash 'Witness
kh1 = forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkGenKey forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
1 Word64
1 Word64
1 Word64
1 :: KeyHash 'Witness
in forall a.
(HasCallStack, DecCBOR (Annotator a), ToCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBORAnnotated
(forall era. Era era => Version
eraProtVerHigh @era)
String
"timelock_script"
( forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf @era
( forall a. [a] -> StrictSeq a
StrictSeq.fromList
[ forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
1 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature KeyHash 'Witness
kh0, forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature KeyHash 'Witness
kh1]
, forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Word64 -> SlotNo
SlotNo Word64
100)
, forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (Word64 -> SlotNo
SlotNo Word64
101)
]
)
)
( (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkListLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkListLen Word
3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkListLen Word
3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkListLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkListLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
0
)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S KeyHash 'Witness
kh0
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkListLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
0
)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S KeyHash 'Witness
kh1
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkListLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
100
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkListLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
101
)
)
metadataNoScriptsGoldenTest :: forall era. Era era => TestTree
metadataNoScriptsGoldenTest :: forall era. Era era => TestTree
metadataNoScriptsGoldenTest =
forall a.
(HasCallStack, DecCBOR (Annotator a), ToCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBORAnnotated
(forall era. Era era => Version
eraProtVerHigh @era)
String
"metadata_no_scripts"
(forall era.
Era era =>
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxData era
AllegraTxAuxData @era (forall k a. k -> a -> Map k a
Map.singleton Word64
17 (Integer -> Metadatum
TxAuxData.I Integer
42)) forall a. StrictSeq a
StrictSeq.empty)
( (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkListLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkMapLen Word
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
17
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
42
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkListLen Word
0
)
)
metadataWithScriptsGoldenTest ::
forall era.
(ShelleyEraScript era, NativeScript era ~ Timelock era) =>
TestTree
metadataWithScriptsGoldenTest :: forall era.
(ShelleyEraScript era, NativeScript era ~ Timelock era) =>
TestTree
metadataWithScriptsGoldenTest =
forall a.
(HasCallStack, DecCBOR (Annotator a), ToCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBORAnnotated
(forall era. Era era => Version
eraProtVerHigh @era)
String
"metadata_with_scripts"
( forall era.
Era era =>
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxData era
AllegraTxAuxData @era
(forall k a. k -> a -> Map k a
Map.singleton Word64
17 (Integer -> Metadatum
TxAuxData.I Integer
42))
(forall a. a -> StrictSeq a
StrictSeq.singleton forall era. ShelleyEraScript era => NativeScript era
policy1)
)
( (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkListLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkMapLen Word
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
17
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
42
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkListLen Word
1
)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S (forall era. ShelleyEraScript era => NativeScript era
policy1 @era)
)
goldenEncodingTestsAllegra :: TestTree
goldenEncodingTestsAllegra :: TestTree
goldenEncodingTestsAllegra =
String -> [TestTree] -> TestTree
testGroup
String
"Allegra"
[ forall a.
(HasCallStack, DecCBOR a, EncCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBOR
(forall era. Era era => Version
eraProtVerHigh @MaryEra)
String
"value"
(forall t s. Inject t s => t -> s
Val.inject (Integer -> Coin
Coin Integer
1) :: Value AllegraEra)
((Tokens -> Tokens) -> ToTokens
T (Integer -> Tokens -> Tokens
TkInteger Integer
1))
, forall era.
(AllegraEraScript era, ToCBOR (NativeScript era)) =>
TestTree
scriptGoldenTest @AllegraEra
, forall era. Era era => TestTree
metadataNoScriptsGoldenTest @AllegraEra
, forall era.
(ShelleyEraScript era, NativeScript era ~ Timelock era) =>
TestTree
metadataWithScriptsGoldenTest @AllegraEra
,
let tin :: TxIn
tin = HasCallStack => TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
1
tout :: ShelleyTxOut AllegraEra
tout = forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut @AllegraEra Addr
testAddrE (Integer -> Coin
Coin Integer
2)
in forall a.
(HasCallStack, DecCBOR (Annotator a), ToCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBORAnnotated
(forall era. Era era => Version
eraProtVerHigh @AllegraEra)
String
"minimal_txbody"
( forall era.
(EraTxOut era, EraTxCert era) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> AllegraTxBody era
AllegraTxBody
(forall a. Ord a => [a] -> Set a
Set.fromList [TxIn
tin])
(forall a. a -> StrictSeq a
StrictSeq.singleton ShelleyTxOut AllegraEra
tout)
forall a. StrictSeq a
StrictSeq.empty
(Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
(Integer -> Coin
Coin Integer
9)
(StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval forall a. StrictMaybe a
SNothing forall a. StrictMaybe a
SNothing)
forall a. StrictMaybe a
SNothing
forall a. StrictMaybe a
SNothing
)
( (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkMapLen Word
3)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
0)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkListLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S TxIn
tin
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
1)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkListLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S ShelleyTxOut AllegraEra
tout
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
2)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word64 -> Tokens -> Tokens
TkWord64 Word64
9)
)
,
let tin :: TxIn
tin = HasCallStack => TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
1
tout :: ShelleyTxOut AllegraEra
tout = forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut @AllegraEra Addr
testAddrE (Integer -> Coin
Coin Integer
2)
reg :: TxCert AllegraEra
reg = forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
testStakeCred
ras :: Map RewardAccount Coin
ras = forall k a. k -> a -> Map k a
Map.singleton (Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
testKeyHash)) (Integer -> Coin
Coin Integer
123)
up :: Update AllegraEra
up = forall era. EraPParams era => Update era
testUpdate
mdh :: TxAuxDataHash
mdh = forall era. EraTxAuxData era => TxAuxData era -> TxAuxDataHash
hashTxAuxData @AllegraEra forall a b. (a -> b) -> a -> b
$ forall era.
Era era =>
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxData era
AllegraTxAuxData forall k a. Map k a
Map.empty forall a. StrictSeq a
StrictSeq.empty
in forall a.
(HasCallStack, DecCBOR (Annotator a), ToCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBORAnnotated
(forall era. Era era => Version
eraProtVerHigh @AllegraEra)
String
"full_txn_body"
( forall era.
(EraTxOut era, EraTxCert era) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> AllegraTxBody era
AllegraTxBody
(forall a. Ord a => [a] -> Set a
Set.fromList [TxIn
tin])
(forall a. a -> StrictSeq a
StrictSeq.singleton ShelleyTxOut AllegraEra
tout)
(forall a. [a] -> StrictSeq a
StrictSeq.fromList [TxCert AllegraEra
reg])
(Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
ras)
(Integer -> Coin
Coin Integer
9)
(StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
500) (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
600))
(forall a. a -> StrictMaybe a
SJust Update AllegraEra
up)
(forall a. a -> StrictMaybe a
SJust TxAuxDataHash
mdh)
)
( (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkMapLen Word
9)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
0)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkListLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S TxIn
tin
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
1)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkListLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S ShelleyTxOut AllegraEra
tout
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
2)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S (Integer -> Coin
Coin Integer
9)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
3)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S (Word64 -> SlotNo
SlotNo Word64
600)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
4)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkListLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S TxCert AllegraEra
reg
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
5)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S Map RewardAccount Coin
ras
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
6)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S Update AllegraEra
up
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
7)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S TxAuxDataHash
mdh
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
8)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S (Word64 -> SlotNo
SlotNo Word64
500)
)
]
goldenEncodingTestsMary :: TestTree
goldenEncodingTestsMary :: TestTree
goldenEncodingTestsMary =
String -> [TestTree] -> TestTree
testGroup
String
"Mary"
[ forall a.
(HasCallStack, DecCBOR a, EncCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBOR
(forall era. Era era => Version
eraProtVerHigh @MaryEra)
String
"ada_only_value"
(forall t s. Inject t s => t -> s
Val.inject (Integer -> Coin
Coin Integer
1) :: MaryValue)
((Tokens -> Tokens) -> ToTokens
T (Integer -> Tokens -> Tokens
TkInteger Integer
1))
, forall a.
(HasCallStack, DecCBOR a, EncCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBOR
(forall era. Era era => Version
eraProtVerHigh @MaryEra)
String
"not_just_ada_value"
( Coin -> MultiAsset -> MaryValue
MaryValue (Integer -> Coin
Coin Integer
2) forall a b. (a -> b) -> a -> b
$
Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[
( PolicyID
policyID1
, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (ShortByteString -> AssetName
AssetName ShortByteString
assetName1, Integer
13)
, (ShortByteString -> AssetName
AssetName ShortByteString
assetName2, Integer
17)
]
)
,
( PolicyID
policyID2
, forall k a. k -> a -> Map k a
Map.singleton (ShortByteString -> AssetName
AssetName ShortByteString
assetName3) Integer
19
)
]
)
( (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkListLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkMapLen Word
2
)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S PolicyID
policyID1
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkMapLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Tokens -> Tokens
TkBytes (ShortByteString -> ByteString
SBS.fromShort ShortByteString
assetName1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
13
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Tokens -> Tokens
TkBytes (ShortByteString -> ByteString
SBS.fromShort ShortByteString
assetName2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
17
)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S PolicyID
policyID2
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkMapLen Word
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Tokens -> Tokens
TkBytes (ShortByteString -> ByteString
SBS.fromShort ShortByteString
assetName3)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
19
)
)
, forall a.
(HasCallStack, DecCBOR a, EncCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBOR
(forall era. Era era => Version
eraProtVerHigh @MaryEra)
String
"multiasset_with_negative"
(Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton PolicyID
policyID1 (forall k a. k -> a -> Map k a
Map.singleton (ShortByteString -> AssetName
AssetName ShortByteString
assetName1) (-Integer
19)))
( (Tokens -> Tokens) -> ToTokens
T
(Word -> Tokens -> Tokens
TkMapLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S PolicyID
policyID1
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkMapLen Word
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Tokens -> Tokens
TkBytes (ShortByteString -> ByteString
SBS.fromShort ShortByteString
assetName1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger (-Integer
19)
)
)
, forall a.
(HasCallStack, DecCBOR a, EncCBOR a, Show a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBORDecodeFailure
(forall era. Era era => Version
eraProtVerHigh @MaryEra)
String
"value_with_negative"
( Coin -> MultiAsset -> MaryValue
MaryValue (Integer -> Coin
Coin Integer
1) forall a b. (a -> b) -> a -> b
$
Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall a b. (a -> b) -> a -> b
$
forall k a. k -> a -> Map k a
Map.singleton PolicyID
policyID1 (forall k a. k -> a -> Map k a
Map.singleton (ShortByteString -> AssetName
AssetName ShortByteString
assetName1) (-Integer
19))
)
( (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkListLen Word
2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger Integer
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Tokens -> Tokens
TkMapLen Word
1
)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S PolicyID
policyID1
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T
( Word -> Tokens -> Tokens
TkMapLen Word
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Tokens -> Tokens
TkBytes (ShortByteString -> ByteString
SBS.fromShort ShortByteString
assetName1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Tokens -> Tokens
TkInteger (-Integer
19)
)
)
, forall era.
(AllegraEraScript era, ToCBOR (NativeScript era)) =>
TestTree
scriptGoldenTest @MaryEra
, forall era. Era era => TestTree
metadataNoScriptsGoldenTest @MaryEra
, forall era.
(ShelleyEraScript era, NativeScript era ~ Timelock era) =>
TestTree
metadataWithScriptsGoldenTest @MaryEra
,
let tin :: TxIn
tin = HasCallStack => TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
1
tout :: ShelleyTxOut MaryEra
tout = forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut @MaryEra Addr
testAddrE (forall t s. Inject t s => t -> s
Val.inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2)
in forall a.
(HasCallStack, DecCBOR (Annotator a), ToCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBORAnnotated
(forall era. Era era => Version
eraProtVerHigh @MaryEra)
String
"minimal_txbody"
( forall era.
(EraTxOut era, EraTxCert era) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> MultiAsset
-> MaryTxBody era
MaryTxBody
(forall a. Ord a => [a] -> Set a
Set.fromList [TxIn
tin])
(forall a. a -> StrictSeq a
StrictSeq.singleton ShelleyTxOut MaryEra
tout)
forall a. StrictSeq a
StrictSeq.empty
(Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
(Integer -> Coin
Coin Integer
9)
(StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval forall a. StrictMaybe a
SNothing forall a. StrictMaybe a
SNothing)
forall a. StrictMaybe a
SNothing
forall a. StrictMaybe a
SNothing
forall a. Monoid a => a
mempty
)
( (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkMapLen Word
3)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
0)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkListLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S TxIn
tin
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
1)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkListLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S ShelleyTxOut MaryEra
tout
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
2)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word64 -> Tokens -> Tokens
TkWord64 Word64
9)
)
,
let tin :: TxIn
tin = HasCallStack => TxId -> Integer -> TxIn
mkTxInPartial TxId
genesisId Integer
1
tout :: ShelleyTxOut MaryEra
tout = forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut @MaryEra Addr
testAddrE (forall t s. Inject t s => t -> s
Val.inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2)
reg :: TxCert MaryEra
reg = forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
testStakeCred
ras :: Map RewardAccount Coin
ras = forall k a. k -> a -> Map k a
Map.singleton (Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
testKeyHash)) (Integer -> Coin
Coin Integer
123)
up :: Update MaryEra
up = forall era. EraPParams era => Update era
testUpdate
mdh :: TxAuxDataHash
mdh = forall era. EraTxAuxData era => TxAuxData era -> TxAuxDataHash
hashTxAuxData @AllegraEra forall a b. (a -> b) -> a -> b
$ forall era.
Era era =>
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxData era
AllegraTxAuxData forall k a. Map k a
Map.empty forall a. StrictSeq a
StrictSeq.empty
mint :: Map PolicyID (Map AssetName Integer)
mint = forall k a. k -> a -> Map k a
Map.singleton PolicyID
policyID1 forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton (ShortByteString -> AssetName
AssetName ShortByteString
assetName1) Integer
13
in forall a.
(HasCallStack, DecCBOR (Annotator a), ToCBOR a, Show a, Eq a) =>
Version -> String -> a -> ToTokens -> TestTree
checkEncodingCBORAnnotated
(forall era. Era era => Version
eraProtVerHigh @MaryEra)
String
"full_txn_body"
( forall era.
(EraTxOut era, EraTxCert era) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> MultiAsset
-> MaryTxBody era
MaryTxBody
(forall a. Ord a => [a] -> Set a
Set.fromList [TxIn
tin])
(forall a. a -> StrictSeq a
StrictSeq.singleton ShelleyTxOut MaryEra
tout)
(forall a. [a] -> StrictSeq a
StrictSeq.fromList [TxCert MaryEra
reg])
(Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
ras)
(Integer -> Coin
Coin Integer
9)
(StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
500) (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
600))
(forall a. a -> StrictMaybe a
SJust Update MaryEra
up)
(forall a. a -> StrictMaybe a
SJust TxAuxDataHash
mdh)
(Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset Map PolicyID (Map AssetName Integer)
mint)
)
( (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkMapLen Word
10)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
0)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkListLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S TxIn
tin
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
1)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkListLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S ShelleyTxOut MaryEra
tout
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
2)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S (Integer -> Coin
Coin Integer
9)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
3)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S (Word64 -> SlotNo
SlotNo Word64
600)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
4)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkListLen Word
1)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S TxCert MaryEra
reg
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
5)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S Map RewardAccount Coin
ras
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
6)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S Update MaryEra
up
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
7)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S TxAuxDataHash
mdh
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
8)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S (Word64 -> SlotNo
SlotNo Word64
500)
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> ToTokens
T (Word -> Tokens -> Tokens
TkWord Word
9)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> ToTokens
S Map PolicyID (Map AssetName Integer)
mint
)
]
assetName32Bytes :: Assertion
assetName32Bytes :: Assertion
assetName32Bytes =
forall t.
(EncCBOR t, DecCBOR t, Eq t, HasCallStack) =>
Version -> Version -> t -> Assertion
roundTripCborRangeFailureExpectation (forall era. Era era => Version
eraProtVerHigh @MaryEra) forall a. Bounded a => a
maxBound forall a b. (a -> b) -> a -> b
$
ShortByteString -> AssetName
AssetName ShortByteString
"123456789-123456789-123456789-123"
goldenEncodingTests :: TestTree
goldenEncodingTests :: TestTree
goldenEncodingTests =
String -> [TestTree] -> TestTree
testGroup
String
"Golden Encoding Tests"
[ TestTree
goldenEncodingTestsAllegra
, TestTree
goldenEncodingTestsMary
, String -> Assertion -> TestTree
testCase String
"33 bytes asset name too big" Assertion
assetName32Bytes
]