{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Dijkstra.Binary.Golden (
  spec,
  module Test.Cardano.Ledger.Conway.Binary.Golden,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo, SupportedLanguage (..))
import Cardano.Ledger.Alonzo.Scripts (plutusScriptBinary)
import Cardano.Ledger.Alonzo.TxWits (Redeemers)
import Cardano.Ledger.BaseTypes (Version)
import Cardano.Ledger.Binary (
  Annotator,
  DecoderError (..),
  DeserialiseFailure (..),
  Tokens (..),
  shelleyProtVer,
 )
import qualified Cardano.Ledger.Binary as Binary
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.Tx (DijkstraTopTx)
import Cardano.Ledger.Keys (WitVKey (..))
import Cardano.Ledger.Plutus (SLanguage (..))
import Cardano.Ledger.TxIn (TxIn (..))
import Control.Monad (forM_)
import qualified Data.ByteString as BS
import Data.Data (Proxy (..))
import Data.List (isSuffixOf)
import qualified Data.OMap.Strict as OMap
import qualified Data.OSet.Strict as OSet
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import Lens.Micro
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysSucceedsLang)
import Test.Cardano.Ledger.Binary.Plain.Golden (Enc (..))
import Test.Cardano.Ledger.Common (Spec, ToExpr, describe, expectRight, it, shouldBe, shouldSatisfy)
import Test.Cardano.Ledger.Conway.Binary.Golden hiding (spec)
import Test.Cardano.Ledger.Core.KeyPair (mkKeyHash, mkKeyPair, mkWitnessVKey)
import Test.Cardano.Ledger.Core.Utils (mkDummySafeHash)
import Test.Cardano.Ledger.Dijkstra.Era (DijkstraEraTest)
import Test.Cardano.Ledger.Imp.Common (forEachEraVersion)

spec :: forall era. (DijkstraEraTest era, ToExpr (BlockBody era)) => Spec
spec :: forall era. (DijkstraEraTest era, ToExpr (BlockBody era)) => Spec
spec = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Golden" (Spec -> Spec)
-> ((Version -> Spec) -> Spec) -> (Version -> Spec) -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. (Era era, HasCallStack) => (Version -> Spec) -> Spec
forEachEraVersion @era ((Version -> Spec) -> Spec) -> (Version -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \Version
version -> do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Redeemers" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era. DijkstraEraTest era => Version -> Spec
goldenListRedeemersDisallowed @era Version
version
    forall era. ConwayEraTest era => Version -> Spec
goldenMapRedeemers @era Version
version
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TxCert" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era. ConwayEraTest era => Version -> Spec
conwayDecodeDuplicateDelegCertFails @era Version
version
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TxWits" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicateVKeyWitsDisallowed @era Version
version
    forall era. DijkstraEraTest era => Version -> Spec
goldenBootstrapDuplicateWitsDisallowed @era Version
version
    forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicateNativeScriptsDisallowed @era Version
version
    forall era (l :: Language).
(DijkstraEraTest era, EraPlutusTxInfo l era) =>
Version -> SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed @era Version
version SLanguage 'PlutusV1
SPlutusV1
    forall era (l :: Language).
(DijkstraEraTest era, EraPlutusTxInfo l era) =>
Version -> SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed @era Version
version SLanguage 'PlutusV2
SPlutusV2
    forall era (l :: Language).
(DijkstraEraTest era, EraPlutusTxInfo l era) =>
Version -> SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed @era Version
version SLanguage 'PlutusV3
SPlutusV3
    forall era (l :: Language).
(DijkstraEraTest era, EraPlutusTxInfo l era) =>
Version -> SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed @era Version
version SLanguage 'PlutusV4
SPlutusV4
    forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicatePlutusDataDisallowed @era Version
version
    forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicateRedeemersDisallowed @era Version
version
    forall era. DijkstraEraTest era => Version -> Spec
goldenEmptyFields @era Version
version
  forall era. DijkstraEraTest era => Version -> Spec
goldenGuards @era Version
version
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Subtransactions" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era. DijkstraEraTest era => Spec
goldenSubTransactions @era
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"IsPhase2Valid flag" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era. DijkstraEraTest era => Spec
goldenIsPhase2ValidFlag @era
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Block transactions" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era. (DijkstraEraTest era, ToExpr (BlockBody era)) => Spec
goldenBlockTransaction @era

goldenGuards :: forall era. DijkstraEraTest era => Version -> Spec
goldenGuards :: forall era. DijkstraEraTest era => Version -> Spec
goldenGuards Version
version = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Guards" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TopTx" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ forall (l :: TxLevel). Typeable l => STxBothLevels l era -> Spec
atLevel @TopTx STxBothLevels TopTx era
forall era. STxBothLevels TopTx era
STopTx
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"SubTx" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ forall (l :: TxLevel). Typeable l => STxBothLevels l era -> Spec
atLevel @SubTx STxBothLevels SubTx era
forall era. STxBothLevels SubTx era
SSubTx
  where
    atLevel :: forall l. Typeable l => STxBothLevels l era -> Spec
    atLevel :: forall (l :: TxLevel). Typeable l => STxBothLevels l era -> Spec
atLevel STxBothLevels l era
level = do
      let
        keyHash :: KeyHash Guard
keyHash = forall (kd :: KeyRole). Int -> KeyHash kd
mkKeyHash @Guard Int
0
        credential :: Credential Guard
credential = KeyHash Guard -> Credential Guard
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Guard
keyHash
        expected :: TxBody l era
expected = forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
mkBasicTxBody @era @l TxBody l era -> (TxBody l era -> TxBody l era) -> TxBody l era
forall a b. a -> (a -> b) -> b
& (OSet (Credential Guard) -> Identity (OSet (Credential Guard)))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (OSet (Credential Guard))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (Credential Guard))
guardsTxBodyL ((OSet (Credential Guard) -> Identity (OSet (Credential Guard)))
 -> TxBody l era -> Identity (TxBody l era))
