{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Cardano.Ledger.Alonzo.TxAuxData (
  -- * AlonzoTxAuxData
  AlonzoTxAuxData (
    MkAlonzoTxAuxData,
    AlonzoTxAuxData,
    AlonzoTxAuxData',
    atadMetadata,
    atadNativeScripts,
    atadPlutus,
    atadMetadata',
    atadNativeScripts',
    atadPlutus'
  ),
  AlonzoEraTxAuxData (..),
  AlonzoTxAuxDataRaw (..),
  mkAlonzoTxAuxData,
  hashAlonzoTxAuxData,
  validateAlonzoTxAuxData,
  getAlonzoTxAuxDataScripts,
  metadataAlonzoTxAuxDataL,
  nativeScriptsAlonzoTxAuxDataL,
  plutusScriptsAllegraTxAuxDataL,
  addPlutusScripts,
  decodeTxAuxDataByTokenType,
  emptyAlonzoTxAuxDataRaw,
) where

import Cardano.Ledger.Allegra.TxAuxData (AllegraEraTxAuxData (..))
import Cardano.Ledger.Alonzo.Era
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoEraScript (..),
  AlonzoScript (..),
  mkBinaryPlutusScript,
  plutusScriptBinary,
  plutusScriptLanguage,
  validScript,
 )
