{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutarch.Api.V1.DCert (
  PDCert (
    PDCertDelegDelegate,
    PDCertDelegDeRegKey,
    PDCertDelegRegKey,
    PDCertGenesis,
    PDCertMir,
    PDCertPoolRegister,
    PDCertPoolRetire
  ),
) where

import PlutusLedgerApi.V1 qualified as Plutus

import Plutarch.Api.V1.Address (PStakingCredential)
import Plutarch.Api.V1.Crypto (PPubKeyHash)
import Plutarch.DataRepr (
  DerivePConstantViaData (DerivePConstantViaData),
 )
import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
import Plutarch.Prelude

data PDCert (s :: S)
  = PDCertDelegRegKey (Term s (PDataRecord '["_0" ':= PStakingCredential]))
  | PDCertDelegDeRegKey (Term s (PDataRecord '["_0" ':= PStakingCredential]))
  | PDCertDelegDelegate
      ( Term
          s
          ( PDataRecord
              '[ "_0" ':= PStakingCredential
               , "_1" ':= PPubKeyHash
               ]
          )
      )
  | PDCertPoolRegister (Term s (PDataRecord '["_0" ':= PPubKeyHash, "_1" ':= PPubKeyHash]))
  | PDCertPoolRetire (Term s (PDataRecord '["_0" ':= PPubKeyHash, "_1" ':= PInteger]))
  | PDCertGenesis (Term s (PDataRecord '[]))
  | PDCertMir (Term s (PDataRecord '[]))
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PDCert s) x -> PDCert s
forall (s :: S) x. PDCert s -> Rep (PDCert s) x
$cto :: forall (s :: S) x. Rep (PDCert s) x -> PDCert s
$cfrom :: forall (s :: S) x. PDCert s -> Rep (PDCert s) x
Generic)
  deriving anyclass (forall (s :: S). PDCert s -> Term s (PInner PDCert)
forall (s :: S) (b :: PType).
Term s (PInner PDCert) -> (PDCert s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PDCert) -> (PDCert s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PDCert) -> (PDCert s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PDCert s -> Term s (PInner PDCert)
$cpcon' :: forall (s :: S). PDCert s -> Term s (PInner PDCert)
PlutusType, forall (s :: S). Term s (PAsData PDCert) -> Term s PDCert
forall (s :: S). Term s PDCert -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PDCert -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PDCert -> Term s PData
pfromDataImpl :: forall (s :: S). Term s (PAsData PDCert) -> Term s PDCert
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PDCert) -> Term s PDCert
PIsData, forall (s :: S). Term s PDCert -> Term s PDCert -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S). Term s PDCert -> Term s PDCert -> Term s PBool
$c#== :: forall (s :: S). Term s PDCert -> Term s PDCert -> Term s PBool
PEq, PEq PDCert
forall (s :: S). Term s PDCert -> Term s PDCert -> Term s PBool
forall (t :: PType).
PEq t
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> PPartialOrd t
#< :: forall (s :: S). Term s PDCert -> Term s PDCert -> Term s PBool
$c#< :: forall (s :: S). Term s PDCert -> Term s PDCert -> Term s PBool
#<= :: forall (s :: S). Term s PDCert -> Term s PDCert -> Term s PBool
$c#<= :: forall (s :: S). Term s PDCert -> Term s PDCert -> Term s PBool
PPartialOrd, PPartialOrd PDCert
forall (t :: PType). PPartialOrd t -> POrd t
POrd, forall (s :: S). Bool -> Term s PDCert -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s PDCert -> Term s PString
$cpshow' :: forall (s :: S). Bool -> Term s PDCert -> Term s PString
PShow)
instance DerivePlutusType PDCert where type DPTStrat _ = PlutusTypeData

instance PUnsafeLiftDecl PDCert where type PLifted PDCert = Plutus.DCert
deriving via (DerivePConstantViaData Plutus.DCert PDCert) instance PConstantDecl Plutus.DCert