-> OSet (Credential Guard) -> TxBody l era -> TxBody l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Credential Guard -> OSet (Credential Guard)
forall a. a -> OSet a
OSet.singleton Credential Guard
credential
        txBodyEnc :: Maybe Enc -> Enc
txBodyEnc Maybe Enc
guards =
          let
            fields :: [Enc]
fields =
              [ [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
0, Version -> Set TxIn -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version (Set TxIn -> Enc) -> Set TxIn -> Enc
forall a b. (a -> b) -> a -> b
$ forall a. Set a
Set.empty @TxIn]
              , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
1, (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
0]
              ]
                [Enc] -> [Enc] -> [Enc]
forall a. Semigroup a => a -> a -> a
<> (case STxBothLevels l era
level of STxBothLevels l era
STopTx -> [[Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
2, Coin -> Enc
forall a. ToCBOR a => a -> Enc
E (Coin -> Enc) -> Coin -> Enc
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
0]]; STxBothLevels l era
SSubTx -> [])
                [Enc] -> [Enc] -> [Enc]
forall a. Semigroup a => a -> a -> a
<> [Enc] -> (Enc -> [Enc]) -> Maybe Enc -> [Enc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Enc
value -> [[Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
14, Enc
value]]) Maybe Enc
guards
           in
            [Enc] -> Enc
Em ([Enc] -> Enc) -> [Enc] -> Enc
forall a b. (a -> b) -> a -> b
$ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkMapLen (Word -> Tokens -> Tokens) -> Word -> Tokens -> Tokens
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ [Enc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Enc]
fields) Enc -> [Enc] -> [Enc]
forall a. a -> [a] -> [a]
: [Enc]
fields
        tagForms :: [(String, Enc -> Enc)]
