{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

{-

Address and staking address credentials for outputs.

-}
module Plutus.V1.Ledger.Credential(
    StakingCredential(..)
    , Credential(..)
    ) where

import Control.DeepSeq (NFData)
import GHC.Generics (Generic)
import Plutus.V1.Ledger.Crypto (PubKeyHash)
import Plutus.V1.Ledger.Scripts (ValidatorHash)
import PlutusTx qualified as PlutusTx
import PlutusTx.Bool qualified as PlutusTx
import PlutusTx.Eq qualified as PlutusTx
import Prettyprinter (Pretty (..), (<+>))

-- | Staking credential used to assign rewards
data StakingCredential
    = StakingHash Credential
    | StakingPtr Integer Integer Integer -- NB: The fields should really be Word64 / Natural / Natural, but 'Integer' is our only integral type so we need to use it instead.
    deriving stock (StakingCredential -> StakingCredential -> Bool
(StakingCredential -> StakingCredential -> Bool)
-> (StakingCredential -> StakingCredential -> Bool)
-> Eq StakingCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakingCredential -> StakingCredential -> Bool
$c/= :: StakingCredential -> StakingCredential -> Bool
== :: StakingCredential -> StakingCredential -> Bool
$c== :: 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
min :: StakingCredential -> StakingCredential -> StakingCredential
$cmin :: StakingCredential -> StakingCredential -> StakingCredential
max :: StakingCredential -> StakingCredential -> StakingCredential
$cmax :: StakingCredential -> StakingCredential -> StakingCredential
>= :: StakingCredential -> StakingCredential -> Bool
$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
compare :: StakingCredential -> StakingCredential -> Ordering
$ccompare :: StakingCredential -> StakingCredential -> Ordering
$cp1Ord :: Eq 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
showList :: [StakingCredential] -> ShowS
$cshowList :: [StakingCredential] -> ShowS
show :: StakingCredential -> String
$cshow :: StakingCredential -> String
showsPrec :: Int -> StakingCredential -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep StakingCredential x -> StakingCredential
$cfrom :: forall x. StakingCredential -> Rep StakingCredential x
Generic)
    deriving anyclass (StakingCredential -> ()
(StakingCredential -> ()) -> NFData StakingCredential
forall a. (a -> ()) -> NFData a
rnf :: StakingCredential -> ()
$crnf :: StakingCredential -> ()
NFData)

instance Pretty StakingCredential where
    pretty :: 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
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 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 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 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

-- | Credential required to unlock a transaction output
data Credential
  = PubKeyCredential PubKeyHash -- ^ The transaction that spends this output must be signed by the private key
  | ScriptCredential ValidatorHash -- ^ The transaction that spends this output must include the validator script and be accepted by the validator.
    deriving stock (Credential -> Credential -> Bool
(Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool) -> Eq Credential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credential -> Credential -> Bool
$c/= :: Credential -> Credential -> Bool
== :: Credential -> Credential -> Bool
$c== :: 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
min :: Credential -> Credential -> Credential
$cmin :: Credential -> Credential -> Credential
max :: Credential -> Credential -> Credential
$cmax :: Credential -> Credential -> Credential
>= :: Credential -> Credential -> Bool
$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
compare :: Credential -> Credential -> Ordering
$ccompare :: Credential -> Credential -> Ordering
$cp1Ord :: Eq 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
showList :: [Credential] -> ShowS
$cshowList :: [Credential] -> ShowS
show :: Credential -> String
$cshow :: Credential -> String
showsPrec :: Int -> Credential -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Credential x -> Credential
$cfrom :: forall x. Credential -> Rep Credential x
Generic)
    deriving anyclass (Credential -> ()
(Credential -> ()) -> NFData Credential
forall a. (a -> ()) -> NFData a
rnf :: Credential -> ()
$crnf :: Credential -> ()
NFData)

instance Pretty Credential where
    pretty :: 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
pretty PubKeyHash
pkh
    pretty (ScriptCredential ValidatorHash
val) = Doc ann
"ScriptCredential:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ValidatorHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ValidatorHash
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 ValidatorHash
a == ScriptCredential ValidatorHash
a' = ValidatorHash
a ValidatorHash -> ValidatorHash -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== ValidatorHash
a'
    Credential
_ == Credential
_                                    = Bool
False

PlutusTx.makeIsDataIndexed ''Credential [('PubKeyCredential,0), ('ScriptCredential,1)]
PlutusTx.makeIsDataIndexed ''StakingCredential [('StakingHash,0), ('StakingPtr,1)]
PlutusTx.makeLift ''Credential
PlutusTx.makeLift ''StakingCredential