{-# 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.Crypto.Hash (HashAlgorithm)
import Cardano.Ledger.Address (
  Addr (..),
  CompactAddr,
  compactAddr,
  decompactAddr,
  fromCborBackwardsBothAddr,
  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,
  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.Crypto (Crypto (ADDRHASH), StandardCrypto)
import Cardano.Ledger.Keys (KeyRole (..))
import Cardano.Ledger.Plutus.Data (
  BinaryData,
  Data,
  Datum (..),
  binaryDataToData,
  dataToBinaryData,
 )
import Cardano.Ledger.Val (Val (..))
import Control.DeepSeq (NFData (rnf), rwhnf)
import Control.Monad ((<$!>))
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import qualified Data.ByteString.Lazy as LBS
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Typeable (Proxy (..), (:~:) (Refl))
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 (EraCrypto era))
      !(CompactForm (Value era))
  | TxOutCompactDH'
      {-# UNPACK #-} !(CompactAddr (EraCrypto era))
      !(CompactForm (Value era))
      !(DataHash (EraCrypto era))
  | TxOutCompactDatum
      {-# UNPACK #-} !(CompactAddr (EraCrypto era))
      !(CompactForm (Value era))
      {-# UNPACK #-} !(BinaryData era) -- Inline data
  | TxOutCompactRefScript
      {-# UNPACK #-} !(CompactAddr (EraCrypto era))
      !(CompactForm (Value era))
      !(Datum era)
      !(Script era)
  | TxOut_AddrHash28_AdaOnly
      !(Credential 'Staking (EraCrypto era))
      {-# UNPACK #-} !Addr28Extra
      {-# UNPACK #-} !(CompactForm Coin) -- Ada value
  | TxOut_AddrHash28_AdaOnly_DataHash32
      !(Credential 'Staking (EraCrypto era))
      {-# 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)

instance Crypto c => EraTxOut (BabbageEra c) where
  {-# SPECIALIZE instance EraTxOut (BabbageEra StandardCrypto) #-}

  type TxOut (BabbageEra c) = BabbageTxOut (BabbageEra c)

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

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

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

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

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

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

instance Crypto c => AlonzoEraTxOut (BabbageEra c) where
  {-# SPECIALIZE instance AlonzoEraTxOut (BabbageEra StandardCrypto) #-}

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

  datumTxOutF :: SimpleGetter (TxOut (BabbageEra c)) (Datum (BabbageEra c))
datumTxOutF = forall s a. (s -> a) -> SimpleGetter s a
to forall era.
(HasCallStack, Era 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 (EraCrypto era)
addr Value era
cv Datum era
_ StrictMaybe (Script era)
s) ->
        \case
          StrictMaybe (Data era)
SNothing -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto era)
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 (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto era)
addr Value era
cv (forall era. BinaryData era -> Datum era
Datum (forall era. Era 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.
(HasCallStack, Era era) =>
BabbageTxOut era -> Datum era
getDatumBabbageTxOut (\(BabbageTxOut Addr (EraCrypto era)
addr Value era
cv Datum era
_ StrictMaybe (Script era)
s) Datum era
d -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto era)
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 (EraCrypto era)
addr Value era
cv Datum era
d StrictMaybe (Script era)
_) StrictMaybe (Script era)
s -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto era)
addr Value era
cv Datum era
d StrictMaybe (Script era)
s)
{-# INLINEABLE referenceScriptBabbageTxOutL #-}

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

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

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

addrEitherBabbageTxOutL ::
  EraTxOut era =>
  Lens' (BabbageTxOut era) (Either (Addr (EraCrypto era)) (CompactAddr (EraCrypto era)))
addrEitherBabbageTxOutL :: forall era.
EraTxOut era =>
Lens'
  (BabbageTxOut era)
  (Either (Addr (EraCrypto era)) (CompactAddr (EraCrypto era)))
addrEitherBabbageTxOutL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    forall era.
(HasCallStack, HashAlgorithm (ADDRHASH (EraCrypto era))) =>
BabbageTxOut era
-> Either (Addr (EraCrypto era)) (CompactAddr (EraCrypto era))
getEitherAddrBabbageTxOut
    ( \BabbageTxOut era
txOut Either (Addr (EraCrypto era)) (CompactAddr (EraCrypto era))
eAddr ->
        let cVal :: CompactForm (Value era)
cVal = forall era.
EraTxOut era =>
BabbageTxOut era -> CompactForm (Value era)
getCompactValueBabbageTxOut BabbageTxOut era
txOut
            (Addr (EraCrypto era)
_, Value era
_, Datum era
datum, StrictMaybe (Script era)
mScript) = forall era.
(Era era, Val (Value era)) =>
BabbageTxOut era
-> (Addr (EraCrypto era), Value era, Datum era,
    StrictMaybe (Script era))
viewTxOut BabbageTxOut era
txOut
         in case Either (Addr (EraCrypto era)) (CompactAddr (EraCrypto era))
eAddr of
              Left Addr (EraCrypto era)
addr -> forall era.
(Era era, Val (Value era)) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOutCompact Addr (EraCrypto era)
addr (forall c. Addr c -> CompactAddr c
compactAddr Addr (EraCrypto era)
addr) CompactForm (Value era)
cVal Datum era
datum StrictMaybe (Script era)
mScript
              Right CompactAddr (EraCrypto era)
cAddr -> forall era.
(Era era, Val (Value era)) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOutCompact (forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr (EraCrypto era)
cAddr) CompactAddr (EraCrypto era)
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 (EraCrypto era)
cAddr, CompactForm (Value era)
_, Datum era
datum, StrictMaybe (Script era)
mScript) = forall era.
(Era era, Val (Value era)) =>
BabbageTxOut era
-> (CompactAddr (EraCrypto era), 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.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut (forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr (EraCrypto era)
cAddr) CompactAddr (EraCrypto era)
cAddr Value era
val Datum era
datum StrictMaybe (Script era)
mScript
              Right CompactForm (Value era)
cVal -> forall era.
(Era era, Val (Value era)) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOutCompact (forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr (EraCrypto era)
cAddr) CompactAddr (EraCrypto era)
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 (EraCrypto era)
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 (EraCrypto era)
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.
  (Era era, Val (Value era)) =>
  BabbageTxOut era ->
  (CompactAddr (EraCrypto era), CompactForm (Value era), Datum era, StrictMaybe (Script era))
viewCompactTxOut :: forall era.
(Era era, Val (Value era)) =>
BabbageTxOut era
-> (CompactAddr (EraCrypto era), CompactForm (Value era),
    Datum era, StrictMaybe (Script era))
viewCompactTxOut BabbageTxOut era
txOut = case BabbageTxOut era
txOut of
  TxOutCompact' CompactAddr (EraCrypto era)
addr CompactForm (Value era)
val -> (CompactAddr (EraCrypto era)
addr, CompactForm (Value era)
val, forall era. Datum era
NoDatum, forall a. StrictMaybe a
SNothing)
  TxOutCompactDH' CompactAddr (EraCrypto era)
addr CompactForm (Value era)
val DataHash (EraCrypto era)
dh -> (CompactAddr (EraCrypto era)
addr, CompactForm (Value era)
val, forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
dh, forall a. StrictMaybe a
SNothing)
  TxOutCompactDatum CompactAddr (EraCrypto era)
addr CompactForm (Value era)
val BinaryData era
datum -> (CompactAddr (EraCrypto era)
addr, CompactForm (Value era)
val, forall era. BinaryData era -> Datum era
Datum BinaryData era
datum, forall a. StrictMaybe a
SNothing)
  TxOutCompactRefScript CompactAddr (EraCrypto era)
addr CompactForm (Value era)
val Datum era
datum Script era
rs -> (CompactAddr (EraCrypto era)
addr, CompactForm (Value era)
val, Datum era
datum, forall a. a -> StrictMaybe a
SJust Script era
rs)
  TxOut_AddrHash28_AdaOnly Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal ->
    let (CompactAddr (EraCrypto era)
a, CompactForm (Value era)
b, StrictMaybe (DataHash (EraCrypto era))
c) =
          forall era.
(Era era, Val (Value era)) =>
AlonzoTxOut era
-> (CompactAddr (EraCrypto era), CompactForm (Value era),
    StrictMaybe (DataHash (EraCrypto era)))
Alonzo.viewCompactTxOut @era forall a b. (a -> b) -> a -> b
$ forall era.
Credential 'Staking (EraCrypto era)
-> Addr28Extra -> CompactForm Coin -> AlonzoTxOut era
Alonzo.TxOut_AddrHash28_AdaOnly Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal
     in (CompactAddr (EraCrypto era)
a, CompactForm (Value era)
b, forall {era}. StrictMaybe (DataHash (EraCrypto era)) -> Datum era
toDatum StrictMaybe (DataHash (EraCrypto era))
c, forall a. StrictMaybe a
SNothing)
  TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal DataHash32
dataHash32 ->
    let (CompactAddr (EraCrypto era)
a, CompactForm (Value era)
b, StrictMaybe (DataHash (EraCrypto era))
c) =
          forall era.
(Era era, Val (Value era)) =>
AlonzoTxOut era
-> (CompactAddr (EraCrypto era), CompactForm (Value era),
    StrictMaybe (DataHash (EraCrypto era)))
Alonzo.viewCompactTxOut @era forall a b. (a -> b) -> a -> b
$
            forall era.
Credential 'Staking (EraCrypto era)
-> Addr28Extra -> CompactForm Coin -> DataHash32 -> AlonzoTxOut era
Alonzo.TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal DataHash32
dataHash32
     in (CompactAddr (EraCrypto era)
a, CompactForm (Value era)
b, forall {era}. StrictMaybe (DataHash (EraCrypto era)) -> Datum era
toDatum StrictMaybe (DataHash (EraCrypto era))
c, forall a. StrictMaybe a
SNothing)
  where
    toDatum :: StrictMaybe (DataHash (EraCrypto era)) -> Datum era
toDatum = \case
      StrictMaybe (DataHash (EraCrypto era))
SNothing -> forall era. Datum era
NoDatum
      SJust DataHash (EraCrypto era)
dh -> forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
dh
{-# INLINEABLE viewCompactTxOut #-}

viewTxOut ::
  forall era.
  (Era era, Val (Value era)) =>
  BabbageTxOut era ->
  (Addr (EraCrypto era), Value era, Datum era, StrictMaybe (Script era))
viewTxOut :: forall era.
(Era era, Val (Value era)) =>
BabbageTxOut era
-> (Addr (EraCrypto era), Value era, Datum era,
    StrictMaybe (Script era))
viewTxOut (TxOutCompact' CompactAddr (EraCrypto era)
bs CompactForm (Value era)
c) = (Addr (EraCrypto era)
addr, Value era
val, forall era. Datum era
NoDatum, forall a. StrictMaybe a
SNothing)
  where
    addr :: Addr (EraCrypto era)
addr = forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr (EraCrypto era)
bs
    val :: Value era
val = forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c
viewTxOut (TxOutCompactDH' CompactAddr (EraCrypto era)
bs CompactForm (Value era)
c DataHash (EraCrypto era)
dh) = (Addr (EraCrypto era)
addr, Value era
val, forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
dh, forall a. StrictMaybe a
SNothing)
  where
    addr :: Addr (EraCrypto era)
addr = forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr (EraCrypto era)
bs
    val :: Value era
val = forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c
viewTxOut (TxOutCompactDatum CompactAddr (EraCrypto era)
bs CompactForm (Value era)
c BinaryData era
d) = (Addr (EraCrypto era)
addr, Value era
val, forall era. BinaryData era -> Datum era
Datum BinaryData era
d, forall a. StrictMaybe a
SNothing)
  where
    addr :: Addr (EraCrypto era)
addr = forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr (EraCrypto era)
bs
    val :: Value era
val = forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c
viewTxOut (TxOutCompactRefScript CompactAddr (EraCrypto era)
bs CompactForm (Value era)
c Datum era
d Script era
rs) = (Addr (EraCrypto era)
addr, Value era
val, Datum era
d, forall a. a -> StrictMaybe a
SJust Script era
rs)
  where
    addr :: Addr (EraCrypto era)
addr = forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr (EraCrypto era)
bs
    val :: Value era
val = forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c
viewTxOut (TxOut_AddrHash28_AdaOnly Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal) = (Addr (EraCrypto era)
addr, Value era
val, forall era. Datum era
NoDatum, forall a. StrictMaybe a
SNothing)
  where
    (Addr (EraCrypto era)
addr, Value era
val, StrictMaybe (DataHash (EraCrypto era))
_) =
      forall era.
(Era era, Val (Value era)) =>
AlonzoTxOut era
-> (Addr (EraCrypto era), Value era,
    StrictMaybe (DataHash (EraCrypto era)))
Alonzo.viewTxOut @era forall a b. (a -> b) -> a -> b
$ forall era.
Credential 'Staking (EraCrypto era)
-> Addr28Extra -> CompactForm Coin -> AlonzoTxOut era
Alonzo.TxOut_AddrHash28_AdaOnly Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal
viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal DataHash32
dataHash32) =
  case StrictMaybe (DataHash (EraCrypto era))
mDataHash of
    StrictMaybe (DataHash (EraCrypto era))
SNothing -> (Addr (EraCrypto era)
addr, Value era
val, forall era. Datum era
NoDatum, forall a. StrictMaybe a
SNothing)
    SJust DataHash (EraCrypto era)
dh -> (Addr (EraCrypto era)
addr, Value era
val, forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
dh, forall a. StrictMaybe a
SNothing)
  where
    (Addr (EraCrypto era)
addr, Value era
val, StrictMaybe (DataHash (EraCrypto era))
mDataHash) =
      forall era.
(Era era, Val (Value era)) =>
AlonzoTxOut era
-> (Addr (EraCrypto era), Value era,
    StrictMaybe (DataHash (EraCrypto era)))
Alonzo.viewTxOut @era forall a b. (a -> b) -> a -> b
$
        forall era.
Credential 'Staking (EraCrypto era)
-> Addr28Extra -> CompactForm Coin -> DataHash32 -> AlonzoTxOut era
Alonzo.TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (EraCrypto era)
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.
(Era era, Val (Value era)) =>
BabbageTxOut era
-> (Addr (EraCrypto era), 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 (EraCrypto era) ->
  Value era ->
  Datum era ->
  StrictMaybe (Script era) ->
  BabbageTxOut era
pattern $bBabbageTxOut :: forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
$mBabbageTxOut :: forall {r} {era}.
(Era era, Val (Value era), HasCallStack) =>
BabbageTxOut era
-> (Addr (EraCrypto era)
    -> Value era -> Datum era -> StrictMaybe (Script era) -> r)
-> ((# #) -> r)
-> r
BabbageTxOut addr vl datum refScript <-
  (viewTxOut -> (addr, vl, datum, refScript))
  where
    BabbageTxOut Addr (EraCrypto era)
addr Value era
vl Datum era
datum StrictMaybe (Script era)
refScript = forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr (EraCrypto era)
addr (forall c. Addr c -> CompactAddr c
compactAddr Addr (EraCrypto era)
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.
  (Era era, Val (Value era), HasCallStack) =>
  Addr (EraCrypto era) ->
  CompactAddr (EraCrypto era) ->
  Value era ->
  Datum era ->
  StrictMaybe (Script era) ->
  BabbageTxOut era
mkTxOut :: forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr (EraCrypto era)
addr CompactAddr (EraCrypto era)
_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 (EraCrypto era)
paymentCred StakeReference (EraCrypto era)
stakeRef <- Addr (EraCrypto era)
addr
  , StakeRefBase StakeCredential (EraCrypto era)
stakeCred <- StakeReference (EraCrypto era)
stakeRef
  , Just (SizeHash (ADDRHASH (EraCrypto era)) :~: 28
Refl, Addr28Extra
addr28Extra) <- forall c.
HashAlgorithm (ADDRHASH c) =>
Network
-> PaymentCredential c
-> Maybe (SizeHash (ADDRHASH c) :~: 28, Addr28Extra)
encodeAddress28 Network
network PaymentCredential (EraCrypto era)
paymentCred =
      forall era.
Credential 'Staking (EraCrypto era)
-> Addr28Extra -> CompactForm Coin -> BabbageTxOut era
TxOut_AddrHash28_AdaOnly StakeCredential (EraCrypto era)
stakeCred Addr28Extra
addr28Extra CompactForm Coin
adaCompact
mkTxOut Addr (EraCrypto era)
addr CompactAddr (EraCrypto era)
_cAddr Value era
vl (DatumHash DataHash (EraCrypto era)
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 (EraCrypto era)
paymentCred StakeReference (EraCrypto era)
stakeRef <- Addr (EraCrypto era)
addr
  , StakeRefBase StakeCredential (EraCrypto era)
stakeCred <- StakeReference (EraCrypto era)
stakeRef
  , Just (SizeHash (ADDRHASH (EraCrypto era)) :~: 28
Refl, Addr28Extra
addr28Extra) <- forall c.
HashAlgorithm (ADDRHASH c) =>
Network
-> PaymentCredential c
-> Maybe (SizeHash (ADDRHASH c) :~: 28, Addr28Extra)
encodeAddress28 Network
network PaymentCredential (EraCrypto era)
paymentCred
  , Just (SizeHash (HASH (EraCrypto era)) :~: 32
Refl, DataHash32
dataHash32) <- forall c.
HashAlgorithm (HASH c) =>
DataHash c -> Maybe (SizeHash (HASH c) :~: 32, DataHash32)
encodeDataHash32 DataHash (EraCrypto era)
dh =
      forall era.
Credential 'Staking (EraCrypto era)
-> Addr28Extra
-> CompactForm Coin
-> DataHash32
-> BabbageTxOut era
TxOut_AddrHash28_AdaOnly_DataHash32 StakeCredential (EraCrypto era)
stakeCred Addr28Extra
addr28Extra CompactForm Coin
adaCompact DataHash32
dataHash32
mkTxOut Addr (EraCrypto era)
_addr CompactAddr (EraCrypto era)
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 (EraCrypto era)
-> CompactForm (Value era) -> BabbageTxOut era
TxOutCompact' CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
cVal
          DatumHash DataHash (EraCrypto era)
dh -> forall era.
CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> DataHash (EraCrypto era)
-> BabbageTxOut era
TxOutCompactDH' CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
cVal DataHash (EraCrypto era)
dh
          Datum BinaryData era
binaryData -> forall era.
CompactAddr (EraCrypto era)
-> CompactForm (Value era) -> BinaryData era -> BabbageTxOut era
TxOutCompactDatum CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
cVal BinaryData era
binaryData
        SJust Script era
rs' -> forall era.
CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> Datum era
-> Script era
-> BabbageTxOut era
TxOutCompactRefScript CompactAddr (EraCrypto era)
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 ::
  (Era era, Val (Value era)) =>
  Addr (EraCrypto era) ->
  CompactAddr (EraCrypto era) ->
  CompactForm (Value era) ->
  Datum era ->
  StrictMaybe (Script era) ->
  BabbageTxOut era
mkTxOutCompact :: forall era.
(Era era, Val (Value era)) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOutCompact Addr (EraCrypto era)
addr CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
cVal = forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr (EraCrypto era)
addr CompactAddr (EraCrypto era)
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 (EraCrypto era) ->
  CompactForm (Value era) ->
  BabbageTxOut era
pattern $bTxOutCompact :: forall era.
(Era era, Val (Value era), Compactible (Value era),
 HasCallStack) =>
CompactAddr (EraCrypto era)
-> CompactForm (Value era) -> BabbageTxOut era
$mTxOutCompact :: forall {r} {era}.
(Era era, Val (Value era), Compactible (Value era),
 HasCallStack) =>
BabbageTxOut era
-> (CompactAddr (EraCrypto era) -> CompactForm (Value era) -> r)
-> ((# #) -> r)
-> r
TxOutCompact addr vl <-
  (viewCompactTxOut -> (addr, vl, NoDatum, SNothing))
  where
    TxOutCompact CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
cVal
      | forall t. Val t => CompactForm t -> Bool
isAdaOnlyCompact CompactForm (Value era)
cVal =
          forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut (forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr (EraCrypto era)
cAddr) CompactAddr (EraCrypto era)
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 (EraCrypto era)
-> CompactForm (Value era) -> BabbageTxOut era
TxOutCompact' CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
cVal

pattern TxOutCompactDH ::
  (Era era, Val (Value era), Compactible (Value era), HasCallStack) =>
  CompactAddr (EraCrypto era) ->
  CompactForm (Value era) ->
  DataHash (EraCrypto era) ->
  BabbageTxOut era
pattern $bTxOutCompactDH :: forall era.
(Era era, Val (Value era), Compactible (Value era),
 HasCallStack) =>
CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> DataHash (EraCrypto era)
-> BabbageTxOut era
$mTxOutCompactDH :: forall {r} {era}.
(Era era, Val (Value era), Compactible (Value era),
 HasCallStack) =>
BabbageTxOut era
-> (CompactAddr (EraCrypto era)
    -> CompactForm (Value era) -> DataHash (EraCrypto era) -> r)
-> ((# #) -> r)
-> r
TxOutCompactDH addr vl dh <-
  (viewCompactTxOut -> (addr, vl, DatumHash dh, SNothing))
  where
    TxOutCompactDH CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
cVal DataHash (EraCrypto era)
dh
      | forall t. Val t => CompactForm t -> Bool
isAdaOnlyCompact CompactForm (Value era)
cVal =
          forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut (forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr (EraCrypto era)
cAddr) CompactAddr (EraCrypto era)
cAddr (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
cVal) (forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
dh) forall a. StrictMaybe a
SNothing
      | Bool
otherwise = forall era.
CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> DataHash (EraCrypto era)
-> BabbageTxOut era
TxOutCompactDH' CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
cVal DataHash (EraCrypto era)
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 (EraCrypto era)
addr CompactForm (Value era)
cv Datum era
d Script era
rs -> forall era.
(EraScript era, Val (Value era)) =>
CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> Encoding
encodeTxOut CompactAddr (EraCrypto era)
addr CompactForm (Value era)
cv Datum era
d (forall a. a -> StrictMaybe a
SJust Script era
rs)
    TxOutCompactDatum CompactAddr (EraCrypto era)
addr CompactForm (Value era)
cv BinaryData era
d -> forall era.
(EraScript era, Val (Value era)) =>
CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> Encoding
encodeTxOut CompactAddr (EraCrypto era)
addr CompactForm (Value era)
cv (forall era. BinaryData era -> Datum era
Datum BinaryData era
d) forall a. StrictMaybe a
SNothing
    TxOutCompactDH CompactAddr (EraCrypto era)
addr CompactForm (Value era)
cv DataHash (EraCrypto era)
dh -> Word -> Encoding
encodeListLen Word
3 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactAddr (EraCrypto era)
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 (EraCrypto era)
dh
    TxOutCompact CompactAddr (EraCrypto era)
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 (EraCrypto era)
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 (EraCrypto era), CompactAddr (EraCrypto era)))
-> Decoder s (BabbageTxOut era)
decodeBabbageTxOut forall c s. Crypto c => Decoder s (Addr c, CompactAddr c)
fromCborBothAddr
  {-# INLINE decCBOR #-}

instance (EraScript era, Val (Value era)) => DecShareCBOR (BabbageTxOut era) where
  type Share (BabbageTxOut era) = Interns (Credential 'Staking (EraCrypto era))
  decShareCBOR :: forall s. Share (BabbageTxOut era) -> Decoder s (BabbageTxOut era)
decShareCBOR Share (BabbageTxOut era)
credsInterns =
    -- Even in Babbage the ledger state still contains garbage pointers that we need to
    -- deal with. This will be taken care of upon entry to Conway era. After which this
    -- backwards compatibility shim can be removed.
    forall era.
(Credential 'Staking (EraCrypto era)
 -> Credential 'Staking (EraCrypto era))
-> BabbageTxOut era -> BabbageTxOut era
internBabbageTxOut (forall k. Interns k -> k -> k
interns Share (BabbageTxOut era)
credsInterns) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall era s.
(EraScript era, Val (Value era)) =>
(forall s'.
 Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era)))
-> Decoder s (BabbageTxOut era)
decodeBabbageTxOut forall c s. Crypto c => Decoder s (Addr c, CompactAddr c)
fromCborBackwardsBothAddr
  {-# INLINEABLE decShareCBOR #-}

internBabbageTxOut ::
  (Credential 'Staking (EraCrypto era) -> Credential 'Staking (EraCrypto era)) ->
  BabbageTxOut era ->
  BabbageTxOut era
internBabbageTxOut :: forall era.
(Credential 'Staking (EraCrypto era)
 -> Credential 'Staking (EraCrypto era))
-> BabbageTxOut era -> BabbageTxOut era
internBabbageTxOut Credential 'Staking (EraCrypto era)
-> Credential 'Staking (EraCrypto era)
internCred = \case
  TxOut_AddrHash28_AdaOnly Credential 'Staking (EraCrypto era)
cred Addr28Extra
addr28Extra CompactForm Coin
ada ->
    forall era.
Credential 'Staking (EraCrypto era)
-> Addr28Extra -> CompactForm Coin -> BabbageTxOut era
TxOut_AddrHash28_AdaOnly (Credential 'Staking (EraCrypto era)
-> Credential 'Staking (EraCrypto era)
internCred Credential 'Staking (EraCrypto era)
cred) Addr28Extra
addr28Extra CompactForm Coin
ada
  TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (EraCrypto era)
cred Addr28Extra
addr28Extra CompactForm Coin
ada DataHash32
dataHash32 ->
    forall era.
Credential 'Staking (EraCrypto era)
-> Addr28Extra
-> CompactForm Coin
-> DataHash32
-> BabbageTxOut era
TxOut_AddrHash28_AdaOnly_DataHash32 (Credential 'Staking (EraCrypto era)
-> Credential 'Staking (EraCrypto era)
internCred Credential 'Staking (EraCrypto era)
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 (EraCrypto era), CompactAddr (EraCrypto era))) ->
  Decoder s (BabbageTxOut era)
decodeBabbageTxOut :: forall era s.
(EraScript era, Val (Value era)) =>
(forall s'.
 Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era)))
-> Decoder s (BabbageTxOut era)
decodeBabbageTxOut forall s'.
Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era))
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 (EraCrypto era), CompactAddr (EraCrypto era)))
-> Decoder s (BabbageTxOut era)
decodeTxOut forall s'.
Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era))
decAddr
    TokenType
TypeMapLen -> forall s era.
(EraScript era, Val (Value era)) =>
(forall s'.
 Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era)))
-> Decoder s (BabbageTxOut era)
decodeTxOut forall s'.
Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era))
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 (EraCrypto era)
a, CompactAddr (EraCrypto era)
ca) <- forall s'.
Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era))
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.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr (EraCrypto era)
a CompactAddr (EraCrypto era)
ca Value era
v forall era. Datum era
NoDatum forall a. StrictMaybe a
SNothing
            Bool
False -> do
              DataHash (EraCrypto era)
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.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr (EraCrypto era)
a CompactAddr (EraCrypto era)
ca Value era
v (forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
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 (EraCrypto era)
a, CompactAddr (EraCrypto era)
ca) <- forall s'.
Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era))
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.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr (EraCrypto era)
a CompactAddr (EraCrypto era)
ca Value era
v forall era. Datum era
NoDatum forall a. StrictMaybe a
SNothing
        Just Int
3 -> do
          (Addr (EraCrypto era)
a, CompactAddr (EraCrypto era)
ca) <- forall s'.
Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era))
decAddr
          Value era
v <- forall a s. DecCBOR a => Decoder s a
decCBOR
          DataHash (EraCrypto era)
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.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr (EraCrypto era)
a CompactAddr (EraCrypto era)
ca Value era
v (forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
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 (EraCrypto era) ->
  CompactForm (Value era) ->
  Datum era ->
  StrictMaybe (Script era) ->
  Encoding
encodeTxOut :: forall era.
(EraScript era, Val (Value era)) =>
CompactAddr (EraCrypto era)
-> CompactForm (Value era)
-> Datum era
-> StrictMaybe (Script era)
-> Encoding
encodeTxOut CompactAddr (EraCrypto era)
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 (EraCrypto era)
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 (EraCrypto era), CompactAddr (EraCrypto era))
decodingTxOutAddr :: !(StrictMaybe (Addr (EraCrypto era), CompactAddr (EraCrypto era)))
  , 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 (EraCrypto era), CompactAddr (EraCrypto era))) ->
  Decoder s (BabbageTxOut era)
