{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Alonzo.Binary.Annotator (
  module Test.Cardano.Ledger.Mary.Binary.Annotator,
) where

import Cardano.Base.Typeable (TypeName (TypeName))
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.BlockBody.Internal
import Cardano.Ledger.Alonzo.Scripts
import Cardano.Ledger.Alonzo.Tx
import Cardano.Ledger.Alonzo.TxAuxData
import Cardano.Ledger.Alonzo.TxBody
import Cardano.Ledger.Alonzo.TxWits
import Cardano.Ledger.Binary
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus
import Cardano.Ledger.Shelley.BlockBody (auxDataSeqDecoder)
import Data.Coerce (coerce)
import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MapExtras as Map (fromElems)
import Data.Maybe.Strict (maybeToStrictMaybe)
import qualified Data.Sequence as Seq
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import Lens.Micro
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Mary.Binary.Annotator
import Test.Cardano.Ledger.Shelley.Arbitrary ()

instance
  ( AlonzoEraTx era
  , DecCBOR (TxBody TopTx era)
  , DecCBOR (TxAuxData era)
  , DecCBOR (TxWits era)
  , DecCBOR (NativeScript era)
  ) =>
  DecCBOR (AlonzoBlockBody era)
  where
  decCBOR :: forall s. Decoder s (AlonzoBlockBody era)
decCBOR = do
    Annotated bodies bodiesBytes <- Decoder s (Seq (TxBody TopTx era))
-> Decoder s (Annotated (Seq (TxBody TopTx era)) ByteString)
forall s a. Decoder s a -> Decoder s (Annotated a ByteString)
decodeAnnotated Decoder s (Seq (TxBody TopTx era))
forall s. Decoder s (Seq (TxBody TopTx era))
forall a s. DecCBOR a => Decoder s a
decCBOR
    Annotated wits witsBytes <- decodeAnnotated decCBOR
    Annotated auxDataMap auxDataBytes <- decodeAnnotated decCBOR
    let bodiesLength = Seq (TxBody TopTx era) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (TxBody TopTx era)
bodies
        inRange Int
x = (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x) Bool -> Bool -> Bool
&& (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int
bodiesLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        witsLength = Seq (TxWits era) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (TxWits era)
wits
    auxData <- auxDataSeqDecoder @(TxAuxData era) bodiesLength auxDataMap
    Annotated isValidIdxs isValidBytes <- decodeAnnotated decCBOR
    let validFlags = Int -> [Int] -> Seq IsValid
alignedValidFlags Int
bodiesLength [Int]
isValidIdxs
    unless (bodiesLength == witsLength) $
      fail $
        "different number of transaction bodies ("
          <> show bodiesLength
          <> ") and witness sets ("
          <> show witsLength
          <> ")"
    unless (all inRange isValidIdxs) $
      fail $
        "Some IsValid index is not in the range: 0 .. "
          ++ show (bodiesLength - 1)
          ++ ", "
          ++ show isValidIdxs

    let mkTx TxBody TopTx era
body TxWits era
wit IsValid
isValid Maybe (TxAuxData era)
aData =
          TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx TxBody TopTx era
body
            Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> TxWits era -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxWits era
wit
            Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData era)
 -> Identity (StrictMaybe (TxAuxData era)))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
