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

module Test.Cardano.Ledger.Dijkstra.Binary.Golden (
  spec,
) 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 (DecoderError (..), DeserialiseFailure (..), Tokens (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.TxCert (Delegatee (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.TxBody
import Cardano.Ledger.Plutus (SLanguage (..))
import Cardano.Ledger.TxIn (TxIn (..))
import qualified Data.OMap.Strict as OMap
import qualified Data.Set as Set
import Lens.Micro
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysSucceedsLang)
import Test.Cardano.Ledger.Binary.Plain.Golden (Enc (..))
import Test.Cardano.Ledger.Common (Spec, describe, it)
import Test.Cardano.Ledger.Conway.Binary.Golden
import Test.Cardano.Ledger.Core.KeyPair (mkKeyHash, mkKeyPair, mkWitnessVKey)
import Test.Cardano.Ledger.Core.Utils (mkDummySafeHash)
import Test.Cardano.Ledger.Dijkstra.Era (DijkstraEraTest)

spec :: forall era. DijkstraEraTest era => Spec
spec :: forall era. DijkstraEraTest era => Spec
spec = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Golden" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  forall era. DijkstraEraTest era => Spec
goldenListRedeemersDisallowed @era
  forall era. DijkstraEraTest era => Spec
goldenDuplicateCertsDisallowed @era
  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 => Spec
goldenDuplicateVKeyWitsDisallowed @era
    forall era. DijkstraEraTest era => Spec
goldenDuplicateNativeScriptsDisallowed @era
    forall era (l :: Language).
(DijkstraEraTest era, EraPlutusTxInfo l era) =>
SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed @era SLanguage 'PlutusV1
SPlutusV1
    forall era (l :: Language).
(DijkstraEraTest era, EraPlutusTxInfo l era) =>
SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed @era SLanguage 'PlutusV2
SPlutusV2
    forall era (l :: Language).
(DijkstraEraTest era, EraPlutusTxInfo l era) =>
SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed @era SLanguage 'PlutusV3
SPlutusV3
    forall era. DijkstraEraTest era => Spec
goldenDuplicatePlutusDataDisallowed @era
    forall era. DijkstraEraTest era => Spec
goldenSubTransactions @era

duplicateCertsTx :: forall era. DijkstraEraTest era => Version -> Enc
duplicateCertsTx :: forall era. DijkstraEraTest era => Version -> Enc
duplicateCertsTx Version
v =
  [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
v (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
v ([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]
    , [Enc] -> Enc
Em
        [ 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
            , Version -> TxCert era -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
v TxCert era
cert
            , Version -> TxCert era -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
v TxCert era
cert
            ]
        ]
    ]
  where
    cert :: TxCert era
cert = forall era.
ConwayEraTxCert era =>
Credential Staking -> Delegatee -> TxCert era
DelegTxCert @era (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Int -> KeyHash Staking
forall (kd :: KeyRole). Int -> KeyHash kd
mkKeyHash Int
0)) (KeyHash StakePool -> Delegatee
DelegStake (Int -> KeyHash StakePool
forall (kd :: KeyRole). Int -> KeyHash kd
mkKeyHash Int
1))

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
        , WitVKey Witness -> Enc
forall a. ToCBOR a => a -> Enc
E WitVKey Witness
vkeywit
        , WitVKey Witness -> Enc
forall a. ToCBOR a => a -> Enc
E WitVKey Witness
vkeywit
        ]
    ]
  where
    vkeywit :: WitVKey Witness
vkeywit = 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)

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
        -- TODO add PlutusV4 support once the CDDL for TxWits is updated to include V4 scripts
        SLanguage l
l -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"Unsupported plutus version: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SLanguage l -> String
forall a. Show a => a -> String
show SLanguage l
l
    , [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

goldenListRedeemersDisallowed :: forall era. DijkstraEraTest era => Spec
goldenListRedeemersDisallowed :: forall era. DijkstraEraTest era => Spec
goldenListRedeemersDisallowed =
  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), Typeable a, HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(Redeemers era)
      (forall era. Era era => Version
eraProtVerLow @era)
      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")
      )

goldenDuplicateCertsDisallowed :: forall era. DijkstraEraTest era => Spec
goldenDuplicateCertsDisallowed :: forall era. DijkstraEraTest era => Spec
goldenDuplicateCertsDisallowed =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding a transaction body with duplicate certificates fails" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a.
(ToExpr a, DecCBOR (Annotator a), Typeable a, HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxBody TopTx era)
      Version
version
      (forall era. DijkstraEraTest era => Version -> Enc
duplicateCertsTx @era Version
version)
      ( Text -> DeserialiseFailure -> DecoderError
DecoderErrorDeserialiseFailure
          Text
"Annotator (MemoBytes (DijkstraTxBodyRaw TopTx DijkstraEra))"
          ( ByteOffset -> String -> DeserialiseFailure
DeserialiseFailure
              ByteOffset
143
              String
"Final number of elements: 1 does not match the total count that was decoded: 2"
          )
      )
  where
    version :: Version
version = forall era. Era era => Version
eraProtVerLow @era

goldenDuplicateVKeyWitsDisallowed :: forall era. DijkstraEraTest era => Spec
goldenDuplicateVKeyWitsDisallowed :: forall era. DijkstraEraTest era => Spec
goldenDuplicateVKeyWitsDisallowed =
  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), Typeable a, HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxWits era)
      (forall era. Era era => Version
eraProtVerLow @era)
      Enc
witsDuplicateVKeyWits
      (Text -> Text -> DecoderError
DecoderErrorCustom Text
"Annotator" Text
"Duplicates found, expected no duplicates")

goldenDuplicateNativeScriptsDisallowed :: forall era. DijkstraEraTest era => Spec
goldenDuplicateNativeScriptsDisallowed :: forall era. DijkstraEraTest era => Spec
goldenDuplicateNativeScriptsDisallowed =
  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), Typeable 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"
      )
  where
    version :: Version
version = forall era. Era era => Version
eraProtVerLow @era

goldenDuplicatePlutusScriptsDisallowed ::
  forall era l.
  ( DijkstraEraTest era
  , EraPlutusTxInfo l era
  ) =>
  SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed :: forall era (l :: Language).
(DijkstraEraTest era, EraPlutusTxInfo l era) =>
SLanguage l -> Spec
goldenDuplicatePlutusScriptsDisallowed 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), Typeable a, HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxWits era)
      (forall era. Era era => Version
eraProtVerLow @era)
      (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 => Spec
goldenDuplicatePlutusDataDisallowed :: forall era. DijkstraEraTest era => Spec
goldenDuplicatePlutusDataDisallowed =
  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), Typeable a, HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn @(TxWits era)
      (forall era. Era era => Version
eraProtVerLow @era)
      Enc
witsDuplicatePlutusData
      ( Text -> Text -> DecoderError
DecoderErrorCustom
          Text
"Annotator"
          Text
"Duplicates found, expected no duplicates"
      )

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.
(ToExpr b, DecCBOR (Annotator a), Eq b, HasCallStack) =>
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), Typeable 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), Typeable 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
        ]