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

module Cardano.Ledger.Babbage.TxOut (
  BabbageTxOut (
    BabbageTxOut,
    TxOutCompact,
    TxOutCompactDH,
    TxOutCompactDatum,
    TxOutCompactRefScript
  ),
  BabbageEraTxOut (..),
  TxOut,
  addrEitherBabbageTxOutL,
  valueEitherBabbageTxOutL,
  dataHashBabbageTxOutL,
  dataBabbageTxOutL,
  datumBabbageTxOutL,
  referenceScriptBabbageTxOutL,
  getDatumBabbageTxOut,
  babbageMinUTxOValue,
  getEitherAddrBabbageTxOut,
  txOutData,
  txOutDataHash,
  txOutScript,
  internBabbageTxOut,
) where

import Cardano.Ledger.Address (
  Addr (..),
  CompactAddr,
  compactAddr,
  decompactAddr,
  fromCborBothAddr,
 )
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.TxBody (
  Addr28Extra,
  AlonzoTxOut (AlonzoTxOut),
  DataHash32,
  decodeAddress28,
  decodeDataHash32,
  encodeAddress28,
  encodeDataHash32,
  getAdaOnly,
 )
import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo
import Cardano.Ledger.Babbage.Era (BabbageEra)
import Cardano.Ledger.Babbage.PParams (
  BabbageEraPParams (..),
  CoinPerByte (..),
  ppCoinsPerUTxOByteL,
 )
