-- editorconfig-checker-disable-file
{-# LANGUAGE DeriveAnyClass    #-}
{-# 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 PlutusLedgerApi.V1.Credential
    ( StakingCredential(..)
    , Credential(..)
    ) where

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

-- | Staking credential used to assign rewards.
data StakingCredential
    -- | The staking hash is the `Credential` required to unlock a transaction output. Either
    -- a public key credential (`Crypto.PubKeyHash`) or
    -- a script credential (`Scripts.ValidatorHash`). Both are hashed with /BLAKE2b-244/. 28 byte.
    = StakingHash Credential
    -- | The certificate pointer, constructed by the given
    -- slot number, transaction and certificate indices.
    -- NB: The fields should really be all `Word64`, as they are implemented in `Word64`,
    -- but 'Integer' is our only integral type so we need to use it instead.
    | StakingPtr
        Integer -- ^ the slot number
        Integer -- ^ the transaction index (within the block)
        Integer -- ^ the certificate index (within the transaction)
    deriving stock (StakingCredential -> StakingCredential -> Bool
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
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
Ord, Int -> StakingCredential -> ShowS
[StakingCredential] -> ShowS
StakingCredential -> String
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: StakingCredential -> ()
$crnf :: StakingCredential -> ()
NFData)

instance Pretty StakingCredential where
    pretty :: forall ann. StakingCredential -> Doc ann
pretty (StakingHash Credential
h)    = Doc ann
"StakingHash" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Credential
h
    pretty (StakingPtr Integer
a Integer
b Integer
c) = Doc ann
"StakingPtr:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Integer
a forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Integer
b forall ann. Doc ann -> Doc ann -> 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 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 forall a. Eq a => a -> a -> Bool
PlutusTx.== Integer
a'
        Bool -> Bool -> Bool
PlutusTx.&& Integer
b forall a. Eq a => a -> a -> Bool
PlutusTx.== Integer
b'
        Bool -> Bool -> Bool
PlutusTx.&& Integer
c forall a. Eq a => a -> a -> Bool
PlutusTx.== Integer
c'
    StakingCredential
_ == StakingCredential
_ = Bool
False

-- | Credentials required to unlock a transaction output.
data Credential
  =
    -- | The transaction that spends this output must be signed by the private key.
    -- See `Crypto.PubKeyHash`.
    PubKeyCredential PubKeyHash
    -- | The transaction that spends this output must include the validator script and
    -- be accepted by the validator. See `Scripts.ValidatorHash`.
  | ScriptCredential ScriptHash
    deriving stock (Credential -> Credential -> Bool
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
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
Ord, Int -> Credential -> ShowS
[Credential] -> ShowS
Credential -> String
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Credential -> ()
$crnf :: Credential -> ()
NFData)

instance Pretty Credential where
    pretty :: forall ann. Credential -> Doc ann
pretty (PubKeyCredential PubKeyHash
pkh) = Doc ann
"PubKeyCredential:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty PubKeyHash
pkh
    pretty (ScriptCredential ScriptHash
val) = Doc ann
"ScriptCredential:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ScriptHash
val

instance PlutusTx.Eq Credential where
    {-# INLINABLE (==) #-}
    PubKeyCredential PubKeyHash
l == :: Credential -> Credential -> Bool
== PubKeyCredential PubKeyHash
r  = PubKeyHash
l forall a. Eq a => a -> a -> Bool
PlutusTx.== PubKeyHash
r
    ScriptCredential ScriptHash
a == ScriptCredential ScriptHash
a' = ScriptHash
a forall a. Eq a => a -> a -> Bool
PlutusTx.== ScriptHash
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