auxDataTxL ((StrictMaybe (TxAuxData era)
  -> Identity (StrictMaybe (TxAuxData era)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> StrictMaybe (TxAuxData era) -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (TxAuxData era) -> StrictMaybe (TxAuxData era)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (TxAuxData era)
aData
            Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (IsValid -> Identity IsValid)
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsValid
Lens' (Tx TopTx era) IsValid
isValidTxL ((IsValid -> Identity IsValid)
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> IsValid -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ IsValid
isValid
    let txs =
          Seq (Tx TopTx era) -> StrictSeq (Tx TopTx era)
forall a. Seq a -> StrictSeq a
StrictSeq.forceToStrict (Seq (Tx TopTx era) -> StrictSeq (Tx TopTx era))
-> Seq (Tx TopTx era) -> StrictSeq (Tx TopTx era)
forall a b. (a -> b) -> a -> b
$
            (TxBody TopTx era
 -> TxWits era -> IsValid -> Maybe (TxAuxData era) -> Tx TopTx era)
-> Seq (TxBody TopTx era)
-> Seq (TxWits era)
-> Seq IsValid
-> Seq (Maybe (TxAuxData era))
-> Seq (Tx TopTx era)
forall a b c d e.
(a -> b -> c -> d -> e)
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
Seq.zipWith4 TxBody TopTx era
-> TxWits era -> IsValid -> Maybe (TxAuxData era) -> Tx TopTx era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraTx era) =>
TxBody TopTx era
-> TxWits era -> IsValid -> Maybe (TxAuxData era) -> Tx TopTx era
mkTx Seq (TxBody TopTx era)
bodies Seq (TxWits era)
wits Seq IsValid
validFlags Seq (Maybe (TxAuxData era))
auxData
    pure $
      AlonzoBlockBodyInternal
        txs
        (hashAlonzoSegWits bodiesBytes witsBytes auxDataBytes isValidBytes)
        bodiesBytes
        witsBytes
        auxDataBytes
        isValidBytes

deriving newtype instance DecCBOR (TxBody TopTx AlonzoEra)

instance
  ( Typeable era
  , DecCBOR (TxBody TopTx era)
  , DecCBOR (TxWits era)
  , DecCBOR (TxAuxData era)
  ) =>
  DecCBOR (AlonzoTx TopTx era)
  where
  decCBOR :: forall s. Decoder s (AlonzoTx TopTx era)
decCBOR = Text
-> (AlonzoTx TopTx era -> Int)
-> Decoder s (AlonzoTx TopTx era)
-> Decoder s (AlonzoTx TopTx era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"AlonzoTx" (Int -> AlonzoTx TopTx era -> Int
forall a b. a -> b -> a
const Int
4) (Decoder s (AlonzoTx TopTx era) -> Decoder s (AlonzoTx TopTx era))
-> Decoder s (AlonzoTx TopTx era) -> Decoder s (AlonzoTx TopTx era)
forall a b. (a -> b) -> a -> b
$ do
    body <- Decoder s (TxBody TopTx era)
forall s. Decoder s (TxBody TopTx era)
forall a s. DecCBOR a => Decoder s a
decCBOR
    wits <- decCBOR
    isValid <- decCBOR
    auxData <- decodeNullStrictMaybe decCBOR
    pure $ AlonzoTx body wits isValid auxData
  {-# INLINE decCBOR #-}

instance
  (Era era, Typeable (NativeScript era), DecCBOR (NativeScript era)) =>
  DecCBOR (AlonzoTxAuxDataRaw era)
  where
  decCBOR :: forall s. Decoder s (AlonzoTxAuxDataRaw era)
decCBOR =
    forall t s.
Decoder s t -> Decoder s t -> Decoder s t -> Decoder s t
decodeTxAuxDataByTokenType @(AlonzoTxAuxDataRaw era)
      Decoder s (AlonzoTxAuxDataRaw era)
forall {s} {era}. Decoder s (AlonzoTxAuxDataRaw era)
decodeShelley
      Decoder s (AlonzoTxAuxDataRaw era)
forall s. Decoder s (AlonzoTxAuxDataRaw era)
decodeAllegra
      Decoder s (AlonzoTxAuxDataRaw era)
decodeAlonzo
    where
      decodeShelley :: Decoder s (AlonzoTxAuxDataRaw era)
decodeShelley = do
        metadata <- Decoder s (Map Word64 Metadatum)
forall s. Decoder s (Map Word64 Metadatum)
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure $ AlonzoTxAuxDataRaw metadata StrictSeq.empty Map.empty
      {-# INLINE decodeShelley #-}
      decodeAllegra :: Decoder s (AlonzoTxAuxDataRaw era)
decodeAllegra =
        Text
-> (AlonzoTxAuxDataRaw era -> Int)
-> Decoder s (AlonzoTxAuxDataRaw era)
-> Decoder s (AlonzoTxAuxDataRaw era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"AlonzoTxAuxDataRaw" (Int -> AlonzoTxAuxDataRaw era -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (AlonzoTxAuxDataRaw era)
 -> Decoder s (AlonzoTxAuxDataRaw era))
-> Decoder s (AlonzoTxAuxDataRaw era)
-> Decoder s (AlonzoTxAuxDataRaw era)
forall a b. (a -> b) -> a -> b
$
          Map Word64 Metadatum
-> StrictSeq (NativeScript era)
-> Map Language (NonEmpty PlutusBinary)
-> AlonzoTxAuxDataRaw era
forall era.
Map Word64 Metadatum
-> StrictSeq (NativeScript era)
-> Map Language (NonEmpty PlutusBinary)
-> AlonzoTxAuxDataRaw era
AlonzoTxAuxDataRaw (Map Word64 Metadatum
 -> StrictSeq (NativeScript era)
 -> Map Language (NonEmpty PlutusBinary)
 -> AlonzoTxAuxDataRaw era)
-> Decoder s (Map Word64 Metadatum)
-> Decoder
     s
     (StrictSeq (NativeScript era)
      -> Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map Word64 Metadatum)
forall s. Decoder s (Map Word64 Metadatum)
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder
  s
  (StrictSeq (NativeScript era)
   -> Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era)
-> Decoder s (StrictSeq (NativeScript era))
-> Decoder
     s (Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (StrictSeq (NativeScript era))
forall s. Decoder s (StrictSeq (NativeScript era))
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder
  s (Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era)
-> Decoder s (Map Language (NonEmpty PlutusBinary))
-> Decoder s (AlonzoTxAuxDataRaw era)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Language (NonEmpty PlutusBinary)
-> Decoder s (Map Language (NonEmpty PlutusBinary))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Language (NonEmpty PlutusBinary)
forall k a. Map k a
Map.empty
      {-# INLINE decodeAllegra #-}
      decodeAlonzo :: Decoder s (AlonzoTxAuxDataRaw era)
decodeAlonzo = do
        Word -> Decoder s ()
forall s. Word -> Decoder s ()
assertTag Word
259
        TypeName (AlonzoTxAuxDataRaw era)
-> [(Word, String)]
-> AlonzoTxAuxDataRaw era
-> (AlonzoTxAuxDataRaw era
    -> Word -> Maybe (Decoder s (AlonzoTxAuxDataRaw era)))
-> Decoder s (AlonzoTxAuxDataRaw era)
forall a s.
TypeName a
-> [(Word, String)]
-> a
-> (a -> Word -> Maybe (Decoder s a))
-> Decoder s a
decodeSparseKeyed TypeName (AlonzoTxAuxDataRaw era)
forall a. Typeable a => TypeName a
TypeName [] AlonzoTxAuxDataRaw era
forall era. AlonzoTxAuxDataRaw era
emptyAlonzoTxAuxDataRaw AlonzoTxAuxDataRaw era
-> Word -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
forall s.
AlonzoTxAuxDataRaw era
-> Word -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
decoderByKey
      {-# INLINE decodeAlonzo #-}

      decoderByKey :: AlonzoTxAuxDataRaw era -> Word -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
      decoderByKey :: forall s.
AlonzoTxAuxDataRaw era
-> Word -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
decoderByKey AlonzoTxAuxDataRaw era
acc = \case
        Word
0 -> Decoder s (AlonzoTxAuxDataRaw era)
-> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxAuxDataRaw era)
 -> Maybe (Decoder s (AlonzoTxAuxDataRaw era)))
-> Decoder s (AlonzoTxAuxDataRaw era)
-> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
forall a b. (a -> b) -> a -> b
$ do
          metadata <- Decoder s (Map Word64 Metadatum)
forall s. Decoder s (Map Word64 Metadatum)
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ acc {atadrMetadata = metadata}
        Word
1 -> Decoder s (AlonzoTxAuxDataRaw era)
-> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxAuxDataRaw era)
 -> Maybe (Decoder s (AlonzoTxAuxDataRaw era)))
-> Decoder s (AlonzoTxAuxDataRaw era)
-> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
forall a b. (a -> b) -> a -> b
$ do
          scripts <- Decoder s (StrictSeq (NativeScript era))
forall s. Decoder s (StrictSeq (NativeScript era))
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ acc {atadrNativeScripts = atadrNativeScripts acc <> scripts}
        Word
2 -> Language -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
decodeAddPlutus Language
PlutusV1
        Word
3 -> Language -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
decodeAddPlutus Language
PlutusV2
        Word
4 -> Language -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
decodeAddPlutus Language
PlutusV3
        Word
5 -> Language -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
decodeAddPlutus Language
PlutusV4
        Word
_ -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
forall a. Maybe a
Nothing
        where
          decodeAddPlutus :: Language -> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
decodeAddPlutus Language
lang = Decoder s (AlonzoTxAuxDataRaw era)
-> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxAuxDataRaw era)
 -> Maybe (Decoder s (AlonzoTxAuxDataRaw era)))
-> Decoder s (AlonzoTxAuxDataRaw era)
-> Maybe (Decoder s (AlonzoTxAuxDataRaw era))
forall a b. (a -> b) -> a -> b
$ do
            Language -> Decoder s ()
forall s. Language -> Decoder s ()
guardPlutus Language
lang
            ps <- Decoder s [PlutusBinary]
forall s. Decoder s [PlutusBinary]
forall a s. DecCBOR a => Decoder s a
decCBOR
            pure $ addPlutusScripts lang ps acc
          {-# INLINE decodeAddPlutus #-}
      {-# INLINE decoderByKey #-}

deriving newtype instance (Era era, DecCBOR (NativeScript era)) => DecCBOR (AlonzoTxAuxData era)

instance (AlonzoEraScript era, DecCBOR (NativeScript era)) => DecCBOR (AlonzoTxWitsRaw era) where
  decCBOR :: forall s. Decoder s (AlonzoTxWitsRaw era)
decCBOR = TypeName (AlonzoTxWitsRaw era)
-> [(Word, String)]
-> AlonzoTxWitsRaw era
-> (AlonzoTxWitsRaw era
    -> Word -> Maybe (Decoder s (AlonzoTxWitsRaw era)))
-> Decoder s (AlonzoTxWitsRaw era)
forall a s.
TypeName a
-> [(Word, String)]
-> a
-> (a -> Word -> Maybe (Decoder s a))
-> Decoder s a
decodeSparseKeyed TypeName (AlonzoTxWitsRaw era)
forall a. Typeable a => TypeName a
TypeName [] AlonzoTxWitsRaw era
forall era. AlonzoEraScript era => AlonzoTxWitsRaw era
emptyTxWitsRaw AlonzoTxWitsRaw era
-> Word -> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall s.
AlonzoTxWitsRaw era
-> Word -> Maybe (Decoder s (AlonzoTxWitsRaw era))
decoderByKey
    where
      setDecoder :: (Ord a, DecCBOR a) => Decoder s (Set a)
      setDecoder :: forall a s. (Ord a, DecCBOR a) => Decoder s (Set a)
setDecoder =
        Version
-> Decoder s (Set a) -> Decoder s (Set a) -> Decoder s (Set a)
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
          (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
          ( Word -> Decoder s ()
forall s. Word -> Decoder s ()
allowTag Word
setTag
              Decoder s () -> Decoder s (Set a) -> Decoder s (Set a)
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Version
-> Decoder s (Set a) -> Decoder s (Set a) -> Decoder s (Set a)
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
                (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @12)
                ((a -> Set a -> Set a)
-> (Set a -> (Int, Set a)) -> Decoder s a -> Decoder s (Set a)
forall s a b c.
Monoid b =>
(a -> b -> b) -> (b -> (Int, c)) -> Decoder s a -> Decoder s c
decodeSetLikeEnforceNoDuplicates a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert (\Set a
s -> (Set a -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
s, Set a
s)) Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR)
                ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> (NonEmpty a -> [a]) -> NonEmpty a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty a -> Set a)
-> Decoder s (NonEmpty a) -> Decoder s (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a -> Decoder s (NonEmpty a)
forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR)
          )
          ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> Decoder s [a] -> Decoder s (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a -> Decoder s [a]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR)
      {-# INLINE setDecoder #-}

      addrWitsSetDecoder :: (Ord a, DecCBOR a) => Decoder s (Set a)
      addrWitsSetDecoder :: forall a s. (Ord a, DecCBOR a) => Decoder s (Set a)
addrWitsSetDecoder =
        do
          let
            nonEmptyDecoder :: Decoder s (Set a)
nonEmptyDecoder = do
              Word -> Decoder s ()
forall s. Word -> Decoder s ()
allowTag Word
setTag
              [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> (NonEmpty a -> [a]) -> NonEmpty a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty a -> Set a)
-> Decoder s (NonEmpty a) -> Decoder s (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a -> Decoder s (NonEmpty a)
forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR
            nonEmptyNoDuplicatesDecoder :: Decoder s (Set a)
nonEmptyNoDuplicatesDecoder = do
              s <- (a -> Set a -> Set a)
-> (Set a -> (Int, Set a)) -> Decoder s a -> Decoder s (Set a)
forall s a b c.
Monoid b =>
(a -> b -> b) -> (b -> (Int, c)) -> Decoder s a -> Decoder s c
decodeSetLikeEnforceNoDuplicates a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert (\Set a
s -> (Set a -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
s, Set a
s)) Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR
              when (Set.null s) $ fail "Set cannot be empty"
              pure s
          Version
-> Decoder s (Set a) -> Decoder s (Set a) -> Decoder s (Set a)
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
            (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
            (Version
-> Decoder s (Set a) -> Decoder s (Set a) -> Decoder s (Set a)
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @12) Decoder s (Set a)
forall {s}. Decoder s (Set a)
nonEmptyNoDuplicatesDecoder Decoder s (Set a)
forall {s}. Decoder s (Set a)
nonEmptyDecoder)
            ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> Decoder s [a] -> Decoder s (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a -> Decoder s [a]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR)
      {-# INLINE addrWitsSetDecoder #-}

      decoderByKey :: AlonzoTxWitsRaw era -> Word -> Maybe (Decoder s (AlonzoTxWitsRaw era))
      decoderByKey :: forall s.
AlonzoTxWitsRaw era
-> Word -> Maybe (Decoder s (AlonzoTxWitsRaw era))
decoderByKey AlonzoTxWitsRaw era
acc = \case
        Word
0 -> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxWitsRaw era)
 -> Maybe (Decoder s (AlonzoTxWitsRaw era)))
-> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (Set (WitVKey Witness))
forall a s. (Ord a, DecCBOR a) => Decoder s (Set a)
addrWitsSetDecoder
          pure $ acc {atwrAddrTxWits = x}
        Word
1 -> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxWitsRaw era)
 -> Maybe (Decoder s (AlonzoTxWitsRaw era)))
-> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (Map ScriptHash (Script era))
forall s. Decoder s (Map ScriptHash (Script era))
nativeScriptsDecoder
          pure $ addScriptsTxWitsRaw x acc
        Word
2 -> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxWitsRaw era)
 -> Maybe (Decoder s (AlonzoTxWitsRaw era)))
-> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (Set BootstrapWitness)
forall a s. (Ord a, DecCBOR a) => Decoder s (Set a)
setDecoder
          pure $ acc {atwrBootAddrTxWits = x}
        Word
3 -> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxWitsRaw era)
 -> Maybe (Decoder s (AlonzoTxWitsRaw era)))
-> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a b. (a -> b) -> a -> b
$ do
          x <- SLanguage 'PlutusV1 -> Decoder s (Map ScriptHash (Script era))
forall era (l :: Language) s.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decoder s (Map ScriptHash (Script era))
alonzoPlutusScriptDecoder SLanguage 'PlutusV1
SPlutusV1
          pure $ addScriptsTxWitsRaw x acc
        Word
4 -> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxWitsRaw era)
 -> Maybe (Decoder s (AlonzoTxWitsRaw era)))
-> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (TxDats era)
forall s. Decoder s (TxDats era)
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ acc {atwrDatsTxWits = x}
        Word
5 -> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxWitsRaw era)
 -> Maybe (Decoder s (AlonzoTxWitsRaw era)))
-> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (Redeemers era)
forall s. Decoder s (Redeemers era)
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ acc {atwrRdmrsTxWits = x}
        Word
6 -> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxWitsRaw era)
 -> Maybe (Decoder s (AlonzoTxWitsRaw era)))
-> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a b. (a -> b) -> a -> b
$ do
          x <- SLanguage 'PlutusV2 -> Decoder s (Map ScriptHash (Script era))
forall era (l :: Language) s.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decoder s (Map ScriptHash (Script era))
alonzoPlutusScriptDecoder SLanguage 'PlutusV2
SPlutusV2
          pure $ addScriptsTxWitsRaw x acc
        Word
7 -> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a. a -> Maybe a
Just (Decoder s (AlonzoTxWitsRaw era)
 -> Maybe (Decoder s (AlonzoTxWitsRaw era)))
-> Decoder s (AlonzoTxWitsRaw era)
-> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a b. (a -> b) -> a -> b
$ do
          x <- SLanguage 'PlutusV3 -> Decoder s (Map ScriptHash (Script era))
forall era (l :: Language) s.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decoder s (Map ScriptHash (Script era))
alonzoPlutusScriptDecoder SLanguage 'PlutusV3
SPlutusV3
          pure $ addScriptsTxWitsRaw x acc
        Word
