-- editorconfig-checker-disable-file
{-# 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 #-}

-- | Address and staking address credentials for outputs.
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 (..), (<+>))

-- | 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 (`ScriptHash`). 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
(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

-- | 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 `ScriptHash`.
  | 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

----------------------------------------------------------------------------------------------------
-- TH Splices --------------------------------------------------------------------------------------

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

deriveShow ''Credential
deriveShow ''StakingCredential