{-# 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 Codec.Serialise.Class (Serialise)
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON)
import Data.Hashable (Hashable)
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] -> Encoding
[StakingCredential] -> Value
StakingCredential -> Encoding
StakingCredential -> Value
(StakingCredential -> Value)
-> (StakingCredential -> Encoding)
-> ([StakingCredential] -> Value)
-> ([StakingCredential] -> Encoding)
-> ToJSON StakingCredential
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StakingCredential] -> Encoding
$ctoEncodingList :: [StakingCredential] -> Encoding
toJSONList :: [StakingCredential] -> Value
$ctoJSONList :: [StakingCredential] -> Value
toEncoding :: StakingCredential -> Encoding
$ctoEncoding :: StakingCredential -> Encoding
toJSON :: StakingCredential -> Value
$ctoJSON :: StakingCredential -> Value
ToJSON, Value -> Parser [StakingCredential]
Value -> Parser StakingCredential
(Value -> Parser StakingCredential)
-> (Value -> Parser [StakingCredential])
-> FromJSON StakingCredential
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StakingCredential]
$cparseJSONList :: Value -> Parser [StakingCredential]
parseJSON :: Value -> Parser StakingCredential
$cparseJSON :: Value -> Parser StakingCredential
FromJSON, [StakingCredential] -> Encoding
StakingCredential -> Encoding
(StakingCredential -> Encoding)
-> (forall s. Decoder s StakingCredential)
-> ([StakingCredential] -> Encoding)
-> (forall s. Decoder s [StakingCredential])
-> Serialise StakingCredential
forall s. Decoder s [StakingCredential]
forall s. Decoder s StakingCredential
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [StakingCredential]
$cdecodeList :: forall s. Decoder s [StakingCredential]
encodeList :: [StakingCredential] -> Encoding
$cencodeList :: [StakingCredential] -> Encoding
decode :: Decoder s StakingCredential
$cdecode :: forall s. Decoder s StakingCredential
encode :: StakingCredential -> Encoding
$cencode :: StakingCredential -> Encoding
Serialise, Int -> StakingCredential -> Int
StakingCredential -> Int
(Int -> StakingCredential -> Int)
-> (StakingCredential -> Int) -> Hashable StakingCredential
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: StakingCredential -> Int
$chash :: StakingCredential -> Int
hashWithSalt :: Int -> StakingCredential -> Int
$chashWithSalt :: Int -> StakingCredential -> Int
Hashable, 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] -> Encoding
[Credential] -> Value
Credential -> Encoding
Credential -> Value
(Credential -> Value)
-> (Credential -> Encoding)
-> ([Credential] -> Value)
-> ([Credential] -> Encoding)
-> ToJSON Credential
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Credential] -> Encoding
$ctoEncodingList :: [Credential] -> Encoding
toJSONList :: [Credential] -> Value
$ctoJSONList :: [Credential] -> Value
toEncoding :: Credential -> Encoding
$ctoEncoding :: Credential -> Encoding
toJSON :: Credential -> Value
$ctoJSON :: Credential -> Value
ToJSON, Value -> Parser [Credential]
Value -> Parser Credential
(Value -> Parser Credential)
-> (Value -> Parser [Credential]) -> FromJSON Credential
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Credential]
$cparseJSONList :: Value -> Parser [Credential]
parseJSON :: Value -> Parser Credential
$cparseJSON :: Value -> Parser Credential
FromJSON, [Credential] -> Encoding
Credential -> Encoding
(Credential -> Encoding)
-> (forall s. Decoder s Credential)
-> ([Credential] -> Encoding)
-> (forall s. Decoder s [Credential])
-> Serialise Credential
forall s. Decoder s [Credential]
forall s. Decoder s Credential
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [Credential]
$cdecodeList :: forall s. Decoder s [Credential]
encodeList :: [Credential] -> Encoding
$cencodeList :: [Credential] -> Encoding
decode :: Decoder s Credential
$cdecode :: forall s. Decoder s Credential
encode :: Credential -> Encoding
$cencode :: Credential -> Encoding
Serialise, Int -> Credential -> Int
Credential -> Int
(Int -> Credential -> Int)
-> (Credential -> Int) -> Hashable Credential
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Credential -> Int
$chash :: Credential -> Int
hashWithSalt :: Int -> Credential -> Int
$chashWithSalt :: Int -> Credential -> Int
Hashable, 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