_ -> Maybe (Decoder s (AlonzoTxWitsRaw era))
forall a. Maybe a
Nothing
      {-# INLINE decoderByKey #-}

      noDuplicateNativeScriptsDecoder :: Decoder s (Map ScriptHash (Script era))
      noDuplicateNativeScriptsDecoder :: forall s. Decoder s (Map ScriptHash (Script era))
noDuplicateNativeScriptsDecoder =
        (NativeScript era -> (ScriptHash, Script era))
-> Decoder s (Map ScriptHash (Script era))
forall k a v s.
(Ord k, DecCBOR a) =>
(a -> (k, v)) -> Decoder s (Map k v)
noDuplicateNonEmptySetAsMapDecoder
          (\NativeScript era
ns -> (Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript (Script era -> ScriptHash) -> Script era -> ScriptHash
forall a b. (a -> b) -> a -> b
$ NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript NativeScript era
ns, NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript NativeScript era
ns))
      {-# INLINE noDuplicateNativeScriptsDecoder #-}

      hashedNativeSciptDecoder :: Decoder s (ScriptHash, Script era)
      hashedNativeSciptDecoder :: forall s. Decoder s (ScriptHash, Script era)
hashedNativeSciptDecoder = (\Script era
script -> (Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)) (Script era -> (ScriptHash, Script era))
-> (NativeScript era -> Script era)
-> NativeScript era
-> (ScriptHash, Script era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => NativeScript era -> Script era
fromNativeScript @era (NativeScript era -> (ScriptHash, Script era))
-> Decoder s (NativeScript era)
-> Decoder s (ScriptHash, Script era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (NativeScript era)
forall s. Decoder s (NativeScript era)
forall a s. DecCBOR a => Decoder s a
decCBOR
      {-# INLINE hashedNativeSciptDecoder #-}

      nativeScriptsDecoder :: Decoder s (Map ScriptHash (Script era))
      nativeScriptsDecoder :: forall s. Decoder s (Map ScriptHash (Script era))
nativeScriptsDecoder =
        Version
-> Decoder s (Map ScriptHash (Script era))
-> Decoder s (Map ScriptHash (Script era))
-> Decoder s (Map ScriptHash (Script era))
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
          (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
          ( Version
-> Decoder s (Map ScriptHash (Script era))
-> Decoder s (Map ScriptHash (Script era))
-> Decoder s (Map ScriptHash (Script era))
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
              (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @12)
              Decoder s (Map ScriptHash (Script era))
forall s. Decoder s (Map ScriptHash (Script era))
noDuplicateNativeScriptsDecoder
              ( do
                  Word -> Decoder s ()
forall s. Word -> Decoder s ()
allowTag Word
setTag
                  [(ScriptHash, Script era)] -> Map ScriptHash (Script era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ScriptHash, Script era)] -> Map ScriptHash (Script era))
-> (NonEmpty (ScriptHash, Script era)
    -> [(ScriptHash, Script era)])
-> NonEmpty (ScriptHash, Script era)
-> Map ScriptHash (Script era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (ScriptHash, Script era) -> [(ScriptHash, Script era)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (ScriptHash, Script era) -> Map ScriptHash (Script era))
-> Decoder s (NonEmpty (ScriptHash, Script era))
-> Decoder s (Map ScriptHash (Script era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ScriptHash, Script era)
-> Decoder s (NonEmpty (ScriptHash, Script era))
forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList Decoder s (ScriptHash, Script era)
forall s. Decoder s (ScriptHash, Script era)
hashedNativeSciptDecoder
              )
          )
          ([(ScriptHash, Script era)] -> Map ScriptHash (Script era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ScriptHash, Script era)] -> Map ScriptHash (Script era))
-> Decoder s [(ScriptHash, Script era)]
-> Decoder s (Map ScriptHash (Script era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ScriptHash, Script era)
-> Decoder s [(ScriptHash, Script era)]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (ScriptHash, Script era)
forall s. Decoder s (ScriptHash, Script era)
pairDecoder)
        where
          pairDecoder :: Decoder s (ScriptHash, Script era)
          pairDecoder :: forall s. Decoder s (ScriptHash, Script era)
pairDecoder = Script era -> (ScriptHash, Script era)
forall era. EraScript era => Script era -> (ScriptHash, Script era)
asHashedScriptPair (Script era -> (ScriptHash, Script era))
-> (NativeScript era -> Script era)
-> NativeScript era
-> (ScriptHash, Script era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript era -> (ScriptHash, Script era))
-> Decoder s (NativeScript era)
-> Decoder s (ScriptHash, Script era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (NativeScript era)
forall s. Decoder s (NativeScript era)
forall a s. DecCBOR a => Decoder s a
decCBOR
      {-# INLINE nativeScriptsDecoder #-}

deriving newtype instance
  (AlonzoEraScript era, DecCBOR (NativeScript era)) =>
  DecCBOR (AlonzoTxWits era)

instance AlonzoEraScript era => DecCBOR (RedeemersRaw era) where
  decCBOR :: forall s. Decoder s (RedeemersRaw era)
decCBOR =
    Version
-> Decoder s (RedeemersRaw era)
-> Decoder s (RedeemersRaw era)
-> Decoder s (RedeemersRaw era)
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
      (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
      ( Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s (RedeemersRaw era))
-> Decoder s (RedeemersRaw era)
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          TokenType
TypeMapLenIndef -> Decoder s (RedeemersRaw era)
forall s. Decoder s (RedeemersRaw era)
decodeMapRedeemers
          TokenType
TypeMapLen -> Decoder s (RedeemersRaw era)
forall s. Decoder s (RedeemersRaw era)
decodeMapRedeemers
          TokenType
_ ->
            Version
-> Decoder s (RedeemersRaw era)
-> Decoder s (RedeemersRaw era)
-> Decoder s (RedeemersRaw era)
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
              (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @12)
              (String -> Decoder s (RedeemersRaw era)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"List encoding of redeemers not supported starting with PV 12")
              Decoder s (RedeemersRaw era)
forall s. Decoder s (RedeemersRaw era)
decodeListRedeemers
      )
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
forall era.
Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
RedeemersRaw (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> RedeemersRaw era)
-> ([(PlutusPurpose AsIx era, (Data era, ExUnits))]
    -> Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> RedeemersRaw era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PlutusPurpose AsIx era, (Data era, ExUnits))]
 -> RedeemersRaw era)
-> Decoder s [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> Decoder s (RedeemersRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Decoder s [(PlutusPurpose AsIx era, (Data era, ExUnits))]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
forall s. Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
decodeElement)
    where
      decodeMapRedeemers :: Decoder s (RedeemersRaw era)
      decodeMapRedeemers :: forall s. Decoder s (RedeemersRaw era)
decodeMapRedeemers =
        Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
forall era.
Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
RedeemersRaw (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> RedeemersRaw era)
-> (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
    -> Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
-> RedeemersRaw era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PlutusPurpose AsIx era, (Data era, ExUnits))]
 -> Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
    -> [(PlutusPurpose AsIx era, (Data era, ExUnits))])
-> NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
 -> RedeemersRaw era)
-> Decoder
     s (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits)))
-> Decoder s (RedeemersRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
          (_, xs) <- Decoder s (Maybe Int)
-> ((PlutusPurpose AsIx era, (Data era, ExUnits))
    -> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
    -> [(PlutusPurpose AsIx era, (Data era, ExUnits))])
-> ([(PlutusPurpose AsIx era, (Data era, ExUnits))]
    -> Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits)))
