-- editorconfig-checker-disable-file
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

module PlutusLedgerApi.V2.Tx
    (
    -- * Transactions
      TxId (..)
    , ScriptTag (..)
    , RedeemerPtr (..)
    , Redeemers
    -- * Transaction outputs
    , TxOut(..)
    , TxOutRef(..)
    , 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.Bool qualified as PlutusTx
import PlutusTx.Eq qualified as PlutusTx

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

-- | The datum attached to an output: either nothing; a datum hash; or the datum itself (an "inline datum").
data OutputDatum = NoOutputDatum | OutputDatumHash DatumHash | OutputDatum Datum
    deriving stock (Int -> OutputDatum -> ShowS
[OutputDatum] -> ShowS
OutputDatum -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputDatum] -> ShowS
$cshowList :: [OutputDatum] -> ShowS
show :: OutputDatum -> String
$cshow :: OutputDatum -> String
showsPrec :: Int -> OutputDatum -> ShowS
$cshowsPrec :: Int -> OutputDatum -> ShowS
Show, OutputDatum -> OutputDatum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputDatum -> OutputDatum -> Bool
$c/= :: OutputDatum -> OutputDatum -> Bool
== :: OutputDatum -> OutputDatum -> Bool
$c== :: OutputDatum -> OutputDatum -> Bool
Eq, forall x. Rep OutputDatum x -> OutputDatum
forall x. OutputDatum -> Rep OutputDatum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OutputDatum x -> OutputDatum
$cfrom :: forall x. OutputDatum -> Rep OutputDatum x
Generic)
    deriving anyclass (OutputDatum -> ()
forall a. (a -> ()) -> NFData a
rnf :: OutputDatum -> ()
$crnf :: OutputDatum -> ()
NFData)

instance PlutusTx.Eq OutputDatum where
    {-# INLINABLE (==) #-}
    OutputDatum
NoOutputDatum == :: OutputDatum -> OutputDatum -> Bool
== OutputDatum
NoOutputDatum                = Bool
True
    (OutputDatumHash DatumHash
dh) == (OutputDatumHash DatumHash
dh') = DatumHash
dh forall a. Eq a => a -> a -> Bool
PlutusTx.== DatumHash
dh'
    (OutputDatum Datum
d) == (OutputDatum Datum
d')           = Datum
d forall a. Eq a => a -> a -> Bool
PlutusTx.== Datum
d'
    OutputDatum
_ == OutputDatum
_                                        = Bool
False

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: " forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty DatumHash
dh
    pretty (OutputDatum Datum
d)      = Doc ann
"inline datum : " forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> 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.
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
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, 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, 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)
    deriving anyclass (TxOut -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxOut -> ()
$crnf :: TxOut -> ()
NFData)

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

instance PlutusTx.Eq TxOut where
    {-# INLINABLE (==) #-}
    (TxOut Address
txOutAddress Value
txOutValue OutputDatum
txOutDatum Maybe ScriptHash
txOutRefScript) == :: TxOut -> TxOut -> Bool
== (TxOut Address
txOutAddress' Value
txOutValue' OutputDatum
txOutDatum' Maybe ScriptHash
txOutRefScript') =
        Address
txOutAddress forall a. Eq a => a -> a -> Bool
PlutusTx.== Address
txOutAddress'
        Bool -> Bool -> Bool
PlutusTx.&& Value
txOutValue forall a. Eq a => a -> a -> Bool
PlutusTx.== Value
txOutValue'
        Bool -> Bool -> Bool
PlutusTx.&& OutputDatum
txOutDatum forall a. Eq a => a -> a -> Bool
PlutusTx.== OutputDatum
txOutDatum'
        Bool -> Bool -> Bool
PlutusTx.&& Maybe ScriptHash
txOutRefScript forall a. Eq a => a -> a -> Bool
PlutusTx.== Maybe ScriptHash
txOutRefScript'

-- | The public key attached to a 'TxOut', if there is one.
txOutPubKey :: TxOut -> Maybe PubKeyHash
txOutPubKey :: TxOut -> Maybe PubKeyHash
txOutPubKey TxOut{Address
txOutAddress :: Address
txOutAddress :: TxOut -> 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 :: Address
txOutAddress :: TxOut -> Address
txOutAddress} = Address -> Maybe ScriptHash
toScriptHash Address
txOutAddress

-- | The address of a transaction output.
outAddress :: Lens' TxOut Address
outAddress :: Lens' TxOut Address
outAddress = 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 :: Address
txOutAddress = Address
a }

-- | The datum attached to a 'TxOut'.
outDatum :: Lens' TxOut OutputDatum
outDatum :: Lens' TxOut OutputDatum
outDatum = 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 :: OutputDatum
txOutDatum = OutputDatum
v }

-- | The value of a transaction output.
-- | TODO: Compute address again
outValue :: Lens' TxOut Value
outValue :: Lens' TxOut Value
outValue = 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 :: Value
txOutValue = Value
v }

-- | The reference script attached to a 'TxOut'.
outReferenceScript :: Lens' TxOut (Maybe ScriptHash)
outReferenceScript :: Lens' TxOut (Maybe ScriptHash)
outReferenceScript = 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 :: Maybe ScriptHash
txOutReferenceScript = Maybe ScriptHash
v }

-- | Whether the output is a pay-to-pubkey output.
isPubKeyOut :: TxOut -> Bool
isPubKeyOut :: TxOut -> Bool
isPubKeyOut = forall a. Maybe a -> Bool
isJust 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 = forall a. Maybe a -> Bool
isJust 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 forall a. Maybe a
Nothing

PlutusTx.makeIsDataIndexed ''OutputDatum [('NoOutputDatum,0), ('OutputDatumHash,1), ('OutputDatum,2)]
PlutusTx.makeLift ''OutputDatum
PlutusTx.makeIsDataIndexed ''TxOut [('TxOut,0)]
PlutusTx.makeLift ''TxOut