{-# 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 (
  Annotator (..),
  DecCBOR (..),
  DecShareCBOR (..),
  Decoder,
  DecoderError (..),
  EncCBOR (..),
  Encoding,
  FromCBOR (..),
  Interns,
  Sized (..),
  ToCBOR (..),
  TokenType (..),
  cborError,
  decodeBreakOr,
  decodeFullAnnotator,
  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 qualified Data.ByteString.Lazy as LBS
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 (Annotator 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 (Annotator b) => T.Text -> Decoder s b
decodeCIC :: forall b s. DecCBOR (Annotator b) => Text -> Decoder s b
decodeCIC Text
s = do
  Version
version <- forall s. Decoder s Version
getDecoderVersion
  ByteString
lbs <- forall s. Decoder s ByteString
decodeNestedCborBytes
  case forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator Version
version Text
s forall a s. DecCBOR a => Decoder s a
decCBOR (ByteString -> ByteString
LBS.fromStrict ByteString
lbs) 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 #-}