-> Decoder s (Int, [(PlutusPurpose AsIx era, (Data era, ExUnits))])
forall s a b.
Monoid b =>
Decoder s (Maybe Int)
-> (a -> b -> b) -> (b -> Decoder s a) -> Decoder s (Int, b)
decodeListLikeWithCount Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef (:) (([(PlutusPurpose AsIx era, (Data era, ExUnits))]
  -> Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits)))
 -> Decoder
      s (Int, [(PlutusPurpose AsIx era, (Data era, ExUnits))]))
-> ([(PlutusPurpose AsIx era, (Data era, ExUnits))]
    -> Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits)))
-> Decoder s (Int, [(PlutusPurpose AsIx era, (Data era, ExUnits))])
forall a b. (a -> b) -> a -> b
$ \[(PlutusPurpose AsIx era, (Data era, ExUnits))]
_ -> do
            ptr <- Decoder s (PlutusPurpose AsIx era)
forall s. Decoder s (PlutusPurpose AsIx era)
forall a s. DecCBOR a => Decoder s a
decCBOR
            (annData, exUnits) <- decCBOR
            pure (ptr, (annData, exUnits))
          case NE.nonEmpty xs of
            Maybe (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits)))
Nothing -> String
-> Decoder
     s (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits)))
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected redeemers map to be non-empty"
            Just NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
