{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
-- needed for asData pattern synonyms
{-# OPTIONS_GHC -fexpose-all-unfoldings #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module PlutusLedgerApi.V2.Data.Tx
  ( -- * Transactions
    TxId (..)
  , ScriptTag (..)
  , RedeemerPtr (..)
  , Redeemers

    -- * Transaction outputs
  , TxOut
  , pattern TxOut
  , txOutAddress
  , txOutValue
  , txOutDatum
  , txOutReferenceScript
  , TxOutRef
  , pattern TxOutRef
  , txOutRefId
  , txOutRefIdx
  , OutputDatum
  , pattern NoOutputDatum
  , pattern OutputDatumHash
  , pattern OutputDatum
  , isPubKeyOut
  , isPayToScriptOut
  , outAddress
  , outValue
  , txOutPubKey
  , outDatum
  , outReferenceScript
  , pubKeyHashTxOut
  ) where

import Control.DeepSeq (NFData)
import Control.Lens
import Data.Maybe (isJust)
import GHC.Generics (Generic)
import Prettyprinter

import PlutusTx qualified
import PlutusTx.AsData qualified as PlutusTx
import PlutusTx.Eq qualified as PlutusTx

import PlutusLedgerApi.V1.Crypto
import PlutusLedgerApi.V1.Data.Address
import PlutusLedgerApi.V1.Data.Tx hiding
  ( TxOut
  , isPayToScriptOut
  , isPubKeyOut
  , outAddress
  , outValue
  , pubKeyHashTxOut
  , txOutAddress
  , txOutDatum
  , txOutDatumHash
  , txOutPubKey
  , txOutValue
  , pattern TxOut
  )
import PlutusLedgerApi.V1.Data.Value
import PlutusLedgerApi.V1.Scripts

{-| The datum attached to an output: either nothing; a datum hash;
or the datum itself (an "inline datum"). -}
PlutusTx.asData
  [d|
    data OutputDatum = NoOutputDatum | OutputDatumHash DatumHash | OutputDatum Datum
      deriving stock (Show, Eq, Generic)
      deriving newtype (PlutusTx.FromData, PlutusTx.UnsafeFromData, PlutusTx.ToData)
      deriving anyclass (NFData)
    |]

PlutusTx.deriveEq ''OutputDatum

instance Pretty OutputDatum where
  pretty :: forall ann. OutputDatum -> Doc ann
pretty OutputDatum
NoOutputDatum = Doc ann
"no datum"
  pretty (OutputDatumHash DatumHash
dh) = Doc ann
"datum hash: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DatumHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DatumHash -> Doc ann
pretty DatumHash
dh
  pretty (OutputDatum Datum
d) = Doc ann
"inline datum : " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Datum -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Datum -> Doc ann
pretty Datum
d

{-| A transaction output, consisting of a target address, a value,
optionally a datum/datum hash, and optionally a reference script. -}
PlutusTx.asData
  [d|
    data TxOut = TxOut
      { txOutAddress :: Address
      , txOutValue :: Value
      , txOutDatum :: OutputDatum
      , txOutReferenceScript :: Maybe ScriptHash
      }
      deriving stock (Show, Eq, Generic)
      deriving newtype (PlutusTx.FromData, PlutusTx.UnsafeFromData, PlutusTx.ToData)
    |]

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 ann. Address -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Address
txOutAddress
        , Doc ann
"with datum"
        , OutputDatum -> Doc ann
forall ann. OutputDatum -> Doc ann
forall a ann. Pretty a => a -> 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 = Address -> Maybe PubKeyHash
toPubKeyHash (Address -> Maybe PubKeyHash)
-> (TxOut -> Address) -> TxOut -> Maybe PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Address
txOutAddress

-- | The validator hash attached to a 'TxOut', if there is one.
txOutScriptHash :: TxOut -> Maybe ScriptHash
txOutScriptHash :: TxOut -> Maybe ScriptHash
txOutScriptHash = Address -> Maybe ScriptHash
toScriptHash (Address -> Maybe ScriptHash)
-> (TxOut -> Address) -> TxOut -> Maybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Address
txOutAddress

-- | The address of a transaction output.
outAddress :: Lens' TxOut Address
outAddress :: Lens' TxOut Address
outAddress = (TxOut -> Address)
-> (TxOut -> Address -> TxOut) -> Lens' TxOut Address
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TxOut -> Address
txOutAddress TxOut -> Address -> TxOut
s
  where
    s :: TxOut -> Address -> TxOut
s TxOut
tx Address
a = TxOut
tx {txOutAddress = a}

-- | The datum attached to a 'TxOut'.
outDatum :: Lens' TxOut OutputDatum
outDatum :: Lens' TxOut OutputDatum
outDatum = (TxOut -> OutputDatum)
-> (TxOut -> OutputDatum -> TxOut) -> Lens' TxOut OutputDatum
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TxOut -> OutputDatum
txOutDatum TxOut -> OutputDatum -> TxOut
s
  where
    s :: TxOut -> OutputDatum -> TxOut
s TxOut
tx OutputDatum
v = TxOut
tx {txOutDatum = v}

{-| The value of a transaction output.
| TODO: Compute address again -}
outValue :: Lens' TxOut Value
outValue :: Lens' TxOut Value
outValue = (TxOut -> Value) -> (TxOut -> Value -> TxOut) -> Lens' TxOut Value
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TxOut -> Value
txOutValue TxOut -> Value -> TxOut
s
  where
    s :: TxOut -> Value -> TxOut
s TxOut
tx Value
v = TxOut
tx {txOutValue = v}

-- | The reference script attached to a 'TxOut'.
outReferenceScript :: Lens' TxOut (Maybe ScriptHash)
outReferenceScript :: Lens' TxOut (Maybe ScriptHash)
outReferenceScript = (TxOut -> Maybe ScriptHash)
-> (TxOut -> Maybe ScriptHash -> TxOut)
-> Lens' TxOut (Maybe ScriptHash)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TxOut -> Maybe ScriptHash
txOutReferenceScript TxOut -> Maybe ScriptHash -> TxOut
s
  where
    s :: TxOut -> Maybe ScriptHash -> TxOut
s TxOut
tx Maybe ScriptHash
v = TxOut
tx {txOutReferenceScript = v}

-- | 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

PlutusTx.makeLift ''OutputDatum
PlutusTx.makeLift ''TxOut