{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

module Plutus.V2.Ledger.Tx(
    -- * Transactions
    TxId (..),
    ScriptTag (..),
    RedeemerPtr (..),
    Redeemers,
    -- * Transaction outputs
    TxOut(..),
    TxOutRef(..),
    OutputDatum (..),
    isPubKeyOut,
    isPayToScriptOut,
    outAddress,
    outValue,
    txOutPubKey,
    outDatum,
    outReferenceScript,
    pubKeyHashTxOut,
    -- * Transaction inputs
    TxInType(..),
    TxIn(..),
    inRef,
    inType,
    inScripts,
    pubKeyTxIn,
    scriptTxIn,
    pubKeyTxIns,
    scriptTxIns,
    ) 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 Plutus.V1.Ledger.Address
import Plutus.V1.Ledger.Crypto
import Plutus.V1.Ledger.Scripts
import Plutus.V1.Ledger.Tx hiding (TxOut (..), isPayToScriptOut, isPubKeyOut, outAddress, outValue, pubKeyHashTxOut,
                            txOutDatum, txOutPubKey)
import Plutus.V1.Ledger.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
(Int -> OutputDatum -> ShowS)
-> (OutputDatum -> String)
-> ([OutputDatum] -> ShowS)
-> Show OutputDatum
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
(OutputDatum -> OutputDatum -> Bool)
-> (OutputDatum -> OutputDatum -> Bool) -> Eq OutputDatum
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. OutputDatum -> Rep OutputDatum x)
-> (forall x. Rep OutputDatum x -> OutputDatum)
-> Generic OutputDatum
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 -> ()
(OutputDatum -> ()) -> NFData 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 DatumHash -> DatumHash -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== DatumHash
dh'
    (OutputDatum Datum
d) == (OutputDatum Datum
d')           = Datum
d Datum -> Datum -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Datum
d'
    OutputDatum
_ == OutputDatum
_                                        = Bool
False

instance Pretty OutputDatum where
    pretty :: 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
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
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
(Int -> TxOut -> ShowS)
-> (TxOut -> String) -> ([TxOut] -> ShowS) -> Show TxOut
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
(TxOut -> TxOut -> Bool) -> (TxOut -> TxOut -> Bool) -> Eq TxOut
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. 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
$cto :: forall x. Rep TxOut x -> TxOut
$cfrom :: forall x. TxOut -> Rep TxOut x
Generic)
    deriving anyclass (TxOut -> ()
(TxOut -> ()) -> NFData TxOut
forall a. (a -> ()) -> NFData a
rnf :: TxOut -> ()
$crnf :: TxOut -> ()
NFData)

instance Pretty TxOut where
    pretty :: 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} =
                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
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
pretty Address
txOutAddress, Doc ann
"with datum", OutputDatum -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty OutputDatum
txOutDatum, Doc ann
"with referenceScript", Maybe ScriptHash -> Doc ann
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 Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Address
txOutAddress'
        Bool -> Bool -> Bool
PlutusTx.&& Value
txOutValue Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Value
txOutValue'
        Bool -> Bool -> Bool
PlutusTx.&& OutputDatum
txOutDatum OutputDatum -> OutputDatum -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== OutputDatum
txOutDatum'
        Bool -> Bool -> Bool
PlutusTx.&& Maybe ScriptHash
txOutRefScript Maybe ScriptHash -> Maybe ScriptHash -> Bool
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.
txOutValidatorHash :: TxOut -> Maybe ValidatorHash
txOutValidatorHash :: TxOut -> Maybe ValidatorHash
txOutValidatorHash TxOut{Address
txOutAddress :: Address
txOutAddress :: TxOut -> Address
txOutAddress} = Address -> Maybe ValidatorHash
toValidatorHash Address
txOutAddress

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

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

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

-- | The reference script attached to a 'TxOut'.
outReferenceScript :: Lens' TxOut (Maybe ScriptHash)
outReferenceScript :: (Maybe ScriptHash -> f (Maybe ScriptHash)) -> TxOut -> f TxOut
outReferenceScript = (TxOut -> Maybe ScriptHash)
-> (TxOut -> Maybe ScriptHash -> TxOut)
-> Lens TxOut TxOut (Maybe ScriptHash) (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 :: Maybe ScriptHash
txOutReferenceScript = Maybe ScriptHash
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 ValidatorHash -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ValidatorHash -> Bool)
-> (TxOut -> Maybe ValidatorHash) -> TxOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Maybe ValidatorHash
txOutValidatorHash

-- | 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.makeIsDataIndexed ''OutputDatum [('NoOutputDatum,0), ('OutputDatumHash,1), ('OutputDatum,2)]
PlutusTx.makeLift ''OutputDatum
PlutusTx.makeIsDataIndexed ''TxOut [('TxOut,0)]
PlutusTx.makeLift ''TxOut