import Cardano.Ledger.BaseTypes (ProtVer)
import Cardano.Ledger.Binary (
  Annotator,
  DecCBOR (..),
  Decoder,
  EncCBOR (..),
  ToCBOR,
  TokenType (..),
  decodeStrictSeq,
  peekTokenType,
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Core
import Cardano.Ledger.MemoBytes (
  EqRaw,
  Mem,
  MemoBytes (..),
  MemoHashIndex,
  Memoized (RawType),
  getMemoRawType,
  getMemoSafeHash,
  lensMemoRawType,
  mkMemoizedEra,
 )
import Cardano.Ledger.Plutus.Language (Language (..), PlutusBinary (..), guardPlutus)
import Cardano.Ledger.Shelley.TxAuxData (Metadatum, validMetadatum)
import Control.DeepSeq (NFData, deepseq)
import Data.List (intercalate)
import qualified Data.List.NonEmpty as NE
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (isNothing, mapMaybe)
import Data.Sequence.Strict (StrictSeq ((:<|)))
import qualified Data.Sequence.Strict as StrictSeq
import Data.Typeable (Typeable)
import Data.Word (Word64)
import GHC.Generics (Generic)
import GHC.Stack
import Lens.Micro (Lens')
import NoThunks.Class (InspectHeapNamed (..), NoThunks)

class AllegraEraTxAuxData era => AlonzoEraTxAuxData era where
  plutusScriptsTxAuxDataL :: Lens' (TxAuxData era) (Map Language (NE.NonEmpty PlutusBinary))

data AlonzoTxAuxDataRaw era = AlonzoTxAuxDataRaw
  { forall era. AlonzoTxAuxDataRaw era -> Map Word64 Metadatum
atadrMetadata :: !(Map Word64 Metadatum)
  , forall era. AlonzoTxAuxDataRaw era -> StrictSeq (NativeScript era)
atadrNativeScripts :: !(StrictSeq (NativeScript era))
  , forall era.
AlonzoTxAuxDataRaw era -> Map Language (NonEmpty PlutusBinary)
atadrPlutus :: !(Map Language (NE.NonEmpty PlutusBinary))
  }
  deriving ((forall x.
 AlonzoTxAuxDataRaw era -> Rep (AlonzoTxAuxDataRaw era) x)
-> (forall x.
    Rep (AlonzoTxAuxDataRaw era) x -> AlonzoTxAuxDataRaw era)
-> Generic (AlonzoTxAuxDataRaw era)
forall x. Rep (AlonzoTxAuxDataRaw era) x -> AlonzoTxAuxDataRaw era
forall x. AlonzoTxAuxDataRaw era -> Rep (AlonzoTxAuxDataRaw era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (AlonzoTxAuxDataRaw era) x -> AlonzoTxAuxDataRaw era
forall era x.
AlonzoTxAuxDataRaw era -> Rep (AlonzoTxAuxDataRaw era) x
$cfrom :: forall era x.
AlonzoTxAuxDataRaw era -> Rep (AlonzoTxAuxDataRaw era) x
from :: forall x. AlonzoTxAuxDataRaw era -> Rep (AlonzoTxAuxDataRaw era) x
$cto :: forall era x.
Rep (AlonzoTxAuxDataRaw era) x -> AlonzoTxAuxDataRaw era
to :: forall x. Rep (AlonzoTxAuxDataRaw era) x -> AlonzoTxAuxDataRaw era
Generic)

deriving instance Eq (NativeScript era) => Eq (AlonzoTxAuxDataRaw era)

deriving instance Show (NativeScript era) => Show (AlonzoTxAuxDataRaw era)

instance NFData (NativeScript era) => NFData (AlonzoTxAuxDataRaw era)

deriving via
  InspectHeapNamed "AlonzoTxAuxDataRaw" (AlonzoTxAuxDataRaw era)
  instance
    NoThunks (AlonzoTxAuxDataRaw era)

-- | Encodes memoized bytes created upon construction.
instance Era era => EncCBOR (AlonzoTxAuxData era)

instance (Era era, EncCBOR (NativeScript era)) => EncCBOR (AlonzoTxAuxDataRaw era) where
  encCBOR :: AlonzoTxAuxDataRaw era -> Encoding
encCBOR AlonzoTxAuxDataRaw {Map Word64 Metadatum
atadrMetadata :: forall era. AlonzoTxAuxDataRaw era -> Map Word64 Metadatum
atadrMetadata :: Map Word64 Metadatum
atadrMetadata, StrictSeq (NativeScript era)
atadrNativeScripts :: forall era. AlonzoTxAuxDataRaw era -> StrictSeq (NativeScript era)
atadrNativeScripts :: StrictSeq (NativeScript era)
atadrNativeScripts, Map Language (NonEmpty PlutusBinary)
atadrPlutus :: forall era.
AlonzoTxAuxDataRaw era -> Map Language (NonEmpty PlutusBinary)
atadrPlutus :: Map Language (NonEmpty PlutusBinary)
atadrPlutus} =
    Encode ('Closed 'Sparse) (AlonzoTxAuxDataRaw era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Sparse) (AlonzoTxAuxDataRaw era) -> Encoding)
-> Encode ('Closed 'Sparse) (AlonzoTxAuxDataRaw era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      Word
-> Encode ('Closed 'Sparse) (AlonzoTxAuxDataRaw era)
-> Encode ('Closed 'Sparse) (AlonzoTxAuxDataRaw era)
forall (x :: Density) t.
Word -> Encode ('Closed x) t -> Encode ('Closed x) t
Tag Word
259 (Encode ('Closed 'Sparse) (AlonzoTxAuxDataRaw era)
 -> Encode ('Closed 'Sparse) (AlonzoTxAuxDataRaw era))
-> Encode ('Closed 'Sparse) (AlonzoTxAuxDataRaw era)
-> Encode ('Closed 'Sparse) (AlonzoTxAuxDataRaw era)
forall a b. (a -> b) -> a -> b
$
        (Map Word64 Metadatum
 -> StrictSeq (NativeScript era)
 -> Maybe (NonEmpty PlutusBinary)
 -> Maybe (NonEmpty PlutusBinary)
 -> Maybe (NonEmpty PlutusBinary)
 -> Maybe (NonEmpty PlutusBinary)
 -> AlonzoTxAuxDataRaw era)
-> Encode
     ('Closed 'Sparse)
     (Map Word64 Metadatum
      -> StrictSeq (NativeScript era)
      -> Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> AlonzoTxAuxDataRaw era)
forall t. t -> Encode ('Closed 'Sparse) t
Keyed
          ( \Map Word64 Metadatum
m StrictSeq (NativeScript era)
ts Maybe (NonEmpty PlutusBinary)
mps1 Maybe (NonEmpty PlutusBinary)
mps2 Maybe (NonEmpty PlutusBinary)
mps3 Maybe (NonEmpty PlutusBinary)
mps4 ->
              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
m StrictSeq (NativeScript era)
ts (Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era)
-> Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era
forall a b. (a -> b) -> a -> b
$
                [(Language, NonEmpty PlutusBinary)]
-> Map Language (NonEmpty PlutusBinary)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [ (Language
pv, NonEmpty PlutusBinary
ps)
                  | (Language
pv, Just NonEmpty PlutusBinary
ps) <-
                      [ (Language
PlutusV1, Maybe (NonEmpty PlutusBinary)
mps1)
                      , (Language
PlutusV2, Maybe (NonEmpty PlutusBinary)
mps2)
                      , (Language
PlutusV3, Maybe (NonEmpty PlutusBinary)
mps3)
                      , (Language
PlutusV4, Maybe (NonEmpty PlutusBinary)
mps4)
                      ]
                  ]
          )
          Encode
  ('Closed 'Sparse)
  (Map Word64 Metadatum
   -> StrictSeq (NativeScript era)
   -> Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> AlonzoTxAuxDataRaw era)
-> Encode ('Closed 'Sparse) (Map Word64 Metadatum)
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (NativeScript era)
      -> Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> AlonzoTxAuxDataRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Map Word64 Metadatum -> Bool)
-> Encode ('Closed 'Sparse) (Map Word64 Metadatum)
-> Encode ('Closed 'Sparse) (Map Word64 Metadatum)
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Map Word64 Metadatum -> Bool
forall a. Map Word64 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (Map Word64 Metadatum)
-> Encode ('Closed 'Sparse) (Map Word64 Metadatum)
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 (Encode ('Closed 'Dense) (Map Word64 Metadatum)
 -> Encode ('Closed 'Sparse) (Map Word64 Metadatum))
-> Encode ('Closed 'Dense) (Map Word64 Metadatum)
-> Encode ('Closed 'Sparse) (Map Word64 Metadatum)
forall a b. (a -> b) -> a -> b
$ Map Word64 Metadatum
-> Encode ('Closed 'Dense) (Map Word64 Metadatum)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map Word64 Metadatum
atadrMetadata)
          Encode
  ('Closed 'Sparse)
  (StrictSeq (NativeScript era)
   -> Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> AlonzoTxAuxDataRaw era)
-> Encode ('Closed 'Sparse) (StrictSeq (NativeScript era))
-> Encode
     ('Closed 'Sparse)
     (Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> AlonzoTxAuxDataRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictSeq (NativeScript era) -> Bool)
-> Encode ('Closed 'Sparse) (StrictSeq (NativeScript era))
-> Encode ('Closed 'Sparse) (StrictSeq (NativeScript era))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit StrictSeq (NativeScript era) -> Bool
forall a. StrictSeq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (StrictSeq (NativeScript era))
-> Encode ('Closed 'Sparse) (StrictSeq (NativeScript era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 (Encode ('Closed 'Dense) (StrictSeq (NativeScript era))
 -> Encode ('Closed 'Sparse) (StrictSeq (NativeScript era)))
-> Encode ('Closed 'Dense) (StrictSeq (NativeScript era))
-> Encode ('Closed 'Sparse) (StrictSeq (NativeScript era))
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript era)
-> Encode ('Closed 'Dense) (StrictSeq (NativeScript era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (NativeScript era)
atadrNativeScripts)
          Encode
  ('Closed 'Sparse)
  (Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> AlonzoTxAuxDataRaw era)
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
-> Encode
     ('Closed 'Sparse)
     (Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary)
      -> AlonzoTxAuxDataRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Maybe (NonEmpty PlutusBinary) -> Bool)
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Maybe (NonEmpty PlutusBinary) -> Bool
forall a. Maybe a -> Bool
isNothing (Word
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 (Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
 -> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary)))
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall a b. (a -> b) -> a -> b
$ (Maybe (NonEmpty PlutusBinary) -> Encoding)
-> Maybe (NonEmpty PlutusBinary)
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (Encoding
-> (NonEmpty PlutusBinary -> Encoding)
-> Maybe (NonEmpty PlutusBinary)
-> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
forall a. Monoid a => a
mempty NonEmpty PlutusBinary -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) (Language
-> Map Language (NonEmpty PlutusBinary)
-> Maybe (NonEmpty PlutusBinary)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
PlutusV1 Map Language (NonEmpty PlutusBinary)
atadrPlutus))
          Encode
  ('Closed 'Sparse)
  (Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary)
   -> AlonzoTxAuxDataRaw era)
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
-> Encode
     ('Closed 'Sparse)
     (Maybe (NonEmpty PlutusBinary)
      -> Maybe (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Maybe (NonEmpty PlutusBinary) -> Bool)
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Maybe (NonEmpty PlutusBinary) -> Bool
forall a. Maybe a -> Bool
isNothing (Word
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
3 (Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
 -> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary)))
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall a b. (a -> b) -> a -> b
$ (Maybe (NonEmpty PlutusBinary) -> Encoding)
-> Maybe (NonEmpty PlutusBinary)
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (Encoding
-> (NonEmpty PlutusBinary -> Encoding)
-> Maybe (NonEmpty PlutusBinary)
-> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
forall a. Monoid a => a
mempty NonEmpty PlutusBinary -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) (Language
-> Map Language (NonEmpty PlutusBinary)
-> Maybe (NonEmpty PlutusBinary)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
PlutusV2 Map Language (NonEmpty PlutusBinary)
atadrPlutus))
          Encode
  ('Closed 'Sparse)
  (Maybe (NonEmpty PlutusBinary)
   -> Maybe (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era)
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
-> Encode
     ('Closed 'Sparse)
     (Maybe (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Maybe (NonEmpty PlutusBinary) -> Bool)
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Maybe (NonEmpty PlutusBinary) -> Bool
forall a. Maybe a -> Bool
isNothing (Word
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
4 (Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
 -> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary)))
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall a b. (a -> b) -> a -> b
$ (Maybe (NonEmpty PlutusBinary) -> Encoding)
-> Maybe (NonEmpty PlutusBinary)
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (Encoding
-> (NonEmpty PlutusBinary -> Encoding)
-> Maybe (NonEmpty PlutusBinary)
-> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
forall a. Monoid a => a
mempty NonEmpty PlutusBinary -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) (Language
-> Map Language (NonEmpty PlutusBinary)
-> Maybe (NonEmpty PlutusBinary)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
PlutusV3 Map Language (NonEmpty PlutusBinary)
atadrPlutus))
          Encode
  ('Closed 'Sparse)
  (Maybe (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era)
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (AlonzoTxAuxDataRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Maybe (NonEmpty PlutusBinary) -> Bool)
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Maybe (NonEmpty PlutusBinary) -> Bool
forall a. Maybe a -> Bool
isNothing (Word
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
5 (Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
 -> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary)))
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
-> Encode ('Closed 'Sparse) (Maybe (NonEmpty PlutusBinary))
forall a b. (a -> b) -> a -> b
$ (Maybe (NonEmpty PlutusBinary) -> Encoding)
-> Maybe (NonEmpty PlutusBinary)
-> Encode ('Closed 'Dense) (Maybe (NonEmpty PlutusBinary))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (Encoding
-> (NonEmpty PlutusBinary -> Encoding)
-> Maybe (NonEmpty PlutusBinary)
-> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
forall a. Monoid a => a
mempty NonEmpty PlutusBinary -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) (Language
-> Map Language (NonEmpty PlutusBinary)
-> Maybe (NonEmpty PlutusBinary)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
PlutusV4 Map Language (NonEmpty PlutusBinary)
atadrPlutus))

-- | Helper function that will construct Auxiliary data from Metadatum map and a list of scripts.
--
-- Note that the relative order of same type scripts will be preserved.
mkAlonzoTxAuxData ::
  forall f era.
  (Foldable f, AlonzoEraScript era) =>
  Map Word64 Metadatum ->
  f (AlonzoScript era) ->
  AlonzoTxAuxData era