tagForms =
          [ (String
"Untagged", Enc -> Enc
forall a. a -> a
id)
          , (String
"Tagged", \Enc
value -> [Enc] -> Enc
Em [(Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkTag Word
258, Enc
value])
          ]
        listForms :: [(String, [Enc] -> Enc)]
listForms =
          [ (String
"Definite", \[Enc]
values -> [Enc] -> Enc
Em [(Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen (Word -> Tokens -> Tokens) -> Word -> Tokens -> Tokens
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ [Enc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Enc]
values, [Enc] -> Enc
Em [Enc]
values])
          , (String
"Indefinite", \[Enc]
values -> [Enc] -> Enc
Em [(Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkListBegin, [Enc] -> Enc
Em [Enc]
values, (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkBreak])
          ]
        elementForms :: [(String, Enc)]
elementForms =
          [ (String
"Legacy key hashes", Version -> KeyHash Guard -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version KeyHash Guard
keyHash)
          , (String
"Credentials", Version -> Credential Guard -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version Credential Guard
credential)
          ]
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Omitted guards retain the empty default" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
        forall a b.
(DecCBOR (Annotator a), Eq b, HasCallStack, Show b) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn @(TxBody l era)
          Version
version
          (Maybe Enc -> Enc
txBodyEnc Maybe Enc
forall a. Maybe a
Nothing)
          (forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
mkBasicTxBody @era @l)
          (TxBody l era
-> Getting
     (OSet (Credential Guard)) (TxBody l era) (OSet (Credential Guard))
-> OSet (Credential Guard)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (Credential Guard)) (TxBody l era) (OSet (Credential Guard))
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (OSet (Credential Guard))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (Credential Guard))
guardsTxBodyL)
      [(String, Enc -> Enc)] -> ((String, Enc -> Enc) -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Enc -> Enc)]
tagForms (((String, Enc -> Enc) -> Spec) -> Spec)
-> ((String, Enc -> Enc) -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \(String
tagName, Enc -> Enc
tag) ->
        String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
tagName (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
          [(String, [Enc] -> Enc)]
-> ((String, [Enc] -> Enc) -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, [Enc] -> Enc)]
listForms (((String, [Enc] -> Enc) -> Spec) -> Spec)
-> ((String, [Enc] -> Enc) -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \(String
listName, [Enc] -> Enc
list) ->
            String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
listName (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
              String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Explicitly empty guards are rejected" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
                forall a.
DecCBOR (Annotator a) =>
Version -> Enc -> Either DecoderError a
decodeEnc @(TxBody l era) Version
version (Maybe Enc -> Enc
txBodyEnc (Maybe Enc -> Enc) -> Maybe Enc -> Enc
forall a b. (a -> b) -> a -> b
$ Enc -> Maybe Enc
forall a. a -> Maybe a
Just (Enc -> Maybe Enc) -> Enc -> Maybe Enc
forall a b. (a -> b) -> a -> b
$ Enc -> Enc
tag (Enc -> Enc) -> Enc -> Enc
forall a b. (a -> b) -> a -> b
$ [Enc] -> Enc
list [])
                  Either DecoderError (TxBody l era)
-> (Either DecoderError (TxBody l era) -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` String -> Either DecoderError (TxBody l era) -> Bool
forall a. String -> Either DecoderError a -> Bool
isFailureWith String
"TxBody: 'Guards' must be non-empty when supplied"
              [(String, Enc)] -> ((String, Enc) -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Enc)]
elementForms (((String, Enc) -> Spec) -> Spec)
-> ((String, Enc) -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \(String
elementName, Enc
element) ->
                String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
elementName (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
                  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Nonempty guards decode as expected" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
                    forall a b.
(DecCBOR (Annotator a), Eq b, HasCallStack, Show b) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn @(TxBody l era)
                      Version
version
                      (Maybe Enc -> Enc
txBodyEnc (Maybe Enc -> Enc) -> Maybe Enc -> Enc
forall a b. (a -> b) -> a -> b
$ Enc -> Maybe Enc
forall a. a -> Maybe a
Just (Enc -> Maybe Enc) -> Enc -> Maybe Enc
forall a b. (a -> b) -> a -> b
$ Enc -> Enc
tag (Enc -> Enc) -> Enc -> Enc
forall a b. (a -> b) -> a -> b
$ [Enc] -> Enc
list [Enc
element])
                      TxBody l era
expected
                      (TxBody l era
-> Getting
     (OSet (Credential Guard)) (TxBody l era) (OSet (Credential Guard))
-> OSet (Credential Guard)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (Credential Guard)) (TxBody l era) (OSet (Credential Guard))
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (OSet (Credential Guard))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (Credential Guard))
guardsTxBodyL)
                  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Duplicate guards are rejected" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
                    forall a.
DecCBOR (Annotator a) =>
Version -> Enc -> Either DecoderError a
decodeEnc @(TxBody l era) Version
version (Maybe Enc -> Enc
txBodyEnc (Maybe Enc -> Enc) -> Maybe Enc -> Enc
forall a b. (a -> b) -> a -> b
$ Enc -> Maybe Enc
forall a. a -> Maybe a
Just (Enc -> Maybe Enc) -> Enc -> Maybe Enc
forall a b. (a -> b) -> a -> b
$ Enc -> Enc
tag (Enc -> Enc) -> Enc -> Enc
forall a b. (a -> b) -> a -> b
$ [Enc] -> Enc
list [Enc
element, Enc
element])
                      Either DecoderError (TxBody l era)
-> (Either DecoderError (TxBody l era) -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` String -> Either DecoderError (TxBody l era) -> Bool
forall a. String -> Either DecoderError a -> Bool
isFailureWith
                        String
"Final number of elements: 1 does not match the total count that was decoded: 2"
    isFailureWith :: String -> Either DecoderError a -> Bool
    isFailureWith :: forall a. String -> Either DecoderError a -> Bool
isFailureWith String
expected (Left (DecoderErrorDeserialiseFailure Text
_ (DeserialiseFailure ByteOffset
_ String
message))) =
      String
expected String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
message
    isFailureWith String
_ Either DecoderError a
_ = Bool
False

goldenEmptyFields :: forall era. DijkstraEraTest era => Version -> Spec
goldenEmptyFields :: forall era. DijkstraEraTest era => Version -> Spec
goldenEmptyFields Version
version =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Empty fields not allowed" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    let
      decoderFailure :: ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
n String
msg =
        Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
          (Proxy (Annotator (TxWits era)) -> Text
forall a. DecCBOR a => Proxy a -> Text
Binary.label (Proxy (Annotator (TxWits era)) -> Text)
-> Proxy (Annotator (TxWits era)) -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Annotator (TxWits era)))
          (ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure ByteOffset
n String
msg)
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Untagged" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"addrTxWits" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
0 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Expected a non-empty set, but got an empty set"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"nativeScripts" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
1 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list found, expected non-empty"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"bootstrapWitness" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
2 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Expected a non-empty set, but got an empty set"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV1Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
3 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list of scripts is not allowed"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusData" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
4 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list found, expected non-empty"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"redeemers" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
5 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
2 String
"List encoding of redeemers not supported starting with PV 12"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV2Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
6 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list of scripts is not allowed"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV3Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
7 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list of scripts is not allowed"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV4Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTest era =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyField @era Version
version Int
8 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
4 String
"Empty list of scripts is not allowed"
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Tagged" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"addrTxWits" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
0 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Expected a non-empty set, but got an empty set"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"nativeScripts" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
1 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list found, expected non-empty"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"bootstrapWitness" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
2 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Expected a non-empty set, but got an empty set"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV1Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
3 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list of scripts is not allowed"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusData" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
4 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list found, expected non-empty"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV2Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
6 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list of scripts is not allowed"
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"plutusV3Script" (Expectation -> Spec)
-> (DecoderError -> Expectation) -> DecoderError -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ToExpr (TxWits era), DecCBOR (Annotator (TxWits era))) =>
Version -> Int -> DecoderError -> Expectation
expectFailureOnTxWitsEmptyFieldWithTag @era Version
version Int
7 (DecoderError -> Spec) -> DecoderError -> Spec
forall a b. (a -> b) -> a -> b
$
        ByteOffset -> String -> DecoderError
decoderFailure ByteOffset
7 String
"Empty list of scripts is not allowed"
    forall era. AlonzoEraTest era => Version -> [Int] -> Spec
txWitsDecodingFailsOnInvalidField @era Version
version [Int
0 .. Int
8]

witsDuplicateVKeyWits :: Enc
witsDuplicateVKeyWits :: Enc
witsDuplicateVKeyWits =
  [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
    [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
1
    , forall a. ToCBOR a => a -> Enc
E @Int Int
0
    , [Enc] -> Enc
Em
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkTag Word
258
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
2
        , Version -> WitVKey Witness -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
shelleyProtVer WitVKey Witness
vkeywit
        , Version -> WitVKey Witness -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
shelleyProtVer WitVKey Witness
vkeywit
        ]
    ]
  where
    vkeywit :: WitVKey Witness
vkeywit = SafeHash EraIndependentTxBody
-> KeyPair (ZonkAny 1) -> WitVKey Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey Witness
mkWitnessVKey (Int -> SafeHash EraIndependentTxBody
forall a. Int -> SafeHash a
mkDummySafeHash Int
0) (Int -> KeyPair (ZonkAny 1)
forall (r :: KeyRole). Int -> KeyPair r
mkKeyPair Int
0)

bootstrapDuplicateWits :: Enc
bootstrapDuplicateWits :: Enc
bootstrapDuplicateWits =
  [Enc] -> Enc
Em
    [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
1
    , forall a. ToCBOR a => a -> Enc
E @Int Int
2
    , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkTag Word
258
    , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
2
    , Enc
bootstrapWitness
    , Enc
bootstrapWitness
    ]
  where
    WitVKey VKey Witness
vkey SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature = SafeHash EraIndependentTxBody
-> KeyPair (ZonkAny 0) -> WitVKey Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey Witness
mkWitnessVKey (Int -> SafeHash EraIndependentTxBody
forall a. Int -> SafeHash a
mkDummySafeHash Int
0) (Int -> KeyPair (ZonkAny 0)
forall (r :: KeyRole). Int -> KeyPair r
mkKeyPair Int
0)
    bootstrapWitness :: Enc
bootstrapWitness =
      [Enc] -> Enc
Em
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
4
        , Version -> VKey Witness -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
shelleyProtVer VKey Witness
vkey
        , Version
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
shelleyProtVer SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature
        , ByteString -> Enc
forall a. ToCBOR a => a -> Enc
E (ByteString -> Enc) -> ByteString -> Enc
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0
        , ByteString -> Enc
forall a. ToCBOR a => a -> Enc
E ByteString
BS.empty
        ]

witsDuplicateNativeScripts :: Enc
witsDuplicateNativeScripts :: Enc
witsDuplicateNativeScripts =
  [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
    [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
1
    , forall a. ToCBOR a => a -> Enc
E @Int Int
1
    , [Enc] -> Enc
Em
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkTag Word
258
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
2
        , Enc
nativeScript
        , Enc
nativeScript
        ]
    ]
  where
    nativeScript :: Enc
nativeScript = [Enc] -> Enc
Em [(Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
2, forall a. ToCBOR a => a -> Enc
E @Int Int
1, (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
0]

witsDuplicatePlutus ::
  forall era l.
  EraPlutusTxInfo l era =>
  SLanguage l -> Enc
witsDuplicatePlutus :: forall era (l :: Language).
EraPlutusTxInfo l era =>
SLanguage l -> Enc
witsDuplicatePlutus SLanguage l
slang =
  [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
    [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
1
    , forall a. ToCBOR a => a -> Enc
E @Int (Int -> Enc) -> Int -> Enc
forall a b. (a -> b) -> a -> b
$ case SLanguage l
slang of
        SLanguage l
SPlutusV1 -> Int
3
        SLanguage l
SPlutusV2 -> Int
6
        SLanguage l
SPlutusV3 -> Int
7
        SLanguage l
SPlutusV4 -> Int
8
    , [Enc] -> Enc
Em
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkTag Word
258
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
2
        , Enc
plutus
        , Enc
plutus
        ]
    ]
  where
    plutus :: Enc
plutus = PlutusBinary -> Enc
forall a. ToCBOR a => a -> Enc
E (PlutusBinary -> Enc)
-> (PlutusScript era -> PlutusBinary) -> PlutusScript era -> Enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScript era -> PlutusBinary
forall era. AlonzoEraScript era => PlutusScript era -> PlutusBinary
plutusScriptBinary (PlutusScript era -> Enc) -> PlutusScript era -> Enc
forall a b. (a -> b) -> a -> b
$ forall era. SupportedLanguage era -> Natural -> PlutusScript era
alwaysSucceedsLang @era (SLanguage l -> SupportedLanguage era
forall (l :: Language) era.
EraPlutusTxInfo l era =>
SLanguage l -> SupportedLanguage era
SupportedLanguage SLanguage l
slang) Natural
0

witsDuplicatePlutusData :: Enc
witsDuplicatePlutusData :: Enc
witsDuplicatePlutusData =
  [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
    [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
1
    , forall a. ToCBOR a => a -> Enc
E @Int Int
4
    , [Enc] -> Enc
Em
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkTag Word
258
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
2
        , Enc
dat
        , Enc
dat
        ]
    ]
  where
    dat :: Enc
dat = forall a. ToCBOR a => a -> Enc
E @Int Int
0

witsDuplicateRedeemers :: Enc
witsDuplicateRedeemers :: Enc
witsDuplicateRedeemers =
  [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
    [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
1
    , forall a. ToCBOR a => a -> Enc
E @Int Int
5
    , [Enc] -> Enc
Em
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
2
        , Enc
redeemer
        , Enc
redeemer
        ]
    ]
  where
    -- [spend, index 10] => [data 20, ex_units [30, 40]]
    redeemer :: Enc
redeemer =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ [Enc] -> Enc
Em [(Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
2, forall a. ToCBOR a => a -> Enc
E @Int Int
0, forall a. ToCBOR a => a -> Enc
E @Int Int
10]
        , [Enc] -> Enc
Em [(Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
2, forall a. ToCBOR a => a -> Enc
E @Int Int
20, [Enc] -> Enc
Em [(Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
2, forall a. ToCBOR a => a -> Enc
E @Int Int
30, forall a. ToCBOR a => a -> Enc
E @Int Int
40]]
        ]

goldenListRedeemersDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenListRedeemersDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenListRedeemersDisallowed Version
version =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding Redeemers encoded as a list fails" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(Redeemers era)
      Version
version
      Enc
listRedeemersEnc
      ( Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
          Text
"Annotator (MemoBytes (RedeemersRaw DijkstraEra))"
          (ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure ByteOffset
0 String
"List encoding of redeemers not supported starting with PV 12")
      )

goldenDuplicateVKeyWitsDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicateVKeyWitsDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicateVKeyWitsDisallowed Version
version =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding a TxWits with duplicate VKeyWits fails" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxWits era)
      Version
version
      Enc
witsDuplicateVKeyWits
      ( Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
          (Proxy (Annotator (TxWits era)) -> Text
forall a. DecCBOR a => Proxy a -> Text
Binary.label (Proxy (Annotator (TxWits era)) -> Text)
-> Proxy (Annotator (TxWits era)) -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Annotator (TxWits era)))
          ( ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure
              ByteOffset
208
              String
"Final number of elements: 1 does not match the total count that was decoded: 2"
          )
      )

goldenBootstrapDuplicateWitsDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenBootstrapDuplicateWitsDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenBootstrapDuplicateWitsDisallowed Version
version =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding a TxWits with duplicate bootstrap witnesses fails" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxWits era)
      Version
version
      Enc
bootstrapDuplicateWits
      ( Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
          (Proxy (Annotator (TxWits era)) -> Text
forall a. DecCBOR a => Proxy a -> Text
Binary.label (Proxy (Annotator (TxWits era)) -> Text)
-> Proxy (Annotator (TxWits era)) -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Annotator (TxWits era)))
          -- Six bytes of framing followed by two 136-byte witnesses.
          ( ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure
              ByteOffset
278
              String
"Final number of elements: 1 does not match the total count that was decoded: 2"
          )
      )

goldenDuplicateNativeScriptsDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicateNativeScriptsDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicateNativeScriptsDisallowed Version
version =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding a TxWits with duplicate native scripts fails" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxWits era)
      Version
version
      Enc
witsDuplicateNativeScripts
      ( Text -> Text -> DecoderError
DecoderErrorCustom
          Text
"Annotator"
          Text
"Duplicates found, expected no duplicates"
      )

goldenDuplicatePlutusScriptsDisallowed ::
  forall era l.
  ( DijkstraEraTest era
  , EraPlutusTxInfo l era
  ) =>
  Version -> SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed :: forall era (l :: Language).
(DijkstraEraTest era, EraPlutusTxInfo l era) =>
Version -> SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed Version
version SLanguage l
slang =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (String
"Decoding a TxWits with duplicate " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SLanguage l -> String
forall a. Show a => a -> String
show SLanguage l
slang String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" scripts fails") (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxWits era)
      Version
version
      (forall era (l :: Language).
EraPlutusTxInfo l era =>
SLanguage l -> Enc
witsDuplicatePlutus @era SLanguage l
slang)
      ( Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
          Text
"Annotator (MemoBytes (AlonzoTxWitsRaw DijkstraEra))"
          ( ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure
              ByteOffset
22
              String
"Final number of elements: 1 does not match the total count that was decoded: 2"
          )
      )

goldenDuplicatePlutusDataDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicatePlutusDataDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicatePlutusDataDisallowed Version
version =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding a TxWits with duplicate plutus data fails" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxWits era)
      Version
version
      Enc
witsDuplicatePlutusData
      ( Text -> Text -> DecoderError
DecoderErrorCustom
          Text
"Annotator"
          Text
"Duplicates found, expected no duplicates"
      )

goldenDuplicateRedeemersDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicateRedeemersDisallowed :: forall era. DijkstraEraTest era => Version -> Spec
goldenDuplicateRedeemersDisallowed Version
version =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding a TxWits with duplicate redeemer keys fails" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxWits era)
      Version
version
      Enc
witsDuplicateRedeemers
      ( Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
          (Proxy (Annotator (TxWits era)) -> Text
forall a. DecCBOR a => Proxy a -> Text
Binary.label (Proxy (Annotator (TxWits era)) -> Text)
-> Proxy (Annotator (TxWits era)) -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Annotator (TxWits era)))
          ( ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure
              ByteOffset
23
              String
"Final number of elements: 1 does not match the total count that was decoded: 2"
          )
      )

goldenSubTransactions :: forall era. DijkstraEraTest era => Spec
goldenSubTransactions :: forall era. DijkstraEraTest era => Spec
goldenSubTransactions = do
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"TxBody with subtransactions decoded as expected" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a b.
(DecCBOR (Annotator a), Eq b, HasCallStack, Show b) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn @(TxBody TopTx era)
      (forall era. Era era => Version
eraProtVerLow @era)
      Enc
txBodySubTransactionsEnc
      ( forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
mkBasicTxBody @era @TopTx
          TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL
            ((OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OMap TxId (Tx SubTx era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tx SubTx era -> OMap TxId (Tx SubTx era)
forall k v. HasOKey k v => v -> OMap k v
OMap.singleton
              (forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @era @SubTx (forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
mkBasicTxBody @era @SubTx))
      )
      TxBody TopTx era -> TxBody TopTx era
forall a. a -> a
id
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtransactions have to be non-empty if the field is present" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxBody TopTx era)
      Version
version
      Enc
txBodyEmptySubTransactionsEnc
      ( Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
          Text
"Annotator (MemoBytes (DijkstraTxBodyRaw TopTx DijkstraEra))"
          (ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure ByteOffset
12 String
"Empty list found, expected non-empty")
      )
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtransactions have to be distinct" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxBody TopTx era)
      Version
version
      Enc
txBodyDuplicateSubTransactionsEnc
      (Text -> Text -> DecoderError
DecoderErrorCustom Text
"Annotator" Text
"Duplicates found, expected no duplicates")
  where
    version :: Version
version = forall era. Era era => Version
eraProtVerLow @era
    txBodyEnc :: Enc
txBodyEnc =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
4
        , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
0, Version -> Set TxIn -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version (Set TxIn -> Enc) -> Set TxIn -> Enc
forall a b. (a -> b) -> a -> b
$ forall a. Set a
Set.empty @TxIn]
        , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
1, Version -> [TxOut era] -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version ([TxOut era] -> Enc) -> [TxOut era] -> Enc
forall a b. (a -> b) -> a -> b
$ [] @(TxOut era)]
        , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
2, Coin -> Enc
forall a. ToCBOR a => a -> Enc
E (Coin -> Enc) -> Coin -> Enc
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
0]
        ]
    txBodySubTransactionsEnc :: Enc
txBodySubTransactionsEnc =
      Enc
txBodyEnc Enc -> Enc -> Enc
forall a. Semigroup a => a -> a -> a
<> [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
23, (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
1), Enc
subTxEnc]
    txBodyEmptySubTransactionsEnc :: Enc
txBodyEmptySubTransactionsEnc =
      Enc
txBodyEnc Enc -> Enc -> Enc
forall a. Semigroup a => a -> a -> a
<> [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
23, (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
0)]
    txBodyDuplicateSubTransactionsEnc :: Enc
txBodyDuplicateSubTransactionsEnc =
      Enc
txBodyEnc Enc -> Enc -> Enc
forall a. Semigroup a => a -> a -> a
<> [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
23, (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
2), Enc
subTxEnc, Enc
subTxEnc]
    subTxEnc :: Enc
subTxEnc =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
3
        , [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
            [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
2
            , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
0, Version -> Set TxIn -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version (Set TxIn -> Enc) -> Set TxIn -> Enc
forall a b. (a -> b) -> a -> b
$ forall a. Set a
Set.empty @TxIn]
            , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
1, Version -> [TxOut era] -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version ([TxOut era] -> Enc) -> [TxOut era] -> Enc
forall a b. (a -> b) -> a -> b
$ [] @(TxOut era)]
            ]
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkMapLen Word
0)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        ]

