{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Chain.UTxO.Tx
  ( Tx (..),
    txF,
    TxId,
    TxAttributes,
    TxIn (..),
    TxOut (..),
  )
where

import Cardano.Binary
  ( Case (..),
    DecoderError (DecoderErrorUnknownTag),
    FromCBOR (..),
    ToCBOR (..),
    encodeListLen,
    enforceSize,
    szCases,
  )
import Cardano.Chain.Common
  ( Address (..),
    Lovelace,
    lovelaceF,
  )
import Cardano.Chain.Common.Attributes (Attributes, attributesAreKnown)
import Cardano.Chain.Common.CBOR
  ( decodeKnownCborDataItem,
    encodeKnownCborDataItem,
    knownCborDataItemSizeExpr,
  )
import Cardano.Crypto (Hash, serializeCborHash, shortHashF)
import Cardano.Prelude
import Data.Aeson (ToJSON)
import Formatting (Format, bprint, build, builder, int)
import qualified Formatting.Buildable as B

--------------------------------------------------------------------------------
-- Tx
--------------------------------------------------------------------------------

-- | Transaction
--
--   NB: transaction witnesses are stored separately
data Tx = UnsafeTx
  { -- | Inputs of transaction.
    Tx -> NonEmpty TxIn
txInputs :: !(NonEmpty TxIn),
    -- | Outputs of transaction.
    Tx -> NonEmpty TxOut
txOutputs :: !(NonEmpty TxOut),
    -- | Attributes of transaction
    Tx -> TxAttributes
txAttributes :: !TxAttributes
  }
  deriving (Tx -> Tx -> Bool
(Tx -> Tx -> Bool) -> (Tx -> Tx -> Bool) -> Eq Tx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tx -> Tx -> Bool
$c/= :: Tx -> Tx -> Bool
== :: Tx -> Tx -> Bool
$c== :: Tx -> Tx -> Bool
Eq, Eq Tx
Eq Tx
-> (Tx -> Tx -> Ordering)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Tx)
-> (Tx -> Tx -> Tx)
-> Ord Tx
Tx -> Tx -> Bool
Tx -> Tx -> Ordering
Tx -> Tx -> Tx
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tx -> Tx -> Tx
$cmin :: Tx -> Tx -> Tx
max :: Tx -> Tx -> Tx
$cmax :: Tx -> Tx -> Tx
>= :: Tx -> Tx -> Bool
$c>= :: Tx -> Tx -> Bool
> :: Tx -> Tx -> Bool
$c> :: Tx -> Tx -> Bool
<= :: Tx -> Tx -> Bool
$c<= :: Tx -> Tx -> Bool
< :: Tx -> Tx -> Bool
$c< :: Tx -> Tx -> Bool
compare :: Tx -> Tx -> Ordering
$ccompare :: Tx -> Tx -> Ordering
$cp1Ord :: Eq Tx
Ord, (forall x. Tx -> Rep Tx x)
-> (forall x. Rep Tx x -> Tx) -> Generic Tx
forall x. Rep Tx x -> Tx
forall x. Tx -> Rep Tx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tx x -> Tx
$cfrom :: forall x. Tx -> Rep Tx x
Generic, Int -> Tx -> ShowS
[Tx] -> ShowS
Tx -> String
(Int -> Tx -> ShowS)
-> (Tx -> String) -> ([Tx] -> ShowS) -> Show Tx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tx] -> ShowS
$cshowList :: [Tx] -> ShowS
show :: Tx -> String
$cshow :: Tx -> String
showsPrec :: Int -> Tx -> ShowS
$cshowsPrec :: Int -> Tx -> ShowS
Show)
  deriving anyclass (Tx -> ()
(Tx -> ()) -> NFData Tx
forall a. (a -> ()) -> NFData a
rnf :: Tx -> ()
$crnf :: Tx -> ()
NFData)

instance B.Buildable Tx where
  build :: Tx -> Builder
