{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}
{-# 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 Data.Typeable (Typeable)
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Credential (StakingCredential)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusTx.Blueprint.Definition (HasBlueprintDefinition (..), definitionRef)
import PlutusTx.Blueprint.Schema.Annotation (SchemaDescription (..), SchemaTitle (..))
import PlutusTx.Blueprint.TH (makeIsDataSchemaIndexed)
import PlutusTx.Lift (makeLift)
import PlutusTx.Prelude qualified as P
import PlutusTx.Show (deriveShow)
import Prettyprinter.Extras (Pretty, PrettyShow (PrettyShow))

{-# ANN DCertDelegRegKey (SchemaTitle "DCertDelegRegKey") #-}
{-# ANN DCertDelegRegKey (SchemaDescription "Delegation key registration certificate") #-}

{-# ANN DCertDelegDeRegKey (SchemaTitle "DCertDelegDeRegKey") #-}
{-# ANN DCertDelegDeRegKey (SchemaDescription "Delegation key deregistration certificate") #-}

{-# ANN DCertDelegDelegate (SchemaTitle "DCertDelegDelegate") #-}
{-# ANN DCertDelegDelegate (SchemaDescription "Delegation certificate") #-}

{-# ANN DCertPoolRegister (SchemaTitle "DCertPoolRegister") #-}
{-# ANN DCertPoolRegister (SchemaDescription "Pool registration certificate") #-}

{-# ANN DCertPoolRetire (SchemaTitle "DCertPoolRetire") #-}
{-# ANN DCertPoolRetire (SchemaDescription "Pool retirement certificate") #-}

{-# ANN DCertGenesis (SchemaTitle "DCertGenesis") #-}
{-# ANN DCertGenesis (SchemaDescription "Genesis key") #-}

{-# ANN DCertMir (SchemaTitle "DCertMir") #-}
{-# ANN DCertMir (SchemaDescription "MIR key") #-}

-- | 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, Typeable)
    deriving anyclass (DCert -> ()
(DCert -> ()) -> NFData DCert
forall a. (a -> ()) -> NFData a
$crnf :: DCert -> ()
rnf :: DCert -> ()
NFData, DefinitionId
DefinitionId -> HasBlueprintDefinition DCert
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)
    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

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

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

deriveShow ''DCert