goldenIsPhase2ValidFlag :: forall era. DijkstraEraTest era => Spec
goldenIsPhase2ValidFlag :: forall era. DijkstraEraTest era => Spec
goldenIsPhase2ValidFlag = do
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Deserialize transactions with missing `isPhase2Valid` flag" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a b.
(DecCBOR (Annotator a), Eq b, HasCallStack, Show b) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn @(Tx TopTx era)
      Version
version
      Enc
txWithoutFlagEnc
      Tx TopTx era
basicValidTx
      Tx TopTx era -> Tx TopTx era
forall a. a -> a
id
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Deserialize transactions with `isPhase2Valid` flag set to true" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a b.
(DecCBOR (Annotator a), Eq b, HasCallStack, Show b) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn @(Tx TopTx era)
      Version
version
      Enc
txWithFlagTrueEnc
      Tx TopTx era
basicValidTx
      Tx TopTx era -> Tx TopTx era
forall a. a -> a
id
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fail to deserialize transactions with `isPhase2Valid` flag set to false" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(Tx TopTx era)
      Version
version
      Enc
txWithFlagFalseEnc
      ( Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
          Text
"Annotator (Tx TopTx DijkstraEra)"
          (ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure ByteOffset
13 String
"Value `false` not allowed for `isPhase2Valid`")
      )
  where
    version :: Version