mkAlonzoTxAuxData :: forall (f :: * -> *) era.
(Foldable f, AlonzoEraScript era) =>
Map Word64 Metadatum -> f (AlonzoScript era) -> AlonzoTxAuxData era
mkAlonzoTxAuxData Map Word64 Metadatum
atadrMetadata f (AlonzoScript era)
allScripts =
  forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (RawType (AlonzoTxAuxData era) -> AlonzoTxAuxData era)
-> RawType (AlonzoTxAuxData era) -> AlonzoTxAuxData era
forall a b. (a -> b) -> a -> b
$
    AlonzoTxAuxDataRaw {Map Word64 Metadatum
atadrMetadata :: Map Word64 Metadatum
atadrMetadata :: Map Word64 Metadatum
atadrMetadata, StrictSeq (NativeScript era)
atadrNativeScripts :: StrictSeq (NativeScript era)
atadrNativeScripts :: StrictSeq (NativeScript era)
atadrNativeScripts, Map Language (NonEmpty PlutusBinary)
atadrPlutus :: Map Language (NonEmpty PlutusBinary)
atadrPlutus :: Map Language (NonEmpty PlutusBinary)
atadrPlutus}
  where
    partitionScripts :: (StrictSeq (NativeScript era),
 Map Language (NonEmpty PlutusBinary))
-> AlonzoScript era
-> (StrictSeq (NativeScript era),
    Map Language (NonEmpty PlutusBinary))
partitionScripts (StrictSeq (NativeScript era)
tss, Map Language (NonEmpty PlutusBinary)
pss) =
      \case
        NativeScript NativeScript era
ts -> (NativeScript era
ts NativeScript era
-> StrictSeq (NativeScript era) -> StrictSeq (NativeScript era)
forall a. a -> StrictSeq a -> StrictSeq a
:<| StrictSeq (NativeScript era)
tss, Map Language (NonEmpty PlutusBinary)
pss)
        PlutusScript PlutusScript era
ps ->
          let lang :: Language
lang = PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
ps
              bs :: PlutusBinary
bs = PlutusScript era -> PlutusBinary
forall era. AlonzoEraScript era => PlutusScript era -> PlutusBinary
plutusScriptBinary PlutusScript era
ps
           in (StrictSeq (NativeScript era)
tss, (Maybe (NonEmpty PlutusBinary) -> Maybe (NonEmpty PlutusBinary))
-> Language
-> Map Language (NonEmpty PlutusBinary)
-> Map Language (NonEmpty PlutusBinary)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (NonEmpty PlutusBinary -> Maybe (NonEmpty PlutusBinary)
forall a. a -> Maybe a
Just (NonEmpty PlutusBinary -> Maybe (NonEmpty PlutusBinary))
-> (Maybe (NonEmpty PlutusBinary) -> NonEmpty PlutusBinary)
-> Maybe (NonEmpty PlutusBinary)
-> Maybe (NonEmpty PlutusBinary)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty PlutusBinary
-> (NonEmpty PlutusBinary -> NonEmpty PlutusBinary)
-> Maybe (NonEmpty PlutusBinary)
-> NonEmpty PlutusBinary
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PlutusBinary -> NonEmpty PlutusBinary
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlutusBinary
bs) (PlutusBinary -> NonEmpty PlutusBinary -> NonEmpty PlutusBinary
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons PlutusBinary
bs)) Language
lang Map Language (NonEmpty PlutusBinary)
pss)
    (StrictSeq (NativeScript era)
atadrNativeScripts, Map Language (NonEmpty PlutusBinary)
atadrPlutus) =
      (AlonzoScript era
 -> (StrictSeq (NativeScript era),
     Map Language (NonEmpty PlutusBinary))
 -> (StrictSeq (NativeScript era),
     Map Language (NonEmpty PlutusBinary)))
-> (StrictSeq (NativeScript era),
    Map Language (NonEmpty PlutusBinary))
-> f (AlonzoScript era)
-> (StrictSeq (NativeScript era),
    Map Language (NonEmpty PlutusBinary))
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((StrictSeq (NativeScript era),
  Map Language (NonEmpty PlutusBinary))
 -> AlonzoScript era
 -> (StrictSeq (NativeScript era),
     Map Language (NonEmpty PlutusBinary)))
-> AlonzoScript era
-> (StrictSeq (NativeScript era),
    Map Language (NonEmpty PlutusBinary))
-> (StrictSeq (NativeScript era),
    Map Language (NonEmpty PlutusBinary))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (StrictSeq (NativeScript era),
 Map Language (NonEmpty PlutusBinary))
-> AlonzoScript era
-> (StrictSeq (NativeScript era),
    Map Language (NonEmpty PlutusBinary))
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
(StrictSeq (NativeScript era),
 Map Language (NonEmpty PlutusBinary))
-> AlonzoScript era
-> (StrictSeq (NativeScript era),
    Map Language (NonEmpty PlutusBinary))
partitionScripts) (StrictSeq (NativeScript era)
forall a. Monoid a => a
mempty, Map Language (NonEmpty PlutusBinary)
forall k a. Map k a
Map.empty) f (AlonzoScript era)
allScripts

getAlonzoTxAuxDataScripts ::
  forall era.
  AlonzoEraScript era =>
  AlonzoTxAuxData era ->
  StrictSeq (AlonzoScript era)
getAlonzoTxAuxDataScripts :: forall era.
AlonzoEraScript era =>
AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
getAlonzoTxAuxDataScripts AlonzoTxAuxData {atadNativeScripts :: forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> StrictSeq (NativeScript era)
atadNativeScripts = StrictSeq (NativeScript era)
timelocks, atadPlutus :: forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> Map Language (NonEmpty PlutusBinary)
atadPlutus = Map Language (NonEmpty PlutusBinary)
plutus} =
  [StrictSeq (AlonzoScript era)] -> StrictSeq (AlonzoScript era)
forall a. Monoid a => [a] -> a
mconcat ([StrictSeq (AlonzoScript era)] -> StrictSeq (AlonzoScript era))
-> [StrictSeq (AlonzoScript era)] -> StrictSeq (AlonzoScript era)
forall a b. (a -> b) -> a -> b
$
    (NativeScript era -> AlonzoScript era
forall era. NativeScript era -> AlonzoScript era
NativeScript (NativeScript era -> AlonzoScript era)
-> StrictSeq (NativeScript era) -> StrictSeq (AlonzoScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript era)
timelocks)
      StrictSeq (AlonzoScript era)