build Tx
tx =
    Format
  Builder
  (Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
-> Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder
forall a. Format Builder a -> a
bprint
      ( Format
  (Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
  (Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
"Tx "
          Format
  (Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
  (Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
-> Format
     Builder
     (Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
-> Format
     Builder
     (Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
  (Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
  (Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
-> Format
     Builder (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
-> Format
     Builder
     (Hash Tx -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
  (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
" with inputs "
          Format
  (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
  (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
-> Format
     Builder (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
-> Format
     Builder (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (NonEmpty TxOut -> Builder -> Builder)
  (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson
          Format
  (NonEmpty TxOut -> Builder -> Builder)
  (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
-> Format Builder (NonEmpty TxOut -> Builder -> Builder)
-> Format
     Builder (NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (NonEmpty TxOut -> Builder -> Builder)
  (NonEmpty TxOut -> Builder -> Builder)
", outputs: "
          Format
  (NonEmpty TxOut -> Builder -> Builder)
  (NonEmpty TxOut -> Builder -> Builder)
-> Format Builder (NonEmpty TxOut -> Builder -> Builder)
-> Format Builder (NonEmpty TxOut -> Builder -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Builder -> Builder) (NonEmpty TxOut -> Builder -> Builder)
forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson
          Format (Builder -> Builder) (NonEmpty TxOut -> Builder -> Builder)
-> Format Builder (Builder -> Builder)
-> Format Builder (NonEmpty TxOut -> Builder -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Builder -> Builder)
forall r. Format r (Builder -> r)
builder
      )
      (Tx -> Hash Tx
forall a. ToCBOR a => a -> Hash a
serializeCborHash Tx
tx)
      (Tx -> NonEmpty TxIn
txInputs Tx
tx)
      (Tx -> NonEmpty TxOut
txOutputs Tx
tx)
      Builder
attrsBuilder
    where
      attrs :: TxAttributes
attrs = Tx -> TxAttributes
txAttributes Tx
tx
      attrsBuilder :: Builder
attrsBuilder
        | TxAttributes -> Bool
forall a. Attributes a -> Bool
attributesAreKnown TxAttributes
attrs = Builder
forall a. Monoid a => a
mempty
        | Bool
otherwise = Format Builder (TxAttributes -> Builder) -> TxAttributes -> Builder
forall a. Format Builder a -> a
bprint (Format (TxAttributes -> Builder) (TxAttributes -> Builder)
", attributes: " Format (TxAttributes -> Builder) (TxAttributes -> Builder)
-> Format Builder (TxAttributes -> Builder)
-> Format Builder (TxAttributes -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (TxAttributes -> Builder)
forall a r. Buildable a => Format r (a -> r)
build) TxAttributes
attrs

-- Used for debugging purposes only
instance ToJSON Tx

instance ToCBOR Tx where
  toCBOR :: Tx -> Encoding
toCBOR Tx
tx =
    Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonEmpty TxIn -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Tx -> NonEmpty TxIn
txInputs Tx
tx) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonEmpty TxOut -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Tx -> NonEmpty TxOut
txOutputs Tx
tx)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxAttributes -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
        (Tx -> TxAttributes
txAttributes Tx
tx)

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Tx -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy Tx
pxy =
    Size
1 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy (NonEmpty TxIn) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Tx -> NonEmpty TxIn
txInputs (Tx -> NonEmpty TxIn) -> Proxy Tx -> Proxy (NonEmpty TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Tx
pxy) Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy (NonEmpty TxOut) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Tx -> NonEmpty TxOut
txOutputs (Tx -> NonEmpty TxOut) -> Proxy Tx -> Proxy (NonEmpty TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Tx
pxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy TxAttributes -> Size
forall t. ToCBOR t => Proxy t -> Size
size
        (Tx -> TxAttributes
txAttributes (Tx -> TxAttributes) -> Proxy Tx -> Proxy TxAttributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Tx
pxy)

instance FromCBOR Tx where
  fromCBOR :: Decoder s Tx
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Tx" Int
3
    NonEmpty TxIn -> NonEmpty TxOut -> TxAttributes -> Tx
UnsafeTx (NonEmpty TxIn -> NonEmpty TxOut -> TxAttributes -> Tx)
-> Decoder s (NonEmpty TxIn)
-> Decoder s (NonEmpty TxOut -> TxAttributes -> Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (NonEmpty TxIn)
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (NonEmpty TxOut -> TxAttributes -> Tx)
-> Decoder s (NonEmpty TxOut) -> Decoder s (TxAttributes -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (NonEmpty TxOut)
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (TxAttributes -> Tx)
-> Decoder s TxAttributes -> Decoder s Tx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s TxAttributes
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- | Specialized formatter for 'Tx'
txF :: Format r (Tx -> r)
txF :: Format r (Tx -> r)
txF = Format r (Tx -> r)
forall a r. Buildable a => Format r (a -> r)
build

--------------------------------------------------------------------------------
-- TxId
--------------------------------------------------------------------------------

-- | Represents transaction identifier as 'Hash' of 'Tx'
type TxId = Hash Tx

--------------------------------------------------------------------------------
-- TxAttributes
--------------------------------------------------------------------------------

-- | Represents transaction attributes: map from 1-byte integer to
--   arbitrary-type value. To be used for extending transaction with new fields
--   via softfork.
type TxAttributes = Attributes ()

--------------------------------------------------------------------------------
-- TxIn
--------------------------------------------------------------------------------

-- | Transaction arbitrary input
data TxIn
  = -- | TxId = Which transaction's output is used
    -- | Word16 = Index of the output in transaction's outputs
    TxInUtxo TxId Word16
  deriving (TxIn -> TxIn -> Bool
(TxIn -> TxIn -> Bool) -> (TxIn -> TxIn -> Bool) -> Eq TxIn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxIn -> TxIn -> Bool
$c/= :: TxIn -> TxIn -> Bool
== :: TxIn -> TxIn -> Bool
$c== :: TxIn -> TxIn -> Bool
Eq, Eq TxIn
Eq TxIn
-> (TxIn -> TxIn -> Ordering)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> TxIn)
-> (TxIn -> TxIn -> TxIn)
-> Ord TxIn
TxIn -> TxIn -> Bool
TxIn -> TxIn -> Ordering
TxIn -> TxIn -> TxIn
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxIn -> TxIn -> TxIn
$cmin :: TxIn -> TxIn -> TxIn
max :: TxIn -> TxIn -> TxIn
$cmax :: TxIn -> TxIn -> TxIn
>= :: TxIn -> TxIn -> Bool
$c>= :: TxIn -> TxIn -> Bool
> :: TxIn -> TxIn -> Bool
$c> :: TxIn -> TxIn -> Bool
<= :: TxIn -> TxIn -> Bool
$c<= :: TxIn -> TxIn -> Bool
< :: TxIn -> TxIn -> Bool
$c< :: TxIn -> TxIn -> Bool
compare :: TxIn -> TxIn -> Ordering
$ccompare :: TxIn -> TxIn -> Ordering
$cp1Ord :: Eq TxIn
Ord, (forall x. TxIn -> Rep TxIn x)
-> (forall x. Rep TxIn x -> TxIn) -> Generic TxIn
forall x. Rep TxIn x -> TxIn
forall x. TxIn -> Rep TxIn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxIn x -> TxIn
$cfrom :: forall x. TxIn -> Rep TxIn x
Generic, Int -> TxIn -> ShowS
[TxIn] -> ShowS
TxIn -> String
(Int -> TxIn -> ShowS)
-> (TxIn -> String) -> ([TxIn] -> ShowS) -> Show TxIn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxIn] -> ShowS
$cshowList :: [TxIn] -> ShowS
show :: TxIn -> String
$cshow :: TxIn -> String
showsPrec :: Int -> TxIn -> ShowS
$cshowsPrec :: Int -> TxIn -> ShowS
Show)
  deriving anyclass (TxIn -> ()
(TxIn -> ()) -> NFData TxIn
forall a. (a -> ()) -> NFData a
rnf :: TxIn -> ()
$crnf :: TxIn -> ()
NFData)

instance B.Buildable TxIn where
  build :: TxIn -> Builder
build (TxInUtxo Hash Tx
txInHash Word16
txInIndex) =
    Format Builder (Hash Tx -> Word16 -> Builder)
-> Hash Tx -> Word16 -> Builder
forall a. Format Builder a -> a
bprint (Format
  (Hash Tx -> Word16 -> Builder) (Hash Tx -> Word16 -> Builder)
"TxInUtxo " Format
  (Hash Tx -> Word16 -> Builder) (Hash Tx -> Word16 -> Builder)
-> Format Builder (Hash Tx -> Word16 -> Builder)
-> Format Builder (Hash Tx -> Word16 -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Word16 -> Builder) (Hash Tx -> Word16 -> Builder)
forall r algo a. Format r (AbstractHash algo a -> r)
shortHashF Format (Word16 -> Builder) (Hash Tx -> Word16 -> Builder)
-> Format Builder (Word16 -> Builder)
-> Format Builder (Hash Tx -> Word16 -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Word16 -> Builder) (Word16 -> Builder)
" #" Format (Word16 -> Builder) (Word16 -> Builder)
-> Format Builder (Word16 -> Builder)
-> Format Builder (Word16 -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Word16 -> Builder)
forall a r. Integral a => Format r (a -> r)
int) Hash Tx
txInHash Word16
txInIndex

-- Used for debugging purposes only
instance ToJSON TxIn

instance ToCBOR TxIn where
  toCBOR :: TxIn -> Encoding
toCBOR (TxInUtxo Hash Tx
txInHash Word16
txInIndex) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Hash Tx, Word16) -> Encoding
forall a. ToCBOR a => a -> Encoding
encodeKnownCborDataItem
        (Hash Tx
txInHash, Word16
txInIndex)

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy TxIn -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy TxIn
_ =
    Size
2
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size -> Size
knownCborDataItemSizeExpr
        ([Case Size] -> Size
szCases [Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"TxInUtxo" (Size -> Case Size) -> Size -> Case Size
forall a b. (a -> b) -> a -> b
$ Proxy (Hash Tx, Word16) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy (Hash Tx, Word16) -> Size)
-> Proxy (Hash Tx, Word16) -> Size
forall a b. (a -> b) -> a -> b
$ Proxy (Hash Tx, Word16)
forall k (t :: k). Proxy t
Proxy @(TxId, Word16)])

instance FromCBOR TxIn where
  fromCBOR :: Decoder s TxIn
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"TxIn" Int
2
    Word8
tag <- forall s. FromCBOR Word8 => Decoder s Word8
forall a s. FromCBOR a => Decoder s a
fromCBOR @Word8
    case Word8
tag of
      Word8
0 -> (Hash Tx -> Word16 -> TxIn) -> (Hash Tx, Word16) -> TxIn
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Hash Tx -> Word16 -> TxIn
TxInUtxo ((Hash Tx, Word16) -> TxIn)
-> Decoder s (Hash Tx, Word16) -> Decoder s TxIn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Hash Tx, Word16)
forall a s. FromCBOR a => Decoder s a
decodeKnownCborDataItem
      Word8
_ -> DecoderError -> Decoder s TxIn
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s TxIn) -> DecoderError -> Decoder s TxIn
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"TxIn" Word8
tag

instance HeapWords TxIn where
  heapWords :: TxIn -> Int
heapWords (TxInUtxo Hash Tx
txid Word16
_w16) = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Hash Tx -> Int
forall a. HeapWords a => a -> Int
heapWords Hash Tx
txid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2

--------------------------------------------------------------------------------
-- TxOut
--------------------------------------------------------------------------------

-- | Transaction output
data TxOut = TxOut
  { TxOut -> Address
txOutAddress :: !Address,
    TxOut -> Lovelace
txOutValue :: !Lovelace
  }
  deriving (TxOut -> TxOut -> Bool
(TxOut -> TxOut -> Bool) -> (TxOut -> TxOut -> Bool) -> Eq TxOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxOut -> TxOut -> Bool
$c/= :: TxOut -> TxOut -> Bool
== :: TxOut -> TxOut -> Bool
$c== :: TxOut -> TxOut -> Bool
Eq, Eq TxOut
Eq TxOut
-> (TxOut -> TxOut -> Ordering)
-> (TxOut -> TxOut -> Bool)
-> (TxOut -> TxOut -> Bool)
-> (TxOut -> TxOut -> Bool)
-> (TxOut -> TxOut -> Bool)
-> (TxOut -> TxOut -> TxOut)
-> (TxOut -> TxOut -> TxOut)
-> Ord TxOut
TxOut -> TxOut -> Bool
TxOut -> TxOut -> Ordering
TxOut -> TxOut -> TxOut
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxOut -> TxOut -> TxOut
$cmin :: TxOut -> TxOut -> TxOut
max :: TxOut -> TxOut -> TxOut
$cmax :: TxOut -> TxOut -> TxOut
>= :: TxOut -> TxOut -> Bool
$c>= :: TxOut -> TxOut -> Bool
> :: TxOut -> TxOut -> Bool
$c> :: TxOut -> TxOut -> Bool
<= :: TxOut -> TxOut -> Bool
$c<= :: TxOut -> TxOut -> Bool
< :: TxOut -> TxOut -> Bool
$c< :: TxOut -> TxOut -> Bool
compare :: TxOut -> TxOut -> Ordering
$ccompare :: TxOut -> TxOut -> Ordering
$cp1Ord :: Eq TxOut
Ord, (forall x. TxOut -> Rep TxOut x)
-> (forall x. Rep TxOut x -> TxOut) -> Generic TxOut
forall x. Rep TxOut x -> TxOut
forall x. TxOut -> Rep TxOut x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxOut x -> TxOut
$cfrom :: forall x. TxOut -> Rep TxOut x
Generic, Int -> TxOut -> ShowS
[TxOut] -> ShowS
TxOut -> String
(Int -> TxOut -> ShowS)
-> (TxOut -> String) -> ([TxOut] -> ShowS) -> Show TxOut
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOut] -> ShowS
$cshowList :: [TxOut] -> ShowS
show :: TxOut -> String
$cshow :: TxOut -> String
showsPrec :: Int -> TxOut -> ShowS
$cshowsPrec :: Int -> TxOut -> ShowS
Show)
  deriving anyclass (TxOut -> ()
(TxOut -> ()) -> NFData TxOut
forall a. (a -> ()) -> NFData a
rnf :: TxOut -> ()
$crnf :: TxOut -> ()
NFData)

instance B.Buildable TxOut where
  build :: TxOut -> Builder
build TxOut
txOut =
    Format Builder (Lovelace -> Address -> Builder)
-> Lovelace -> Address -> Builder
forall a. Format Builder a -> a
bprint
      (Format
  (Lovelace -> Address -> Builder) (Lovelace -> Address -> Builder)
"TxOut " Format
  (Lovelace -> Address -> Builder) (Lovelace -> Address -> Builder)
-> Format Builder (Lovelace -> Address -> Builder)
-> Format Builder (Lovelace -> Address -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Address -> Builder) (Lovelace -> Address -> Builder)
forall r. Format r (Lovelace -> r)
lovelaceF Format (Address -> Builder) (Lovelace -> Address -> Builder)
-> Format Builder (Address -> Builder)
-> Format Builder (Lovelace -> Address -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Address -> Builder) (Address -> Builder)
" -> " Format (Address -> Builder) (Address -> Builder)
-> Format Builder (Address -> Builder)
-> Format Builder (Address -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Address -> Builder)
forall a r. Buildable a => Format r (a -> r)
build)
      (TxOut -> Lovelace
txOutValue TxOut
txOut)
      (TxOut -> Address
txOutAddress TxOut
txOut)

-- Used for debugging purposes only
instance ToJSON TxOut

instance ToCBOR TxOut where
  toCBOR :: TxOut -> Encoding
toCBOR TxOut
txOut =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Address -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (TxOut -> Address
txOutAddress TxOut
txOut) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Lovelace -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (TxOut -> Lovelace
txOutValue TxOut
txOut)

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy TxOut -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy TxOut
pxy =
    Size
1 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy Address -> Size
forall t. ToCBOR t => Proxy t -> Size
size (TxOut -> Address
txOutAddress (TxOut -> Address) -> Proxy TxOut -> Proxy Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy TxOut
pxy) Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy Lovelace -> Size
forall t. ToCBOR t => Proxy t -> Size
size (TxOut -> Lovelace
txOutValue (TxOut -> Lovelace) -> Proxy TxOut -> Proxy Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy TxOut
pxy)

instance FromCBOR TxOut where
  fromCBOR :: Decoder s TxOut
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"TxOut" Int
2
    Address -> Lovelace -> TxOut
TxOut (Address -> Lovelace -> TxOut)
-> Decoder s Address -> Decoder s (Lovelace -> TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Address
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Lovelace -> TxOut)
-> Decoder s Lovelace -> Decoder s TxOut
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Lovelace
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance HeapWords TxOut where
  heapWords :: TxOut -> Int
heapWords (TxOut Address
address Lovelace
_) = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Address -> Int
forall a. HeapWords a => a -> Int
heapWords Address
address