{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module PlutusLedgerApi.V1.Credential
( StakingCredential(..)
, Credential(..)
) where
import Control.DeepSeq (NFData)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusLedgerApi.V1.Scripts (ScriptHash)
import PlutusTx qualified
import PlutusTx.Blueprint (HasBlueprintDefinition, definitionRef)
import PlutusTx.Bool qualified as PlutusTx
import PlutusTx.Eq qualified as PlutusTx
import PlutusTx.Show (deriveShow)
import Prettyprinter (Pretty (..), (<+>))
data StakingCredential
= StakingHash Credential
| StakingPtr
Integer
Integer
Integer
deriving stock (StakingCredential -> StakingCredential -> Bool
(StakingCredential -> StakingCredential -> Bool)
-> (StakingCredential -> StakingCredential -> Bool)
-> Eq StakingCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakingCredential -> StakingCredential -> Bool
== :: StakingCredential -> StakingCredential -> Bool
$c/= :: StakingCredential -> StakingCredential -> Bool
/= :: StakingCredential -> StakingCredential -> Bool
Eq, Eq StakingCredential
Eq StakingCredential =>
(StakingCredential -> StakingCredential -> Ordering)
-> (StakingCredential -> StakingCredential -> Bool)
-> (StakingCredential -> StakingCredential -> Bool)
-> (StakingCredential -> StakingCredential -> Bool)
-> (StakingCredential -> StakingCredential -> Bool)
-> (StakingCredential -> StakingCredential -> StakingCredential)
-> (StakingCredential -> StakingCredential -> StakingCredential)
-> Ord StakingCredential
StakingCredential -> StakingCredential -> Bool
StakingCredential -> StakingCredential -> Ordering
StakingCredential -> StakingCredential -> StakingCredential
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 :: StakingCredential -> StakingCredential -> Ordering
compare :: StakingCredential -> StakingCredential -> Ordering
$c< :: StakingCredential -> StakingCredential -> Bool
< :: StakingCredential -> StakingCredential -> Bool
$c<= :: StakingCredential -> StakingCredential -> Bool
<= :: StakingCredential -> StakingCredential -> Bool
$c> :: StakingCredential -> StakingCredential -> Bool
> :: StakingCredential -> StakingCredential -> Bool
$c>= :: StakingCredential -> StakingCredential -> Bool
>= :: StakingCredential -> StakingCredential -> Bool
$cmax :: StakingCredential -> StakingCredential -> StakingCredential
max :: StakingCredential -> StakingCredential -> StakingCredential
$cmin :: StakingCredential -> StakingCredential -> StakingCredential
min :: StakingCredential -> StakingCredential -> StakingCredential
Ord, Int -> StakingCredential -> ShowS
[StakingCredential] -> ShowS
StakingCredential -> String
(Int -> StakingCredential -> ShowS)
-> (StakingCredential -> String)
-> ([StakingCredential] -> ShowS)
-> Show StakingCredential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakingCredential -> ShowS
showsPrec :: Int -> StakingCredential -> ShowS
$cshow :: StakingCredential -> String
show :: StakingCredential -> String
$cshowList :: [StakingCredential] -> ShowS
showList :: [StakingCredential] -> ShowS
Show, (forall x. StakingCredential -> Rep StakingCredential x)
-> (forall x. Rep StakingCredential x -> StakingCredential)
-> Generic StakingCredential
forall x. Rep StakingCredential x -> StakingCredential
forall x. StakingCredential -> Rep StakingCredential x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakingCredential -> Rep StakingCredential x
from :: forall x. StakingCredential -> Rep StakingCredential x
$cto :: forall x. Rep StakingCredential x -> StakingCredential
to :: forall x. Rep StakingCredential x -> StakingCredential
Generic, Typeable)
deriving anyclass (StakingCredential -> ()
(StakingCredential -> ()) -> NFData StakingCredential
forall a. (a -> ()) -> NFData a
$crnf :: StakingCredential -> ()
rnf :: StakingCredential -> ()
NFData, DefinitionId
DefinitionId -> HasBlueprintDefinition StakingCredential
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)
instance Pretty StakingCredential where
pretty :: forall ann. StakingCredential -> Doc ann
pretty (StakingHash Credential
h) = Doc ann
"StakingHash" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Credential -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Credential -> Doc ann
pretty Credential
h
pretty (StakingPtr Integer
a Integer
b Integer
c) = Doc ann
"StakingPtr:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
a Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
b Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
c
instance PlutusTx.Eq StakingCredential where
{-# INLINABLE (==) #-}
StakingHash Credential
l == :: StakingCredential -> StakingCredential -> Bool
== StakingHash Credential
r = Credential
l Credential -> Credential -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Credential
r
StakingPtr Integer
a Integer
b Integer
c == StakingPtr Integer
a' Integer
b' Integer
c' =
Integer
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Integer
a'
Bool -> Bool -> Bool
PlutusTx.&& Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Integer
b'
Bool -> Bool -> Bool
PlutusTx.&& Integer
c Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Integer
c'
StakingCredential
_ == StakingCredential
_ = Bool
False
data Credential
=
PubKeyCredential PubKeyHash
| ScriptCredential ScriptHash
deriving stock (Credential -> Credential -> Bool
(Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool) -> Eq Credential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Credential -> Credential -> Bool
== :: Credential -> Credential -> Bool
$c/= :: Credential -> Credential -> Bool
/= :: Credential -> Credential -> Bool
Eq, Eq Credential
Eq Credential =>
(Credential -> Credential -> Ordering)
-> (Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool)
-> (Credential -> Credential -> Credential)
-> (Credential -> Credential -> Credential)
-> Ord Credential
Credential -> Credential -> Bool
Credential -> Credential -> Ordering
Credential -> Credential -> Credential
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 :: Credential -> Credential -> Ordering
compare :: Credential -> Credential -> Ordering
$c< :: Credential -> Credential -> Bool
< :: Credential -> Credential -> Bool
$c<= :: Credential -> Credential -> Bool
<= :: Credential -> Credential -> Bool
$c> :: Credential -> Credential -> Bool
> :: Credential -> Credential -> Bool
$c>= :: Credential -> Credential -> Bool
>= :: Credential -> Credential -> Bool
$cmax :: Credential -> Credential -> Credential
max :: Credential -> Credential -> Credential
$cmin :: Credential -> Credential -> Credential
min :: Credential -> Credential -> Credential
Ord, Int -> Credential -> ShowS
[Credential] -> ShowS
Credential -> String
(Int -> Credential -> ShowS)
-> (Credential -> String)
-> ([Credential] -> ShowS)
-> Show Credential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Credential -> ShowS
showsPrec :: Int -> Credential -> ShowS
$cshow :: Credential -> String
show :: Credential -> String
$cshowList :: [Credential] -> ShowS
showList :: [Credential] -> ShowS
Show, (forall x. Credential -> Rep Credential x)
-> (forall x. Rep Credential x -> Credential) -> Generic Credential
forall x. Rep Credential x -> Credential
forall x. Credential -> Rep Credential x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Credential -> Rep Credential x
from :: forall x. Credential -> Rep Credential x
$cto :: forall x. Rep Credential x -> Credential
to :: forall x. Rep Credential x -> Credential
Generic, Typeable)
deriving anyclass (Credential -> ()
(Credential -> ()) -> NFData Credential
forall a. (a -> ()) -> NFData a
$crnf :: Credential -> ()
rnf :: Credential -> ()
NFData, DefinitionId
DefinitionId -> HasBlueprintDefinition Credential
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)
instance Pretty Credential where
pretty :: forall ann. Credential -> Doc ann
pretty (PubKeyCredential PubKeyHash
pkh) = Doc ann
"PubKeyCredential:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PubKeyHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PubKeyHash -> Doc ann
pretty PubKeyHash
pkh
pretty (ScriptCredential ScriptHash
val) = Doc ann
"ScriptCredential:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ScriptHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ScriptHash -> Doc ann
pretty ScriptHash
val
instance PlutusTx.Eq Credential where
{-# INLINABLE (==) #-}
PubKeyCredential PubKeyHash
l == :: Credential -> Credential -> Bool
== PubKeyCredential PubKeyHash
r = PubKeyHash
l PubKeyHash -> PubKeyHash -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== PubKeyHash
r
ScriptCredential ScriptHash
a == ScriptCredential ScriptHash
a' = ScriptHash
a ScriptHash -> ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== ScriptHash
a'
Credential
_ == Credential
_ = Bool
False
PlutusTx.makeIsDataSchemaIndexed ''Credential [('PubKeyCredential, 0), ('ScriptCredential, 1)]
PlutusTx.makeIsDataSchemaIndexed ''StakingCredential [('StakingHash, 0), ('StakingPtr, 1)]
PlutusTx.makeLift ''Credential
PlutusTx.makeLift ''StakingCredential
deriveShow ''Credential
deriveShow ''StakingCredential