version = forall era. Era era => Version
eraProtVerLow @era
    basicValidTx :: Tx TopTx era
basicValidTx = forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @era @TopTx (forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
mkBasicTxBody @era @TopTx) Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (IsPhase2Valid -> Identity IsPhase2Valid)
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsPhase2Valid
Lens' (Tx TopTx era) IsPhase2Valid
isPhase2ValidTxL ((IsPhase2Valid -> Identity IsPhase2Valid)
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> IsPhase2Valid -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ IsPhase2Valid
Phase2Valid
    txWithoutFlagEnc :: Enc
txWithoutFlagEnc =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
3
        , Enc
txBodyEnc
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkMapLen Word
0)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        ]
    txWithFlagTrueEnc :: Enc
txWithFlagTrueEnc =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
4
        , Enc
txBodyEnc
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkMapLen Word
0)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Bool -> Tokens -> Tokens
TkBool Bool
True)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        ]
    txWithFlagFalseEnc :: Enc
txWithFlagFalseEnc =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
4
        , Enc
txBodyEnc
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkMapLen Word
0)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Bool -> Tokens -> Tokens
TkBool Bool
False)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        ]
    txBodyEnc :: Enc
txBodyEnc =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
3
        , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
0, Version -> Set TxIn -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version (Set TxIn -> Enc) -> Set TxIn -> Enc
forall a b. (a -> b) -> a -> b
$ forall a. Set a
Set.empty @TxIn]
        , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
