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

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

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.HeapWords (HeapWords (..))
import Cardano.Ledger.Binary (
  Case (..),
  DecCBOR (..),
  DecoderError (DecoderErrorUnknownTag),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  cborError,
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  szCases,
  toByronCBOR,
 )
import Cardano.Prelude hiding (cborError)
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
  { Tx -> NonEmpty TxIn
txInputs :: !(NonEmpty TxIn)
  -- ^ Inputs of transaction.
  , Tx -> NonEmpty TxOut
txOutputs :: !(NonEmpty TxOut)
  -- ^ Outputs of transaction.
  , Tx -> TxAttributes
txAttributes :: !TxAttributes
  -- ^ Attributes of transaction
  }
  deriving (Tx -> Tx -> Bool
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
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
Ord, 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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Tx -> ()
$crnf :: Tx -> ()
NFData)

instance B.Buildable Tx where
  build :: Tx -> Builder
build Tx
tx =
    forall a. Format Builder a -> a
bprint
      ( Format
  (TxId -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
  (TxId -> NonEmpty TxIn -> NonEmpty TxOut -> Builder -> Builder)
"Tx "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
          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 "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson
          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: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (Builder -> r)
builder
      )
      (forall a. EncCBOR 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
        | forall a. Attributes a -> Bool
attributesAreKnown TxAttributes
attrs = forall a. Monoid a => a
mempty
        | Bool
otherwise = forall a. Format Builder a -> a
bprint (Format (TxAttributes -> Builder) (TxAttributes -> Builder)
", attributes: " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build) TxAttributes
attrs

instance ToCBOR Tx where
  toCBOR :: Tx -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Tx where
  fromCBOR :: forall s. Decoder s Tx
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- Used for debugging purposes only
instance ToJSON Tx

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

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

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

-- | Specialized formatter for 'Tx'
txF :: Format r (Tx -> r)
txF :: forall r. Format r (Tx -> r)
txF = 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
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
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
Ord, 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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxIn -> ()
$crnf :: TxIn -> ()
NFData)

instance B.Buildable TxIn where
  build :: TxIn -> Builder
build (TxInUtxo TxId
txInHash Word16
txInIndex) =
    forall a. Format Builder a -> a
bprint (Format (TxId -> Word16 -> Builder) (TxId -> Word16 -> Builder)
"TxInUtxo " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r algo a. Format r (AbstractHash algo a -> r)
shortHashF 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)
" #" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Integral a => Format r (a -> r)
int) TxId
txInHash Word16
txInIndex

-- Used for debugging purposes only
instance ToJSON TxIn

instance ToCBOR TxIn where
  toCBOR :: TxIn -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR TxIn where
  fromCBOR :: forall s. Decoder s TxIn
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR TxIn where
  encCBOR :: TxIn -> Encoding
encCBOR (TxInUtxo TxId
txInHash Word16
txInIndex) =
    Word -> Encoding
encodeListLen Word
2
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encodeKnownCborDataItem
        (TxId
txInHash, Word16
txInIndex)

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

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

instance HeapWords TxIn where
  heapWords :: TxIn -> Int
heapWords (TxInUtxo TxId
txid Word16
_w16) = Int
3 forall a. Num a => a -> a -> a
+ forall a. HeapWords a => a -> Int
heapWords TxId
txid 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
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
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
Ord, 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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxOut -> ()
$crnf :: TxOut -> ()
NFData)

instance B.Buildable TxOut where
  build :: TxOut -> Builder
build TxOut
txOut =
    forall a. Format Builder a -> a
bprint
      (Format
  (Lovelace -> Address -> Builder) (Lovelace -> Address -> Builder)
"TxOut " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (Lovelace -> r)
lovelaceF 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)
" -> " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 EncCBOR TxOut where
  encCBOR :: TxOut -> Encoding
encCBOR TxOut
txOut =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TxOut -> Address
txOutAddress TxOut
txOut) forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TxOut -> Lovelace
txOutValue TxOut
txOut)

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

instance ToCBOR TxOut where
  toCBOR :: TxOut -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR TxOut where
  fromCBOR :: forall s. Decoder s TxOut
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

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

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