{-# 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.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)

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. -}
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)

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

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