{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# 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 (..)
  , OutputDatum (..)
  , TxOut (..)
  , txOutPubKey
  , txOutScriptHash
  , isPubKeyOut
  , isPayToScriptOut
  , pubKeyHashTxOut
  ) where

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 (..), TxOutRef (..))
import PlutusLedgerApi.V4.Address
  ( Address
  , pubKeyHashAddress
  , toPubKeyHash
  , toScriptHash
  )
import PlutusTx qualified
import PlutusTx.Blueprint (HasBlueprintDefinition, definitionRef)
import PlutusTx.Eq qualified as PlutusTx
import Prettyprinter (Pretty (pretty), hang, vsep, (<+>))

-- | 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.makeIsDataSchemaIndexed ''TxOut [('TxOut, 0)])
$(PlutusTx.makeLift ''TxOut)