decodeTxOut :: forall s era.
(EraScript era, Val (Value era)) =>
(forall s'.
 Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era)))
-> Decoder s (BabbageTxOut era)
decodeTxOut forall s'.
Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era))
decAddr = do
  DecodingTxOut era
dtxo <- forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$ forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed String
"TxOut" DecodingTxOut era
initial Word -> Field (DecodingTxOut era)
bodyFields [(Word, String)]
requiredFields
  case DecodingTxOut era
dtxo of
    DecodingTxOut StrictMaybe (Addr (EraCrypto era), CompactAddr (EraCrypto era))
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 (EraCrypto era)
addr, CompactAddr (EraCrypto era)
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.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> CompactAddr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
mkTxOut Addr (EraCrypto era)
addr CompactAddr (EraCrypto era)
cAddr Value era
val Datum era
d StrictMaybe (Script era)
script
  where
    initial :: DecodingTxOut era
    initial :: DecodingTxOut era
initial = forall era.
StrictMaybe (Addr (EraCrypto era), CompactAddr (EraCrypto era))
-> 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).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field
        (\(Addr (EraCrypto era), CompactAddr (EraCrypto era))
x DecodingTxOut era
txo -> DecodingTxOut era
txo {decodingTxOutAddr :: StrictMaybe (Addr (EraCrypto era), CompactAddr (EraCrypto era))
decodingTxOutAddr = forall a. a -> StrictMaybe a
SJust (Addr (EraCrypto era), CompactAddr (EraCrypto era))
x})
        (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s'.
Decoder s' (Addr (EraCrypto era), CompactAddr (EraCrypto era))
decAddr)
    bodyFields Word