1, Version -> [TxOut era] -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version ([TxOut era] -> Enc) -> [TxOut era] -> Enc
forall a b. (a -> b) -> a -> b
$ [] @(TxOut era)]
        , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
2, Coin -> Enc
forall a. ToCBOR a => a -> Enc
E (Coin -> Enc) -> Coin -> Enc
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
0]
        ]

goldenBlockTransaction ::
  forall era. (DijkstraEraTest era, ToExpr (BlockBody era)) => Spec
goldenBlockTransaction :: forall era. (DijkstraEraTest era, ToExpr (BlockBody era)) => Spec
goldenBlockTransaction = do
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Deserialize a block body with a valid transaction" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a b.
(DecCBOR (Annotator a), Eq b, HasCallStack, Show b) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn @(BlockBody era)
      Version
version
      (Bool -> Enc
blockBodyEnc Bool
True)
      (IsPhase2Valid -> BlockBody era
blockBodyWithFlag IsPhase2Valid
Phase2Valid)
      BlockBody era -> BlockBody era
forall a. a -> a
id
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Deserialize a block body with an invalid transaction" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a b.
(DecCBOR (Annotator a), Eq b, HasCallStack, Show b) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn @(BlockBody era)
      Version
version
      (Bool -> Enc
blockBodyEnc Bool
False)
      (IsPhase2Valid -> BlockBody era
blockBodyWithFlag IsPhase2Valid
Phase2Invalid)
      BlockBody era -> BlockBody era
