{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns         #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

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 (Lens', lens)
import Data.Maybe (isJust)
import GHC.Generics (Generic)
import Prettyprinter (Pretty (pretty), hang, vsep, (<+>))

import PlutusTx.Blueprint.TH (makeIsDataSchemaIndexed)
import PlutusTx.Bool qualified as PlutusTx
import PlutusTx.Eq qualified as PlutusTx
import PlutusTx.Lift (makeLift)

import PlutusLedgerApi.V1.Address (Address, pubKeyHashAddress, toPubKeyHash, toScriptHash)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusLedgerApi.V1.Scripts (Datum, DatumHash, ScriptHash)
import PlutusLedgerApi.V1.Tx hiding (TxOut (..), isPayToScriptOut, isPubKeyOut, outAddress,
                              outValue, pubKeyHashTxOut, txOutDatum, txOutPubKey)
import PlutusLedgerApi.V1.Value (Value)
import PlutusTx.Blueprint.Definition (HasBlueprintDefinition, definitionRef)

{- | 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
$cshowsPrec :: Int -> OutputDatum -> ShowS
showsPrec :: Int -> OutputDatum -> ShowS
$cshow :: OutputDatum -> String
show :: OutputDatum -> String
$cshowList :: [OutputDatum] -> ShowS
showList :: [OutputDatum] -> ShowS
Show, OutputDatum -> OutputDatum -> Bool
(OutputDatum -> OutputDatum -> Bool)
-> (OutputDatum -> OutputDatum -> Bool) -> Eq OutputDatum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputDatum -> OutputDatum -> Bool
== :: OutputDatum -> OutputDatum -> Bool
$c/= :: OutputDatum -> OutputDatum -> Bool
/= :: 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
$cfrom :: forall x. OutputDatum -> Rep OutputDatum x
from :: forall x. OutputDatum -> Rep OutputDatum x
$cto :: forall x. Rep OutputDatum x -> OutputDatum
to :: forall x. Rep OutputDatum x -> OutputDatum
Generic)
  deriving anyclass (OutputDatum -> ()
(OutputDatum -> ()) -> NFData OutputDatum
forall a. (a -> ()) -> NFData a
$crnf :: OutputDatum -> ()
rnf :: OutputDatum -> ()
NFData, DefinitionId
DefinitionId -> HasBlueprintDefinition OutputDatum
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)

instance PlutusTx.Eq OutputDatum where
  {-# INLINEABLE (==) #-}
  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 :: 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.
-}
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 (TxOut -> ()
(TxOut -> ()) -> NFData TxOut
forall a. (a -> ()) -> NFData a
$crnf :: TxOut -> ()
rnf :: TxOut -> ()
NFData, DefinitionId
DefinitionId -> HasBlueprintDefinition TxOut
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)

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
        ]

instance PlutusTx.Eq TxOut where
  {-# INLINEABLE (==) #-}
  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 :: 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

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

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

$(makeLift ''OutputDatum)
$(makeLift ''TxOut)

$( makeIsDataSchemaIndexed
    ''OutputDatum
    [ ('NoOutputDatum, 0)
    , ('OutputDatumHash, 1)
    , ('OutputDatum, 2)
    ]
 )
$(makeIsDataSchemaIndexed ''TxOut [('TxOut, 0)])