neList -> NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Decoder
     s (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits)))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
 -> Decoder
      s (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))))
-> NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Decoder
     s (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits)))
forall a b. (a -> b) -> a -> b
$ NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
-> NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
neList
      {-# INLINE decodeMapRedeemers #-}
      decodeListRedeemers :: Decoder s (RedeemersRaw era)
      decodeListRedeemers :: forall s. Decoder s (RedeemersRaw era)
decodeListRedeemers =
        Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
forall era.
Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
RedeemersRaw (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> RedeemersRaw era)
-> (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
    -> Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
-> RedeemersRaw era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PlutusPurpose AsIx era, (Data era, ExUnits))]
 -> Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
    -> [(PlutusPurpose AsIx era, (Data era, ExUnits))])
-> NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
forall a. NonEmpty a -> [a]
NE.toList
          (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits))
 -> RedeemersRaw era)
-> Decoder
     s (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits)))
-> Decoder s (RedeemersRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Decoder
     s (NonEmpty (PlutusPurpose AsIx era, (Data era, ExUnits)))
forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
forall s. Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
decodeElement
      {-# INLINE decodeListRedeemers #-}
      decodeElement :: Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
      decodeElement :: forall s. Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
decodeElement = do
        let redeemerLen :: (a, b) -> Int
redeemerLen (a
redeemerPtr, b
_) = Maybe a -> Int
forall (proxy :: * -> *) a. EncCBORGroup a => proxy a -> Int
listLenInt (a -> Maybe a
forall a. a -> Maybe a
Just a
redeemerPtr) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        Text
-> ((PlutusPurpose AsIx era, (Data era, ExUnits)) -> Int)
-> Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Decoder s (PlutusPurpose AsIx era, (Data era, ExUnits))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Redeemer" (PlutusPurpose AsIx era, (Data era, ExUnits)) -> Int
forall {a} {b}. EncCBORGroup a => (a, b) -> Int
redeemerLen do
          !redeemerPtr <- Decoder s (PlutusPurpose AsIx era)
forall s. Decoder s (PlutusPurpose AsIx era)
forall a s. DecCBORGroup a => Decoder s a
decCBORGroup
          !redeemerData <- decCBOR
          !redeemerExUnits <- decCBOR
          pure (redeemerPtr, (redeemerData, redeemerExUnits))
      {-# INLINE decodeElement #-}
  {-# INLINE decCBOR #-}

deriving newtype instance AlonzoEraScript era => DecCBOR (Redeemers era)

instance (AlonzoEraScript era, DecCBOR (NativeScript era)) => DecCBOR (AlonzoScript era) where
  decCBOR :: forall s. Decoder s (AlonzoScript era)
decCBOR = Text
-> (Word -> Decoder s (Int, AlonzoScript era))
-> Decoder s (AlonzoScript era)
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"AlonzoScript" ((Word -> Decoder s (Int, AlonzoScript era))
 -> Decoder s (AlonzoScript era))
-> (Word -> Decoder s (Int, AlonzoScript era))
-> Decoder s (AlonzoScript era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> do
      ns <- Decoder s (NativeScript era)
forall s. Decoder s (NativeScript era)
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, NativeScript ns)
    Word
1 -> SLanguage 'PlutusV1 -> Decoder s (Int, AlonzoScript era)
forall {era} {l :: Language} {a} {s}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era, PlutusLanguage l, Num a) =>
SLanguage l -> Decoder s (a, AlonzoScript era)
decodePlutusVariant SLanguage 'PlutusV1
SPlutusV1
    Word
2 -> SLanguage 'PlutusV2 -> Decoder s (Int, AlonzoScript era)
forall {era} {l :: Language} {a} {s}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era, PlutusLanguage l, Num a) =>
SLanguage l -> Decoder s (a, AlonzoScript era)
decodePlutusVariant SLanguage 'PlutusV2
SPlutusV2
    Word
3 -> SLanguage 'PlutusV3 -> Decoder s (Int, AlonzoScript era)
forall {era} {l :: Language} {a} {s}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era, PlutusLanguage l, Num a) =>
SLanguage l -> Decoder s (a, AlonzoScript era)
decodePlutusVariant SLanguage 'PlutusV3
SPlutusV3
    Word
4 -> SLanguage 'PlutusV4 -> Decoder s (Int, AlonzoScript era)
forall {era} {l :: Language} {a} {s}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era, PlutusLanguage l, Num a) =>
SLanguage l -> Decoder s (a, AlonzoScript era)
decodePlutusVariant SLanguage 'PlutusV4
SPlutusV4
    Word