forall a. a -> a
id
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fail to deserialize a block transaction with `isPhase2Valid` before auxiliary data" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(BlockBody era)
      Version
version
      Enc
blockBodyLegacyFlagEnc
      ( Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
          Text
"Annotator (MemoBytes (DijkstraBlockBodyRaw DijkstraEra))"
          (ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure ByteOffset
14 String
"Failed to decode AlonzoTxAuxData")
      )
  -- The transaction encoder does not produce an indefinite-length list, so
  -- these bytes can only be the original ones
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Keep the bytes of a block transaction encoded as an indefinite-length list" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ do
    tx <- Either DecoderError (DijkstraTopTx era) -> IO (DijkstraTopTx era)
forall a b. (HasCallStack, Show a) => Either a b -> IO b
expectRight (Either DecoderError (DijkstraTopTx era) -> IO (DijkstraTopTx era))
-> Either DecoderError (DijkstraTopTx era)
-> IO (DijkstraTopTx era)
forall a b. (a -> b) -> a -> b
$ forall a.
DecCBOR (Annotator a) =>
Version -> Enc -> Either DecoderError a
decodeEnc @(DijkstraTopTx era) Version
version Enc
txInBlockIndefiniteEnc
    originalBytes tx `shouldBe` Plain.serialize' txInBlockIndefiniteEnc
  where
    version :: Version
