{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}

module PlutusLedgerApi.V4.Tx
  ( -- * Transactions
    TxId (..)

    -- * Transaction outputs
  , TxOutRef (TxOutRef, txOutRefId, txOutRefIdx)
  , OutputDatum (..)
  , TxOut (..)
  , txOutPubKey
  , txOutScriptHash
  , isPubKeyOut
  , isPayToScriptOut
  , pubKeyHashTxOut
  ) where

import Control.DeepSeq (NFData)
import Data.Maybe (isJust)
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusLedgerApi.V1.Scripts (ScriptHash)
import PlutusLedgerApi.V1.Value (Value)
import PlutusLedgerApi.V2.Tx (OutputDatum (..))
import PlutusLedgerApi.V3.Tx (TxId (..))
import PlutusLedgerApi.V3.Tx qualified as V3
import PlutusLedgerApi.V4.Address
  ( Address
  , pubKeyHashAddress
  , toPubKeyHash
  , toScriptHash
  )
import PlutusLedgerApi.V4.Internal (ListEncoded (..))
import PlutusTx qualified
import PlutusTx.Blueprint (definitionRef)
import PlutusTx.Blueprint.Class (HasBlueprintSchema (..))
import PlutusTx.Blueprint.Definition (HasBlueprintDefinition (..), UnrollAll)
import PlutusTx.Eq qualified as PlutusTx
import Prettyprinter (Pretty (pretty), hang, vsep, (<+>))

newtype TxOutRef = TxOutRefValue V3.TxOutRef
  deriving stock ((forall x. TxOutRef -> Rep TxOutRef x)
-> (forall x. Rep TxOutRef x -> TxOutRef) -> Generic TxOutRef
forall x. Rep TxOutRef x -> TxOutRef
forall x. TxOutRef -> Rep TxOutRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxOutRef -> Rep TxOutRef x
from :: forall x. TxOutRef -> Rep TxOutRef x
$cto :: forall x. Rep TxOutRef x -> TxOutRef
to :: forall x. Rep TxOutRef x -> TxOutRef
Generic)
  deriving newtype (Int -> TxOutRef -> ShowS
[TxOutRef] -> ShowS
TxOutRef -> String
(Int -> TxOutRef -> ShowS)
-> (TxOutRef -> String) -> ([TxOutRef] -> ShowS) -> Show TxOutRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxOutRef -> ShowS
showsPrec :: Int -> TxOutRef -> ShowS
$cshow :: TxOutRef -> String
show :: TxOutRef -> String
$cshowList :: [TxOutRef] -> ShowS
showList :: [TxOutRef] -> ShowS
Show, TxOutRef -> TxOutRef -> Bool
(TxOutRef -> TxOutRef -> Bool)
-> (TxOutRef -> TxOutRef -> Bool) -> Eq TxOutRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxOutRef -> TxOutRef -> Bool
== :: TxOutRef -> TxOutRef -> Bool
$c/= :: TxOutRef -> TxOutRef -> Bool
/= :: TxOutRef -> TxOutRef -> Bool
Eq, Eq TxOutRef
Eq TxOutRef =>
(TxOutRef -> TxOutRef -> Ordering)
-> (TxOutRef -> TxOutRef -> Bool)
-> (TxOutRef -> TxOutRef -> Bool)
-> (TxOutRef -> TxOutRef -> Bool)
-> (TxOutRef -> TxOutRef -> Bool)
-> (TxOutRef -> TxOutRef -> TxOutRef)
-> (TxOutRef -> TxOutRef -> TxOutRef)
-> Ord TxOutRef
TxOutRef -> TxOutRef -> Bool
TxOutRef -> TxOutRef -> Ordering
TxOutRef -> TxOutRef -> TxOutRef
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
$ccompare :: TxOutRef -> TxOutRef -> Ordering
compare :: TxOutRef -> TxOutRef -> Ordering
$c< :: TxOutRef -> TxOutRef -> Bool
< :: TxOutRef -> TxOutRef -> Bool
$c<= :: TxOutRef -> TxOutRef -> Bool
<= :: TxOutRef -> TxOutRef -> Bool
$c> :: TxOutRef -> TxOutRef -> Bool
> :: TxOutRef -> TxOutRef -> Bool
$c>= :: TxOutRef -> TxOutRef -> Bool
>= :: TxOutRef -> TxOutRef -> Bool
$cmax :: TxOutRef -> TxOutRef -> TxOutRef
max :: TxOutRef -> TxOutRef -> TxOutRef
$cmin :: TxOutRef -> TxOutRef -> TxOutRef
min :: TxOutRef -> TxOutRef -> TxOutRef
Ord, TxOutRef -> ()
(TxOutRef -> ()) -> NFData TxOutRef
forall a. (a -> ()) -> NFData a
$crnf :: TxOutRef -> ()
rnf :: TxOutRef -> ()
NFData, (forall ann. TxOutRef -> Doc ann)
-> (forall ann. [TxOutRef] -> Doc ann) -> Pretty TxOutRef
forall ann. [TxOutRef] -> Doc ann
forall ann. TxOutRef -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. TxOutRef -> Doc ann
pretty :: forall ann. TxOutRef -> Doc ann
$cprettyList :: forall ann. [TxOutRef] -> Doc ann
prettyList :: forall ann. [TxOutRef] -> Doc ann
Pretty, TxOutRef -> TxOutRef -> Bool
(TxOutRef -> TxOutRef -> Bool) -> Eq TxOutRef
forall a. (a -> a -> Bool) -> Eq a
$c== :: TxOutRef -> TxOutRef -> Bool
== :: TxOutRef -> TxOutRef -> Bool
PlutusTx.Eq)
  deriving
    (TxOutRef -> BuiltinData
(TxOutRef -> BuiltinData) -> ToData TxOutRef
forall a. (a -> BuiltinData) -> ToData a
$ctoBuiltinData :: TxOutRef -> BuiltinData
toBuiltinData :: TxOutRef -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe TxOutRef
(BuiltinData -> Maybe TxOutRef) -> FromData TxOutRef
forall a. (BuiltinData -> Maybe a) -> FromData a
$cfromBuiltinData :: BuiltinData -> Maybe TxOutRef
fromBuiltinData :: BuiltinData -> Maybe TxOutRef
PlutusTx.FromData, BuiltinData -> TxOutRef
(BuiltinData -> TxOutRef) -> UnsafeFromData TxOutRef
forall a. (BuiltinData -> a) -> UnsafeFromData a
$cunsafeFromBuiltinData :: BuiltinData -> TxOutRef
unsafeFromBuiltinData :: BuiltinData -> TxOutRef
PlutusTx.UnsafeFromData)
    via ListEncoded V3.TxOutRef

