-- 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.V1.Tx
    (
    -- * Transactions
      TxId (..)
    , ScriptTag (..)
    , RedeemerPtr (..)
    , Redeemers
    -- * Transaction outputs
    , TxOut(..)
    , TxOutRef(..)
    , isPubKeyOut
    , isPayToScriptOut
    , outAddress
    , outValue
    , txOutPubKey
    ,txOutDatum
    ,pubKeyHashTxOut
    ) where

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

import PlutusTx qualified
import PlutusTx.Bool qualified as PlutusTx
import PlutusTx.Builtins qualified as PlutusTx
import PlutusTx.Eq qualified as PlutusTx
import PlutusTx.Ord qualified as PlutusTx

import PlutusLedgerApi.V1.Address
import PlutusLedgerApi.V1.Bytes
import PlutusLedgerApi.V1.Crypto
import PlutusLedgerApi.V1.Scripts
import PlutusLedgerApi.V1.Value
{- | A transaction ID, i.e. the hash of a transaction. Hashed with BLAKE2b-256. 32 byte.

This is a simple type without any validation, __use with caution__.
You may want to add checks for its invariants. See the
 [Shelley ledger specification](https://hydra.iohk.io/build/16861845/download/1/ledger-spec.pdf).
-}
newtype TxId = TxId { TxId -> BuiltinByteString
getTxId :: PlutusTx.BuiltinByteString }
    deriving stock (TxId -> TxId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxId -> TxId -> Bool
$c/= :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
$c== :: TxId -> TxId -> Bool
Eq, Eq TxId
TxId -> TxId -> Bool
TxId -> TxId -> Ordering
TxId -> TxId -> TxId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxId -> TxId -> TxId
$cmin :: TxId -> TxId -> TxId
max :: TxId -> TxId -> TxId
$cmax :: TxId -> TxId -> TxId
>= :: TxId -> TxId -> Bool
$c>= :: TxId -> TxId -> Bool
> :: TxId -> TxId -> Bool
$c> :: TxId -> TxId -> Bool
<= :: TxId -> TxId -> Bool
$c<= :: TxId -> TxId -> Bool
< :: TxId -> TxId -> Bool
$c< :: TxId -> TxId -> Bool
compare :: TxId -> TxId -> Ordering
$ccompare :: TxId -> TxId -> Ordering
Ord, forall x. Rep TxId x -> TxId
forall x. TxId -> Rep TxId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxId x -> TxId
$cfrom :: forall x. TxId -> Rep TxId x
Generic)
    deriving anyclass (TxId -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxId -> ()
$crnf :: TxId -> ()
NFData)
    deriving newtype (TxId -> TxId -> Bool
forall a. (a -> a -> Bool) -> Eq a
== :: TxId -> TxId -> Bool
$c== :: TxId -> TxId -> Bool
PlutusTx.Eq, Eq TxId
TxId -> TxId -> Bool
TxId -> TxId -> Ordering
TxId -> TxId -> TxId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxId -> TxId -> TxId
$cmin :: TxId -> TxId -> TxId
max :: TxId -> TxId -> TxId
$cmax :: TxId -> TxId -> TxId
>= :: TxId -> TxId -> Bool
$c>= :: TxId -> TxId -> Bool
> :: TxId -> TxId -> Bool
$c> :: TxId -> TxId -> Bool
<= :: TxId -> TxId -> Bool
$c<= :: TxId -> TxId -> Bool
< :: TxId -> TxId -> Bool
$c< :: TxId -> TxId -> Bool
compare :: TxId -> TxId -> Ordering
$ccompare :: TxId -> TxId -> Ordering
PlutusTx.Ord)
    deriving
        (String -> TxId
forall a. (String -> a) -> IsString a
fromString :: String -> TxId
$cfromString :: String -> TxId
IsString        -- ^ from hex encoding
        , Int -> TxId -> ShowS
[TxId] -> ShowS
TxId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxId] -> ShowS
$cshowList :: [TxId] -> ShowS
show :: TxId -> String
$cshow :: TxId -> String
showsPrec :: Int -> TxId -> ShowS
$cshowsPrec :: Int -> TxId -> ShowS
Show           -- ^ using hex encoding
        , forall ann. [TxId] -> Doc ann
forall ann. TxId -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [TxId] -> Doc ann
$cprettyList :: forall ann. [TxId] -> Doc ann
pretty :: forall ann. TxId -> Doc ann
$cpretty :: forall ann. TxId -> Doc ann
Pretty         -- ^ using hex encoding
        ) via LedgerBytes

