{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE DerivingVia     #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns    #-}

{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

-- | Digests of certificates that are included in transactions.
module PlutusLedgerApi.V1.DCert
    ( DCert(..)
    ) where

import Control.DeepSeq (NFData)
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Credential (StakingCredential)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusTx qualified
import PlutusTx.Prelude qualified as P
import Prettyprinter.Extras

-- | A representation of the ledger DCert. Some information is digested, and
--   not included
data DCert
  = DCertDelegRegKey StakingCredential
  | DCertDelegDeRegKey StakingCredential
  | DCertDelegDelegate
      StakingCredential
      -- ^ delegator
      PubKeyHash
      -- ^ delegatee
  | -- | A digest of the PoolParams
    DCertPoolRegister
      PubKeyHash
      -- ^ poolId
      PubKeyHash
      -- ^ pool VFR
  | -- | The retirement certificate and the Epoch in which the retirement will take place
    DCertPoolRetire PubKeyHash Integer -- NB: Should be Word64 but we only have Integer on-chain
  | -- | A really terse Digest
    DCertGenesis
  | -- | Another really terse Digest
    DCertMir
    deriving stock (DCert -> DCert -> Bool
(DCert -> DCert -> Bool) -> (DCert -> DCert -> Bool) -> Eq DCert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DCert -> DCert -> Bool
== :: DCert -> DCert -> Bool
$c/= :: DCert -> DCert -> Bool
/= :: DCert -> DCert -> Bool
Eq, Eq DCert
Eq DCert =>
(DCert -> DCert -> Ordering)
-> (DCert -> DCert -> Bool)
-> (DCert -> DCert -> Bool)
-> (DCert -> DCert -> Bool)
-> (DCert -> DCert -> Bool)
-> (DCert -> DCert -> DCert)
-> (DCert -> DCert -> DCert)
-> Ord DCert
DCert -> DCert -> Bool
DCert -> DCert -> Ordering
DCert -> DCert -> DCert
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 :: DCert -> DCert -> Ordering
compare :: DCert -> DCert -> Ordering
$c< :: DCert -> DCert -> Bool
< :: DCert -> DCert -> Bool
$c<= :: DCert -> DCert -> Bool
<= :: DCert -> DCert -> Bool
$c> :: DCert -> DCert -> Bool
> :: DCert -> DCert -> Bool
$c>= :: DCert -> DCert -> Bool
>= :: DCert -> DCert -> Bool
$cmax :: DCert -> DCert -> DCert
max :: DCert -> DCert -> DCert
$cmin :: DCert -> DCert -> DCert
min :: DCert -> DCert -> DCert
Ord, Int -> DCert -> ShowS
[DCert] -> ShowS
DCert -> String
(Int -> DCert -> ShowS)
-> (DCert -> String) -> ([DCert] -> ShowS) -> Show DCert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DCert -> ShowS
showsPrec :: Int -> DCert -> ShowS
$cshow :: DCert -> String
show :: DCert -> String
$cshowList :: [DCert] -> ShowS
showList :: [DCert] -> ShowS
Show, (forall x. DCert -> Rep DCert x)
-> (forall x. Rep DCert x -> DCert) -> Generic DCert
forall x. Rep DCert x -> DCert
forall x. DCert -> Rep DCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DCert -> Rep DCert x
from :: forall x. DCert -> Rep DCert x
$cto :: forall x. Rep DCert x -> DCert
to :: forall x. Rep DCert x -> DCert
Generic)
    deriving anyclass (DCert -> ()
(DCert -> ()) -> NFData DCert
forall a. (a -> ()) -> NFData a
$crnf :: DCert -> ()
rnf :: DCert -> ()
NFData)
    deriving (forall ann. DCert -> Doc ann)
-> (forall ann. [DCert] -> Doc ann) -> Pretty DCert
forall ann. [DCert] -> Doc ann
forall ann. DCert -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. DCert -> Doc ann
pretty :: forall ann. DCert -> Doc ann
$cprettyList :: forall ann. [DCert] -> Doc ann
prettyList :: forall ann. [DCert] -> Doc ann
Pretty via (PrettyShow DCert)

instance P.Eq DCert where
    {-# INLINABLE (==) #-}
    DCertDelegRegKey StakingCredential
sc == :: DCert -> DCert -> Bool
== DCertDelegRegKey StakingCredential
sc'                = StakingCredential
sc StakingCredential -> StakingCredential -> Bool
forall a. Eq a => a -> a -> Bool
P.== StakingCredential
sc'
    DCertDelegDeRegKey StakingCredential
sc == DCertDelegDeRegKey StakingCredential
sc'            = StakingCredential
sc StakingCredential -> StakingCredential -> Bool
forall a. Eq a => a -> a -> Bool
P.== StakingCredential
sc'
    DCertDelegDelegate StakingCredential
sc PubKeyHash
pkh == DCertDelegDelegate StakingCredential
sc' PubKeyHash
pkh'   = StakingCredential
sc StakingCredential -> StakingCredential -> Bool
forall a. Eq a => a -> a -> Bool
P.== StakingCredential
sc' Bool -> Bool -> Bool
&& PubKeyHash
pkh PubKeyHash -> PubKeyHash -> Bool
forall a. Eq a => a -> a -> Bool
P.== PubKeyHash
pkh'
    DCertPoolRegister PubKeyHash
pid PubKeyHash
pvfr == DCertPoolRegister PubKeyHash
pid' PubKeyHash
pvfr' = PubKeyHash
pid PubKeyHash -> PubKeyHash -> Bool
forall a. Eq a => a -> a -> Bool
P.== PubKeyHash
pid' Bool -> Bool -> Bool
&& PubKeyHash
pvfr PubKeyHash -> PubKeyHash -> Bool
forall a. Eq a => a -> a -> Bool
P.== PubKeyHash
pvfr'
    DCertPoolRetire PubKeyHash
pkh Integer
i == DCertPoolRetire PubKeyHash
pkh' Integer
i'           = PubKeyHash
pkh PubKeyHash -> PubKeyHash -> Bool
forall a. Eq a => a -> a -> Bool
P.== PubKeyHash
pkh' Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P.== Integer
i'
    DCert
DCertGenesis == DCert
DCertGenesis                               = Bool
True
    DCert
DCertMir == DCert
DCertMir                                       = Bool
True
    DCert
_ == DCert
_                                                     = Bool
False

PlutusTx.makeIsDataIndexed
    ''DCert
    [ ('DCertDelegRegKey,0)
    , ('DCertDelegDeRegKey,1)
    , ('DCertDelegDelegate,2)
    , ('DCertPoolRegister,3)
    , ('DCertPoolRetire,4)
    , ('DCertGenesis,5)
    , ('DCertMir,6)
    ]
PlutusTx.makeLift ''DCert