pattern TxOutRef :: TxId -> Integer -> TxOutRef
pattern $mTxOutRef :: forall {r}. TxOutRef -> (TxId -> Integer -> r) -> ((# #) -> r) -> r
$bTxOutRef :: TxId -> Integer -> TxOutRef
TxOutRef {TxOutRef -> TxId
txOutRefId, TxOutRef -> Integer
txOutRefIdx} =
  TxOutRefValue (V3.TxOutRef txOutRefId txOutRefIdx)
{-# COMPLETE TxOutRef #-}

instance HasBlueprintDefinition TxOutRef where
  type Unroll TxOutRef = TxOutRef ': UnrollAll '[TxId, Integer]

instance HasBlueprintSchema V3.TxOutRef referencedTypes => HasBlueprintSchema TxOutRef referencedTypes where
  schema :: Schema referencedTypes
schema = forall t (referencedTypes :: [*]).
HasBlueprintSchema t referencedTypes =>
Schema referencedTypes
schema @(ListEncoded V3.TxOutRef) @referencedTypes

PlutusTx.makeLift ''TxOutRef

-- | Transaction output for Plutus V4.
data TxOut = TxOut
  { TxOut -> Address
txOutAddress :: Address
  , TxOut -> Value
txOutValue :: Value
  , TxOut -> OutputDatum
txOutDatum :: OutputDatum
  , TxOut -> Maybe ScriptHash
txOutReferenceScript :: Maybe ScriptHash
  }
  deriving stock (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
$cshowsPrec :: Int -> TxOut -> ShowS
showsPrec :: Int -> TxOut -> ShowS
$cshow :: TxOut -> String
show :: TxOut -> String
$cshowList :: [TxOut] -> ShowS
showList :: [TxOut] -> ShowS
Show, TxOut -> TxOut -> Bool
(TxOut -> TxOut -> Bool) -> (TxOut -> TxOut -> Bool) -> Eq TxOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxOut -> TxOut -> Bool
== :: TxOut -> TxOut -> Bool
$c/= :: TxOut -> TxOut -> Bool
/= :: TxOut -> TxOut -> Bool
Eq, (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
$cfrom :: forall x. TxOut -> Rep TxOut x
from :: forall x. TxOut -> Rep TxOut x
$cto :: forall x. Rep TxOut x -> TxOut
to :: forall x. Rep TxOut x -> TxOut
Generic)
  deriving anyclass (DefinitionId
DefinitionId -> HasBlueprintDefinition TxOut
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)

PlutusTx.deriveEq ''TxOut

instance Pretty TxOut where
  pretty :: forall ann. TxOut -> Doc ann
pretty TxOut {Address
txOutAddress :: TxOut -> Address
txOutAddress :: Address
txOutAddress, Value
txOutValue :: TxOut -> Value
txOutValue :: Value
txOutValue, OutputDatum
txOutDatum :: TxOut -> OutputDatum
txOutDatum :: OutputDatum
txOutDatum, Maybe ScriptHash
txOutReferenceScript :: TxOut -> Maybe ScriptHash
txOutReferenceScript :: Maybe ScriptHash
txOutReferenceScript} =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
        [ Doc ann
"-"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Value -> Doc ann
pretty Value
txOutValue
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"addressed to"
        , Address -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Address -> Doc ann
pretty Address
txOutAddress
        , Doc ann
"with datum"
        , OutputDatum -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. OutputDatum -> Doc ann
pretty OutputDatum
txOutDatum
        , Doc ann
"with referenceScript"
        , Maybe ScriptHash -> Doc ann
forall ann. Maybe ScriptHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe ScriptHash
txOutReferenceScript
        ]

-- | The public key attached to a 'TxOut', if there is one.
txOutPubKey :: TxOut -> Maybe PubKeyHash
txOutPubKey :: TxOut -> Maybe PubKeyHash
txOutPubKey TxOut {Address
txOutAddress :: TxOut -> Address
txOutAddress :: Address
txOutAddress} = Address -> Maybe PubKeyHash
toPubKeyHash Address
txOutAddress

-- | The validator hash attached to a 'TxOut', if there is one.
txOutScriptHash :: TxOut -> Maybe ScriptHash
txOutScriptHash :: TxOut -> Maybe ScriptHash
txOutScriptHash TxOut {Address
txOutAddress :: TxOut -> Address
txOutAddress :: Address
txOutAddress} = Address -> Maybe ScriptHash
toScriptHash Address
txOutAddress

-- | Whether the output is a pay-to-pubkey output.
isPubKeyOut :: TxOut -> Bool
isPubKeyOut :: TxOut -> Bool
isPubKeyOut = Maybe PubKeyHash -> Bool
forall a. Maybe a -> Bool
isJust (Maybe PubKeyHash -> Bool)
-> (TxOut -> Maybe PubKeyHash) -> TxOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Maybe PubKeyHash
txOutPubKey

-- | Whether the output is a pay-to-script output.
isPayToScriptOut :: TxOut -> Bool
isPayToScriptOut :: TxOut -> Bool
isPayToScriptOut = Maybe ScriptHash -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ScriptHash -> Bool)
-> (TxOut -> Maybe ScriptHash) -> TxOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Maybe ScriptHash
txOutScriptHash

-- | Create a transaction output locked by a public key.
pubKeyHashTxOut :: Value -> PubKeyHash -> TxOut
pubKeyHashTxOut :: Value -> PubKeyHash -> TxOut
pubKeyHashTxOut Value
v PubKeyHash
pkh = Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
TxOut (PubKeyHash -> Address
pubKeyHashAddress PubKeyHash
pkh) Value
v OutputDatum
NoOutputDatum Maybe ScriptHash
forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------------------
-- TH Splices --------------------------------------------------------------------------------------

$(PlutusTx.makeIsDataSchemaAsList ''TxOut)
$(PlutusTx.makeLift ''TxOut)