-> [StrictSeq (AlonzoScript era)] -> [StrictSeq (AlonzoScript era)]
forall a. a -> [a] -> [a]
: [ [AlonzoScript era] -> StrictSeq (AlonzoScript era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList ([AlonzoScript era] -> StrictSeq (AlonzoScript era))
-> [AlonzoScript era] -> StrictSeq (AlonzoScript era)
forall a b. (a -> b) -> a -> b
$
            -- It is fine to filter out unsupported languages with mapMaybe, because the invariant for
            -- AlonzoTxAuxData is that it does not contain scripts with languages that are not
            -- supported in this era
            (PlutusBinary -> Maybe (AlonzoScript era))
-> [PlutusBinary] -> [AlonzoScript era]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((PlutusScript era -> AlonzoScript era)
-> Maybe (PlutusScript era) -> Maybe (AlonzoScript era)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlutusScript era -> AlonzoScript era
forall era. PlutusScript era -> AlonzoScript era
PlutusScript (Maybe (PlutusScript era) -> Maybe (AlonzoScript era))
-> (PlutusBinary -> Maybe (PlutusScript era))
-> PlutusBinary
-> Maybe (AlonzoScript era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> PlutusBinary -> Maybe (PlutusScript era)
forall (m :: * -> *) era.
(MonadFail m, AlonzoEraScript era) =>
Language -> PlutusBinary -> m (PlutusScript era)
mkBinaryPlutusScript Language
lang) ([PlutusBinary] -> [AlonzoScript era])
-> [PlutusBinary] -> [AlonzoScript era]
forall a b. (a -> b) -> a -> b
$
              NonEmpty PlutusBinary -> [PlutusBinary]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty PlutusBinary
plutusScripts
        | Language
lang <- [Language
PlutusV1 .. forall era. AlonzoEraScript era => Language
eraMaxLanguage @era]
        , Just NonEmpty PlutusBinary
plutusScripts <- [Language
-> Map Language (NonEmpty PlutusBinary)
-> Maybe (NonEmpty PlutusBinary)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
lang Map Language (NonEmpty PlutusBinary)
plutus]
        ]

instance
  ( Era era
  , DecCBOR (Annotator (NativeScript era))
  , Typeable (NativeScript era)
  ) =>
  DecCBOR (Annotator (AlonzoTxAuxDataRaw era))
  where
  decCBOR :: forall s. Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decCBOR =
    forall t s.
Decoder s t -> Decoder s t -> Decoder s t -> Decoder s t
decodeTxAuxDataByTokenType @(Annotator (AlonzoTxAuxDataRaw era))
      Decoder s (Annotator (AlonzoTxAuxDataRaw era))
forall s. Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeShelley
      Decoder s (Annotator (AlonzoTxAuxDataRaw era))
forall s. Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeAllegra
      Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeAlonzo
    where
      decodeShelley :: Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeShelley =
        Decode Any (Annotator (AlonzoTxAuxDataRaw era))
-> Decoder s (Annotator (AlonzoTxAuxDataRaw era))
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode
          ( Decode
  Any
  (Map Word64 Metadatum
   -> StrictSeq (NativeScript era)
   -> Map Language (NonEmpty PlutusBinary)
   -> AlonzoTxAuxDataRaw era)
-> Decode
     Any
     (Annotator
        (Map Word64 Metadatum
         -> StrictSeq (NativeScript era)
         -> Map Language (NonEmpty PlutusBinary)
         -> AlonzoTxAuxDataRaw era))
forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann ((Map Word64 Metadatum
 -> StrictSeq (NativeScript era)
 -> Map Language (NonEmpty PlutusBinary)
 -> AlonzoTxAuxDataRaw era)
-> Decode
     Any
     (Map Word64 Metadatum
      -> StrictSeq (NativeScript era)
      -> Map Language (NonEmpty PlutusBinary)
      -> AlonzoTxAuxDataRaw era)
forall t (w :: Wrapped). t -> Decode w t
Emit 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)
              Decode
  Any
  (Annotator
     (Map Word64 Metadatum
      -> StrictSeq (NativeScript era)
      -> Map Language (NonEmpty PlutusBinary)
      -> AlonzoTxAuxDataRaw era))
-> Decode ('Closed Any) (Annotator (Map Word64 Metadatum))
-> Decode
     Any
     (Annotator
        (StrictSeq (NativeScript era)
         -> Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era))
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (Map Word64 Metadatum)
-> Decode ('Closed Any) (Annotator (Map Word64 Metadatum))
forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann Decode ('Closed Any) (Map Word64 Metadatum)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
              Decode
  Any
  (Annotator
     (StrictSeq (NativeScript era)
      -> Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era))
-> Decode ('Closed Any) (Annotator (StrictSeq (NativeScript era)))
-> Decode
     Any
     (Annotator
        (Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era))
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (StrictSeq (NativeScript era))
-> Decode ('Closed Any) (Annotator (StrictSeq (NativeScript era)))
forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (StrictSeq (NativeScript era)
-> Decode ('Closed Any) (StrictSeq (NativeScript era))
forall t (w :: Wrapped). t -> Decode w t
Emit StrictSeq (NativeScript era)
forall a. StrictSeq a
StrictSeq.empty)
              Decode
  Any
  (Annotator
     (Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era))
-> Decode
     ('Closed Any) (Annotator (Map Language (NonEmpty PlutusBinary)))
-> Decode Any (Annotator (AlonzoTxAuxDataRaw era))
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (Map Language (NonEmpty PlutusBinary))
-> Decode
     ('Closed Any) (Annotator (Map Language (NonEmpty PlutusBinary)))
forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (Map Language (NonEmpty PlutusBinary)
-> Decode ('Closed Any) (Map Language (NonEmpty PlutusBinary))
forall t (w :: Wrapped). t -> Decode w t
Emit Map Language (NonEmpty PlutusBinary)
forall k a. Map k a
Map.empty)
          )
      decodeAllegra :: Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeAllegra =
        Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
-> Decoder s (Annotator (AlonzoTxAuxDataRaw era))
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode
          ( Decode
  ('Closed 'Dense)
  (Map Word64 Metadatum
   -> StrictSeq (NativeScript era)
   -> Map Language (NonEmpty PlutusBinary)
   -> AlonzoTxAuxDataRaw era)
-> Decode
     ('Closed 'Dense)
     (Annotator
        (Map Word64 Metadatum
         -> StrictSeq (NativeScript era)
         -> Map Language (NonEmpty PlutusBinary)
         -> AlonzoTxAuxDataRaw era))
forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann ((Map Word64 Metadatum
 -> StrictSeq (NativeScript era)
 -> Map Language (NonEmpty PlutusBinary)
 -> AlonzoTxAuxDataRaw era)
-> Decode
     ('Closed 'Dense)
     (Map Word64 Metadatum
      -> StrictSeq (NativeScript era)
      -> Map Language (NonEmpty PlutusBinary)
      -> AlonzoTxAuxDataRaw era)
forall t. t -> Decode ('Closed 'Dense) t
RecD 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)
              Decode
  ('Closed 'Dense)
  (Annotator
     (Map Word64 Metadatum
      -> StrictSeq (NativeScript era)
      -> Map Language (NonEmpty PlutusBinary)
      -> AlonzoTxAuxDataRaw era))
-> Decode ('Closed Any) (Annotator (Map Word64 Metadatum))
-> Decode
     ('Closed 'Dense)
     (Annotator
        (StrictSeq (NativeScript era)
         -> Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era))
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (Map Word64 Metadatum)
-> Decode ('Closed Any) (Annotator (Map Word64 Metadatum))
forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann Decode ('Closed Any) (Map Word64 Metadatum)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
              Decode
  ('Closed 'Dense)
  (Annotator
     (StrictSeq (NativeScript era)
      -> Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era))
-> Decode
     ('Closed 'Dense) (Annotator (StrictSeq (NativeScript era)))
-> Decode
     ('Closed 'Dense)
     (Annotator
        (Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era))
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! (forall s. Decoder s (Annotator (StrictSeq (NativeScript era))))
-> Decode
     ('Closed 'Dense) (Annotator (StrictSeq (NativeScript era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D
                (StrictSeq (Annotator (NativeScript era))
-> Annotator (StrictSeq (NativeScript era))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
StrictSeq (m a) -> m (StrictSeq a)
sequence (StrictSeq (Annotator (NativeScript era))
 -> Annotator (StrictSeq (NativeScript era)))
-> Decoder s (StrictSeq (Annotator (NativeScript era)))
-> Decoder s (Annotator (StrictSeq (NativeScript era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (NativeScript era))
-> Decoder s (StrictSeq (Annotator (NativeScript era)))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (Annotator (NativeScript era))
forall s. Decoder s (Annotator (NativeScript era))
forall a s. DecCBOR a => Decoder s a
decCBOR)
              Decode
  ('Closed 'Dense)
  (Annotator
     (Map Language (NonEmpty PlutusBinary) -> AlonzoTxAuxDataRaw era))
-> Decode
     ('Closed Any) (Annotator (Map Language (NonEmpty PlutusBinary)))
-> Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (Map Language (NonEmpty PlutusBinary))
-> Decode
     ('Closed Any) (Annotator (Map Language (NonEmpty PlutusBinary)))
forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann (Map Language (NonEmpty PlutusBinary)
-> Decode ('Closed Any) (Map Language (NonEmpty PlutusBinary))
forall t (w :: Wrapped). t -> Decode w t
Emit Map Language (NonEmpty PlutusBinary)
forall k a. Map k a
Map.empty)
          )
      decodeAlonzo :: Decoder s (Annotator (AlonzoTxAuxDataRaw era))
decodeAlonzo =
        Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
-> Decoder s (Annotator (AlonzoTxAuxDataRaw era))
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
 -> Decoder s (Annotator (AlonzoTxAuxDataRaw era)))
-> Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
-> Decoder s (Annotator (AlonzoTxAuxDataRaw era))
forall a b. (a -> b) -> a -> b
$
          Word
-> Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
-> Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
forall (x :: Density) t.
Word -> Decode ('Closed x) t -> Decode ('Closed x) t
TagD Word
259 (Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
 -> Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era)))
-> Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
-> Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
forall a b. (a -> b) -> a -> b
$
            [Char]
-> Annotator (AlonzoTxAuxDataRaw era)
-> (Word -> Field (Annotator (AlonzoTxAuxDataRaw era)))
-> [(Word, [Char])]
-> Decode ('Closed 'Dense) (Annotator (AlonzoTxAuxDataRaw era))
forall t.
Typeable t =>
[Char]
-> t
-> (Word -> Field t)
-> [(Word, [Char])]
-> Decode ('Closed 'Dense) t
SparseKeyed [Char]
"AlonzoTxAuxData" (AlonzoTxAuxDataRaw era -> Annotator (AlonzoTxAuxDataRaw era)
forall a. a -> Annotator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AlonzoTxAuxDataRaw era
forall era. AlonzoTxAuxDataRaw era
emptyAlonzoTxAuxDataRaw) Word -> Field (Annotator (AlonzoTxAuxDataRaw era))
auxDataField []

      auxDataField :: Word -> Field (Annotator (AlonzoTxAuxDataRaw era))
      auxDataField :: Word -> Field (Annotator (AlonzoTxAuxDataRaw era))
auxDataField Word
0 = (Map Word64 Metadatum
 -> AlonzoTxAuxDataRaw era -> AlonzoTxAuxDataRaw era)
-> Decode ('Closed Any) (Map Word64 Metadatum)
-> Field (Annotator (AlonzoTxAuxDataRaw era))
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA (\Map Word64 Metadatum
x AlonzoTxAuxDataRaw era
ad -> AlonzoTxAuxDataRaw era
ad {atadrMetadata = x}) Decode ('Closed Any) (Map Word64 Metadatum)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      auxDataField Word
1 =
        (StrictSeq (NativeScript era)
 -> AlonzoTxAuxDataRaw era -> AlonzoTxAuxDataRaw era)
-> Decode
     ('Closed 'Dense) (Annotator (StrictSeq (NativeScript era)))
-> Field (Annotator (AlonzoTxAuxDataRaw era))
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
          (\StrictSeq (NativeScript era)
x AlonzoTxAuxDataRaw era
ad -> AlonzoTxAuxDataRaw era
ad {atadrNativeScripts = atadrNativeScripts ad <> x})
          ((forall s. Decoder s (Annotator (StrictSeq (NativeScript era))))
-> Decode
     ('Closed 'Dense) (Annotator (StrictSeq (NativeScript era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (StrictSeq (Annotator (NativeScript era))
-> Annotator (StrictSeq (NativeScript era))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
StrictSeq (m a) -> m (StrictSeq a)
sequence (StrictSeq (Annotator (NativeScript era))
 -> Annotator (StrictSeq (NativeScript era)))
-> Decoder s (StrictSeq (Annotator (NativeScript era)))
-> Decoder s (Annotator (StrictSeq (NativeScript era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (NativeScript era))
-> Decoder s (StrictSeq (Annotator (NativeScript era)))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (Annotator (NativeScript era))
forall s. Decoder s (Annotator (NativeScript era))
forall a s. DecCBOR a => Decoder s a
decCBOR))
      auxDataField Word
2 = ([PlutusBinary]
 -> AlonzoTxAuxDataRaw era -> AlonzoTxAuxDataRaw era)
-> Decode ('Closed 'Dense) [PlutusBinary]
-> Field (Annotator (AlonzoTxAuxDataRaw era))
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA (Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
forall era.
Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
addPlutusScripts Language
PlutusV1) ((forall s. Decoder s [PlutusBinary])
-> Decode ('Closed 'Dense) [PlutusBinary]
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Language -> Decoder s ()
forall s. Language -> Decoder s ()
guardPlutus Language
PlutusV1 Decoder s ()
-> Decoder s [PlutusBinary] -> Decoder s [PlutusBinary]
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Decoder s [PlutusBinary]
forall s. Decoder s [PlutusBinary]
forall a s. DecCBOR a => Decoder s a
decCBOR))
      auxDataField Word
3 = ([PlutusBinary]
 -> AlonzoTxAuxDataRaw era -> AlonzoTxAuxDataRaw era)
-> Decode ('Closed 'Dense) [PlutusBinary]
-> Field (Annotator (AlonzoTxAuxDataRaw era))
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA (Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
forall era.
Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
addPlutusScripts Language
PlutusV2) ((forall s. Decoder s [PlutusBinary])
-> Decode ('Closed 'Dense) [PlutusBinary]
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Language -> Decoder s ()
forall s. Language -> Decoder s ()
guardPlutus Language
PlutusV2 Decoder s ()
-> Decoder s [PlutusBinary] -> Decoder s [PlutusBinary]
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Decoder s [PlutusBinary]
forall s. Decoder s [PlutusBinary]
forall a s. DecCBOR a => Decoder s a
decCBOR))
      auxDataField Word
4 = ([PlutusBinary]
 -> AlonzoTxAuxDataRaw era -> AlonzoTxAuxDataRaw era)
-> Decode ('Closed 'Dense) [PlutusBinary]
-> Field (Annotator (AlonzoTxAuxDataRaw era))
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA (Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
forall era.
Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
addPlutusScripts Language
PlutusV3) ((forall s. Decoder s [PlutusBinary])
-> Decode ('Closed 'Dense) [PlutusBinary]
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Language -> Decoder s ()
forall s. Language -> Decoder s ()
guardPlutus Language
PlutusV3 Decoder s ()
-> Decoder s [PlutusBinary] -> Decoder s [PlutusBinary]
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Decoder s [PlutusBinary]
forall s. Decoder s [PlutusBinary]
forall a s. DecCBOR a => Decoder s a
decCBOR))
      auxDataField Word
5 = ([PlutusBinary]
 -> AlonzoTxAuxDataRaw era -> AlonzoTxAuxDataRaw era)
-> Decode ('Closed 'Dense) [PlutusBinary]
-> Field (Annotator (AlonzoTxAuxDataRaw era))
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Applicative ann) =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA (Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
forall era.
Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
addPlutusScripts Language
PlutusV4) ((forall s. Decoder s [PlutusBinary])
-> Decode ('Closed 'Dense) [PlutusBinary]
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Language -> Decoder s ()
forall s. Language -> Decoder s ()
guardPlutus Language
PlutusV4 Decoder s ()
-> Decoder s [PlutusBinary] -> Decoder s [PlutusBinary]
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Decoder s [PlutusBinary]
forall s. Decoder s [PlutusBinary]
forall a s. DecCBOR a => Decoder s a
decCBOR))
      auxDataField Word
n = Word -> Field (Annotator (AlonzoTxAuxDataRaw era))
forall t. Word -> Field t
invalidField Word
n

decodeTxAuxDataByTokenType :: forall t s. Decoder s t -> Decoder s t -> Decoder s t -> Decoder s t
decodeTxAuxDataByTokenType :: forall t s.
Decoder s t -> Decoder s t -> Decoder s t -> Decoder s t
decodeTxAuxDataByTokenType Decoder s t
decodeShelley Decoder s t
decodeAllegra Decoder s t
decodeAlonzo =
  Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType -> (TokenType -> Decoder s t) -> Decoder s t
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
TypeMapLen -> Decoder s t
decodeShelley
    TokenType
TypeMapLen64 -> Decoder s t
decodeShelley
    TokenType
TypeMapLenIndef -> Decoder s t
decodeShelley
    TokenType
TypeListLen -> Decoder s t
decodeAllegra
    TokenType
TypeListLen64 -> Decoder s t
decodeAllegra
    TokenType
TypeListLenIndef -> Decoder s t
decodeAllegra
    TokenType
TypeTag -> Decoder s t
decodeAlonzo
    TokenType
TypeTag64 -> Decoder s t
decodeAlonzo
    TokenType
_ -> [Char] -> Decoder s t
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Failed to decode AlonzoTxAuxData"

addPlutusScripts :: Language -> [PlutusBinary] -> AlonzoTxAuxDataRaw era -> AlonzoTxAuxDataRaw era
addPlutusScripts :: forall era.
Language
-> [PlutusBinary]
-> AlonzoTxAuxDataRaw era
-> AlonzoTxAuxDataRaw era
addPlutusScripts Language
lang [PlutusBinary]
scripts AlonzoTxAuxDataRaw era
ad =
  case [PlutusBinary] -> Maybe (NonEmpty PlutusBinary)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [PlutusBinary]
scripts of
    Maybe (NonEmpty PlutusBinary)
Nothing -> AlonzoTxAuxDataRaw era
ad
    Just NonEmpty PlutusBinary
neScripts ->
      -- Avoid leaks by deepseq, since non empty list is lazy.
      NonEmpty PlutusBinary
neScripts NonEmpty PlutusBinary
-> AlonzoTxAuxDataRaw era -> AlonzoTxAuxDataRaw era
forall a b. NFData a => a -> b -> b
`deepseq` AlonzoTxAuxDataRaw era
ad {atadrPlutus = Map.insert lang neScripts $ atadrPlutus ad}

emptyAlonzoTxAuxDataRaw :: AlonzoTxAuxDataRaw era
emptyAlonzoTxAuxDataRaw :: forall era. AlonzoTxAuxDataRaw era
emptyAlonzoTxAuxDataRaw = 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
forall a. Monoid a => a
mempty StrictSeq (NativeScript era)
forall a. Monoid a => a
mempty Map Language (NonEmpty PlutusBinary)
forall a. Monoid a => a
mempty

-- ================================================================================
-- Version with serialized bytes.

newtype AlonzoTxAuxData era = MkAlonzoTxAuxData (MemoBytes (AlonzoTxAuxDataRaw era))
  deriving ((forall x. AlonzoTxAuxData era -> Rep (AlonzoTxAuxData era) x)
-> (forall x. Rep (AlonzoTxAuxData era) x -> AlonzoTxAuxData era)
-> Generic (AlonzoTxAuxData era)
forall x. Rep (AlonzoTxAuxData era) x -> AlonzoTxAuxData era
forall x. AlonzoTxAuxData era -> Rep (AlonzoTxAuxData era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AlonzoTxAuxData era) x -> AlonzoTxAuxData era
forall era x. AlonzoTxAuxData era -> Rep (AlonzoTxAuxData era) x
$cfrom :: forall era x. AlonzoTxAuxData era -> Rep (AlonzoTxAuxData era) x
from :: forall x. AlonzoTxAuxData era -> Rep (AlonzoTxAuxData era) x
$cto :: forall era x. Rep (AlonzoTxAuxData era) x -> AlonzoTxAuxData era
to :: forall x. Rep (AlonzoTxAuxData era) x -> AlonzoTxAuxData era
Generic)
  deriving newtype (Typeable (AlonzoTxAuxData era)
Typeable (AlonzoTxAuxData era) =>
(AlonzoTxAuxData era -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (AlonzoTxAuxData era) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [AlonzoTxAuxData era] -> Size)
-> ToCBOR (AlonzoTxAuxData era)
AlonzoTxAuxData era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxAuxData era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxAuxData era) -> Size
forall era. Typeable era => Typeable (AlonzoTxAuxData era)
forall era. Typeable era => AlonzoTxAuxData era -> Encoding
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxAuxData era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxAuxData era) -> Size
$ctoCBOR :: forall era. Typeable era => AlonzoTxAuxData era -> Encoding
toCBOR :: AlonzoTxAuxData era -> Encoding
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxAuxData era) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxAuxData era) -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxAuxData era] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxAuxData era] -> Size
ToCBOR, AlonzoTxAuxData era -> Int
AlonzoTxAuxData era -> ByteString
(AlonzoTxAuxData era -> ByteString)
-> (AlonzoTxAuxData era -> Int)
-> (forall i. Proxy i -> AlonzoTxAuxData era -> SafeHash i)
-> SafeToHash (AlonzoTxAuxData era)
forall i. Proxy i -> AlonzoTxAuxData era -> SafeHash i
forall era. AlonzoTxAuxData era -> Int
forall era. AlonzoTxAuxData era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall era i. Proxy i -> AlonzoTxAuxData era -> SafeHash i
$coriginalBytes :: forall era. AlonzoTxAuxData era -> ByteString
originalBytes :: AlonzoTxAuxData era -> ByteString
$coriginalBytesSize :: forall era. AlonzoTxAuxData era -> Int
originalBytesSize :: AlonzoTxAuxData era -> Int
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> AlonzoTxAuxData era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> AlonzoTxAuxData era -> SafeHash i
SafeToHash)

instance Memoized (AlonzoTxAuxData era) where
  type RawType (AlonzoTxAuxData era) = AlonzoTxAuxDataRaw era

deriving via
  Mem (AlonzoTxAuxDataRaw era)
  instance
    (Era era, DecCBOR (Annotator (NativeScript era)), Typeable (NativeScript era)) =>
    DecCBOR (Annotator (AlonzoTxAuxData era))

instance Eq (NativeScript era) => EqRaw (AlonzoTxAuxData era)

instance EraTxAuxData AlonzoEra where
  type TxAuxData AlonzoEra = AlonzoTxAuxData AlonzoEra

  mkBasicTxAuxData :: TxAuxData AlonzoEra
mkBasicTxAuxData = Map Word64 Metadatum
-> StrictSeq (NativeScript AlonzoEra)
-> Map Language (NonEmpty PlutusBinary)
-> AlonzoTxAuxData AlonzoEra
forall era.
(HasCallStack, AlonzoEraScript era) =>
Map Word64 Metadatum
-> StrictSeq (NativeScript era)
-> Map Language (NonEmpty PlutusBinary)
-> AlonzoTxAuxData era
AlonzoTxAuxData Map Word64 Metadatum
forall a. Monoid a => a
mempty StrictSeq (Timelock AlonzoEra)
StrictSeq (NativeScript AlonzoEra)
forall a. Monoid a => a
mempty Map Language (NonEmpty PlutusBinary)
forall a. Monoid a => a
mempty

  metadataTxAuxDataL :: Lens' (TxAuxData AlonzoEra) (Map Word64 Metadatum)
metadataTxAuxDataL = (Map Word64 Metadatum -> f (Map Word64 Metadatum))
-> TxAuxData AlonzoEra -> f (TxAuxData AlonzoEra)
(Map Word64 Metadatum -> f (Map Word64 Metadatum))
-> AlonzoTxAuxData AlonzoEra -> f (AlonzoTxAuxData AlonzoEra)
forall era.
(Era era, EncCBOR (NativeScript era)) =>
Lens' (AlonzoTxAuxData era) (Map Word64 Metadatum)
Lens' (AlonzoTxAuxData AlonzoEra) (Map Word64 Metadatum)
metadataAlonzoTxAuxDataL

  validateTxAuxData :: ProtVer -> TxAuxData AlonzoEra -> Bool
validateTxAuxData = ProtVer -> TxAuxData AlonzoEra -> Bool
ProtVer -> AlonzoTxAuxData AlonzoEra -> Bool
forall era.
(AlonzoEraScript era, Script era ~ AlonzoScript era) =>
ProtVer -> AlonzoTxAuxData era -> Bool
validateAlonzoTxAuxData

metadataAlonzoTxAuxDataL ::
  forall era.
  (Era era, EncCBOR (NativeScript era)) => Lens' (AlonzoTxAuxData era) (Map Word64 Metadatum)
metadataAlonzoTxAuxDataL :: forall era.
(Era era, EncCBOR (NativeScript era)) =>
Lens' (AlonzoTxAuxData era) (Map Word64 Metadatum)
metadataAlonzoTxAuxDataL =
  forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @era RawType (AlonzoTxAuxData era) -> Map Word64 Metadatum
AlonzoTxAuxDataRaw era -> Map Word64 Metadatum
forall era. AlonzoTxAuxDataRaw era -> Map Word64 Metadatum
atadrMetadata ((RawType (AlonzoTxAuxData era)
  -> Map Word64 Metadatum -> RawType (AlonzoTxAuxData era))
 -> forall {f :: * -> *}.
    Functor f =>
    (Map Word64 Metadatum -> f (Map Word64 Metadatum))
    -> AlonzoTxAuxData era -> f (AlonzoTxAuxData era))
-> (RawType (AlonzoTxAuxData era)
    -> Map Word64 Metadatum -> RawType (AlonzoTxAuxData era))
-> forall {f :: * -> *}.
   Functor f =>
   (Map Word64 Metadatum -> f (Map Word64 Metadatum))
   -> AlonzoTxAuxData era -> f (AlonzoTxAuxData era)
forall a b. (a -> b) -> a -> b
$
    \RawType (AlonzoTxAuxData era)
txAuxDataRaw Map Word64 Metadatum
md -> RawType (AlonzoTxAuxData era)
txAuxDataRaw {atadrMetadata = md}

hashAlonzoTxAuxData ::
  HashAnnotated x EraIndependentTxAuxData =>
  x ->
  TxAuxDataHash
hashAlonzoTxAuxData :: forall x.
HashAnnotated x EraIndependentTxAuxData =>
x -> TxAuxDataHash
hashAlonzoTxAuxData x
x = SafeHash EraIndependentTxAuxData -> TxAuxDataHash
TxAuxDataHash (x -> SafeHash EraIndependentTxAuxData
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated x
x)
{-# DEPRECATED hashAlonzoTxAuxData "In favor of `hashTxAuxData`" #-}

validateAlonzoTxAuxData ::
  (AlonzoEraScript era, Script era ~ AlonzoScript era) =>
  ProtVer ->
  AlonzoTxAuxData era ->
  Bool
validateAlonzoTxAuxData :: forall era.
(AlonzoEraScript era, Script era ~ AlonzoScript era) =>
ProtVer -> AlonzoTxAuxData era -> Bool
validateAlonzoTxAuxData ProtVer
pv auxData :: AlonzoTxAuxData era
auxData@AlonzoTxAuxData {atadMetadata :: forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> Map Word64 Metadatum
atadMetadata = Map Word64 Metadatum
metadata} =
  (Metadatum -> Bool) -> Map Word64 Metadatum -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Metadatum -> Bool
validMetadatum Map Word64 Metadatum
metadata
    Bool -> Bool -> Bool
&& (AlonzoScript era -> Bool) -> StrictSeq (AlonzoScript era) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ProtVer -> Script era -> Bool
forall era.
(HasCallStack, AlonzoEraScript era) =>
ProtVer -> Script era -> Bool
validScript ProtVer
pv) (AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
forall era.
AlonzoEraScript era =>
AlonzoTxAuxData era -> StrictSeq (AlonzoScript era)
getAlonzoTxAuxDataScripts AlonzoTxAuxData era
auxData)

instance AllegraEraTxAuxData AlonzoEra where
  nativeScriptsTxAuxDataL :: Lens' (TxAuxData AlonzoEra) (StrictSeq (NativeScript AlonzoEra))
nativeScriptsTxAuxDataL = (StrictSeq (NativeScript AlonzoEra)
 -> f (StrictSeq (NativeScript AlonzoEra)))
-> TxAuxData AlonzoEra -> f (TxAuxData AlonzoEra)
(StrictSeq (NativeScript AlonzoEra)
 -> f (StrictSeq (NativeScript AlonzoEra)))
-> AlonzoTxAuxData AlonzoEra -> f (AlonzoTxAuxData AlonzoEra)
forall era.
(Era era, EncCBOR (NativeScript era)) =>
Lens' (AlonzoTxAuxData era) (StrictSeq (NativeScript era))
Lens'
  (AlonzoTxAuxData AlonzoEra) (StrictSeq (NativeScript AlonzoEra))
nativeScriptsAlonzoTxAuxDataL

nativeScriptsAlonzoTxAuxDataL ::
  forall era.
  (Era era, EncCBOR (NativeScript era)) => Lens' (AlonzoTxAuxData era) (StrictSeq (NativeScript era))
nativeScriptsAlonzoTxAuxDataL :: forall era.
(Era era, EncCBOR (NativeScript era)) =>
Lens' (AlonzoTxAuxData era) (StrictSeq (NativeScript era))
nativeScriptsAlonzoTxAuxDataL =
  forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @era RawType (AlonzoTxAuxData era) -> StrictSeq (NativeScript era)
AlonzoTxAuxDataRaw era -> StrictSeq (NativeScript era)
forall era. AlonzoTxAuxDataRaw era -> StrictSeq (NativeScript era)
atadrNativeScripts ((RawType (AlonzoTxAuxData era)
  -> StrictSeq (NativeScript era) -> RawType (AlonzoTxAuxData era))
 -> forall {f :: * -> *}.
    Functor f =>
    (StrictSeq (NativeScript era) -> f (StrictSeq (NativeScript era)))
    -> AlonzoTxAuxData era -> f (AlonzoTxAuxData era))
-> (RawType (AlonzoTxAuxData era)
    -> StrictSeq (NativeScript era) -> RawType (AlonzoTxAuxData era))
-> forall {f :: * -> *}.
   Functor f =>
   (StrictSeq (NativeScript era) -> f (StrictSeq (NativeScript era)))
   -> AlonzoTxAuxData era -> f (AlonzoTxAuxData era)
forall a b. (a -> b) -> a -> b
$
    \RawType (AlonzoTxAuxData era)
txAuxDataRaw StrictSeq (NativeScript era)
ts -> RawType (AlonzoTxAuxData era)
txAuxDataRaw {atadrNativeScripts = ts}

instance AlonzoEraTxAuxData AlonzoEra where
  plutusScriptsTxAuxDataL :: Lens' (TxAuxData AlonzoEra) (Map Language (NonEmpty PlutusBinary))
plutusScriptsTxAuxDataL = (Map Language (NonEmpty PlutusBinary)
 -> f (Map Language (NonEmpty PlutusBinary)))
-> TxAuxData AlonzoEra -> f (TxAuxData AlonzoEra)
(Map Language (NonEmpty PlutusBinary)
 -> f (Map Language (NonEmpty PlutusBinary)))
-> AlonzoTxAuxData AlonzoEra -> f (AlonzoTxAuxData AlonzoEra)
forall era.
(Era era, EncCBOR (NativeScript era)) =>
Lens' (AlonzoTxAuxData era) (Map Language (NonEmpty PlutusBinary))
Lens'
  (AlonzoTxAuxData AlonzoEra) (Map Language (NonEmpty PlutusBinary))
plutusScriptsAllegraTxAuxDataL

plutusScriptsAllegraTxAuxDataL ::
  forall era.
  (Era era, EncCBOR (NativeScript era)) =>
  Lens' (AlonzoTxAuxData era) (Map Language (NE.NonEmpty PlutusBinary))
plutusScriptsAllegraTxAuxDataL :: forall era.
(Era era, EncCBOR (NativeScript era)) =>
Lens' (AlonzoTxAuxData era) (Map Language (NonEmpty PlutusBinary))
plutusScriptsAllegraTxAuxDataL =
  forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @era RawType (AlonzoTxAuxData era)
-> Map Language (NonEmpty PlutusBinary)
AlonzoTxAuxDataRaw era -> Map Language (NonEmpty PlutusBinary)
forall era.
AlonzoTxAuxDataRaw era -> Map Language (NonEmpty PlutusBinary)
atadrPlutus ((RawType (AlonzoTxAuxData era)
  -> Map Language (NonEmpty PlutusBinary)
  -> RawType (AlonzoTxAuxData era))
 -> forall {f :: * -> *}.
    Functor f =>
    (Map Language (NonEmpty PlutusBinary)
     -> f (Map Language (NonEmpty PlutusBinary)))
    -> AlonzoTxAuxData era -> f (AlonzoTxAuxData era))
-> (RawType (AlonzoTxAuxData era)
    -> Map Language (NonEmpty PlutusBinary)
    -> RawType (AlonzoTxAuxData era))
-> forall {f :: * -> *}.
   Functor f =>
   (Map Language (NonEmpty PlutusBinary)
    -> f (Map Language (NonEmpty PlutusBinary)))
   -> AlonzoTxAuxData era -> f (AlonzoTxAuxData era)
forall a b. (a -> b) -> a -> b
$
    \RawType (AlonzoTxAuxData era)
txAuxDataRaw Map Language (NonEmpty PlutusBinary)
ts -> RawType (AlonzoTxAuxData era)
txAuxDataRaw {atadrPlutus = ts}

instance HashAnnotated (AlonzoTxAuxData era) EraIndependentTxAuxData where
  hashAnnotated :: AlonzoTxAuxData era -> SafeHash EraIndependentTxAuxData
hashAnnotated = AlonzoTxAuxData era -> SafeHash EraIndependentTxAuxData
AlonzoTxAuxData era
-> SafeHash (MemoHashIndex (RawType (AlonzoTxAuxData era)))
forall t. Memoized t => t -> SafeHash (MemoHashIndex (RawType t))
getMemoSafeHash

deriving newtype instance NFData (NativeScript era) => NFData (AlonzoTxAuxData era)

deriving instance Eq (NativeScript era) => Eq (AlonzoTxAuxData era)

deriving instance Show (NativeScript era) => Show (AlonzoTxAuxData era)

type instance MemoHashIndex (AlonzoTxAuxDataRaw era) = EraIndependentTxAuxData

deriving via
  InspectHeapNamed "AlonzoTxAuxDataRaw" (AlonzoTxAuxData era)
  instance
    NoThunks (AlonzoTxAuxData era)

-- | Construct auxiliary data. Make sure not to supply plutus script versions that are not
-- supported in this era, because it will result in a runtime exception. Use
-- `mkAlonzoTxAuxData` instead if you need runtime safety guarantees.
pattern AlonzoTxAuxData ::
  forall era.
  (HasCallStack, AlonzoEraScript era) =>
  Map Word64 Metadatum ->
  StrictSeq (NativeScript era) ->
  Map Language (NE.NonEmpty PlutusBinary) ->
  AlonzoTxAuxData era
pattern $mAlonzoTxAuxData :: forall {r} {era}.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era
-> (Map Word64 Metadatum
    -> StrictSeq (NativeScript era)
    -> Map Language (NonEmpty PlutusBinary)
    -> r)
-> ((# #) -> r)
-> r
$bAlonzoTxAuxData :: forall era.
(HasCallStack, AlonzoEraScript era) =>
Map Word64 Metadatum
-> StrictSeq (NativeScript era)
-> Map Language (NonEmpty PlutusBinary)
-> AlonzoTxAuxData era
AlonzoTxAuxData {forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> Map Word64 Metadatum
atadMetadata, forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> StrictSeq (NativeScript era)
atadNativeScripts, forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> Map Language (NonEmpty PlutusBinary)
atadPlutus} <-
  (getMemoRawType -> AlonzoTxAuxDataRaw atadMetadata atadNativeScripts atadPlutus)
  where
    AlonzoTxAuxData Map Word64 Metadatum
atadrMetadata StrictSeq (NativeScript era)
atadrNativeScripts Map Language (NonEmpty PlutusBinary)
atadrPlutus =
      let unsupportedScripts :: Map Language (NonEmpty PlutusBinary)
unsupportedScripts =
            (Language -> NonEmpty PlutusBinary -> Bool)
-> Map Language (NonEmpty PlutusBinary)
-> Map Language (NonEmpty PlutusBinary)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Language
lang NonEmpty PlutusBinary
_ -> Language
lang Language -> Language -> Bool
forall a. Ord a => a -> a -> Bool
> forall era. AlonzoEraScript era => Language
eraMaxLanguage @era) Map Language (NonEmpty PlutusBinary)
atadrPlutus
          prefix :: [Char]
prefix =
            [Char] -> Context -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (Language -> [Char]
forall a. Show a => a -> [Char]
show (Language -> [Char]) -> [Language] -> Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Language (NonEmpty PlutusBinary) -> [Language]
forall k a. Map k a -> [k]
Map.keys Map Language (NonEmpty PlutusBinary)
unsupportedScripts)
              [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Map Language (NonEmpty PlutusBinary) -> Int
forall k a. Map k a -> Int
Map.size Map Language (NonEmpty PlutusBinary)
unsupportedScripts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then [Char]
" languages are" else [Char]
" language is"
       in if Map Language (NonEmpty PlutusBinary) -> Bool
forall k a. Map k a -> Bool
Map.null Map Language (NonEmpty PlutusBinary)
unsupportedScripts
            then
              forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (RawType (AlonzoTxAuxData era) -> AlonzoTxAuxData era)
-> RawType (AlonzoTxAuxData era) -> AlonzoTxAuxData era
forall a b. (a -> b) -> a -> b
$ AlonzoTxAuxDataRaw {Map Word64 Metadatum
atadrMetadata :: Map Word64 Metadatum
atadrMetadata :: Map Word64 Metadatum
atadrMetadata, StrictSeq (NativeScript era)
atadrNativeScripts :: StrictSeq (NativeScript era)
atadrNativeScripts :: StrictSeq (NativeScript era)
atadrNativeScripts, Map Language (NonEmpty PlutusBinary)
atadrPlutus :: Map Language (NonEmpty PlutusBinary)
atadrPlutus :: Map Language (NonEmpty PlutusBinary)
atadrPlutus}
            else [Char] -> AlonzoTxAuxData era
forall a. HasCallStack => [Char] -> a
error ([Char] -> AlonzoTxAuxData era) -> [Char] -> AlonzoTxAuxData era
forall a b. (a -> b) -> a -> b
$ [Char]
prefix [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" not supported in " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ forall era. Era era => [Char]
eraName @era

{-# COMPLETE AlonzoTxAuxData #-}

pattern AlonzoTxAuxData' ::
  forall era.
  Map Word64 Metadatum ->
  StrictSeq (NativeScript era) ->
  Map Language (NE.NonEmpty PlutusBinary) ->
  AlonzoTxAuxData era
pattern $mAlonzoTxAuxData' :: forall {r} {era}.
AlonzoTxAuxData era
-> (Map Word64 Metadatum
    -> StrictSeq (NativeScript era)
    -> Map Language (NonEmpty PlutusBinary)
    -> r)
-> ((# #) -> r)
-> r
AlonzoTxAuxData' {forall era. AlonzoTxAuxData era -> Map Word64 Metadatum
atadMetadata', forall era. AlonzoTxAuxData era -> StrictSeq (NativeScript era)
atadNativeScripts', forall era.
AlonzoTxAuxData era -> Map Language (NonEmpty PlutusBinary)
atadPlutus'} <-
  (getMemoRawType -> AlonzoTxAuxDataRaw atadMetadata' atadNativeScripts' atadPlutus')