n -> Word -> Decoder s (Int, AlonzoScript era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
n
    where
      decodePlutusVariant :: SLanguage l -> Decoder s (a, AlonzoScript era)
decodePlutusVariant SLanguage l
slang = do
        ps <- SLanguage l -> Decoder s (PlutusScript era)
forall era (l :: Language) s.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decoder s (PlutusScript era)
decodePlutusScript SLanguage l
slang
        pure (2, PlutusScript ps)
      {-# INLINE decodePlutusVariant #-}

-- | Decodes a set of `a`'s and maps a function over it to get key-value pairs.
-- If the key-value pairs create a non-empty Map without duplicates, then that map is returned,
-- otherwise fail
noDuplicateNonEmptySetAsMapDecoder ::
  (Ord k, DecCBOR a) =>
  (a -> (k, v)) ->
  Decoder s (Map k v)
noDuplicateNonEmptySetAsMapDecoder :: forall k a v s.
(Ord k, DecCBOR a) =>
(a -> (k, v)) -> Decoder s (Map k v)
noDuplicateNonEmptySetAsMapDecoder a -> (k, v)
toKV = do
  Word -> Decoder s ()
forall s. Word -> Decoder s ()
allowTag Word
setTag
  vals <- Decoder s a -> Decoder s [a]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR
  go (Map.empty, 0) vals
  where
    go :: (Map k v, Int) -> [a] -> Decoder s (Map k v)
go (Map k v
m, Int
n) []
      | Map k v -> Bool
forall k a. Map k a -> Bool
Map.null Map k v
m = String -> Decoder s (Map k v)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty script Set is not allowed"
      | Map k v -> Int
forall a. Map k a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map k v
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n = String -> Decoder s (Map k v)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Duplicate elements in the scripts Set were encountered"
      | Bool
otherwise = Map k v -> Decoder s (Map k v)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k v
m
    go (!Map k v
m, !Int
n) (a
x : [a]
xs) = do
      let (k
k, v
v) = a -> (k, v)
toKV a
x
      (Map k v, Int) -> [a] -> Decoder s (Map k v)
go (k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k v
v Map k v
m, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs

instance Era era => DecCBOR (TxDatsRaw era) where
  decCBOR :: forall s. Decoder s (TxDatsRaw era)
decCBOR =
    Version
-> Decoder s (TxDatsRaw era)
-> Decoder s (TxDatsRaw era)
-> Decoder s (TxDatsRaw era)
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
      (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
      ( Version
-> Decoder s (TxDatsRaw era)
-> Decoder s (TxDatsRaw era)
-> Decoder s (TxDatsRaw era)
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
          (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @12)
          Decoder s (TxDatsRaw era)
forall s. Decoder s (TxDatsRaw era)
noDuplicatesDatsDecoder
          ( Word -> Decoder s ()
forall s. Word -> Decoder s ()
allowTag Word
setTag
              Decoder s ()
-> Decoder s (TxDatsRaw era) -> Decoder s (TxDatsRaw era)
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Map DataHash (Data era) -> TxDatsRaw era
forall era. Map DataHash (Data era) -> TxDatsRaw era
TxDatsRaw (Map DataHash (Data era) -> TxDatsRaw era)
-> (NonEmpty (Data era) -> Map DataHash (Data era))
-> NonEmpty (Data era)
-> TxDatsRaw era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Data era -> DataHash) -> [Data era] -> Map DataHash (Data era)
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
Map.fromElems Data era -> DataHash
forall era. Data era -> DataHash
hashData ([Data era] -> Map DataHash (Data era))
-> (NonEmpty (Data era) -> [Data era])
-> NonEmpty (Data era)
-> Map DataHash (Data era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Data era) -> [Data era]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (Data era) -> TxDatsRaw era)
-> Decoder s (NonEmpty (Data era)) -> Decoder s (TxDatsRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Data era) -> Decoder s (NonEmpty (Data era))
forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList Decoder s (Data era)
forall s. Decoder s (Data era)
forall a s. DecCBOR a => Decoder s a
decCBOR
          )
      )
      (Map DataHash (Data era) -> TxDatsRaw era
forall era. Map DataHash (Data era) -> TxDatsRaw era
TxDatsRaw (Map DataHash (Data era) -> TxDatsRaw era)
-> ([Data era] -> Map DataHash (Data era))
-> [Data era]
-> TxDatsRaw era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Data era -> DataHash) -> [Data era] -> Map DataHash (Data era)
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
Map.fromElems Data era -> DataHash
forall era. Data era -> DataHash
hashData ([Data era] -> TxDatsRaw era)
-> Decoder s [Data era] -> Decoder s (TxDatsRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Data era) -> Decoder s [Data era]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Data era)
forall s. Decoder s (Data era)
forall a s. DecCBOR a => Decoder s a
decCBOR)
    where
      noDuplicatesDatsDecoder :: Decoder s (TxDatsRaw era)
      noDuplicatesDatsDecoder :: forall s. Decoder s (TxDatsRaw era)
