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

module Cardano.Ledger.Alonzo.TxWits (
  Redeemers (Redeemers),
  RedeemersRaw,
  unRedeemers,
  nullRedeemers,
  lookupRedeemer,
  upgradeRedeemers,
  TxDats (TxDats, TxDats'),
  TxDatsRaw,
  upgradeTxDats,
  AlonzoTxWits (
    AlonzoTxWits,
    txwitsVKey,
    txwitsBoot,
    txscripts,
    txdats,
    txrdmrs,
    AlonzoTxWits',
    txwitsVKey',
    txwitsBoot',
    txscripts',
    txdats',
    txrdmrs'
  ),
  AlonzoTxWitsRaw,
  addrAlonzoTxWitsL,
  bootAddrAlonzoTxWitsL,
  scriptAlonzoTxWitsL,
  datsAlonzoTxWitsL,
  rdmrsAlonzoTxWitsL,
  AlonzoEraTxWits (..),
  hashDataTxWitsL,
  unTxDats,
  nullDats,
  alonzoEqTxWitsRaw,
)
where

import Cardano.Ledger.Alonzo.Era (AlonzoEra)
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoEraScript (..),
  AsIx (..),
  decodePlutusScript,
  fromPlutusScript,
  toPlutusSLanguage,
 )
import Cardano.Ledger.Binary (
  Annotator,
  DecCBOR (..),
  DecCBORGroup (..),
  Decoder,
  EncCBOR (..),
  EncCBORGroup (..),
  Encoding,
  ToCBOR (..),
  TokenType (..),
  allowTag,
  decodeList,
  decodeListLenOrIndef,
  decodeListLikeWithCount,
  decodeMapLenOrIndef,
  decodeMapLikeEnforceNoDuplicates,
  decodeNonEmptyList,
  encodeFoldableEncoder,
  encodeListLen,
  encodeTag,
  ifDecoderVersionAtLeast,
  ifEncodingVersionAtLeast,
  natVersion,
  peekTokenType,
  setTag,
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Core
import Cardano.Ledger.Keys (BootstrapWitness, WitVKey)
import Cardano.Ledger.MemoBytes (
  EqRaw (..),
  Mem,
  MemoBytes,
  Memoized (..),
  eqRawType,
  getMemoRawType,
  lensMemoRawType,
  mkMemoized,
 )
import Cardano.Ledger.Plutus.Data (Data, hashData, upgradeData)
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..))
import Cardano.Ledger.Plutus.Language (
  Language (..),
  Plutus (..),
  PlutusLanguage,
  SLanguage (..),
  plutusBinary,
  plutusLanguage,
 )
import Cardano.Ledger.Shelley.TxWits (
  ShelleyTxWits (..),
  mapTraverseableDecoderA,
  shelleyEqTxWitsRaw,
 )
import Control.DeepSeq (NFData)
import Control.Monad (when, (>=>))
import Data.Bifunctor (Bifunctor (first))
import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.MapExtras as Map (fromElems)
import Data.Maybe (mapMaybe)
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks)

-- ==========================================

newtype RedeemersRaw era = RedeemersRaw
  { forall era.
RedeemersRaw era
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemersRaw :: Map (PlutusPurpose AsIx era) (Data era, ExUnits)
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (RedeemersRaw era) x -> RedeemersRaw era
forall era x. RedeemersRaw era -> Rep (RedeemersRaw era) x
$cto :: forall era x. Rep (RedeemersRaw era) x -> RedeemersRaw era
$cfrom :: forall era x. RedeemersRaw era -> Rep (RedeemersRaw era) x
Generic)

deriving newtype instance AlonzoEraScript era => Eq (RedeemersRaw era)
deriving newtype instance AlonzoEraScript era => NFData (RedeemersRaw era)
deriving newtype instance AlonzoEraScript era => NoThunks (RedeemersRaw era)
deriving newtype instance AlonzoEraScript era => Show (RedeemersRaw era)

instance AlonzoEraScript era => EncCBOR (RedeemersRaw era) where
  encCBOR :: RedeemersRaw era -> Encoding
encCBOR (RedeemersRaw Map (PlutusPurpose AsIx era) (Data era, ExUnits)
rs) =
    Version -> Encoding -> Encoding -> Encoding