-- | A tag indicating the type of script that we are pointing to.
data ScriptTag = Spend | Mint | Cert | Reward
    deriving stock (Int -> ScriptTag -> ShowS
[ScriptTag] -> ShowS
ScriptTag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptTag] -> ShowS
$cshowList :: [ScriptTag] -> ShowS
show :: ScriptTag -> String
$cshow :: ScriptTag -> String
showsPrec :: Int -> ScriptTag -> ShowS
$cshowsPrec :: Int -> ScriptTag -> ShowS
Show, ScriptTag -> ScriptTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptTag -> ScriptTag -> Bool
$c/= :: ScriptTag -> ScriptTag -> Bool
== :: ScriptTag -> ScriptTag -> Bool
$c== :: ScriptTag -> ScriptTag -> Bool
Eq, Eq ScriptTag
ScriptTag -> ScriptTag -> Bool
ScriptTag -> ScriptTag -> Ordering
ScriptTag -> ScriptTag -> ScriptTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScriptTag -> ScriptTag -> ScriptTag
$cmin :: ScriptTag -> ScriptTag -> ScriptTag
max :: ScriptTag -> ScriptTag -> ScriptTag
$cmax :: ScriptTag -> ScriptTag -> ScriptTag
>= :: ScriptTag -> ScriptTag -> Bool
$c>= :: ScriptTag -> ScriptTag -> Bool
> :: ScriptTag -> ScriptTag -> Bool
$c> :: ScriptTag -> ScriptTag -> Bool
<= :: ScriptTag -> ScriptTag -> Bool
$c<= :: ScriptTag -> ScriptTag -> Bool
< :: ScriptTag -> ScriptTag -> Bool
$c< :: ScriptTag -> ScriptTag -> Bool
compare :: ScriptTag -> ScriptTag -> Ordering
$ccompare :: ScriptTag -> ScriptTag -> Ordering
Ord, forall x. Rep ScriptTag x -> ScriptTag
forall x. ScriptTag -> Rep ScriptTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptTag x -> ScriptTag
$cfrom :: forall x. ScriptTag -> Rep ScriptTag x
Generic)
    deriving anyclass (ScriptTag -> ()
forall a. (a -> ()) -> NFData a
rnf :: ScriptTag -> ()
$crnf :: ScriptTag -> ()
NFData)

