{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}
module PlutusLedgerApi.V3.Tx (
TxId (..),
TxOutRef (..),
) where
import Control.DeepSeq (NFData)
import Data.Function ((&))
import Data.String (IsString)
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Bytes (LedgerBytes (..))
import PlutusTx.Blueprint.Class (HasBlueprintSchema (..))
import PlutusTx.Blueprint.Definition (HasBlueprintDefinition, definitionRef)
import PlutusTx.Blueprint.Schema (withSchemaInfo)
import PlutusTx.Blueprint.Schema.Annotation (SchemaInfo (..))
import PlutusTx.Blueprint.TH (makeIsDataSchemaIndexed)
import PlutusTx.Bool qualified as PlutusTx
import PlutusTx.Builtins.Internal qualified as PlutusTx
import PlutusTx.Eq qualified as PlutusTx
import PlutusTx.IsData.Class (FromData, ToData, UnsafeFromData)
import PlutusTx.Lift (makeLift)
import PlutusTx.Ord qualified as PlutusTx
import Prettyprinter (Pretty, pretty)
newtype TxId = TxId {TxId -> BuiltinByteString
getTxId :: PlutusTx.BuiltinByteString}
deriving stock (TxId -> TxId -> Bool
(TxId -> TxId -> Bool) -> (TxId -> TxId -> Bool) -> Eq TxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
$c/= :: TxId -> TxId -> Bool
/= :: TxId -> TxId -> Bool
Eq, Eq TxId
Eq TxId =>
(TxId -> TxId -> Ordering)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> TxId)
-> (TxId -> TxId -> TxId)
-> Ord 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
$ccompare :: TxId -> TxId -> Ordering
compare :: TxId -> TxId -> Ordering
$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
>= :: TxId -> TxId -> Bool
$cmax :: TxId -> TxId -> TxId
max :: TxId -> TxId -> TxId
$cmin :: TxId -> TxId -> TxId
min :: TxId -> TxId -> TxId
Ord, (forall x. TxId -> Rep TxId x)
-> (forall x. Rep TxId x -> TxId) -> Generic TxId
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
$cfrom :: forall x. TxId -> Rep TxId x
from :: forall x. TxId -> Rep TxId x
$cto :: forall x. Rep TxId x -> TxId
to :: forall x. Rep TxId x -> TxId
Generic)
deriving anyclass (TxId -> ()
(TxId -> ()) -> NFData TxId
forall a. (a -> ()) -> NFData a
$crnf :: TxId -> ()
rnf :: TxId -> ()
NFData, DefinitionId
DefinitionId -> HasBlueprintDefinition TxId
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)
deriving newtype (TxId -> TxId -> Bool
(TxId -> TxId -> Bool) -> Eq TxId
forall a. (a -> a -> Bool) -> Eq a
$c== :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
PlutusTx.Eq, Eq TxId
Eq TxId =>
(TxId -> TxId -> Ordering)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> TxId)
-> (TxId -> TxId -> TxId)
-> Ord 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
$ccompare :: TxId -> TxId -> Ordering
compare :: TxId -> TxId -> Ordering
$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
>= :: TxId -> TxId -> Bool
$cmax :: TxId -> TxId -> TxId
max :: TxId -> TxId -> TxId
$cmin :: TxId -> TxId -> TxId
min :: TxId -> TxId -> TxId
PlutusTx.Ord, TxId -> BuiltinData
(TxId -> BuiltinData) -> ToData TxId
forall a. (a -> BuiltinData) -> ToData a
$ctoBuiltinData :: TxId -> BuiltinData
toBuiltinData :: TxId -> BuiltinData
ToData, BuiltinData -> Maybe TxId
(BuiltinData -> Maybe TxId) -> FromData TxId
forall a. (BuiltinData -> Maybe a) -> FromData a
$cfromBuiltinData :: BuiltinData -> Maybe TxId
fromBuiltinData :: BuiltinData -> Maybe TxId
FromData, BuiltinData -> TxId
(BuiltinData -> TxId) -> UnsafeFromData TxId
forall a. (BuiltinData -> a) -> UnsafeFromData a
$cunsafeFromBuiltinData :: BuiltinData -> TxId
unsafeFromBuiltinData :: BuiltinData -> TxId
UnsafeFromData)
deriving
(
String -> TxId
(String -> TxId) -> IsString TxId
forall a. (String -> a) -> IsString a
$cfromString :: String -> TxId
fromString :: String -> TxId
IsString
,
Int -> TxId -> ShowS
[TxId] -> ShowS
TxId -> String
(Int -> TxId -> ShowS)
-> (TxId -> String) -> ([TxId] -> ShowS) -> Show TxId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxId -> ShowS
showsPrec :: Int -> TxId -> ShowS
$cshow :: TxId -> String
show :: TxId -> String
$cshowList :: [TxId] -> ShowS
showList :: [TxId] -> ShowS
Show
,
(forall ann. TxId -> Doc ann)
-> (forall ann. [TxId] -> Doc ann) -> Pretty TxId
forall ann. [TxId] -> Doc ann
forall ann. TxId -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. TxId -> Doc ann
pretty :: forall ann. TxId -> Doc ann
$cprettyList :: forall ann. [TxId] -> Doc ann
prettyList :: forall ann. [TxId] -> Doc ann
Pretty
)
via LedgerBytes
instance HasBlueprintSchema TxId referencedTypes where
schema :: Schema referencedTypes
schema =
forall t (referencedTypes :: [*]).
HasBlueprintSchema t referencedTypes =>
Schema referencedTypes
schema @PlutusTx.BuiltinByteString
Schema referencedTypes
-> (Schema referencedTypes -> Schema referencedTypes)
-> Schema referencedTypes
forall a b. a -> (a -> b) -> b
& (SchemaInfo -> SchemaInfo)
-> Schema referencedTypes -> Schema referencedTypes
forall (referencedTypes :: [*]).
(SchemaInfo -> SchemaInfo)
-> Schema referencedTypes -> Schema referencedTypes
withSchemaInfo \SchemaInfo
info ->
SchemaInfo
info{title = Just "TxId"}
data TxOutRef = TxOutRef
{ TxOutRef -> TxId
txOutRefId :: TxId
, TxOutRef -> Integer
txOutRefIdx :: Integer
}
deriving stock (Int -> TxOutRef -> ShowS
[TxOutRef] -> ShowS
TxOutRef -> String
(Int -> TxOutRef -> ShowS)
-> (TxOutRef -> String) -> ([TxOutRef] -> ShowS) -> Show TxOutRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxOutRef -> ShowS
showsPrec :: Int -> TxOutRef -> ShowS
$cshow :: TxOutRef -> String
show :: TxOutRef -> String
$cshowList :: [TxOutRef] -> ShowS
showList :: [TxOutRef] -> ShowS
Show, TxOutRef -> TxOutRef -> Bool
(TxOutRef -> TxOutRef -> Bool)
-> (TxOutRef -> TxOutRef -> Bool) -> Eq TxOutRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxOutRef -> TxOutRef -> Bool
== :: TxOutRef -> TxOutRef -> Bool
$c/= :: TxOutRef -> TxOutRef -> Bool
/= :: TxOutRef -> TxOutRef -> Bool
Eq, Eq TxOutRef
Eq TxOutRef =>
(TxOutRef -> TxOutRef -> Ordering)
-> (TxOutRef -> TxOutRef -> Bool)
-> (TxOutRef -> TxOutRef -> Bool)
-> (TxOutRef -> TxOutRef -> Bool)
-> (TxOutRef -> TxOutRef -> Bool)
-> (TxOutRef -> TxOutRef -> TxOutRef)
-> (TxOutRef -> TxOutRef -> TxOutRef)
-> Ord 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
$ccompare :: TxOutRef -> TxOutRef -> Ordering
compare :: TxOutRef -> TxOutRef -> Ordering
$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
>= :: TxOutRef -> TxOutRef -> Bool
$cmax :: TxOutRef -> TxOutRef -> TxOutRef
max :: TxOutRef -> TxOutRef -> TxOutRef
$cmin :: TxOutRef -> TxOutRef -> TxOutRef
min :: TxOutRef -> TxOutRef -> TxOutRef
Ord, (forall x. TxOutRef -> Rep TxOutRef x)
-> (forall x. Rep TxOutRef x -> TxOutRef) -> Generic TxOutRef
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
$cfrom :: forall x. TxOutRef -> Rep TxOutRef x
from :: forall x. TxOutRef -> Rep TxOutRef x
$cto :: forall x. Rep TxOutRef x -> TxOutRef
to :: forall x. Rep TxOutRef x -> TxOutRef
Generic)
deriving anyclass (TxOutRef -> ()
(TxOutRef -> ()) -> NFData TxOutRef
forall a. (a -> ()) -> NFData a
$crnf :: TxOutRef -> ()
rnf :: TxOutRef -> ()
NFData, DefinitionId
DefinitionId -> HasBlueprintDefinition TxOutRef
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)
instance Pretty TxOutRef where
pretty :: forall ann. TxOutRef -> Doc ann
pretty TxOutRef{TxId
txOutRefId :: TxOutRef -> TxId
txOutRefId :: TxId
txOutRefId, Integer
txOutRefIdx :: TxOutRef -> Integer
txOutRefIdx :: Integer
txOutRefIdx} = TxId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TxId -> Doc ann
pretty TxId
txOutRefId Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"!" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
txOutRefIdx
instance PlutusTx.Eq TxOutRef where
{-# INLINEABLE (==) #-}
TxOutRef
l == :: TxOutRef -> TxOutRef -> Bool
== TxOutRef
r =
(TxOutRef -> TxId
txOutRefId TxOutRef
l TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== TxOutRef -> TxId
txOutRefId TxOutRef
r)
Bool -> Bool -> Bool
PlutusTx.&& (TxOutRef -> Integer
txOutRefIdx TxOutRef
l Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== TxOutRef -> Integer
txOutRefIdx TxOutRef
r)
$(makeLift ''TxId)
$(makeIsDataSchemaIndexed ''TxOutRef [('TxOutRef, 0)])
$(makeLift ''TxOutRef)