noDuplicatesDatsDecoder =
        Decoder s (Map DataHash (Data era)) -> Decoder s (TxDatsRaw era)
forall a b. Coercible a b => a -> b
coerce (Decoder s (Map DataHash (Data era)) -> Decoder s (TxDatsRaw era))
-> ((Data era -> (DataHash, Data era))
    -> Decoder s (Map DataHash (Data era)))
-> (Data era -> (DataHash, Data era))
-> Decoder s (TxDatsRaw era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Data era -> (DataHash, Data era))
-> Decoder s (Map DataHash (Data era))
forall k a v s.
(Ord k, DecCBOR a) =>
(a -> (k, v)) -> Decoder s (Map k v)
noDuplicateNonEmptySetAsMapDecoder ((Data era -> (DataHash, Data era)) -> Decoder s (TxDatsRaw era))
-> (Data era -> (DataHash, Data era)) -> Decoder s (TxDatsRaw era)
forall a b. (a -> b) -> a -> b
$ \Data era
dat -> (Data era -> DataHash
forall era. Data era -> DataHash
hashData Data era
dat, Data era
dat)
  {-# INLINE decCBOR #-}

deriving newtype instance Era era => DecCBOR (TxDats era)

deriving newtype instance DecCBOR (Tx TopTx AlonzoEra)