-- | A redeemer pointer is a pair of a script type tag ('ScriptTag') `t` and an index `i`,
-- picking out the i-th script of type `t` in the transaction.
data RedeemerPtr = RedeemerPtr ScriptTag Integer
    deriving stock (Int -> RedeemerPtr -> ShowS
[RedeemerPtr] -> ShowS
RedeemerPtr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedeemerPtr] -> ShowS
$cshowList :: [RedeemerPtr] -> ShowS
show :: RedeemerPtr -> String
$cshow :: RedeemerPtr -> String
showsPrec :: Int -> RedeemerPtr -> ShowS
$cshowsPrec :: Int -> RedeemerPtr -> ShowS
Show, RedeemerPtr -> RedeemerPtr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedeemerPtr -> RedeemerPtr -> Bool
$c/= :: RedeemerPtr -> RedeemerPtr -> Bool
== :: RedeemerPtr -> RedeemerPtr -> Bool
$c== :: RedeemerPtr -> RedeemerPtr -> Bool
Eq, Eq RedeemerPtr
RedeemerPtr -> RedeemerPtr -> Bool
RedeemerPtr -> RedeemerPtr -> Ordering
RedeemerPtr -> RedeemerPtr -> RedeemerPtr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RedeemerPtr -> RedeemerPtr -> RedeemerPtr
$cmin :: RedeemerPtr -> RedeemerPtr -> RedeemerPtr
max :: RedeemerPtr -> RedeemerPtr -> RedeemerPtr
$cmax :: RedeemerPtr -> RedeemerPtr -> RedeemerPtr
>= :: RedeemerPtr -> RedeemerPtr -> Bool
$c>= :: RedeemerPtr -> RedeemerPtr -> Bool
> :: RedeemerPtr -> RedeemerPtr -> Bool
$c> :: RedeemerPtr -> RedeemerPtr -> Bool
<= :: RedeemerPtr -> RedeemerPtr -> Bool
$c<= :: RedeemerPtr -> RedeemerPtr -> Bool
< :: RedeemerPtr -> RedeemerPtr -> Bool
$c< :: RedeemerPtr -> RedeemerPtr -> Bool
compare :: RedeemerPtr -> RedeemerPtr -> Ordering
$ccompare :: RedeemerPtr -> RedeemerPtr -> Ordering
Ord, forall x. Rep RedeemerPtr x -> RedeemerPtr
forall x. RedeemerPtr -> Rep RedeemerPtr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RedeemerPtr x -> RedeemerPtr
$cfrom :: forall x. RedeemerPtr -> Rep RedeemerPtr x
Generic)
    deriving anyclass (RedeemerPtr -> ()
forall a. (a -> ()) -> NFData a
rnf :: RedeemerPtr -> ()
$crnf :: RedeemerPtr -> ()
NFData)

-- | Redeemers is a `Map` of redeemer pointer ('RedeemerPtr') and its 'Redeemer'.
type Redeemers = Map RedeemerPtr Redeemer

-- | A reference to a transaction output. This is a
-- pair of a transaction ID (`TxId`), and an index indicating which of the outputs
-- of that transaction we are referring to.
data TxOutRef = TxOutRef {
    TxOutRef -> TxId
txOutRefId  :: TxId, -- ^ The transaction ID.
    TxOutRef -> Integer
txOutRefIdx :: Integer -- ^ Index into the referenced transaction's outputs
    }
    deriving stock (Int -> TxOutRef -> ShowS
[TxOutRef] -> ShowS
TxOutRef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOutRef] -> ShowS
$cshowList :: [TxOutRef] -> ShowS
show :: TxOutRef -> String
$cshow :: TxOutRef -> String
showsPrec :: Int -> TxOutRef -> ShowS
$cshowsPrec :: Int -> TxOutRef -> ShowS
Show, TxOutRef -> TxOutRef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxOutRef -> TxOutRef -> Bool
$c/= :: TxOutRef -> TxOutRef -> Bool
== :: TxOutRef -> TxOutRef -> Bool
$c== :: TxOutRef -> TxOutRef -> Bool
Eq, Eq TxOutRef
TxOutRef -> TxOutRef -> Bool
TxOutRef -> TxOutRef -> Ordering
TxOutRef -> TxOutRef -> TxOutRef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxOutRef -> TxOutRef -> TxOutRef
$cmin :: TxOutRef -> TxOutRef -> TxOutRef
max :: TxOutRef -> TxOutRef -> TxOutRef
$cmax :: TxOutRef -> TxOutRef -> TxOutRef
>= :: TxOutRef -> TxOutRef -> Bool
$c>= :: TxOutRef -> TxOutRef -> Bool
> :: TxOutRef -> TxOutRef -> Bool
$c> :: TxOutRef -> TxOutRef -> Bool
<= :: TxOutRef -> TxOutRef -> Bool
$c<= :: TxOutRef -> TxOutRef -> Bool
< :: TxOutRef -> TxOutRef -> Bool
$c< :: TxOutRef -> TxOutRef -> Bool
compare :: TxOutRef -> TxOutRef -> Ordering
$ccompare :: TxOutRef -> TxOutRef -> Ordering
Ord, forall x. Rep TxOutRef x -> TxOutRef
forall x. TxOutRef -> Rep TxOutRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxOutRef x -> TxOutRef
$cfrom :: forall x. TxOutRef -> Rep TxOutRef x
Generic)
    deriving anyclass (TxOutRef -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxOutRef -> ()
$crnf :: TxOutRef -> ()
NFData)