version = forall era. Era era => Version
eraProtVerLow @era
    blockBodyWithFlag :: IsPhase2Valid -> BlockBody era
blockBodyWithFlag IsPhase2Valid
isPhase2Valid =
      forall era. EraBlockBody era => BlockBody era
mkBasicBlockBody @era
        BlockBody era -> (BlockBody era -> BlockBody era) -> BlockBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (Tx TopTx era) -> Identity (StrictSeq (Tx TopTx era)))
-> BlockBody era -> Identity (BlockBody era)
forall era.
EraBlockBody era =>
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
txSeqBlockBodyL
          ((StrictSeq (Tx TopTx era) -> Identity (StrictSeq (Tx TopTx era)))
 -> BlockBody era -> Identity (BlockBody era))
-> StrictSeq (Tx TopTx era) -> BlockBody era -> BlockBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tx TopTx era -> StrictSeq (Tx TopTx era)
forall a. a -> StrictSeq a
SSeq.singleton
            (forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @era @TopTx (forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
mkBasicTxBody @era @TopTx) Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (IsPhase2Valid -> Identity IsPhase2Valid)
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsPhase2Valid
Lens' (Tx TopTx era) IsPhase2Valid
isPhase2ValidTxL ((IsPhase2Valid -> Identity IsPhase2Valid)
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> IsPhase2Valid -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ IsPhase2Valid
isPhase2Valid)
    blockBodyEnc :: Bool -> Enc
blockBodyEnc Bool
isValid =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
3
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
1
        , Bool -> Enc
txInBlockEnc Bool
isValid
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        ]
    -- The `isPhase2Valid` flag comes after the auxiliary data in a block transaction
    txInBlockEnc :: Bool -> Enc
txInBlockEnc Bool
isPhase2Valid =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
4
        , Enc
txBodyEnc
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkMapLen Word
0)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Bool -> Tokens -> Tokens
TkBool Bool
isPhase2Valid)
        ]
    -- The mempool position of the `isPhase2Valid` flag (before the auxiliary data)
    -- is not allowed in a block transaction
    blockBodyLegacyFlagEnc :: Enc
blockBodyLegacyFlagEnc =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
3
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
1
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkListLen Word
4
        , Enc
txBodyEnc
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkMapLen Word
0)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Bool -> Tokens -> Tokens
TkBool Bool
True)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        ]
    txInBlockIndefiniteEnc :: Enc
txInBlockIndefiniteEnc =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkListBegin
        , Enc
txBodyEnc
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkMapLen Word
0)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkNull
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Bool -> Tokens -> Tokens
TkBool Bool
True)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkBreak
        ]
    txBodyEnc :: Enc
txBodyEnc =
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E ((Tokens -> Tokens) -> Enc) -> (Tokens -> Tokens) -> Enc
forall a b. (a -> b) -> a -> b
$ Word -> Tokens -> Tokens
TkMapLen Word
3
        , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
0, Version -> Set TxIn -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version (Set TxIn -> Enc) -> Set TxIn -> Enc
forall a b. (a -> b) -> a -> b
$ forall a. Set a
Set.empty @TxIn]
        , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
1, Version -> [TxOut era] -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
version ([TxOut era] -> Enc) -> [TxOut era] -> Enc
forall a b. (a -> b) -> a -> b
$ [] @(TxOut era)]
        , [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E @Int Int
2, Coin -> Enc
forall a. ToCBOR a => a -> Enc
E (Coin -> Enc) -> Coin -> Enc
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
0]
        ]