ifEncodingVersionAtLeast
      (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
      (forall a. EncCBOR a => a -> Encoding
encCBOR Map (PlutusPurpose AsIx era) (Data era, ExUnits)
rs)
      (forall (f :: * -> *) a.
Foldable f =>
(a -> Encoding) -> f a -> Encoding
encodeFoldableEncoder forall {a} {a} {a}.
(EncCBORGroup a, EncCBOR a, EncCBOR a) =>
(a, (a, a)) -> Encoding
keyValueEncoder forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toAscList Map (PlutusPurpose AsIx era) (Data era, ExUnits)
rs)
    where
      keyValueEncoder :: (a, (a, a)) -> Encoding
keyValueEncoder (a
ptr, (a
dats, a
exs)) =
        Word -> Encoding
encodeListLen (forall a. EncCBORGroup a => a -> Word
listLen a
ptr forall a. Num a => a -> a -> a
+ Word
2)
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBORGroup a => a -> Encoding
encCBORGroup a
ptr
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR a
dats
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR a
exs

instance Memoized Redeemers where
  type RawType Redeemers = RedeemersRaw

-- | Note that 'Redeemers' are based on 'MemoBytes' since we must preserve
-- the original bytes for the 'Cardano.Ledger.Alonzo.Tx.ScriptIntegrity'.
-- Since the 'Redeemers' exist outside of the transaction body,
-- this is how we ensure that they are not manipulated.
newtype Redeemers era = RedeemersConstr (MemoBytes RedeemersRaw era)
  deriving newtype (forall x. Rep (Redeemers era) x -> Redeemers era
forall x. Redeemers era -> Rep (Redeemers era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (Redeemers era) x -> Redeemers era
forall era x. Redeemers era -> Rep (Redeemers era) x
to :: forall x. Rep (Redeemers era) x -> Redeemers era
$cto :: forall era x. Rep (Redeemers era) x -> Redeemers era
from :: forall x. Redeemers era -> Rep (Redeemers era) x
$cfrom :: forall era x. Redeemers era -> Rep (Redeemers era) x
Generic, Redeemers era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Redeemers era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Redeemers era) -> Size
forall {era}. Typeable era => Typeable (Redeemers era)
forall era. Typeable era => Redeemers 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 [Redeemers era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Redeemers era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Redeemers era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Redeemers era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Redeemers era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Redeemers era) -> Size
toCBOR :: Redeemers era -> Encoding
$ctoCBOR :: forall era. Typeable era => Redeemers era -> Encoding
ToCBOR, Redeemers era -> Int
Redeemers era -> ByteString
forall i. Proxy i -> Redeemers era -> SafeHash i
forall era. Redeemers era -> Int
forall era. Redeemers era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall era i. Proxy i -> Redeemers era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> Redeemers era -> SafeHash i
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> Redeemers era -> SafeHash i
originalBytesSize :: Redeemers era -> Int
$coriginalBytesSize :: forall era. Redeemers era -> Int
originalBytes :: Redeemers era -> ByteString
$coriginalBytes :: forall era. Redeemers era -> ByteString
SafeToHash, Typeable)

deriving newtype instance AlonzoEraScript era => Eq (Redeemers era)
deriving newtype instance AlonzoEraScript era => NFData (Redeemers era)
deriving newtype instance AlonzoEraScript era => NoThunks (Redeemers era)
deriving instance AlonzoEraScript era => Show (Redeemers era)

instance AlonzoEraScript era => Semigroup (Redeemers era) where
  Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
x <> :: Redeemers era -> Redeemers era -> Redeemers era
<> Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
y = forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers forall a b. (a -> b) -> a -> b
$ Map (PlutusPurpose AsIx era) (Data era, ExUnits)
x forall a. Semigroup a => a -> a -> a
<> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
y

instance AlonzoEraScript era => Monoid (Redeemers era) where
  mempty :: Redeemers era
mempty = forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers forall a. Monoid a => a
mempty

-- =====================================================
-- Pattern for Redeemers

pattern Redeemers ::
  forall era.
  AlonzoEraScript era =>
  Map (PlutusPurpose AsIx era) (Data era, ExUnits) ->
  Redeemers era
pattern $bRedeemers :: forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
$mRedeemers :: forall {r} {era}.
AlonzoEraScript era =>
Redeemers era
-> (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> r)
-> ((# #) -> r)
-> r
Redeemers rs <-
  (getMemoRawType -> RedeemersRaw rs)
  where
    Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
rs' = forall era (t :: * -> *).
(Era era, EncCBOR (RawType t era), Memoized t) =>
RawType t era -> t era
mkMemoized forall a b. (a -> b) -> a -> b
$ forall era.
Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
RedeemersRaw Map (PlutusPurpose AsIx era) (Data era, ExUnits)
rs'

{-# COMPLETE Redeemers #-}

unRedeemers :: Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers :: forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers = forall era.
RedeemersRaw era
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemersRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

nullRedeemers :: Redeemers era -> Bool
nullRedeemers :: forall era. Redeemers era -> Bool
nullRedeemers = forall k a. Map k a -> Bool
Map.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers

emptyRedeemers :: AlonzoEraScript era => Redeemers era
emptyRedeemers :: forall era. AlonzoEraScript era => Redeemers era
emptyRedeemers = forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers forall a. Monoid a => a
mempty

lookupRedeemer ::
  Ord (PlutusPurpose AsIx era) =>
  PlutusPurpose AsIx era ->
  Redeemers era ->
  Maybe (Data era, ExUnits)
lookupRedeemer :: forall era.
Ord (PlutusPurpose AsIx era) =>
PlutusPurpose AsIx era
-> Redeemers era -> Maybe (Data era, ExUnits)
lookupRedeemer PlutusPurpose AsIx era
key = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PlutusPurpose AsIx era
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers

-- | Upgrade redeemers from one era to another. The underlying data structure
-- will remain identical, but the memoised serialisation may change to reflect
-- the versioned serialisation of the new era.
upgradeRedeemers ::
  forall era.
  (AlonzoEraScript (PreviousEra era), AlonzoEraScript era) =>
  Redeemers (PreviousEra era) ->
  Redeemers era
upgradeRedeemers :: forall era.
(AlonzoEraScript (PreviousEra era), AlonzoEraScript era) =>
Redeemers (PreviousEra era) -> Redeemers era
upgradeRedeemers =
  forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys forall era.
(AlonzoEraScript era, AlonzoEraScript (PreviousEra era)) =>
PlutusPurpose AsIx (PreviousEra era) -> PlutusPurpose AsIx era
upgradePlutusPurposeAsIx
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall era1 era2. (Era era1, Era era2) => Data era1 -> Data era2
upgradeData)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers

-- ====================================================================
-- In the Spec, AlonzoTxWits has 4 logical fields. Here in the implementation
-- we make two physical modifications.
-- 1) The witsVKey field of AlonzoTxWits is specified as a (Map VKey Signature)
--    for efficiency this is stored as a (Set WitVKey) where WitVKey is
--    logically a triple (VKey,Signature,VKeyHash).
-- 2) We add a 5th field _witsBoot to be backwards compatible with
--    earlier Eras: Byron, Mary, Allegra
-- So logically things look like this
--   data AlonzoTxWits = AlonzoTxWits
--      (Set (WitVKey 'Witness (Crypto era)))
--      (Set (BootstrapWitness (Crypto era)))
--      (Map (ScriptHash (Crypto era)) (Script era))
--      (TxDats era)
--      (Map RdmrPtr (Data era, ExUnits))

-- | Internal 'AlonzoTxWits' type, lacking serialised bytes.
data AlonzoTxWitsRaw era = AlonzoTxWitsRaw
  { forall era. AlonzoTxWitsRaw era -> Set (WitVKey 'Witness)
atwrAddrTxWits :: !(Set (WitVKey 'Witness))
  , forall era. AlonzoTxWitsRaw era -> Set BootstrapWitness
atwrBootAddrTxWits :: !(Set BootstrapWitness)
  , forall era. AlonzoTxWitsRaw era -> Map ScriptHash (Script era)
atwrScriptTxWits :: !(Map ScriptHash (Script era))
  , forall era. AlonzoTxWitsRaw era -> TxDats era
atwrDatsTxWits :: !(TxDats era)
  , forall era. AlonzoTxWitsRaw era -> Redeemers era
atwrRdmrsTxWits :: !(Redeemers era)
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AlonzoTxWitsRaw era) x -> AlonzoTxWitsRaw era
forall era x. AlonzoTxWitsRaw era -> Rep (AlonzoTxWitsRaw era) x
$cto :: forall era x. Rep (AlonzoTxWitsRaw era) x -> AlonzoTxWitsRaw era
$cfrom :: forall era x. AlonzoTxWitsRaw era -> Rep (AlonzoTxWitsRaw era) x
Generic)

instance
  ( Era era
  , NFData (Script era)
  , NFData (TxDats era)
  , NFData (Redeemers era)
  ) =>
  NFData (AlonzoTxWitsRaw era)

newtype AlonzoTxWits era = TxWitnessConstr (MemoBytes AlonzoTxWitsRaw era)
  deriving newtype (AlonzoTxWits era -> Int
AlonzoTxWits era -> ByteString
forall i. Proxy i -> AlonzoTxWits era -> SafeHash i
forall era. AlonzoTxWits era -> Int
forall era. AlonzoTxWits era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall era i. Proxy i -> AlonzoTxWits era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> AlonzoTxWits era -> SafeHash i
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> AlonzoTxWits era -> SafeHash i
originalBytesSize :: AlonzoTxWits era -> Int
$coriginalBytesSize :: forall era. AlonzoTxWits era -> Int
originalBytes :: AlonzoTxWits era -> ByteString
$coriginalBytes :: forall era. AlonzoTxWits era -> ByteString
SafeToHash, AlonzoTxWits era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxWits era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxWits era) -> Size
forall {era}. Typeable era => Typeable (AlonzoTxWits era)
forall era. Typeable era => AlonzoTxWits 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 [AlonzoTxWits era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxWits era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxWits era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxWits era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxWits era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxWits era) -> Size
toCBOR :: AlonzoTxWits era -> Encoding
$ctoCBOR :: forall era. Typeable era => AlonzoTxWits era -> Encoding
ToCBOR)
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AlonzoTxWits era) x -> AlonzoTxWits era
forall era x. AlonzoTxWits era -> Rep (AlonzoTxWits era) x
$cto :: forall era x. Rep (AlonzoTxWits era) x -> AlonzoTxWits era
$cfrom :: forall era x. AlonzoTxWits era -> Rep (AlonzoTxWits era) x
Generic)

instance Memoized AlonzoTxWits where
  type RawType AlonzoTxWits = AlonzoTxWitsRaw

instance AlonzoEraScript era => Semigroup (AlonzoTxWits era) where
  <> :: AlonzoTxWits era -> AlonzoTxWits era -> AlonzoTxWits era
(<>) AlonzoTxWits era
x AlonzoTxWits era
y | forall era. AlonzoEraScript era => AlonzoTxWits era -> Bool
isEmptyTxWitness AlonzoTxWits era
x = AlonzoTxWits era
y
  (<>) AlonzoTxWits era
x AlonzoTxWits era
y | forall era. AlonzoEraScript era => AlonzoTxWits era -> Bool
isEmptyTxWitness AlonzoTxWits era
y = AlonzoTxWits era
x
  (<>)
    (forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType -> AlonzoTxWitsRaw Set (WitVKey 'Witness)
a Set BootstrapWitness
b Map ScriptHash (Script era)
c TxDats era
d (Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
e))
    (forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType -> AlonzoTxWitsRaw Set (WitVKey 'Witness)
u Set BootstrapWitness
v Map ScriptHash (Script era)
w TxDats era
x (Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
y)) =
      forall era.
AlonzoEraScript era =>
Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWits era
AlonzoTxWits (Set (WitVKey 'Witness)
a forall a. Semigroup a => a -> a -> a
<> Set (WitVKey 'Witness)
u) (Set BootstrapWitness
b forall a. Semigroup a => a -> a -> a
<> Set BootstrapWitness
v) (Map ScriptHash (Script era)
c forall a. Semigroup a => a -> a -> a
<> Map ScriptHash (Script era)
w) (TxDats era
d forall a. Semigroup a => a -> a -> a
<> TxDats era
x) (forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
e forall a. Semigroup a => a -> a -> a
<> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
y))

instance AlonzoEraScript era => Monoid (AlonzoTxWits era) where
  mempty :: AlonzoTxWits era
mempty = forall era.
AlonzoEraScript era =>
Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWits era
AlonzoTxWits forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers forall a. Monoid a => a
mempty)

deriving instance
  ( Era era
  , NFData (Script era)
  , NFData (TxDats era)
  , NFData (Redeemers era)
  ) =>
  NFData (AlonzoTxWits era)

isEmptyTxWitness :: AlonzoEraScript era => AlonzoTxWits era -> Bool
isEmptyTxWitness :: forall era. AlonzoEraScript era => AlonzoTxWits era -> Bool
isEmptyTxWitness (forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType -> AlonzoTxWitsRaw Set (WitVKey 'Witness)
a Set BootstrapWitness
b Map ScriptHash (Script era)
c TxDats era
d (Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
e)) =
  forall a. Set a -> Bool
Set.null Set (WitVKey 'Witness)
a Bool -> Bool -> Bool
&& forall a. Set a -> Bool
Set.null Set BootstrapWitness
b Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map ScriptHash (Script era)
c Bool -> Bool -> Bool
&& forall era. TxDats era -> Bool
nullDats TxDats era
d Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map (PlutusPurpose AsIx era) (Data era, ExUnits)
e

-- =====================================================
newtype TxDatsRaw era = TxDatsRaw {forall era. TxDatsRaw era -> Map DataHash (Data era)
unTxDatsRaw :: Map DataHash (Data era)}
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxDatsRaw era) x -> TxDatsRaw era
forall era x. TxDatsRaw era -> Rep (TxDatsRaw era) x
$cto :: forall era x. Rep (TxDatsRaw era) x -> TxDatsRaw era
$cfrom :: forall era x. TxDatsRaw era -> Rep (TxDatsRaw era) x
Generic, Typeable, TxDatsRaw era -> TxDatsRaw era -> Bool
forall era. TxDatsRaw era -> TxDatsRaw era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxDatsRaw era -> TxDatsRaw era -> Bool
$c/= :: forall era. TxDatsRaw era -> TxDatsRaw era -> Bool
== :: TxDatsRaw era -> TxDatsRaw era -> Bool
$c== :: forall era. TxDatsRaw era -> TxDatsRaw era -> Bool
Eq)
  deriving newtype (Context -> TxDatsRaw era -> IO (Maybe ThunkInfo)
Proxy (TxDatsRaw era) -> String
forall era.
Typeable era =>
Context -> TxDatsRaw era -> IO (Maybe ThunkInfo)
forall era. Typeable era => Proxy (TxDatsRaw era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TxDatsRaw era) -> String
$cshowTypeOf :: forall era. Typeable era => Proxy (TxDatsRaw era) -> String
wNoThunks :: Context -> TxDatsRaw era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Typeable era =>
Context -> TxDatsRaw era -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxDatsRaw era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Typeable era =>
Context -> TxDatsRaw era -> IO (Maybe ThunkInfo)
NoThunks, TxDatsRaw era -> ()
forall era. TxDatsRaw era -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxDatsRaw era -> ()
$crnf :: forall era. TxDatsRaw era -> ()
NFData)

deriving instance Show (TxDatsRaw era)

instance (Typeable era, EncCBOR (Data era)) => EncCBOR (TxDatsRaw era) where
  encCBOR :: TxDatsRaw era -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encodeWithSetTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. TxDatsRaw era -> Map DataHash (Data era)
unTxDatsRaw

pattern TxDats' :: Map DataHash (Data era) -> TxDats era
pattern $mTxDats' :: forall {r} {era}.
TxDats era -> (Map DataHash (Data era) -> r) -> ((# #) -> r) -> r
TxDats' m <- (getMemoRawType -> TxDatsRaw m)

{-# COMPLETE TxDats' #-}

pattern TxDats :: Era era => Map DataHash (Data era) -> TxDats era
pattern $bTxDats :: forall era. Era era => Map DataHash (Data era) -> TxDats era
$mTxDats :: forall {r} {era}.
Era era =>
TxDats era -> (Map DataHash (Data era) -> r) -> ((# #) -> r) -> r
TxDats m <- (getMemoRawType -> TxDatsRaw m)
  where
    TxDats Map DataHash (Data era)
m = forall era (t :: * -> *).
(Era era, EncCBOR (RawType t era), Memoized t) =>
RawType t era -> t era
mkMemoized (forall era. Map DataHash (Data era) -> TxDatsRaw era
TxDatsRaw Map DataHash (Data era)
m)

{-# COMPLETE TxDats #-}

unTxDats :: TxDats era -> Map DataHash (Data era)
unTxDats :: forall era. TxDats era -> Map DataHash (Data era)
unTxDats (TxDats' Map DataHash (Data era)
m) = Map DataHash (Data era)
m

nullDats :: TxDats era -> Bool
nullDats :: forall era. TxDats era -> Bool
nullDats (TxDats' Map DataHash (Data era)
d) = forall k a. Map k a -> Bool
Map.null Map DataHash (Data era)
d

instance Era era => DecCBOR (Annotator (TxDatsRaw era)) where
  decCBOR :: forall s. Decoder s (Annotator (TxDatsRaw era))
decCBOR =
    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)
      ( forall s. Word -> Decoder s ()
allowTag Word
setTag
          forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA
            (forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList forall a s. DecCBOR a => Decoder s a
decCBOR)
            (forall era. Map DataHash (Data era) -> TxDatsRaw era
TxDatsRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
Map.fromElems forall era. Data era -> DataHash
hashData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
      )
      (forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR) (forall era. Map DataHash (Data era) -> TxDatsRaw era
TxDatsRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
Map.fromElems forall era. Data era -> DataHash
hashData))
  {-# INLINE decCBOR #-}

-- | Note that 'TxDats' are based on 'MemoBytes' since we must preserve
-- the original bytes for the 'Cardano.Ledger.Alonzo.Tx.ScriptIntegrity'.
-- Since the 'TxDats' exist outside of the transaction body,
-- this is how we ensure that they are not manipulated.
newtype TxDats era = TxDatsConstr (MemoBytes TxDatsRaw era)
  deriving newtype (TxDats era -> Int
TxDats era -> ByteString
forall i. Proxy i -> TxDats era -> SafeHash i
forall era. TxDats era -> Int
forall era. TxDats era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall era i. Proxy i -> TxDats era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> TxDats era -> SafeHash i
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> TxDats era -> SafeHash i
originalBytesSize :: TxDats era -> Int
$coriginalBytesSize :: forall era. TxDats era -> Int
originalBytes :: TxDats era -> ByteString
$coriginalBytes :: forall era. TxDats era -> ByteString
SafeToHash, TxDats era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxDats era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxDats era) -> Size
forall {era}. Typeable era => Typeable (TxDats era)
forall era. Typeable era => TxDats 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 [TxDats era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxDats era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxDats era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxDats era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxDats era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxDats era) -> Size
toCBOR :: TxDats era -> Encoding
$ctoCBOR :: forall era. Typeable era => TxDats era -> Encoding
ToCBOR, TxDats era -> TxDats era -> Bool
forall era. TxDats era -> TxDats era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxDats era -> TxDats era -> Bool
$c/= :: forall era. TxDats era -> TxDats era -> Bool
== :: TxDats era -> TxDats era -> Bool
$c== :: forall era. TxDats era -> TxDats era -> Bool
Eq, Context -> TxDats era -> IO (Maybe ThunkInfo)
Proxy (TxDats era) -> String
forall era.
Typeable era =>
Context -> TxDats era -> IO (Maybe ThunkInfo)
forall era. Typeable era => Proxy (TxDats era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TxDats era) -> String
$cshowTypeOf :: forall era. Typeable era => Proxy (TxDats era) -> String
wNoThunks :: Context -> TxDats era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Typeable era =>
Context -> TxDats era -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxDats era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Typeable era =>
Context -> TxDats era -> IO (Maybe ThunkInfo)
NoThunks, TxDats era -> ()
forall era. TxDats era -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxDats era -> ()
$crnf :: forall era. TxDats era -> ()
NFData)
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxDats era) x -> TxDats era
forall era x. TxDats era -> Rep (TxDats era) x
$cto :: forall era x. Rep (TxDats era) x -> TxDats era
$cfrom :: forall era x. TxDats era -> Rep (TxDats era) x
Generic)

instance Memoized TxDats where
  type RawType TxDats = TxDatsRaw

deriving instance Show (TxDats era)

instance Era era => Semigroup (TxDats era) where
  (TxDats Map DataHash (Data era)
m) <> :: TxDats era -> TxDats era -> TxDats era
<> (TxDats Map DataHash (Data era)
m') = forall era. Era era => Map DataHash (Data era) -> TxDats era
TxDats (Map DataHash (Data era)
m forall a. Semigroup a => a -> a -> a
<> Map DataHash (Data era)
m')

instance Era era => Monoid (TxDats era) where
  mempty :: TxDats era
mempty = forall era. Era era => Map DataHash (Data era) -> TxDats era
TxDats forall a. Monoid a => a
mempty

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

deriving via
  (Mem TxDatsRaw era)
  instance
    Era era => DecCBOR (Annotator (TxDats era))

-- | Upgrade 'TxDats' from one era to another. The underlying data structure
-- will remain identical, but the memoised serialisation may change to reflect
-- the versioned serialisation of the new era.
upgradeTxDats ::
  (Era era1, Era era2) =>
  TxDats era1 ->
  TxDats era2
upgradeTxDats :: forall era1 era2.
(Era era1, Era era2) =>
TxDats era1 -> TxDats era2
upgradeTxDats (TxDats Map DataHash (Data era1)
datMap) = forall era. Era era => Map DataHash (Data era) -> TxDats era
TxDats forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall era1 era2. (Era era1, Era era2) => Data era1 -> Data era2
upgradeData Map DataHash (Data era1)
datMap

-- =====================================================
-- AlonzoTxWits instances

deriving stock instance AlonzoEraScript era => Eq (AlonzoTxWitsRaw era)

deriving stock instance AlonzoEraScript era => Show (AlonzoTxWitsRaw era)

instance AlonzoEraScript era => NoThunks (AlonzoTxWitsRaw era)

deriving newtype instance AlonzoEraScript era => Eq (AlonzoTxWits era)

deriving newtype instance AlonzoEraScript era => Show (AlonzoTxWits era)

deriving newtype instance AlonzoEraScript era => NoThunks (AlonzoTxWits era)

-- =====================================================
-- Pattern for AlonzoTxWits

pattern AlonzoTxWits' ::
  Era era =>
  Set (WitVKey 'Witness) ->
  Set BootstrapWitness ->
  Map ScriptHash (Script era) ->
  TxDats era ->
  Redeemers era ->
  AlonzoTxWits era
pattern $mAlonzoTxWits' :: forall {r} {era}.
Era era =>
AlonzoTxWits era
-> (Set (WitVKey 'Witness)
    -> Set BootstrapWitness
    -> Map ScriptHash (Script era)
    -> TxDats era
    -> Redeemers era
    -> r)
-> ((# #) -> r)
-> r
AlonzoTxWits' {forall era. Era era => AlonzoTxWits era -> Set (WitVKey 'Witness)
txwitsVKey', forall era. Era era => AlonzoTxWits era -> Set BootstrapWitness
txwitsBoot', forall era.
Era era =>
AlonzoTxWits era -> Map ScriptHash (Script era)
txscripts', forall era. Era era => AlonzoTxWits era -> TxDats era
txdats', forall era. Era era => AlonzoTxWits era -> Redeemers era
txrdmrs'} <-
  (getMemoRawType -> AlonzoTxWitsRaw txwitsVKey' txwitsBoot' txscripts' txdats' txrdmrs')

{-# COMPLETE AlonzoTxWits' #-}

pattern AlonzoTxWits ::
  AlonzoEraScript era =>
  Set (WitVKey 'Witness) ->
  Set BootstrapWitness ->
  Map ScriptHash (Script era) ->
  TxDats era ->
  Redeemers era ->
  AlonzoTxWits era
pattern $bAlonzoTxWits :: forall era.
AlonzoEraScript era =>
Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWits era
$mAlonzoTxWits :: forall {r} {era}.
AlonzoEraScript era =>
AlonzoTxWits era
-> (Set (WitVKey 'Witness)
    -> Set BootstrapWitness
    -> Map ScriptHash (Script era)
    -> TxDats era
    -> Redeemers era
    -> r)
-> ((# #) -> r)
-> r
AlonzoTxWits {forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness)
txwitsVKey, forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set BootstrapWitness
txwitsBoot, forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map ScriptHash (Script era)
txscripts, forall era. AlonzoEraScript era => AlonzoTxWits era -> TxDats era
txdats, forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Redeemers era
txrdmrs} <-
  (getMemoRawType -> AlonzoTxWitsRaw txwitsVKey txwitsBoot txscripts txdats txrdmrs)
  where
    AlonzoTxWits Set (WitVKey 'Witness)
witsVKey' Set BootstrapWitness
witsBoot' Map ScriptHash (Script era)
witsScript' TxDats era
witsDat' Redeemers era
witsRdmr' =
      forall era (t :: * -> *).
(Era era, EncCBOR (RawType t era), Memoized t) =>
RawType t era -> t era
mkMemoized forall a b. (a -> b) -> a -> b
$ forall era.
Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWitsRaw era
AlonzoTxWitsRaw Set (WitVKey 'Witness)
witsVKey' Set BootstrapWitness
witsBoot' Map ScriptHash (Script era)
witsScript' TxDats era
witsDat' Redeemers era
witsRdmr'

{-# COMPLETE AlonzoTxWits #-}

-- =======================================================
-- Accessors
-- =======================================================

addrAlonzoTxWitsL ::
  AlonzoEraScript era =>
  Lens' (AlonzoTxWits era) (Set (WitVKey 'Witness))
addrAlonzoTxWitsL :: forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Set (WitVKey 'Witness))
addrAlonzoTxWitsL =
  forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxWitsRaw era -> Set (WitVKey 'Witness)
atwrAddrTxWits forall a b. (a -> b) -> a -> b
$ \RawType AlonzoTxWits era
witsRaw Set (WitVKey 'Witness)
addrWits -> RawType AlonzoTxWits era
witsRaw {atwrAddrTxWits :: Set (WitVKey 'Witness)
atwrAddrTxWits = Set (WitVKey 'Witness)
addrWits}
{-# INLINEABLE addrAlonzoTxWitsL #-}

bootAddrAlonzoTxWitsL ::
  AlonzoEraScript era =>
  Lens' (AlonzoTxWits era) (Set BootstrapWitness)
bootAddrAlonzoTxWitsL :: forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Set BootstrapWitness)
bootAddrAlonzoTxWitsL =
  forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxWitsRaw era -> Set BootstrapWitness
atwrBootAddrTxWits forall a b. (a -> b) -> a -> b
$
    \RawType AlonzoTxWits era
witsRaw Set BootstrapWitness
bootAddrWits -> RawType AlonzoTxWits era
witsRaw {atwrBootAddrTxWits :: Set BootstrapWitness
atwrBootAddrTxWits = Set BootstrapWitness
bootAddrWits}
{-# INLINEABLE bootAddrAlonzoTxWitsL #-}

scriptAlonzoTxWitsL ::
  AlonzoEraScript era =>
  Lens' (AlonzoTxWits era) (Map ScriptHash (Script era))
scriptAlonzoTxWitsL :: forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Map ScriptHash (Script era))
scriptAlonzoTxWitsL =
  forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxWitsRaw era -> Map ScriptHash (Script era)
atwrScriptTxWits forall a b. (a -> b) -> a -> b
$ \RawType AlonzoTxWits era
witsRaw Map ScriptHash (Script era)
scriptWits -> RawType AlonzoTxWits era
witsRaw {atwrScriptTxWits :: Map ScriptHash (Script era)
atwrScriptTxWits = Map ScriptHash (Script era)
scriptWits}
{-# INLINEABLE scriptAlonzoTxWitsL #-}

datsAlonzoTxWitsL ::
  AlonzoEraScript era =>
  Lens' (AlonzoTxWits era) (TxDats era)
datsAlonzoTxWitsL :: forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (TxDats era)
datsAlonzoTxWitsL =
  forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxWitsRaw era -> TxDats era
atwrDatsTxWits forall a b. (a -> b) -> a -> b
$ \RawType AlonzoTxWits era
witsRaw TxDats era
datsWits -> RawType AlonzoTxWits era
witsRaw {atwrDatsTxWits :: TxDats era
atwrDatsTxWits = TxDats era
datsWits}
{-# INLINEABLE datsAlonzoTxWitsL #-}

rdmrsAlonzoTxWitsL ::
  AlonzoEraScript era =>
  Lens' (AlonzoTxWits era) (Redeemers era)
rdmrsAlonzoTxWitsL :: forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Redeemers era)
rdmrsAlonzoTxWitsL =
  forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxWitsRaw era -> Redeemers era
atwrRdmrsTxWits forall a b. (a -> b) -> a -> b
$ \RawType AlonzoTxWits era
witsRaw Redeemers era
rdmrsWits -> RawType AlonzoTxWits era
witsRaw {atwrRdmrsTxWits :: Redeemers era
atwrRdmrsTxWits = Redeemers era
rdmrsWits}
{-# INLINEABLE rdmrsAlonzoTxWitsL #-}

instance EraScript AlonzoEra => EraTxWits AlonzoEra where
  type TxWits AlonzoEra = AlonzoTxWits AlonzoEra

  mkBasicTxWits :: TxWits AlonzoEra
mkBasicTxWits = forall a. Monoid a => a
mempty

  addrTxWitsL :: Lens' (TxWits AlonzoEra) (Set (WitVKey 'Witness))
addrTxWitsL = forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Set (WitVKey 'Witness))
addrAlonzoTxWitsL
  {-# INLINE addrTxWitsL #-}

  bootAddrTxWitsL :: Lens' (TxWits AlonzoEra) (Set BootstrapWitness)
bootAddrTxWitsL = forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Set BootstrapWitness)
bootAddrAlonzoTxWitsL
  {-# INLINE bootAddrTxWitsL #-}

  scriptTxWitsL :: Lens' (TxWits AlonzoEra) (Map ScriptHash (Script AlonzoEra))
scriptTxWitsL = forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Map ScriptHash (Script era))
scriptAlonzoTxWitsL
  {-# INLINE scriptTxWitsL #-}

  upgradeTxWits :: EraTxWits (PreviousEra AlonzoEra) =>
TxWits (PreviousEra AlonzoEra) -> TxWits AlonzoEra
upgradeTxWits (ShelleyTxWits {Set (WitVKey 'Witness)
addrWits :: forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness)
addrWits :: Set (WitVKey 'Witness)
addrWits, Map ScriptHash (Script MaryEra)
scriptWits :: forall era.
EraScript era =>
ShelleyTxWits era -> Map ScriptHash (Script era)
scriptWits :: Map ScriptHash (Script MaryEra)
scriptWits, Set BootstrapWitness
bootWits :: forall era.
EraScript era =>
ShelleyTxWits era -> Set BootstrapWitness
bootWits :: Set BootstrapWitness
bootWits}) =
    forall era.
AlonzoEraScript era =>
Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWits era
AlonzoTxWits Set (WitVKey 'Witness)
addrWits Set BootstrapWitness
bootWits (forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map ScriptHash (Script MaryEra)
scriptWits) forall a. Monoid a => a
mempty forall era. AlonzoEraScript era => Redeemers era
emptyRedeemers

class (EraTxWits era, AlonzoEraScript era) => AlonzoEraTxWits era where
  datsTxWitsL :: Lens' (TxWits era) (TxDats era)

  rdmrsTxWitsL :: Lens' (TxWits era) (Redeemers era)

instance EraScript AlonzoEra => AlonzoEraTxWits AlonzoEra where
  datsTxWitsL :: Lens' (TxWits AlonzoEra) (TxDats AlonzoEra)
datsTxWitsL = forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (TxDats era)
datsAlonzoTxWitsL
  {-# INLINE datsTxWitsL #-}

  rdmrsTxWitsL :: Lens' (TxWits AlonzoEra) (Redeemers AlonzoEra)
rdmrsTxWitsL = forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Redeemers era)
rdmrsAlonzoTxWitsL
  {-# INLINE rdmrsTxWitsL #-}

instance (TxWits era ~ AlonzoTxWits era, AlonzoEraTxWits era) => EqRaw (AlonzoTxWits era) where
  eqRaw :: AlonzoTxWits era -> AlonzoTxWits era -> Bool
eqRaw = forall era. AlonzoEraTxWits era => TxWits era -> TxWits era -> Bool
alonzoEqTxWitsRaw

-- | This is a convenience Lens that will hash the `Data` when it is being added to the
-- `TxWits`. See `datsTxWitsL` for a version that aloows setting `TxDats` instead.
hashDataTxWitsL :: AlonzoEraTxWits era => Lens (TxWits era) (TxWits era) (TxDats era) [Data era]
hashDataTxWitsL :: forall era.
AlonzoEraTxWits era =>
Lens (TxWits era) (TxWits era) (TxDats era) [Data era]
hashDataTxWitsL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\TxWits era
wits -> TxWits era
wits forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
datsTxWitsL)
    (\TxWits era
wits [Data era]
ds -> TxWits era
wits forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
datsTxWitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era. Era era => Map DataHash (Data era) -> TxDats era
TxDats (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(forall era. Data era -> DataHash
hashData Data era
d, Data era
d) | Data era
d <- [Data era]
ds]))
{-# INLINEABLE hashDataTxWitsL #-}

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

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

instance AlonzoEraScript era => EncCBOR (AlonzoTxWitsRaw era) where
  encCBOR :: AlonzoTxWitsRaw era -> Encoding
encCBOR (AlonzoTxWitsRaw Set (WitVKey 'Witness)
vkeys Set BootstrapWitness
boots Map ScriptHash (Script era)
scripts TxDats era
dats Redeemers era
rdmrs) =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Encode ('Closed 'Sparse) t
Keyed
        ( \Set (WitVKey 'Witness)
a Set BootstrapWitness
b Map ScriptHash (Script era)
c Map ScriptHash (Plutus 'PlutusV1)
d Map ScriptHash (Plutus 'PlutusV2)
e Map ScriptHash (Plutus 'PlutusV3)
f TxDats era
g Redeemers era
h ->
            let ps :: Map ScriptHash (Script era)
ps = forall (l :: Language) h.
PlutusLanguage l =>
Map h (Plutus l) -> Map h (Script era)
toScript @'PlutusV1 Map ScriptHash (Plutus 'PlutusV1)
d forall a. Semigroup a => a -> a -> a
<> forall (l :: Language) h.
PlutusLanguage l =>
Map h (Plutus l) -> Map h (Script era)
toScript @'PlutusV2 Map ScriptHash (Plutus 'PlutusV2)
e forall a. Semigroup a => a -> a -> a
<> forall (l :: Language) h.
PlutusLanguage l =>
Map h (Plutus l) -> Map h (Script era)
toScript @'PlutusV3 Map ScriptHash (Plutus 'PlutusV3)
f
             in forall era.
Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWitsRaw era
AlonzoTxWitsRaw Set (WitVKey 'Witness)
a Set BootstrapWitness
b (Map ScriptHash (Script era)
c forall a. Semigroup a => a -> a -> a
<> Map ScriptHash (Script era)
ps) TxDats era
g Redeemers era
h
        )
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 forall a b. (a -> b) -> a -> b
$ forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (WitVKey 'Witness)
vkeys)
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 forall a b. (a -> b) -> a -> b
$ forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set BootstrapWitness
boots)
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit
          forall (t :: * -> *) a. Foldable t => t a -> Bool
null
          ( forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 forall a b. (a -> b) -> a -> b
$
              forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E
                (forall a. EncCBOR a => a -> Encoding
encodeWithSetTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall era. EraScript era => Script era -> Maybe (NativeScript era)
getNativeScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems)
                (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter forall era. EraScript era => Script era -> Bool
isNativeScript Map ScriptHash (Script era)
scripts)
          )
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
3 forall a b. (a -> b) -> a -> b
$ forall (l :: Language).
PlutusLanguage l =>
SLanguage l -> Encode ('Closed 'Dense) (Map ScriptHash (Plutus l))
encodePlutus SLanguage 'PlutusV1
SPlutusV1)
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
6 forall a b. (a -> b) -> a -> b
$ forall (l :: Language).
PlutusLanguage l =>
SLanguage l -> Encode ('Closed 'Dense) (Map ScriptHash (Plutus l))
encodePlutus SLanguage 'PlutusV2
SPlutusV2)
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
7 forall a b. (a -> b) -> a -> b
$ forall (l :: Language).
PlutusLanguage l =>
SLanguage l -> Encode ('Closed 'Dense) (Map ScriptHash (Plutus l))
encodePlutus SLanguage 'PlutusV3
SPlutusV3)
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall era. TxDats era -> Bool
nullDats (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
4 forall a b. (a -> b) -> a -> b
$ forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxDats era
dats)
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall era. Redeemers era -> Bool
nullRedeemers (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
5 forall a b. (a -> b) -> a -> b
$ forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Redeemers era
rdmrs)
    where
      encodePlutus ::
        PlutusLanguage l =>
        SLanguage l ->
        Encode ('Closed 'Dense) (Map.Map ScriptHash (Plutus l))
      encodePlutus :: forall (l :: Language).
PlutusLanguage l =>
SLanguage l -> Encode ('Closed 'Dense) (Map ScriptHash (Plutus l))
encodePlutus SLanguage l
slang =
        forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E
          (forall a. EncCBOR a => a -> Encoding
encodeWithSetTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => a -> Encoding
encCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (l :: Language). Plutus l -> PlutusBinary
plutusBinary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems)
          (forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
toPlutusScript forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (l :: Language) era.
(PlutusLanguage l, AlonzoEraScript era) =>
SLanguage l -> PlutusScript era -> Maybe (Plutus l)
toPlutusSLanguage SLanguage l
slang) Map ScriptHash (Script era)
scripts)
      toScript ::
        forall l h. PlutusLanguage l => Map.Map h (Plutus l) -> Map.Map h (Script era)
      toScript :: forall (l :: Language) h.
PlutusLanguage l =>
Map h (Plutus l) -> Map h (Script era)
toScript Map h (Plutus l)
ps =
        case forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (l :: Language).
(AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Maybe (PlutusScript era)
mkPlutusScript) Map h (Plutus l)
ps of
          Maybe (Map h (Script era))
Nothing ->
            forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
              String
"Impossible: Re-constructing unsupported language: "
                forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage (forall {k} (t :: k). Proxy t
Proxy @l))
          Just Map h (Script era)
plutusScripts -> Map h (Script era)
plutusScripts

instance AlonzoEraScript era => DecCBOR (Annotator (RedeemersRaw era)) where
  decCBOR :: forall s. Decoder s (Annotator (RedeemersRaw era))
decCBOR = do
    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)
      ( forall s. Decoder s TokenType
peekTokenType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          TokenType
TypeMapLenIndef -> forall s. Decoder s (Annotator (RedeemersRaw era))
decodeMapRedeemers
          TokenType
TypeMapLen -> forall s. Decoder s (Annotator (RedeemersRaw era))
decodeMapRedeemers
          TokenType
_ -> Decoder s (Annotator (RedeemersRaw era))
decodeListRedeemers
      )
      ( forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA
          (forall s a. Decoder s a -> Decoder s [a]
decodeList forall s.
Decoder s (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
decodeAnnElement)
          (forall era.
Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
RedeemersRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList)
      )
    where
      decodeRedeemersWith :: Decoder
  s (NonEmpty (Annotator (PlutusPurpose AsIx b, (Data b, ExUnits))))
-> Decoder s (Annotator (RedeemersRaw b))
decodeRedeemersWith Decoder
  s (NonEmpty (Annotator (PlutusPurpose AsIx b, (Data b, ExUnits))))
nonEmptyDecoder =
        forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA
          Decoder
  s (NonEmpty (Annotator (PlutusPurpose AsIx b, (Data b, ExUnits))))
nonEmptyDecoder
          (forall era.
Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> RedeemersRaw era
RedeemersRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
      decodeMapRedeemers :: Decoder s (Annotator (RedeemersRaw era))
decodeMapRedeemers = forall {b} {s}.
Ord (PlutusPurpose AsIx b) =>
Decoder
  s (NonEmpty (Annotator (PlutusPurpose AsIx b, (Data b, ExUnits))))
-> Decoder s (Annotator (RedeemersRaw b))
decodeRedeemersWith forall a b. (a -> b) -> a -> b
$ do
        (Int
_, [Annotator (PlutusPurpose AsIx era, (Data era, ExUnits))]
xs) <- forall s a b.
Monoid b =>
Decoder s (Maybe Int)
-> (a -> b -> b) -> (b -> Decoder s a) -> Decoder s (Int, b)
decodeListLikeWithCount forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef (:) forall a b. (a -> b) -> a -> b
$ \[Annotator (PlutusPurpose AsIx era, (Data era, ExUnits))]
_ -> do
          PlutusPurpose AsIx era
ptr <- forall a s. DecCBOR a => Decoder s a
decCBOR
          (Annotator (Data era)
annData, ExUnits
exUnits) <- forall a s. DecCBOR a => Decoder s a
decCBOR
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (\Data era
d -> (PlutusPurpose AsIx era
ptr, (Data era
d, ExUnits
exUnits))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (Data era)
annData
        case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Annotator (PlutusPurpose AsIx era, (Data era, ExUnits))]
xs of
          Maybe
  (NonEmpty
     (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits))))
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected redeemers map to be non-empty"
          Just NonEmpty (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
neList -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
neList
      decodeListRedeemers :: Decoder s (Annotator (RedeemersRaw era))
decodeListRedeemers =
        forall {b} {s}.
Ord (PlutusPurpose AsIx b) =>
Decoder
  s (NonEmpty (Annotator (PlutusPurpose AsIx b, (Data b, ExUnits))))
-> Decoder s (Annotator (RedeemersRaw b))
decodeRedeemersWith (forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList forall s.
Decoder s (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
decodeAnnElement)
      decodeAnnElement ::
        forall s. Decoder s (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
      decodeAnnElement :: forall s.
Decoder s (Annotator (PlutusPurpose AsIx era, (Data era, ExUnits)))
decodeAnnElement = do
        (PlutusPurpose AsIx era
rdmrPtr, Annotator (Data era)
dat, ExUnits
ex) <- forall s.
Decoder s (PlutusPurpose AsIx era, Annotator (Data era), ExUnits)
decodeElement
        let f :: a -> a -> b -> (a, (a, b))
f a
x a
y b
z = (a
x, (a
y, b
z))
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {a} {a} {b}. a -> a -> b -> (a, (a, b))
f PlutusPurpose AsIx era
rdmrPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (Data era)
dat forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ExUnits
ex
      {-# INLINE decodeAnnElement #-}
      decodeElement ::
        forall s. Decoder s (PlutusPurpose AsIx era, Annotator (Data era), ExUnits)
      decodeElement :: forall s.
Decoder s (PlutusPurpose AsIx era, Annotator (Data era), ExUnits)
decodeElement = do
        forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed
          Text
"Redeemer"
          (\(PlutusPurpose AsIx era
rdmrPtr, Annotator (Data era)
_, ExUnits
_) -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. EncCBORGroup a => a -> Word
listLen PlutusPurpose AsIx era
rdmrPtr) forall a. Num a => a -> a -> a
+ Int
2)
          forall a b. (a -> b) -> a -> b
$ (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBORGroup a => Decoder s a
decCBORGroup forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      {-# INLINE decodeElement #-}
  {-# INLINE decCBOR #-}

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

deriving via
  (Mem RedeemersRaw era)
  instance
    AlonzoEraScript era => DecCBOR (Annotator (Redeemers era))

instance
  ( AlonzoEraScript era
  , EncCBOR (Data era)
  ) =>
  DecCBOR (Annotator (AlonzoTxWitsRaw era))
  where
  decCBOR :: forall s. Decoder s (Annotator (AlonzoTxWitsRaw era))
decCBOR =
    forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
      forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed
        String
"AlonzoTxWits"
        (forall (f :: * -> *) a. Applicative f => a -> f a
pure AlonzoTxWitsRaw era
emptyTxWitness)
        Word -> Field (Annotator (AlonzoTxWitsRaw era))
txWitnessField
        []
    where
      emptyTxWitness :: AlonzoTxWitsRaw era
emptyTxWitness = forall era.
Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWitsRaw era
AlonzoTxWitsRaw forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall era. AlonzoEraScript era => Redeemers era
emptyRedeemers

      txWitnessField :: Word -> Field (Annotator (AlonzoTxWitsRaw era))
      txWitnessField :: Word -> Field (Annotator (AlonzoTxWitsRaw era))
txWitnessField Word
0 =
        forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
          (\Set (WitVKey 'Witness)
x AlonzoTxWitsRaw era
wits -> AlonzoTxWitsRaw era
wits {atwrAddrTxWits :: Set (WitVKey 'Witness)
atwrAddrTxWits = Set (WitVKey 'Witness)
x})
          ( forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a b. (a -> b) -> a -> b
$
              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)
                ( forall s. Word -> Decoder s ()
allowTag Word
setTag
                    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList forall a s. DecCBOR a => Decoder s a
decCBOR) (forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
                )
                (forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR) forall a. Ord a => [a] -> Set a
Set.fromList)
          )
      txWitnessField Word
1 =
        forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
          Map ScriptHash (Script era)
-> AlonzoTxWitsRaw era -> AlonzoTxWitsRaw era
addScripts
          (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s (Annotator (Map ScriptHash (Script era)))
nativeScriptsDecoder)
      txWitnessField Word
2 =
        forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
          (\Set BootstrapWitness
x AlonzoTxWitsRaw era
wits -> AlonzoTxWitsRaw era
wits {atwrBootAddrTxWits :: Set BootstrapWitness
atwrBootAddrTxWits = Set BootstrapWitness
x})
          ( forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a b. (a -> b) -> a -> b
$
              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)
                ( forall s. Word -> Decoder s ()
allowTag Word
setTag
                    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList forall a s. DecCBOR a => Decoder s a
decCBOR) (forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
                )
                (forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR) forall a. Ord a => [a] -> Set a
Set.fromList)
          )
      txWitnessField Word
3 = forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA Map ScriptHash (Script era)
-> AlonzoTxWitsRaw era -> AlonzoTxWitsRaw era
addScripts (forall (l :: Language).
PlutusLanguage l =>
SLanguage l
-> Decode ('Closed 'Dense) (Map ScriptHash (Script era))
decodePlutus SLanguage 'PlutusV1
SPlutusV1)
      txWitnessField Word
4 =
        forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
          (\TxDats era
x AlonzoTxWitsRaw era
wits -> AlonzoTxWitsRaw era
wits {atwrDatsTxWits :: TxDats era
atwrDatsTxWits = TxDats era
x})
          forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      txWitnessField Word
5 = forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA (\Redeemers era
x AlonzoTxWitsRaw era
wits -> AlonzoTxWitsRaw era
wits {atwrRdmrsTxWits :: Redeemers era
atwrRdmrsTxWits = Redeemers era
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      txWitnessField Word
6 = forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA Map ScriptHash (Script era)
-> AlonzoTxWitsRaw era -> AlonzoTxWitsRaw era
addScripts (forall (l :: Language).
PlutusLanguage l =>
SLanguage l
-> Decode ('Closed 'Dense) (Map ScriptHash (Script era))
decodePlutus SLanguage 'PlutusV2
SPlutusV2)
      txWitnessField Word
7 = forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) x -> Field (ann t)
fieldA Map ScriptHash (Script era)
-> AlonzoTxWitsRaw era -> AlonzoTxWitsRaw era
addScripts (forall (l :: Language).
PlutusLanguage l =>
SLanguage l
-> Decode ('Closed 'Dense) (Map ScriptHash (Script era))
decodePlutus SLanguage 'PlutusV3
SPlutusV3)
      txWitnessField Word
n = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Any
_ Annotator (AlonzoTxWitsRaw era)
t -> Annotator (AlonzoTxWitsRaw era)
t) (forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n)
      {-# INLINE txWitnessField #-}

      nativeScriptsDecoder :: Decoder s (Annotator (Map ScriptHash (Script era)))
      nativeScriptsDecoder :: forall s. Decoder s (Annotator (Map ScriptHash (Script era)))
nativeScriptsDecoder =
        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)
          ( forall s. Word -> Decoder s ()
allowTag Word
setTag
              forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList forall s. Decoder s (Annotator (ScriptHash, Script era))
pairDecoder) (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
          )
          (forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s [a]
decodeList forall s. Decoder s (Annotator (ScriptHash, Script era))
pairDecoder) forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList)
        where
          pairDecoder :: Decoder s (Annotator (ScriptHash, Script era))
          pairDecoder :: forall s. Decoder s (Annotator (ScriptHash, Script era))
pairDecoder = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Script era -> (ScriptHash, Script era)
asHashedPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => NativeScript era -> Script era
fromNativeScript) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

      addScripts ::
        Map ScriptHash (Script era) ->
        AlonzoTxWitsRaw era ->
        AlonzoTxWitsRaw era
      addScripts :: Map ScriptHash (Script era)
-> AlonzoTxWitsRaw era -> AlonzoTxWitsRaw era
addScripts Map ScriptHash (Script era)
scriptWitnesses AlonzoTxWitsRaw era
txWits =
        AlonzoTxWitsRaw era
txWits
          { atwrScriptTxWits :: Map ScriptHash (Script era)
atwrScriptTxWits = Map ScriptHash (Script era)
scriptWitnesses forall a. Semigroup a => a -> a -> a
<> forall era. AlonzoTxWitsRaw era -> Map ScriptHash (Script era)
atwrScriptTxWits AlonzoTxWitsRaw era
txWits
          }
      {-# INLINE addScripts #-}

      decodePlutus ::
        PlutusLanguage l =>
        SLanguage l ->
        Decode ('Closed 'Dense) (Map ScriptHash (Script era))
      decodePlutus :: forall (l :: Language).
PlutusLanguage l =>
SLanguage l
-> Decode ('Closed 'Dense) (Map ScriptHash (Script era))
decodePlutus SLanguage l
slang =
        forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a b. (a -> b) -> a -> b
$
          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)
            (forall s.
Decoder s (Script era) -> Decoder s (Map ScriptHash (Script era))
scriptDecoderV9 (forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era (l :: Language) s.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decoder s (PlutusScript era)
decodePlutusScript SLanguage l
slang))
            (forall s.
Decoder s (Script era) -> Decoder s (Map ScriptHash (Script era))
scriptDecoder (forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era (l :: Language) s.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decoder s (PlutusScript era)
decodePlutusScript SLanguage l
slang))
      {-# INLINE decodePlutus #-}

      scriptDecoderV9 ::
        Decoder s (Script era) ->
        Decoder s (Map ScriptHash (Script era))
      scriptDecoderV9 :: forall s.
Decoder s (Script era) -> Decoder s (Map ScriptHash (Script era))
scriptDecoderV9 Decoder s (Script era)
decodeScript = do
        forall s. Word -> Decoder s ()
allowTag Word
setTag
        Map ScriptHash (Script era)
scriptMap <- forall k s v.
Ord k =>
Decoder s (Maybe Int) -> Decoder s (k, v) -> Decoder s (Map k v)
decodeMapLikeEnforceNoDuplicates forall s. Decoder s (Maybe Int)
decodeListLenOrIndef forall a b. (a -> b) -> a -> b
$ do
          Script era -> (ScriptHash, Script era)
asHashedPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Script era)
decodeScript
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall k a. Map k a -> Bool
Map.null Map ScriptHash (Script era)
scriptMap) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty list of scripts is not allowed"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Map ScriptHash (Script era)
scriptMap
      {-# INLINE scriptDecoderV9 #-}

      scriptDecoder ::
        Decoder s (Script era) ->
        Decoder s (Map ScriptHash (Script era))
      scriptDecoder :: forall s.
Decoder s (Script era) -> Decoder s (Map ScriptHash (Script era))
scriptDecoder Decoder s (Script era)
decodeScript =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
          forall s a. Decoder s a -> Decoder s [a]
decodeList forall a b. (a -> b) -> a -> b
$
            Script era -> (ScriptHash, Script era)
asHashedPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Script era)
decodeScript
      {-# INLINE scriptDecoder #-}

      asHashedPair :: Script era -> (ScriptHash, Script era)
asHashedPair Script era
script =
        let !scriptHash :: ScriptHash
scriptHash = forall era. EraScript era => Script era -> ScriptHash
hashScript @era Script era
script
         in (ScriptHash
scriptHash, Script era
script)
      {-# INLINE asHashedPair #-}
  {-# INLINE decCBOR #-}

deriving via
  (Mem AlonzoTxWitsRaw era)
  instance
    AlonzoEraScript era => DecCBOR (Annotator (AlonzoTxWits era))

alonzoEqTxWitsRaw :: AlonzoEraTxWits era => TxWits era -> TxWits era -> Bool
alonzoEqTxWitsRaw :: forall era. AlonzoEraTxWits era => TxWits era -> TxWits era -> Bool
alonzoEqTxWitsRaw TxWits era
txWits1 TxWits era
txWits2 =
  forall era. EraTxWits era => TxWits era -> TxWits era -> Bool
shelleyEqTxWitsRaw TxWits era
txWits1 TxWits era
txWits2
    Bool -> Bool -> Bool
&& forall (t :: * -> *) era.
(Memoized t, Eq (RawType t era)) =>
t era -> t era -> Bool
eqRawType (TxWits era
txWits1 forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
datsTxWitsL) (TxWits era
txWits2 forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
datsTxWitsL)
    Bool -> Bool -> Bool
&& forall (t :: * -> *) era.
(Memoized t, Eq (RawType t era)) =>
t era -> t era -> Bool
eqRawType (TxWits era
txWits1 forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL) (TxWits era
txWits2 forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL)

encodeWithSetTag :: EncCBOR a => a -> Encoding
encodeWithSetTag :: forall a. EncCBOR a => a -> Encoding
encodeWithSetTag a
xs =
  Version -> Encoding -> Encoding -> Encoding
ifEncodingVersionAtLeast
    (forall (v :: Nat).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
    (Word -> Encoding
encodeTag Word
setTag forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR a
xs)
    (forall a. EncCBOR a => a -> Encoding
encCBOR a
xs)