import Cardano.Ledger.Babbage.Scripts ()
import Cardano.Ledger.BaseTypes (
  StrictMaybe (..),
  strictMaybeToMaybe,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  Decoder,
  DecoderError (..),
  EncCBOR (..),
  Encoding,
  FromCBOR (..),
  Interns,
  Sized (..),
  ToCBOR (..),
  TokenType (..),
  cborError,
  decodeBreakOr,
  decodeFull',
  decodeListLenOrIndef,
  decodeMemPack,
  decodeNestedCborBytes,
  encodeListLen,
  encodeNestedCbor,
  getDecoderVersion,
  interns,
  peekTokenType,
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Compactible
import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
import Cardano.Ledger.Plutus.Data (
  BinaryData,
  Data,
  Datum (..),
  binaryDataToData,
  dataToBinaryData,
 )
import Cardano.Ledger.Val (Val (..))
import Control.DeepSeq (NFData (rnf), rwhnf)
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import Data.Maybe (fromMaybe)
import Data.MemPack
import qualified Data.Text as T
import Data.Typeable (Proxy (..))
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Lens.Micro (Lens', lens, to, (^.))
import NoThunks.Class (NoThunks)

class (AlonzoEraTxOut era, AlonzoEraScript era) => BabbageEraTxOut era where
  referenceScriptTxOutL :: Lens' (TxOut era) (StrictMaybe (Script era))

  dataTxOutL :: Lens' (TxOut era) (StrictMaybe (Data era))

  datumTxOutL :: Lens' (TxOut era) (Datum era)

data BabbageTxOut era
  = TxOutCompact'
      {-# UNPACK #-} !CompactAddr
      !(CompactForm (Value era))
  | TxOutCompactDH'
      {-# UNPACK #-} !CompactAddr
      !(CompactForm (Value era))
      !DataHash
  | TxOutCompactDatum
      {-# UNPACK #-} !CompactAddr
      !(CompactForm (Value era))
      {-# UNPACK #-} !(BinaryData era) -- Inline data
  | TxOutCompactRefScript
      {-# UNPACK #-} !CompactAddr
      !(CompactForm (Value era))
      !(Datum era)
      !(Script era)
  | TxOut_AddrHash28_AdaOnly
      !(Credential 'Staking)
      {-# UNPACK #-} !Addr28Extra
      {-# UNPACK #-} !(CompactForm Coin) -- Ada value
  | TxOut_AddrHash28_AdaOnly_DataHash32
      !(Credential 'Staking)
      {-# UNPACK #-} !Addr28Extra
      {-# UNPACK #-} !(CompactForm Coin) -- Ada value
      {-# UNPACK #-} !DataHash32
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (BabbageTxOut era) x -> BabbageTxOut era
forall era x. BabbageTxOut era -> Rep (BabbageTxOut era) x
$cto :: forall era x. Rep (BabbageTxOut era) x -> BabbageTxOut era
$cfrom :: forall era x. BabbageTxOut era -> Rep (BabbageTxOut era) x
Generic)

-- | This instance is backwards compatible in binary representation with TxOut instances for all
-- previous era
instance
  ( Era era
  , MemPack (Script era)
  , MemPack (CompactForm (Value era))
  ) =>
  MemPack (BabbageTxOut era)
  where
  packedByteCount :: BabbageTxOut era -> Int
packedByteCount = \case
    TxOutCompact' CompactAddr
cAddr CompactForm (Value era)
cValue ->
      Int
packedTagByteCount forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount CompactAddr
cAddr forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount CompactForm (Value era)
cValue
    TxOutCompactDH' CompactAddr
cAddr CompactForm (Value era)
cValue DataHash
dataHash ->
      Int
packedTagByteCount forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount CompactAddr
cAddr forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount CompactForm (Value era)
cValue forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount DataHash
dataHash
    TxOut_AddrHash28_AdaOnly Credential 'Staking
cred Addr28Extra
addr28 CompactForm Coin
cCoin ->
      Int
packedTagByteCount forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount Credential 'Staking
cred forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount Addr28Extra
addr28 forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount CompactForm Coin
cCoin
    TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
cred Addr28Extra
addr28 CompactForm Coin
cCoin DataHash32
dataHash32 ->
      Int
packedTagByteCount
        forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount Credential 'Staking
cred
        forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount Addr28Extra
addr28
        forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount CompactForm Coin
cCoin
        forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount DataHash32
dataHash32
    TxOutCompactDatum CompactAddr
cAddr CompactForm (Value era)
cValue BinaryData era
datum ->
      Int
packedTagByteCount forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount CompactAddr
cAddr forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount CompactForm (Value era)
cValue forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount BinaryData era
datum
    TxOutCompactRefScript CompactAddr
cAddr CompactForm (Value era)
cValue Datum era
datum Script era
script ->
      Int
packedTagByteCount
        forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount CompactAddr
cAddr
        forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount CompactForm (Value era)
cValue
        forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount Datum era
datum
        forall a. Num a => a -> a -> a
+ forall a. MemPack a => a -> Int
packedByteCount Script era
script
  {-# INLINE packedByteCount #-}
  packM :: forall s. BabbageTxOut era -> Pack s ()
packM = \case
    TxOutCompact' CompactAddr
cAddr CompactForm (Value era)
cValue ->
      forall s. Tag -> Pack s ()
packTagM Tag
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM CompactAddr
cAddr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM CompactForm (Value era)
cValue
    TxOutCompactDH' CompactAddr
cAddr CompactForm (Value era)
cValue DataHash
dataHash ->
      forall s. Tag -> Pack s ()
packTagM Tag
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM CompactAddr
cAddr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM CompactForm (Value era)
cValue forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM DataHash
dataHash
    TxOut_AddrHash28_AdaOnly Credential 'Staking
cred Addr28Extra
addr28 CompactForm Coin
cCoin ->
      forall s. Tag -> Pack s ()
packTagM Tag
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM Credential 'Staking
cred forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM Addr28Extra
addr28 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM CompactForm Coin
cCoin
    TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
cred Addr28Extra
addr28 CompactForm Coin
cCoin DataHash32
dataHash32 ->
      forall s. Tag -> Pack s ()
packTagM Tag
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM Credential 'Staking
cred forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM Addr28Extra
addr28 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM CompactForm Coin
cCoin forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM DataHash32
dataHash32
    TxOutCompactDatum CompactAddr
cAddr CompactForm (Value era)
cValue BinaryData era
datum ->
      forall s. Tag -> Pack s ()
packTagM Tag
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM CompactAddr
cAddr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM CompactForm (Value era)
cValue forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM BinaryData era
datum
    TxOutCompactRefScript CompactAddr
cAddr CompactForm (Value era)
cValue Datum era
datum Script era
script ->
      forall s. Tag -> Pack s ()
packTagM Tag
5 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM CompactAddr
cAddr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM CompactForm (Value era)
cValue forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM Datum era
datum forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. MemPack a => a -> Pack s ()
packM Script era
script
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (BabbageTxOut era)
unpackM =
    forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Tag
0 -> forall era.
CompactAddr -> CompactForm (Value era) -> BabbageTxOut era
TxOutCompact' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
      Tag
1 -> forall era.
CompactAddr
-> CompactForm (Value era) -> DataHash -> BabbageTxOut era
TxOutCompactDH' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
      Tag
2 -> forall era.
Credential 'Staking
-> Addr28Extra -> CompactForm Coin -> BabbageTxOut era
TxOut_AddrHash28_AdaOnly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
      Tag
3 -> forall era.
Credential 'Staking
-> Addr28Extra
-> CompactForm Coin
-> DataHash32
-> BabbageTxOut era
TxOut_AddrHash28_AdaOnly_DataHash32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
      Tag
4 -> forall era.
CompactAddr
-> CompactForm (Value era) -> BinaryData era -> BabbageTxOut era
TxOutCompactDatum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
      Tag
5 -> forall era.
CompactAddr
-> CompactForm (Value era)
-> Datum era
-> Script era
-> BabbageTxOut era
TxOutCompactRefScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
      Tag
n -> forall a (m :: * -> *) b. (MemPack a, MonadFail m) => Tag -> m b
unknownTagM @(BabbageTxOut era) Tag
n
  {-# INLINE unpackM #-}

instance EraTxOut BabbageEra where
  type TxOut BabbageEra = BabbageTxOut BabbageEra

  mkBasicTxOut :: HasCallStack => Addr -> Value BabbageEra -> TxOut BabbageEra
mkBasicTxOut Addr
addr Value BabbageEra
vl = forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value BabbageEra
vl forall era. Datum era
NoDatum forall a. StrictMaybe a
SNothing

  upgradeTxOut :: EraTxOut (PreviousEra BabbageEra) =>
TxOut (PreviousEra BabbageEra) -> TxOut BabbageEra
upgradeTxOut (AlonzoTxOut Addr
addr Value AlonzoEra
value StrictMaybe DataHash
mDatumHash) = forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value AlonzoEra
value Datum BabbageEra
datum forall a. StrictMaybe a
SNothing
    where
      datum :: Datum BabbageEra
datum = case StrictMaybe DataHash
mDatumHash of
        StrictMaybe DataHash
SNothing -> forall era. Datum era
NoDatum
        SJust DataHash
datumHash -> forall era. DataHash -> Datum era
DatumHash DataHash
datumHash

  addrEitherTxOutL :: Lens' (TxOut BabbageEra) (Either Addr CompactAddr)
addrEitherTxOutL = forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (Either Addr CompactAddr)
addrEitherBabbageTxOutL
  {-# INLINE addrEitherTxOutL #-}

  valueEitherTxOutL :: Lens'
  (TxOut BabbageEra)
  (Either (Value BabbageEra) (CompactForm (Value BabbageEra)))
valueEitherTxOutL = forall era.
EraTxOut era =>
Lens'
  (BabbageTxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherBabbageTxOutL
  {-# INLINE valueEitherTxOutL #-}

  getMinCoinSizedTxOut :: PParams BabbageEra -> Sized (TxOut BabbageEra) -> Coin
getMinCoinSizedTxOut = forall era a.
BabbageEraPParams era =>
PParams era -> Sized a -> Coin
babbageMinUTxOValue

dataHashBabbageTxOutL ::
  EraTxOut era => Lens' (BabbageTxOut era) (StrictMaybe DataHash)
dataHashBabbageTxOutL :: forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (StrictMaybe DataHash)
dataHashBabbageTxOutL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    forall era. BabbageTxOut era -> StrictMaybe DataHash
getDataHashBabbageTxOut
    ( \(BabbageTxOut Addr
addr Value era
cv Datum era
_ StrictMaybe (Script era)
s) -> \case
        StrictMaybe DataHash
SNothing -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value era
cv forall era. Datum era
NoDatum StrictMaybe (Script era)
s
        SJust DataHash
dh -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value era
cv (forall era. DataHash -> Datum era
DatumHash DataHash
dh) StrictMaybe (Script era)
s
    )
{-# INLINEABLE dataHashBabbageTxOutL #-}

instance AlonzoEraTxOut BabbageEra where
  dataHashTxOutL :: Lens' (TxOut BabbageEra) (StrictMaybe DataHash)
dataHashTxOutL = forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (StrictMaybe DataHash)
dataHashBabbageTxOutL
  {-# INLINEABLE dataHashTxOutL #-}

  datumTxOutF :: SimpleGetter (TxOut BabbageEra) (Datum BabbageEra)
datumTxOutF = forall s a. (s -> a) -> SimpleGetter s a
to forall era. BabbageTxOut era -> Datum era
getDatumBabbageTxOut
  {-# INLINEABLE datumTxOutF #-}

dataBabbageTxOutL :: EraTxOut era => Lens' (BabbageTxOut era) (StrictMaybe (Data era))
dataBabbageTxOutL :: forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (StrictMaybe (Data era))
dataBabbageTxOutL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    forall era. Era era => BabbageTxOut era -> StrictMaybe (Data era)
getDataBabbageTxOut
    ( \(BabbageTxOut Addr
addr Value era
cv Datum era
_ StrictMaybe (Script era)
s) ->
        \case
          StrictMaybe (Data era)
SNothing -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value era
cv forall era. Datum era
NoDatum StrictMaybe (Script era)
s
          SJust Data era
d -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value era
cv (forall era. BinaryData era -> Datum era
Datum (forall era. Data era -> BinaryData era
dataToBinaryData Data era
d)) StrictMaybe (Script era)
s
    )
{-# INLINEABLE dataBabbageTxOutL #-}

datumBabbageTxOutL :: EraTxOut era => Lens' (BabbageTxOut era) (Datum era)
datumBabbageTxOutL :: forall era. EraTxOut era => Lens' (BabbageTxOut era) (Datum era)
datumBabbageTxOutL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. BabbageTxOut era -> Datum era
getDatumBabbageTxOut (\(BabbageTxOut Addr
addr Value era
cv Datum era
_ StrictMaybe (Script era)
s) Datum era
d -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value era
cv Datum era
d StrictMaybe (Script era)
s)
{-# INLINEABLE datumBabbageTxOutL #-}

referenceScriptBabbageTxOutL :: EraTxOut era => Lens' (BabbageTxOut era) (StrictMaybe (Script era))
referenceScriptBabbageTxOutL :: forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (StrictMaybe (Script era))
referenceScriptBabbageTxOutL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. BabbageTxOut era -> StrictMaybe (Script era)
getScriptBabbageTxOut (\(BabbageTxOut Addr
addr Value era
cv Datum era
d StrictMaybe (Script era)
_) StrictMaybe (Script era)
s -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value era
cv Datum era
d StrictMaybe (Script era)
s)
{-# INLINEABLE referenceScriptBabbageTxOutL #-}

instance BabbageEraTxOut BabbageEra where
  dataTxOutL :: Lens' (TxOut BabbageEra) (StrictMaybe (Data BabbageEra))
dataTxOutL = forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (StrictMaybe (Data era))
dataBabbageTxOutL
  {-# INLINEABLE dataTxOutL #-}

  datumTxOutL :: Lens' (TxOut BabbageEra) (Datum BabbageEra)
datumTxOutL = forall era. EraTxOut era => Lens' (BabbageTxOut era) (Datum era)
datumBabbageTxOutL
  {-# INLINEABLE datumTxOutL #-}

  referenceScriptTxOutL :: Lens' (TxOut BabbageEra) (StrictMaybe (Script BabbageEra))
referenceScriptTxOutL = forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (StrictMaybe (Script era))
referenceScriptBabbageTxOutL
  {-# INLINEABLE referenceScriptTxOutL #-}

addrEitherBabbageTxOutL ::
  EraTxOut era =>
  Lens' (BabbageTxOut era) (Either Addr CompactAddr)
addrEitherBabbageTxOutL :: forall era.
EraTxOut era =>
Lens' (BabbageTxOut era) (Either Addr CompactAddr)
addrEitherBabbageTxOutL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    forall era. BabbageTxOut era -> Either Addr CompactAddr
getEitherAddrBabbageTxOut
    ( \BabbageTxOut era
txOut Either Addr CompactAddr
eAddr ->
        let cVal :: CompactForm (Value era)
cVal = forall era.
EraTxOut era =>
BabbageTxOut era -> CompactForm (Value era)
getCompactValueBabbageTxOut BabbageTxOut era
txOut
            (Addr
_, Value era
_, Datum era
datum, StrictMaybe (Script era)
mScript) = forall era.
Val (Value era) =>
BabbageTxOut era
-> (Addr, Value era, Datum era, StrictMaybe (Script era))
viewTxOut BabbageTxOut era
txOut
         in case Either Addr CompactAddr
eAddr of
              Left Addr
addr -> forall era.
Val (Value era) =>
Addr
-> CompactAddr
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOutCompact Addr
addr (Addr -> CompactAddr
compactAddr Addr
addr) CompactForm (Value era)
cVal Datum era
datum StrictMaybe (Script era)
mScript
              Right CompactAddr
cAddr -> forall era.
Val (Value era) =>
Addr
-> CompactAddr
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOutCompact (HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
cAddr) CompactAddr
cAddr CompactForm (Value era)
cVal Datum era
datum StrictMaybe (Script era)
mScript
    )
{-# INLINEABLE addrEitherBabbageTxOutL #-}

valueEitherBabbageTxOutL ::
  forall era.
  EraTxOut era =>
  Lens' (BabbageTxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherBabbageTxOutL :: forall era.
EraTxOut era =>
Lens'
  (BabbageTxOut era) (Either (Value era) (CompactForm (Value era)))
valueEitherBabbageTxOutL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxOut era =>
BabbageTxOut era -> CompactForm (Value era)
getCompactValueBabbageTxOut)
    ( \BabbageTxOut era
txOut Either (Value era) (CompactForm (Value era))
eVal ->
        let (CompactAddr
cAddr, CompactForm (Value era)
_, Datum era
datum, StrictMaybe (Script era)
mScript) = forall era.
Val (Value era) =>
BabbageTxOut era
-> (CompactAddr, CompactForm (Value era), Datum era,
    StrictMaybe (Script era))
viewCompactTxOut BabbageTxOut era
txOut
         in case Either (Value era) (CompactForm (Value era))
eVal of
              Left Value era
val -> forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut (HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
cAddr) CompactAddr
cAddr Value era
val Datum era
datum StrictMaybe (Script era)
mScript
              Right CompactForm (Value era)
cVal -> forall era.
Val (Value era) =>
Addr
-> CompactAddr
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOutCompact (HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
cAddr) CompactAddr
cAddr CompactForm (Value era)
cVal Datum era
datum StrictMaybe (Script era)
mScript
    )
{-# INLINEABLE valueEitherBabbageTxOutL #-}

deriving stock instance
  (Era era, Eq (Script era), Eq (CompactForm (Value era))) =>
  Eq (BabbageTxOut era)

-- | Already in NF
instance NFData (BabbageTxOut era) where
  rnf :: BabbageTxOut era -> ()
rnf = forall a. a -> ()
rwhnf

instance
  (Era era, ToJSON (Datum era), ToJSON (Script era), Val (Value era)) =>
  ToJSON (BabbageTxOut era)
  where
  toJSON :: BabbageTxOut era -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era e a.
(Era era, KeyValue e a, Val (Value era), ToJSON (Script era)) =>
BabbageTxOut era -> [a]
toBabbageTxOutPairs
  toEncoding :: BabbageTxOut era -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era e a.
(Era era, KeyValue e a, Val (Value era), ToJSON (Script era)) =>
BabbageTxOut era -> [a]
toBabbageTxOutPairs

toBabbageTxOutPairs ::
  ( Era era
  , KeyValue e a
  , Val (Value era)
  , ToJSON (Script era)
  ) =>
  BabbageTxOut era ->
  [a]
toBabbageTxOutPairs :: forall era e a.
(Era era, KeyValue e a, Val (Value era), ToJSON (Script era)) =>
BabbageTxOut era -> [a]
toBabbageTxOutPairs (BabbageTxOut !Addr
addr !Value era
val !Datum era
dat !StrictMaybe (Script era)
mRefScript) =
  [ Key
"address" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Addr
addr
  , Key
"value" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value era
val
  , Key
"datum" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Datum era
dat
  , Key
"referenceScript" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (Script era)
mRefScript
  ]

viewCompactTxOut ::
  forall era.
  Val (Value era) =>
  BabbageTxOut era ->
  (CompactAddr, CompactForm (Value era), Datum era, StrictMaybe (Script era))
viewCompactTxOut :: forall era.
Val (Value era) =>
BabbageTxOut era
-> (CompactAddr, CompactForm (Value era), Datum era,
    StrictMaybe (Script era))
viewCompactTxOut BabbageTxOut era
txOut = case BabbageTxOut era
txOut of
  TxOutCompact' CompactAddr
addr CompactForm (Value era)
val -> (CompactAddr
addr, CompactForm (Value era)
val, forall era. Datum era
NoDatum, forall a. StrictMaybe a
SNothing)
  TxOutCompactDH' CompactAddr
addr CompactForm (Value era)
val DataHash
dh -> (CompactAddr
addr, CompactForm (Value era)
val, forall era. DataHash -> Datum era
DatumHash DataHash
dh, forall a. StrictMaybe a
SNothing)
  TxOutCompactDatum CompactAddr
addr CompactForm (Value era)
val BinaryData era
datum -> (CompactAddr
addr, CompactForm (Value era)
val, forall era. BinaryData era -> Datum era
Datum BinaryData era
datum, forall a. StrictMaybe a
SNothing)
  TxOutCompactRefScript CompactAddr
addr CompactForm (Value era)
val Datum era
datum Script era
rs -> (CompactAddr
addr, CompactForm (Value era)
val, Datum era
datum, forall a. a -> StrictMaybe a
SJust Script era
rs)
  TxOut_AddrHash28_AdaOnly Credential 'Staking
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal ->
    let (CompactAddr
a, CompactForm (Value era)
b, StrictMaybe DataHash
c) =
          forall era.
Val (Value era) =>
AlonzoTxOut era
-> (CompactAddr, CompactForm (Value era), StrictMaybe DataHash)
Alonzo.viewCompactTxOut @era forall a b. (a -> b) -> a -> b
$ forall era.
Credential 'Staking
-> Addr28Extra -> CompactForm Coin -> AlonzoTxOut era
Alonzo.TxOut_AddrHash28_AdaOnly Credential 'Staking
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal
     in (CompactAddr
a, CompactForm (Value era)
b, forall {era}. StrictMaybe DataHash -> Datum era
toDatum StrictMaybe DataHash
c, forall a. StrictMaybe a
SNothing)
  TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal DataHash32
dataHash32 ->
    let (CompactAddr
a, CompactForm (Value era)
b, StrictMaybe DataHash
c) =
          forall era.
Val (Value era) =>
AlonzoTxOut era
-> (CompactAddr, CompactForm (Value era), StrictMaybe DataHash)
Alonzo.viewCompactTxOut @era forall a b. (a -> b) -> a -> b
$
            forall era.
Credential 'Staking
-> Addr28Extra -> CompactForm Coin -> DataHash32 -> AlonzoTxOut era
Alonzo.TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal DataHash32
dataHash32
     in (CompactAddr
a, CompactForm (Value era)
b, forall {era}. StrictMaybe DataHash -> Datum era
toDatum StrictMaybe DataHash
c, forall a. StrictMaybe a
SNothing)
  where
    toDatum :: StrictMaybe DataHash -> Datum era
toDatum = \case
      StrictMaybe DataHash
SNothing -> forall era. Datum era
NoDatum
      SJust DataHash
dh -> forall era. DataHash -> Datum era
DatumHash DataHash
dh
{-# INLINEABLE viewCompactTxOut #-}

viewTxOut ::
  forall era.
  Val (Value era) =>
  BabbageTxOut era ->
  (Addr, Value era, Datum era, StrictMaybe (Script era))
viewTxOut :: forall era.
Val (Value era) =>
BabbageTxOut era
-> (Addr, Value era, Datum era, StrictMaybe (Script era))
viewTxOut (TxOutCompact' CompactAddr
bs CompactForm (Value era)
c) = (Addr
addr, Value era
val, forall era. Datum era
NoDatum, forall a. StrictMaybe a
SNothing)
  where
    addr :: Addr
addr = HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
bs
    val :: Value era
val = forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c
viewTxOut (TxOutCompactDH' CompactAddr
bs CompactForm (Value era)
c DataHash
dh) = (Addr
addr, Value era
val, forall era. DataHash -> Datum era
DatumHash DataHash
dh, forall a. StrictMaybe a
SNothing)
  where
    addr :: Addr
addr = HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
bs
    val :: Value era
val = forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c
viewTxOut (TxOutCompactDatum CompactAddr
bs CompactForm (Value era)
c BinaryData era
d) = (Addr
addr, Value era
val, forall era. BinaryData era -> Datum era
Datum BinaryData era
d, forall a. StrictMaybe a
SNothing)
  where
    addr :: Addr
addr = HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
bs
    val :: Value era
val = forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c
viewTxOut (TxOutCompactRefScript CompactAddr
bs CompactForm (Value era)
c Datum era
d Script era
rs) = (Addr
addr, Value era
val, Datum era
d, forall a. a -> StrictMaybe a
SJust Script era
rs)
  where
    addr :: Addr
addr = HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
bs
    val :: Value era
val = forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c
viewTxOut (TxOut_AddrHash28_AdaOnly Credential 'Staking
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal) = (Addr
addr, Value era
val, forall era. Datum era
NoDatum, forall a. StrictMaybe a
SNothing)
  where
    (Addr
addr, Value era
val, StrictMaybe DataHash
_) =
      forall era.
Val (Value era) =>
AlonzoTxOut era -> (Addr, Value era, StrictMaybe DataHash)
Alonzo.viewTxOut @era forall a b. (a -> b) -> a -> b
$ forall era.
Credential 'Staking
-> Addr28Extra -> CompactForm Coin -> AlonzoTxOut era
Alonzo.TxOut_AddrHash28_AdaOnly Credential 'Staking
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal
viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal DataHash32
dataHash32) =
  case StrictMaybe DataHash
mDataHash of
    StrictMaybe DataHash
SNothing -> (Addr
addr, Value era
val, forall era. Datum era
NoDatum, forall a. StrictMaybe a
SNothing)
    SJust DataHash
dh -> (Addr
addr, Value era
val, forall era. DataHash -> Datum era
DatumHash DataHash
dh, forall a. StrictMaybe a
SNothing)
  where
    (Addr
addr, Value era
val, StrictMaybe DataHash
mDataHash) =
      forall era.
Val (Value era) =>
AlonzoTxOut era -> (Addr, Value era, StrictMaybe DataHash)
Alonzo.viewTxOut @era forall a b. (a -> b) -> a -> b
$
        forall era.
Credential 'Staking
-> Addr28Extra -> CompactForm Coin -> DataHash32 -> AlonzoTxOut era
Alonzo.TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal DataHash32
dataHash32
{-# INLINEABLE viewTxOut #-}

instance
  (Era era, Show (Script era), Val (Value era)) =>
  Show (BabbageTxOut era)
  where
  show :: BabbageTxOut era -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Val (Value era) =>
BabbageTxOut era
-> (Addr, Value era, Datum era, StrictMaybe (Script era))
viewTxOut

instance (Era era, NoThunks (Script era), Val (Value era)) => NoThunks (BabbageTxOut era)

pattern BabbageTxOut ::
  (Era era, Val (Value era), HasCallStack) =>
  Addr ->
  Value era ->
  Datum era ->
  StrictMaybe (Script era) ->
  BabbageTxOut era
pattern $bBabbageTxOut :: forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
$mBabbageTxOut :: forall {r} {era}.
(Era era, Val (Value era), HasCallStack) =>
BabbageTxOut era
-> (Addr
    -> Value era -> Datum era -> StrictMaybe (Script era) -> r)
-> ((# #) -> r)
-> r
BabbageTxOut addr vl datum refScript <-
  (viewTxOut -> (addr, vl, datum, refScript))
  where
    BabbageTxOut Addr
addr Value era
vl Datum era
datum StrictMaybe (Script era)
refScript = forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr
addr (Addr -> CompactAddr
compactAddr Addr
addr) Value era
vl Datum era
datum StrictMaybe (Script era)
refScript

{-# COMPLETE BabbageTxOut #-}

-- | Helper function for constructing a BabbageTxOut. Both compacted and uncompacted
-- address should be the exact same address in different forms.
mkTxOut ::
  forall era.
  (Val (Value era), HasCallStack) =>
  Addr ->
  CompactAddr ->
  Value era ->
  Datum era ->
  StrictMaybe (Script era) ->
  BabbageTxOut era
mkTxOut :: forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr
addr CompactAddr
_cAddr Value era
vl Datum era
NoDatum StrictMaybe (Script era)
SNothing
  | Just CompactForm Coin
adaCompact <- forall era.
Val (Value era) =>
Proxy era -> Value era -> Maybe (CompactForm Coin)
getAdaOnly (forall {k} (t :: k). Proxy t
Proxy @era) Value era
vl
  , Addr Network
network PaymentCredential
paymentCred StakeReference
stakeRef <- Addr
addr
  , StakeRefBase Credential 'Staking
stakeCred <- StakeReference
stakeRef =
      let
        addr28Extra :: Addr28Extra
addr28Extra = Network -> PaymentCredential -> Addr28Extra
encodeAddress28 Network
network PaymentCredential
paymentCred
       in
        forall era.
Credential 'Staking
-> Addr28Extra -> CompactForm Coin -> BabbageTxOut era
TxOut_AddrHash28_AdaOnly Credential 'Staking
stakeCred Addr28Extra
addr28Extra CompactForm Coin
adaCompact
mkTxOut Addr
addr CompactAddr
_cAddr Value era
vl (DatumHash DataHash
dh) StrictMaybe (Script era)
SNothing
  | Just CompactForm Coin
adaCompact <- forall era.
Val (Value era) =>
Proxy era -> Value era -> Maybe (CompactForm Coin)
getAdaOnly (forall {k} (t :: k). Proxy t
Proxy @era) Value era
vl
  , Addr Network
network PaymentCredential
paymentCred StakeReference
stakeRef <- Addr
addr
  , StakeRefBase Credential 'Staking
stakeCred <- StakeReference
stakeRef =
      let
        addr28Extra :: Addr28Extra
addr28Extra = Network -> PaymentCredential -> Addr28Extra
encodeAddress28 Network
network PaymentCredential
paymentCred
        dataHash32 :: DataHash32
dataHash32 = DataHash -> DataHash32
encodeDataHash32 DataHash
dh
       in
        forall era.
Credential 'Staking
-> Addr28Extra
-> CompactForm Coin
-> DataHash32
-> BabbageTxOut era
TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
stakeCred Addr28Extra
addr28Extra CompactForm Coin
adaCompact DataHash32
dataHash32
mkTxOut Addr
_addr CompactAddr
cAddr Value era
vl Datum era
d StrictMaybe (Script era)
rs =
  let cVal :: CompactForm (Value era)
cVal = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error (String
"Illegal Value in TxOut: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Value era
vl)) forall a b. (a -> b) -> a -> b
$ forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Value era
vl
   in case StrictMaybe (Script era)
rs of
        StrictMaybe (Script era)
SNothing -> case Datum era
d of
          Datum era
NoDatum -> forall era.
CompactAddr -> CompactForm (Value era) -> BabbageTxOut era
TxOutCompact' CompactAddr
cAddr CompactForm (Value era)
cVal
          DatumHash DataHash
dh -> forall era.
CompactAddr
-> CompactForm (Value era) -> DataHash -> BabbageTxOut era
TxOutCompactDH' CompactAddr
cAddr CompactForm (Value era)
cVal DataHash
dh
          Datum BinaryData era
binaryData -> forall era.
CompactAddr
-> CompactForm (Value era) -> BinaryData era -> BabbageTxOut era
TxOutCompactDatum CompactAddr
cAddr CompactForm (Value era)
cVal BinaryData era
binaryData
        SJust Script era
rs' -> forall era.
CompactAddr
-> CompactForm (Value era)
-> Datum era
-> Script era
-> BabbageTxOut era
TxOutCompactRefScript CompactAddr
cAddr CompactForm (Value era)
cVal Datum era
d Script era
rs'
{-# INLINEABLE mkTxOut #-}

-- TODO: Implement mkTxOut in terms of mkTxOutCompact, it will avoid unnecessary
-- MultiAsset serilization/deserialization
mkTxOutCompact ::
  Val (Value era) =>
  Addr ->
  CompactAddr ->
  CompactForm (Value era) ->
  Datum era ->
  StrictMaybe (Script era) ->
  BabbageTxOut era
mkTxOutCompact :: forall era.
Val (Value era) =>
Addr
-> CompactAddr
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOutCompact Addr
addr CompactAddr
cAddr CompactForm (Value era)
cVal = forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr
addr CompactAddr
cAddr (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
cVal)
{-# INLINE mkTxOutCompact #-}

pattern TxOutCompact ::
  (Era era, Val (Value era), Compactible (Value era), HasCallStack) =>
  CompactAddr ->
  CompactForm (Value era) ->
  BabbageTxOut era
pattern $bTxOutCompact :: forall era.
(Era era, Val (Value era), Compactible (Value era),
 HasCallStack) =>
CompactAddr -> CompactForm (Value era) -> BabbageTxOut era
$mTxOutCompact :: forall {r} {era}.
(Era era, Val (Value era), Compactible (Value era),
 HasCallStack) =>
BabbageTxOut era
-> (CompactAddr -> CompactForm (Value era) -> r)
-> ((# #) -> r)
-> r
TxOutCompact addr vl <-
  (viewCompactTxOut -> (addr, vl, NoDatum, SNothing))
  where
    TxOutCompact CompactAddr
cAddr CompactForm (Value era)
cVal
      | forall t. Val t => CompactForm t -> Bool
isAdaOnlyCompact CompactForm (Value era)
cVal =
          forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut (HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
cAddr) CompactAddr
cAddr (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
cVal) forall era. Datum era
NoDatum forall a. StrictMaybe a
SNothing
      | Bool
otherwise = forall era.
CompactAddr -> CompactForm (Value era) -> BabbageTxOut era
TxOutCompact' CompactAddr
cAddr CompactForm (Value era)
cVal

pattern TxOutCompactDH ::
  (Era era, Val (Value era), Compactible (Value era), HasCallStack) =>
  CompactAddr ->
  CompactForm (Value era) ->
  DataHash ->
  BabbageTxOut era
pattern $bTxOutCompactDH :: forall era.
(Era era, Val (Value era), Compactible (Value era),
 HasCallStack) =>
CompactAddr
-> CompactForm (Value era) -> DataHash -> BabbageTxOut era
$mTxOutCompactDH :: forall {r} {era}.
(Era era, Val (Value era), Compactible (Value era),
 HasCallStack) =>
BabbageTxOut era
-> (CompactAddr -> CompactForm (Value era) -> DataHash -> r)
-> ((# #) -> r)
-> r
TxOutCompactDH addr vl dh <-
  (viewCompactTxOut -> (addr, vl, DatumHash dh, SNothing))
  where
    TxOutCompactDH CompactAddr
cAddr CompactForm (Value era)
cVal DataHash
dh
      | forall t. Val t => CompactForm t -> Bool
isAdaOnlyCompact CompactForm (Value era)
cVal =
          forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut (HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
cAddr) CompactAddr
cAddr (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
cVal) (forall era. DataHash -> Datum era
DatumHash DataHash
dh) forall a. StrictMaybe a
SNothing
      | Bool
otherwise = forall era.
CompactAddr
-> CompactForm (Value era) -> DataHash -> BabbageTxOut era
TxOutCompactDH' CompactAddr
cAddr CompactForm (Value era)
cVal DataHash
dh

{-# COMPLETE TxOutCompact, TxOutCompactDH #-}

instance (EraScript era, Val (Value era)) => ToCBOR (BabbageTxOut era) where
  toCBOR :: BabbageTxOut era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era
  {-# INLINE toCBOR #-}

instance (EraScript era, Val (Value era)) => FromCBOR (BabbageTxOut era) where
  fromCBOR :: forall s. Decoder s (BabbageTxOut era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era
  {-# INLINE fromCBOR #-}

instance (EraScript era, Val (Value era)) => EncCBOR (BabbageTxOut era) where
  encCBOR :: BabbageTxOut era -> Encoding
encCBOR = \case
    TxOutCompactRefScript CompactAddr
addr CompactForm (Value era)
cv Datum era
d Script era
rs -> forall era.
(EraScript era, Val (Value era)) =>
CompactAddr
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> Encoding
encodeTxOut CompactAddr
addr CompactForm (Value era)
cv Datum era
d (forall a. a -> StrictMaybe a
SJust Script era
rs)
    TxOutCompactDatum CompactAddr
addr CompactForm (Value era)
cv BinaryData era
d -> forall era.
(EraScript era, Val (Value era)) =>
CompactAddr
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> Encoding
encodeTxOut CompactAddr
addr CompactForm (Value era)
cv (forall era. BinaryData era -> Datum era
Datum BinaryData era
d) forall a. StrictMaybe a
SNothing
    TxOutCompactDH CompactAddr
addr CompactForm (Value era)
cv DataHash
dh -> Word -> Encoding
encodeListLen Word
3 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactAddr
addr forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm (Value era)
cv forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR DataHash
dh
    TxOutCompact CompactAddr
addr CompactForm (Value era)
cv -> Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactAddr
addr forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm (Value era)
cv

instance (EraScript era, Val (Value era)) => DecCBOR (BabbageTxOut era) where
  decCBOR :: forall s. Decoder s (BabbageTxOut era)
decCBOR = forall era s.
(EraScript era, Val (Value era)) =>
(forall s'. Decoder s' (Addr, CompactAddr))
-> Decoder s (BabbageTxOut era)
decodeBabbageTxOut forall s'. Decoder s' (Addr, CompactAddr)
fromCborBothAddr
  {-# INLINE decCBOR #-}

instance
  ( EraScript era
  , Val (Value era)
  , MemPack (Script era)
  , MemPack (CompactForm (Value era))
  ) =>
  DecShareCBOR (BabbageTxOut era)
  where
  type Share (BabbageTxOut era) = Interns (Credential 'Staking)
  decShareCBOR :: forall s. Share (BabbageTxOut era) -> Decoder s (BabbageTxOut era)
decShareCBOR Share (BabbageTxOut era)
credsInterns = do
    BabbageTxOut era
txOut <-
      forall s. Decoder s TokenType
peekTokenType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        TokenType
TypeBytes -> forall a s. MemPack a => Decoder s a
decodeMemPack
        TokenType
TypeBytesIndef -> forall a s. MemPack a => Decoder s a
decodeMemPack
        TokenType
_ -> 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
$! forall era.
(Credential 'Staking -> Credential 'Staking)
-> BabbageTxOut era -> BabbageTxOut era
internBabbageTxOut (forall k. Interns k -> k -> k
interns Share (BabbageTxOut era)
credsInterns) BabbageTxOut era
txOut
  {-# INLINEABLE decShareCBOR #-}

internBabbageTxOut ::
  (Credential 'Staking -> Credential 'Staking) ->
  BabbageTxOut era ->
  BabbageTxOut era
internBabbageTxOut :: forall era.
(Credential 'Staking -> Credential 'Staking)
-> BabbageTxOut era -> BabbageTxOut era
internBabbageTxOut Credential 'Staking -> Credential 'Staking
internCred = \case
  TxOut_AddrHash28_AdaOnly Credential 'Staking
cred Addr28Extra
addr28Extra CompactForm Coin
ada ->
    forall era.
Credential 'Staking
-> Addr28Extra -> CompactForm Coin -> BabbageTxOut era
TxOut_AddrHash28_AdaOnly (Credential 'Staking -> Credential 'Staking
internCred Credential 'Staking
cred) Addr28Extra
addr28Extra CompactForm Coin
ada
  TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
cred Addr28Extra
addr28Extra CompactForm Coin
ada DataHash32
dataHash32 ->
    forall era.
Credential 'Staking
-> Addr28Extra
-> CompactForm Coin
-> DataHash32
-> BabbageTxOut era
TxOut_AddrHash28_AdaOnly_DataHash32 (Credential 'Staking -> Credential 'Staking
internCred Credential 'Staking
cred) Addr28Extra
addr28Extra CompactForm Coin
ada DataHash32
dataHash32
  BabbageTxOut era
txOut -> BabbageTxOut era
txOut
{-# INLINE internBabbageTxOut #-}

decodeBabbageTxOut ::
  (EraScript era, Val (Value era)) =>
  -- | We need to use a backwards compatible decoder for any address in a pre-babbage
  -- TxOut format. This is needed in order to get rid of bogus pointers from the ledger
  -- state in Conway
  (forall s'. Decoder s' (Addr, CompactAddr)) ->
  Decoder s (BabbageTxOut era)
decodeBabbageTxOut :: forall era s.
(EraScript era, Val (Value era)) =>
(forall s'. Decoder s' (Addr, CompactAddr))
-> Decoder s (BabbageTxOut era)
decodeBabbageTxOut forall s'. Decoder s' (Addr, CompactAddr)
decAddr = do
  forall s. Decoder s TokenType
peekTokenType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    TokenType
TypeMapLenIndef -> forall s era.
(EraScript era, Val (Value era)) =>
(forall s'. Decoder s' (Addr, CompactAddr))
-> Decoder s (BabbageTxOut era)
decodeTxOut forall s'. Decoder s' (Addr, CompactAddr)
decAddr
    TokenType
TypeMapLen -> forall s era.
(EraScript era, Val (Value era)) =>
(forall s'. Decoder s' (Addr, CompactAddr))
-> Decoder s (BabbageTxOut era)
decodeTxOut forall s'. Decoder s' (Addr, CompactAddr)
decAddr
    TokenType
_ -> Decoder s (BabbageTxOut era)
oldTxOut
  where
    oldTxOut :: Decoder s (BabbageTxOut era)
oldTxOut = do
      Maybe Int
lenOrIndef <- forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
      case Maybe Int
lenOrIndef of
        Maybe Int
Nothing -> do
          (Addr
a, CompactAddr
ca) <- forall s'. Decoder s' (Addr, CompactAddr)
decAddr
          Value era
v <- forall a s. DecCBOR a => Decoder s a
decCBOR
          forall s. Decoder s Bool
decodeBreakOr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr
a CompactAddr
ca Value era
v forall era. Datum era
NoDatum forall a. StrictMaybe a
SNothing
            Bool
False -> do
              DataHash
dh <- forall a s. DecCBOR a => Decoder s a
decCBOR
              forall s. Decoder s Bool
decodeBreakOr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr
a CompactAddr
ca Value era
v (forall era. DataHash -> Datum era
DatumHash DataHash
dh) forall a. StrictMaybe a
SNothing
                Bool
False -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"TxOut" Text
"Excess terms in TxOut"
        Just Int
2 -> do
          (Addr
a, CompactAddr
ca) <- forall s'. Decoder s' (Addr, CompactAddr)
decAddr
          Value era
v <- 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
$ forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr
a CompactAddr
ca Value era
v forall era. Datum era
NoDatum forall a. StrictMaybe a
SNothing
        Just Int
3 -> do
          (Addr
a, CompactAddr
ca) <- forall s'. Decoder s' (Addr, CompactAddr)
decAddr
          Value era
v <- forall a s. DecCBOR a => Decoder s a
decCBOR
          DataHash
dh <- 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
$ forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr
a CompactAddr
ca Value era
v (forall era. DataHash -> Datum era
DatumHash DataHash
dh) forall a. StrictMaybe a
SNothing
        Just Int
_ -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"TxOut" Text
"Wrong number of terms in TxOut"
    {-# INLINE oldTxOut #-}
{-# INLINEABLE decodeBabbageTxOut #-}

encodeTxOut ::
  forall era.
  (EraScript era, Val (Value era)) =>
  CompactAddr ->
  CompactForm (Value era) ->
  Datum era ->
  StrictMaybe (Script era) ->
  Encoding
encodeTxOut :: forall era.
(EraScript era, Val (Value era)) =>
CompactAddr
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> Encoding
encodeTxOut CompactAddr
cAddr CompactForm (Value era)
cVal Datum era
datum StrictMaybe (Script era)
script =
  forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
    forall t. t -> Encode ('Closed 'Sparse) t
Keyed (,,,,)
      forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To CompactAddr
cAddr)
      forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
cVal))
      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 a. Eq a => a -> a -> Bool
== forall era. Datum era
NoDatum) (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Datum era
datum))
      forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall a.
Word
-> (a -> Encoding)
-> StrictMaybe a
-> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybeWith Word
3 forall a. EncCBOR a => a -> Encoding
encodeNestedCbor StrictMaybe (Script era)
script
{-# INLINE encodeTxOut #-}

data DecodingTxOut era = DecodingTxOut
  { forall era. DecodingTxOut era -> StrictMaybe (Addr, CompactAddr)
decodingTxOutAddr :: !(StrictMaybe (Addr, CompactAddr))
  , forall era. DecodingTxOut era -> Value era
decodingTxOutVal :: !(Value era)
  , forall era. DecodingTxOut era -> Datum era
decodingTxOutDatum :: !(Datum era)
  , forall era. DecodingTxOut era -> StrictMaybe (Script era)
decodingTxOutScript :: !(StrictMaybe (Script era))
  }

decodeTxOut ::
  forall s era.
  (EraScript era, Val (Value era)) =>
  (forall s'. Decoder s' (Addr, CompactAddr)) ->
  Decoder s (BabbageTxOut era)
decodeTxOut :: forall s era.
(EraScript era, Val (Value era)) =>
(forall s'. Decoder s' (Addr, CompactAddr))
-> Decoder s (BabbageTxOut era)
decodeTxOut forall s'. Decoder s' (Addr, CompactAddr)
decAddr = do
  DecodingTxOut era
dtxo <- forall t (w :: Wrapped) s. Typeable t => 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
"TxOut" DecodingTxOut era
initial Word -> Field (DecodingTxOut era)
bodyFields [(Word, String)]
requiredFields
  case DecodingTxOut era
dtxo of
    DecodingTxOut StrictMaybe (Addr, CompactAddr)
SNothing Value era
_ Datum era
_ StrictMaybe (Script era)
_ ->
      forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"BabbageTxOut" Text
"Impossible: no Addr"
    DecodingTxOut (SJust (Addr
addr, CompactAddr
cAddr)) Value era
val Datum era
d StrictMaybe (Script era)
script ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
(Val (Value era), HasCallStack) =>
Addr
-> CompactAddr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr
addr CompactAddr
cAddr Value era
val Datum era
d StrictMaybe (Script era)
script
  where
    initial :: DecodingTxOut era
    initial :: DecodingTxOut era
initial = forall era.
StrictMaybe (Addr, CompactAddr)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> DecodingTxOut era
DecodingTxOut forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty forall era. Datum era
NoDatum forall a. StrictMaybe a
SNothing
    bodyFields :: (Word -> Field (DecodingTxOut era))
    bodyFields :: Word -> Field (DecodingTxOut era)
bodyFields Word
0 =
      forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field
        (\(Addr, CompactAddr)
x DecodingTxOut era
txo -> DecodingTxOut era
txo {decodingTxOutAddr :: StrictMaybe (Addr, CompactAddr)
decodingTxOutAddr = forall a. a -> StrictMaybe a
SJust (Addr, CompactAddr)
x})
        (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s'. Decoder s' (Addr, CompactAddr)
decAddr)
    bodyFields Word
1 =
      forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field
        (\Value era
x DecodingTxOut era
txo -> DecodingTxOut era
txo {decodingTxOutVal :: Value era
decodingTxOutVal = Value era
x})
        forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    bodyFields Word
2 =
      forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field
        (\Datum era
x DecodingTxOut era
txo -> DecodingTxOut era
txo {decodingTxOutDatum :: Datum era
decodingTxOutDatum = Datum era
x})
        (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a s. DecCBOR a => Decoder s a
decCBOR)
    bodyFields Word
3 =
      forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield
        (\StrictMaybe (Script era)
x DecodingTxOut era
txo -> DecodingTxOut era
txo {decodingTxOutScript :: StrictMaybe (Script era)
decodingTxOutScript = StrictMaybe (Script era)
x})
        (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a b. (a -> b) -> a -> b
$ forall b s. DecCBOR b => Text -> Decoder s b
decodeCIC Text
"Script")
    bodyFields Word
n = forall t. Word -> Field t
invalidField Word
n
    {-# INLINE bodyFields #-}
    requiredFields :: [(Word, String)]
requiredFields =
      [ (Word
0, String
"addr")
      , (Word
1, String
"val")
      ]
{-# INLINE decodeTxOut #-}

babbageMinUTxOValue ::
  BabbageEraPParams era =>
  PParams era ->
  Sized a ->
  Coin
babbageMinUTxOValue :: forall era a.
BabbageEraPParams era =>
PParams era -> Sized a -> Coin
babbageMinUTxOValue PParams era
pp Sized a
sizedTxOut =
  Integer -> Coin
Coin forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
constantOverhead forall a. Num a => a -> a -> a
+ forall a. Sized a -> Int64
sizedSize Sized a
sizedTxOut) forall a. Num a => a -> a -> a
* Integer
cpb
  where
    CoinPerByte (Coin Integer
cpb) = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL
    -- This constant is an approximation of the memory overhead that comes
    -- from TxIn and an entry in the Map data structure:
    --
    -- 160 = 20 words * 8bytes
    --
    -- This means that if:
    --
    --  * 'coinsPerUTxOByte' = 4310
    --  * A simple TxOut with staking and payment credentials with ADA only
    --    amount of 978370 lovelace
    --
    -- we get the size of TxOut to be 67 bytes and the minimum value will come
    -- out to be 978597 lovelace. Also the absolute minimum value will be
    -- 857690, because TxOut without staking address can't be less than 39 bytes
    constantOverhead :: Int64
constantOverhead = Int64
160
{-# INLINE babbageMinUTxOValue #-}

getEitherAddrBabbageTxOut ::
  BabbageTxOut era ->
  Either Addr CompactAddr
getEitherAddrBabbageTxOut :: forall era. BabbageTxOut era -> Either Addr CompactAddr
getEitherAddrBabbageTxOut = \case
  TxOutCompact' CompactAddr
cAddr CompactForm (Value era)
_ -> forall a b. b -> Either a b
Right CompactAddr
cAddr
  TxOutCompactDH' CompactAddr
cAddr CompactForm (Value era)
_ DataHash
_ -> forall a b. b -> Either a b
Right CompactAddr
cAddr
  TxOutCompactRefScript CompactAddr
cAddr CompactForm (Value era)
_ Datum era
_ Script era
_ -> forall a b. b -> Either a b
Right CompactAddr
cAddr
  TxOutCompactDatum CompactAddr
cAddr CompactForm (Value era)
_ BinaryData era
_ -> forall a b. b -> Either a b
Right CompactAddr
cAddr
  TxOut_AddrHash28_AdaOnly Credential 'Staking
stakeRef Addr28Extra
addr28Extra CompactForm Coin
_ ->
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> Addr28Extra -> Addr
decodeAddress28 Credential 'Staking
stakeRef Addr28Extra
addr28Extra
  TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
stakeRef Addr28Extra
addr28Extra CompactForm Coin
_ DataHash32
_ ->
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> Addr28Extra -> Addr
decodeAddress28 Credential 'Staking
stakeRef Addr28Extra
addr28Extra
{-# INLINE getEitherAddrBabbageTxOut #-}

-- TODO: Switch to using `getDatumBabbageTxOut`
getDataBabbageTxOut :: Era era => BabbageTxOut era -> StrictMaybe (Data era)
getDataBabbageTxOut :: forall era. Era era => BabbageTxOut era -> StrictMaybe (Data era)
getDataBabbageTxOut = \case
  TxOutCompact' {} -> forall a. StrictMaybe a
SNothing
  TxOutCompactDH' {} -> forall a. StrictMaybe a
SNothing
  TxOutCompactDatum CompactAddr
_ CompactForm (Value era)
_ BinaryData era
binaryData -> forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Era era => BinaryData era -> Data era
binaryDataToData BinaryData era
binaryData
  TxOutCompactRefScript CompactAddr
_ CompactForm (Value era)
_ Datum era
datum Script era
_
    | Datum BinaryData era
binaryData <- Datum era
datum -> forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Era era => BinaryData era -> Data era
binaryDataToData BinaryData era
binaryData
    | Bool
otherwise -> forall a. StrictMaybe a
SNothing
  TxOut_AddrHash28_AdaOnly {} -> forall a. StrictMaybe a
SNothing
  TxOut_AddrHash28_AdaOnly_DataHash32 {} -> forall a. StrictMaybe a
SNothing
{-# INLINE getDataBabbageTxOut #-}

-- TODO: Switch to using `getDatumBabbageTxOut`

-- | Return the data hash of a given transaction output, if one is present.
--  Note that this function does *not* return the hash of an inline datum
--  if one is present.
getDataHashBabbageTxOut ::
  BabbageTxOut era ->
  StrictMaybe DataHash
getDataHashBabbageTxOut :: forall era. BabbageTxOut era -> StrictMaybe DataHash
getDataHashBabbageTxOut BabbageTxOut era
txOut =
  case forall era. BabbageTxOut era -> Datum era
getDatumBabbageTxOut BabbageTxOut era
txOut of
    Datum era
NoDatum -> forall a. StrictMaybe a
SNothing
    DatumHash DataHash
dh -> forall a. a -> StrictMaybe a
SJust DataHash
dh
    Datum BinaryData era
_d -> forall a. StrictMaybe a
SNothing
{-# INLINE getDataHashBabbageTxOut #-}

getScriptBabbageTxOut :: BabbageTxOut era -> StrictMaybe (Script era)
getScriptBabbageTxOut :: forall era. BabbageTxOut era -> StrictMaybe (Script era)
getScriptBabbageTxOut = \case
  TxOutCompact' {} -> forall a. StrictMaybe a
SNothing
  TxOutCompactDH' {} -> forall a. StrictMaybe a
SNothing
  TxOutCompactDatum {} -> forall a. StrictMaybe a
SNothing
  TxOutCompactRefScript CompactAddr
_ CompactForm (Value era)
_ Datum era
_ Script era
s -> forall a. a -> StrictMaybe a
SJust Script era
s
  TxOut_AddrHash28_AdaOnly {} -> forall a. StrictMaybe a
SNothing
  TxOut_AddrHash28_AdaOnly_DataHash32 {} -> forall a. StrictMaybe a
SNothing
{-# INLINE getScriptBabbageTxOut #-}

getDatumBabbageTxOut :: BabbageTxOut era -> Datum era
getDatumBabbageTxOut :: forall era. BabbageTxOut era -> Datum era
getDatumBabbageTxOut = \case
  TxOutCompact' {} -> forall era. Datum era
NoDatum
  TxOutCompactDH' CompactAddr
_ CompactForm (Value era)
_ DataHash
dh -> forall era. DataHash -> Datum era
DatumHash DataHash
dh
  TxOutCompactDatum CompactAddr
_ CompactForm (Value era)
_ BinaryData era
binaryData -> forall era. BinaryData era -> Datum era
Datum BinaryData era
binaryData
  TxOutCompactRefScript CompactAddr
_ CompactForm (Value era)
_ Datum era
datum Script era
_ -> Datum era
datum
  TxOut_AddrHash28_AdaOnly {} -> forall era. Datum era
NoDatum
  TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
_ Addr28Extra
_ CompactForm Coin
_ DataHash32
dataHash32 ->
    forall era. DataHash -> Datum era
DatumHash forall a b. (a -> b) -> a -> b
$ DataHash32 -> DataHash
decodeDataHash32 DataHash32
dataHash32
{-# INLINEABLE getDatumBabbageTxOut #-}

getCompactValueBabbageTxOut :: EraTxOut era => BabbageTxOut era -> CompactForm (Value era)
getCompactValueBabbageTxOut :: forall era.
EraTxOut era =>
BabbageTxOut era -> CompactForm (Value era)
getCompactValueBabbageTxOut =
  \case
    TxOutCompact' CompactAddr
_ CompactForm (Value era)
cv -> CompactForm (Value era)
cv
    TxOutCompactDH' CompactAddr
_ CompactForm (Value era)
cv DataHash
_ -> CompactForm (Value era)
cv
    TxOutCompactDatum CompactAddr
_ CompactForm (Value era)
cv BinaryData era
_ -> CompactForm (Value era)
cv
    TxOutCompactRefScript CompactAddr
_ CompactForm (Value era)
cv Datum era
_ Script era
_ -> CompactForm (Value era)
cv
    TxOut_AddrHash28_AdaOnly Credential 'Staking
_ Addr28Extra
_ CompactForm Coin
cc -> forall t. Val t => CompactForm Coin -> CompactForm t
injectCompact CompactForm Coin
cc
    TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking
_ Addr28Extra
_ CompactForm Coin
cc DataHash32
_ -> forall t. Val t => CompactForm Coin -> CompactForm t
injectCompact CompactForm Coin
cc
{-# INLINE getCompactValueBabbageTxOut #-}

txOutData :: Era era => BabbageTxOut era -> Maybe (Data era)
txOutData :: forall era. Era era => BabbageTxOut era -> Maybe (Data era)
txOutData = forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => BabbageTxOut era -> StrictMaybe (Data era)
getDataBabbageTxOut
{-# DEPRECATED txOutData "In favor of `dataTxOutL` or `getDataBabbageTxOut`" #-}

txOutDataHash :: BabbageTxOut era -> Maybe DataHash
txOutDataHash :: forall era. BabbageTxOut era -> Maybe DataHash
txOutDataHash = forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. BabbageTxOut era -> StrictMaybe DataHash
getDataHashBabbageTxOut
{-# DEPRECATED txOutDataHash "In favor of `dataHashTxOutL` or `getDataHashBabbageTxOut`" #-}

txOutScript :: BabbageTxOut era -> Maybe (Script era)
txOutScript :: forall era. BabbageTxOut era -> Maybe (Script era)
txOutScript = forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. BabbageTxOut era -> StrictMaybe (Script era)
getScriptBabbageTxOut
{-# DEPRECATED txOutScript "In favor of `dataTxOutL` or `getScriptBabbageTxOut`" #-}

decodeCIC :: DecCBOR b => T.Text -> Decoder s b
decodeCIC :: forall b s. DecCBOR b => Text -> Decoder s b
decodeCIC Text
s = do
  Version
version <- forall s. Decoder s Version
getDecoderVersion
  ByteString
bs <- forall s. Decoder s ByteString
decodeNestedCborBytes
  case forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' Version
version ByteString
bs of
    Left DecoderError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DecoderError
e
    Right b
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x
{-# INLINEABLE decodeCIC #-}