1 =
      forall x t (d :: Density).
(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).
(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).
(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 x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Any
_ DecodingTxOut era
t -> DecodingTxOut era
t) (forall (w :: Wrapped) t. Word -> Decode w t
Invalid 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 ::
  (HasCallStack, HashAlgorithm (ADDRHASH (EraCrypto era))) =>
  BabbageTxOut era ->
  Either (Addr (EraCrypto era)) (CompactAddr (EraCrypto era))
getEitherAddrBabbageTxOut :: forall era.
(HasCallStack, HashAlgorithm (ADDRHASH (EraCrypto era))) =>
BabbageTxOut era
-> Either (Addr (EraCrypto era)) (CompactAddr (EraCrypto era))
getEitherAddrBabbageTxOut = \case
  TxOutCompact' CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
_ -> forall a b. b -> Either a b
Right CompactAddr (EraCrypto era)
cAddr
  TxOutCompactDH' CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
_ DataHash (EraCrypto era)
_ -> forall a b. b -> Either a b
Right CompactAddr (EraCrypto era)
cAddr
  TxOutCompactRefScript CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
_ Datum era
_ Script era
_ -> forall a b. b -> Either a b
Right CompactAddr (EraCrypto era)
cAddr
  TxOutCompactDatum CompactAddr (EraCrypto era)
cAddr CompactForm (Value era)
_ BinaryData era
_ -> forall a b. b -> Either a b
Right CompactAddr (EraCrypto era)
cAddr
  TxOut_AddrHash28_AdaOnly Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
_
    | Just Addr (EraCrypto era)
addr <- forall c.
HashAlgorithm (ADDRHASH c) =>
Credential 'Staking c -> Addr28Extra -> Maybe (Addr c)
decodeAddress28 Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra -> forall a b. a -> Either a b
Left Addr (EraCrypto era)
addr
    | Bool
otherwise -> forall a. HasCallStack => String -> a
error String
"Impossible: Compacted an address of non-standard size"
  TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
_ DataHash32
_
    | Just Addr (EraCrypto era)
addr <- forall c.
HashAlgorithm (ADDRHASH c) =>
Credential 'Staking c -> Addr28Extra -> Maybe (Addr c)
decodeAddress28 Credential 'Staking (EraCrypto era)
stakeRef Addr28Extra
addr28Extra -> forall a b. a -> Either a b
Left Addr (EraCrypto era)
addr
    | Bool
otherwise -> forall a. HasCallStack => String -> a
error String
"Impossible: Compacted an address or a hash of non-standard size"
{-# 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 (EraCrypto era)
_ 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 (EraCrypto era)
_ 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 ::
  (HasCallStack, Era era) =>
  BabbageTxOut era ->
  StrictMaybe (DataHash (EraCrypto era))
getDataHashBabbageTxOut :: forall era.
(HasCallStack, Era era) =>
BabbageTxOut era -> StrictMaybe (DataHash (EraCrypto era))
getDataHashBabbageTxOut BabbageTxOut era
txOut =
  case forall era.
(HasCallStack, Era era) =>
BabbageTxOut era -> Datum era
getDatumBabbageTxOut BabbageTxOut era
txOut of
    Datum era
NoDatum -> forall a. StrictMaybe a
SNothing
    DatumHash DataHash (EraCrypto era)
dh -> forall a. a -> StrictMaybe a
SJust DataHash (EraCrypto era)
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 (EraCrypto era)
_ 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 :: (HasCallStack, Era era) => BabbageTxOut era -> Datum era
getDatumBabbageTxOut :: forall era.
(HasCallStack, Era era) =>
BabbageTxOut era -> Datum era
getDatumBabbageTxOut = \case
  TxOutCompact' {} -> forall era. Datum era
NoDatum
  TxOutCompactDH' CompactAddr (EraCrypto era)
_ CompactForm (Value era)
_ DataHash (EraCrypto era)
dh -> forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
dh
  TxOutCompactDatum CompactAddr (EraCrypto era)
_ CompactForm (Value era)
_ BinaryData era
binaryData -> forall era. BinaryData era -> Datum era
Datum BinaryData era
binaryData
  TxOutCompactRefScript CompactAddr (EraCrypto era)
_ 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 (EraCrypto era)
_ Addr28Extra
_ CompactForm Coin
_ DataHash32
dataHash32
    | Just DataHash (EraCrypto era)
dh <- forall c.
HashAlgorithm (HASH c) =>
DataHash32 -> Maybe (DataHash c)
decodeDataHash32 DataHash32
dataHash32 -> forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
dh
    | Bool
otherwise -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Impossible: Compacted a hash of non-standard size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show 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 (EraCrypto era)
_ CompactForm (Value era)
cv -> CompactForm (Value era)
cv
    TxOutCompactDH' CompactAddr (EraCrypto era)
_ CompactForm (Value era)
cv DataHash (EraCrypto era)
_ -> CompactForm (Value era)
cv
    TxOutCompactDatum CompactAddr (EraCrypto era)
_ CompactForm (Value era)
cv BinaryData era
_ -> CompactForm (Value era)
cv
    TxOutCompactRefScript CompactAddr (EraCrypto era)
_ CompactForm (Value era)
cv Datum era
_ Script era
_ -> CompactForm (Value era)
cv
    TxOut_AddrHash28_AdaOnly Credential 'Staking (EraCrypto era)
_ Addr28Extra
_ CompactForm Coin
cc -> forall t. Val t => CompactForm Coin -> CompactForm t
injectCompact CompactForm Coin
cc
    TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (EraCrypto era)
_ 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 :: Era era => BabbageTxOut era -> Maybe (DataHash (EraCrypto era))
txOutDataHash :: forall era.
Era era =>
BabbageTxOut era -> Maybe (DataHash (EraCrypto era))
txOutDataHash = forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(HasCallStack, Era era) =>
BabbageTxOut era -> StrictMaybe (DataHash (EraCrypto era))
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 #-}