instance Pretty TxOutRef where
    pretty :: forall ann. TxOutRef -> Doc ann
pretty TxOutRef{TxId
txOutRefId :: TxId
txOutRefId :: TxOutRef -> TxId
txOutRefId, Integer
txOutRefIdx :: Integer
txOutRefIdx :: TxOutRef -> Integer
txOutRefIdx} = forall a ann. Pretty a => a -> Doc ann
pretty TxId
txOutRefId forall a. Semigroup a => a -> a -> a
<> Doc ann
"!" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Integer
txOutRefIdx

instance PlutusTx.Eq TxOutRef where
    {-# INLINABLE (==) #-}
    TxOutRef
l == :: TxOutRef -> TxOutRef -> Bool
== TxOutRef
r =
        TxOutRef -> TxId
txOutRefId TxOutRef
l forall a. Eq a => a -> a -> Bool
PlutusTx.== TxOutRef -> TxId
txOutRefId TxOutRef
r
        Bool -> Bool -> Bool
PlutusTx.&& TxOutRef -> Integer
txOutRefIdx TxOutRef
l forall a. Eq a => a -> a -> Bool
PlutusTx.== TxOutRef -> Integer
txOutRefIdx TxOutRef
r
-- | A transaction output, consisting of a target address ('Address'), a value ('Value'),
-- and optionally a datum hash ('DatumHash').
data TxOut = TxOut {
    TxOut -> Address
txOutAddress   :: Address,
    TxOut -> Value
txOutValue     :: Value,
    TxOut -> Maybe DatumHash
txOutDatumHash :: Maybe DatumHash
    }
    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} =
                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]

instance PlutusTx.Eq TxOut where
    {-# INLINABLE (==) #-}
    TxOut
l == :: TxOut -> TxOut -> Bool
== TxOut
r =
        TxOut -> Address
txOutAddress TxOut
l forall a. Eq a => a -> a -> Bool
PlutusTx.== TxOut -> Address
txOutAddress TxOut
r
        Bool -> Bool -> Bool
PlutusTx.&& TxOut -> Value
txOutValue TxOut
l forall a. Eq a => a -> a -> Bool
PlutusTx.== TxOut -> Value
txOutValue TxOut
r
        Bool -> Bool -> Bool
PlutusTx.&& TxOut -> Maybe DatumHash
txOutDatumHash TxOut
l forall a. Eq a => a -> a -> Bool
PlutusTx.== TxOut -> Maybe DatumHash
txOutDatumHash TxOut
r

-- | The datum attached to a 'TxOut', if there is one.
txOutDatum :: TxOut -> Maybe DatumHash
txOutDatum :: TxOut -> Maybe DatumHash
txOutDatum TxOut{Maybe DatumHash
txOutDatumHash :: Maybe DatumHash
txOutDatumHash :: TxOut -> Maybe DatumHash
txOutDatumHash} = Maybe DatumHash
txOutDatumHash

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

-- | 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 -> Maybe DatumHash -> TxOut
TxOut (PubKeyHash -> Address
pubKeyHashAddress PubKeyHash
pkh) Value
v forall a. Maybe a
Nothing

PlutusTx.makeLift ''TxId
PlutusTx.makeIsDataIndexed ''TxId [('TxId,0)]

PlutusTx.makeIsDataIndexed ''TxOut [('TxOut,0)]
PlutusTx.makeLift ''TxOut

PlutusTx.makeIsDataIndexed ''TxOutRef [('TxOutRef,0)]
PlutusTx.makeLift ''TxOutRef