{-# LANGUAGE TemplateHaskell #-}

{- |
Module     : Agora.Governor
Maintainer : connor@mlabs.city
Description: Governor entity scripts acting as authority of entire system.

Governor entity scripts acting as authority of entire system.
-}
module Agora.Governor (
  -- * Haskell-land
  GovernorDatum (..),
  GovernorRedeemer (..),
  Governor (..),

  -- * Plutarch-land
  PGovernorDatum (..),
  PGovernorRedeemer (..),

  -- * Utilities
  pgetNextProposalId,
  getNextProposalId,
  governorDatumValid,
) where

import Agora.Proposal (
  PProposalId (..),
  PProposalThresholds (..),
  ProposalId (ProposalId),
  ProposalThresholds,
 )
import Agora.Proposal.Time (
  MaxTimeRangeWidth,
  PMaxTimeRangeWidth,
  PProposalTimingConfig,
  ProposalTimingConfig,
 )
import Agora.SafeMoney (GTTag)
import Data.Tagged (Tagged (..))
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I))
import Plutarch.DataRepr (
  DerivePConstantViaData (..),
  PDataFields,
  PIsDataReprInstances (PIsDataReprInstances),
 )
import Plutarch.Extra.Comonad (pextract)
import Plutarch.Extra.TermCont (pletC, pmatchC)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
import Plutarch.SafeMoney (PDiscrete (..))
import PlutusLedgerApi.V1 (TxOutRef)
import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusTx qualified

--------------------------------------------------------------------------------

{- | Datum for the Governor script.

     @since 0.1.0
-}
data GovernorDatum = GovernorDatum
  { GovernorDatum -> ProposalThresholds
proposalThresholds :: ProposalThresholds
  -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'.
  , GovernorDatum -> ProposalId
nextProposalId :: ProposalId
  -- ^ What tag the next proposal will get upon creating.
  , GovernorDatum -> ProposalTimingConfig
proposalTimings :: ProposalTimingConfig
  -- ^ The timing configuration for proposals.
  --   Will get copied over upon the creation of proposals.
  , GovernorDatum -> MaxTimeRangeWidth
createProposalTimeRangeMaxWidth :: MaxTimeRangeWidth
  -- ^ The maximum valid duration of a transaction that creats a proposal.
  }
  deriving stock (Int -> GovernorDatum -> ShowS
[GovernorDatum] -> ShowS
GovernorDatum -> String
(Int -> GovernorDatum -> ShowS)
-> (GovernorDatum -> String)
-> ([GovernorDatum] -> ShowS)
-> Show GovernorDatum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GovernorDatum] -> ShowS
$cshowList :: [GovernorDatum] -> ShowS
show :: GovernorDatum -> String
$cshow :: GovernorDatum -> String
showsPrec :: Int -> GovernorDatum -> ShowS
$cshowsPrec :: Int -> GovernorDatum -> ShowS
Show, (forall x. GovernorDatum -> Rep GovernorDatum x)
-> (forall x. Rep GovernorDatum x -> GovernorDatum)
-> Generic GovernorDatum
forall x. Rep GovernorDatum x -> GovernorDatum
forall x. GovernorDatum -> Rep GovernorDatum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GovernorDatum x -> GovernorDatum
$cfrom :: forall x. GovernorDatum -> Rep GovernorDatum x
GHC.Generic)

-- | @since 0.1.0
PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)]

{- | Redeemer for Governor script. The governor has two primary
     responsibilities:

     1. The gating of Proposal creation.
     2. The gating of minting authority tokens.

     Parameters of the governor can also be mutated by an effect.

     @since 0.1.0
-}
data GovernorRedeemer
  = -- | Checks that a proposal was created lawfully, and allows it.
    CreateProposal
  | -- | Checks that a SINGLE proposal finished correctly,
    --   and allows minting GATs for each effect script.
    MintGATs
  | -- | Allows effects to mutate the parameters.
    MutateGovernor
  deriving stock (Int -> GovernorRedeemer -> ShowS
[GovernorRedeemer] -> ShowS
GovernorRedeemer -> String
(Int -> GovernorRedeemer -> ShowS)
-> (GovernorRedeemer -> String)
-> ([GovernorRedeemer] -> ShowS)
-> Show GovernorRedeemer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GovernorRedeemer] -> ShowS
$cshowList :: [GovernorRedeemer] -> ShowS
show :: GovernorRedeemer -> String
$cshow :: GovernorRedeemer -> String
showsPrec :: Int -> GovernorRedeemer -> ShowS
$cshowsPrec :: Int -> GovernorRedeemer -> ShowS
Show, (forall x. GovernorRedeemer -> Rep GovernorRedeemer x)
-> (forall x. Rep GovernorRedeemer x -> GovernorRedeemer)
-> Generic GovernorRedeemer
forall x. Rep GovernorRedeemer x -> GovernorRedeemer
forall x. GovernorRedeemer -> Rep GovernorRedeemer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GovernorRedeemer x -> GovernorRedeemer
$cfrom :: forall x. GovernorRedeemer -> Rep GovernorRedeemer x
GHC.Generic)

-- | @since 0.1.0
PlutusTx.makeIsDataIndexed
  ''GovernorRedeemer
  [ ('CreateProposal, 0)
  , ('MintGATs, 1)
  , ('MutateGovernor, 2)
  ]

{- | Parameters for creating Governor scripts.

     @since 0.1.0
-}
data Governor = Governor
  { Governor -> TxOutRef
gstOutRef :: TxOutRef
  -- ^ Referenced utxo will be spent to mint the GST.
  , Governor -> Tagged @Type GTTag AssetClass
gtClassRef :: Tagged GTTag AssetClass
  -- ^ Governance token of the system.
  , Governor -> Integer
maximumCosigners :: Integer
  -- ^ Arbitrary limit for maximum amount of cosigners on a proposal.
  -- See `Agora.Proposal.proposalDatumValid`.
  }
  deriving stock ((forall x. Governor -> Rep Governor x)
-> (forall x. Rep Governor x -> Governor) -> Generic Governor
forall x. Rep Governor x -> Governor
forall x. Governor -> Rep Governor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Governor x -> Governor
$cfrom :: forall x. Governor -> Rep Governor x
GHC.Generic)

--------------------------------------------------------------------------------

{- | Plutarch-level datum for the Governor script.

     @since 0.1.0
-}
newtype PGovernorDatum (s :: S) = PGovernorDatum
  { forall (s :: S).
PGovernorDatum s
-> Term
     s
     (PDataRecord
        ((':)
           @PLabeledType
           ("proposalThresholds" ':= PProposalThresholds)
           ((':)
              @PLabeledType
              ("nextProposalId" ':= PProposalId)
              ((':)
                 @PLabeledType
                 ("proposalTimings" ':= PProposalTimingConfig)
                 ((':)
                    @PLabeledType
                    ("createProposalTimeRangeMaxWidth" ':= PMaxTimeRangeWidth)
                    ('[] @PLabeledType))))))
getGovernorDatum ::
      Term
        s
        ( PDataRecord
            '[ "proposalThresholds" ':= PProposalThresholds
             , "nextProposalId" ':= PProposalId
             , "proposalTimings" ':= PProposalTimingConfig
             , "createProposalTimeRangeMaxWidth" ':= PMaxTimeRangeWidth
             ]
        )
  }
  deriving stock
    ( -- | @since 0.1.0
      (forall x. PGovernorDatum s -> Rep (PGovernorDatum s) x)
-> (forall x. Rep (PGovernorDatum s) x -> PGovernorDatum s)
-> Generic (PGovernorDatum s)
forall x. Rep (PGovernorDatum s) x -> PGovernorDatum s
forall x. PGovernorDatum s -> Rep (PGovernorDatum s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PGovernorDatum s) x -> PGovernorDatum s
forall (s :: S) x. PGovernorDatum s -> Rep (PGovernorDatum s) x
$cto :: forall (s :: S) x. Rep (PGovernorDatum s) x -> PGovernorDatum s
$cfrom :: forall (s :: S) x. PGovernorDatum s -> Rep (PGovernorDatum s) x
GHC.Generic
    )
  deriving anyclass
    ( -- | @since 0.1.0
      All @[Type] (SListI @Type) (Code (PGovernorDatum s))
All @[Type] (SListI @Type) (Code (PGovernorDatum s))
-> (PGovernorDatum s -> Rep (PGovernorDatum s))
-> (Rep (PGovernorDatum s) -> PGovernorDatum s)
-> Generic (PGovernorDatum s)
Rep (PGovernorDatum s) -> PGovernorDatum s
PGovernorDatum s -> Rep (PGovernorDatum s)
forall a.
All @[Type] (SListI @Type) (Code a)
-> (a -> Rep a) -> (Rep a -> a) -> Generic a
forall {s :: S}.
All @[Type] (SListI @Type) (Code (PGovernorDatum s))
forall (s :: S). Rep (PGovernorDatum s) -> PGovernorDatum s
forall (s :: S). PGovernorDatum s -> Rep (PGovernorDatum s)
to :: Rep (PGovernorDatum s) -> PGovernorDatum s
$cto :: forall (s :: S). Rep (PGovernorDatum s) -> PGovernorDatum s
from :: PGovernorDatum s -> Rep (PGovernorDatum s)
$cfrom :: forall (s :: S). PGovernorDatum s -> Rep (PGovernorDatum s)
Generic
    )
  deriving anyclass
    ( -- | @since 0.1.0
      PIsData PGovernorDatum
PlutusType PGovernorDatum
PlutusType PGovernorDatum
-> PIsData PGovernorDatum
-> (forall (s :: S).
    PGovernorDatum s
    -> Term s (PDataSum (PIsDataReprRepr PGovernorDatum)))
-> (forall (s :: S) (b :: PType).
    Term s (PDataSum (PIsDataReprRepr PGovernorDatum))
    -> (PGovernorDatum s -> Term s b) -> Term s b)
-> PIsDataRepr PGovernorDatum
forall (s :: S).
PGovernorDatum s
-> Term s (PDataSum (PIsDataReprRepr PGovernorDatum))
forall (s :: S) (b :: PType).
Term s (PDataSum (PIsDataReprRepr PGovernorDatum))
-> (PGovernorDatum s -> Term s b) -> Term s b
forall (a :: PType).
PlutusType a
-> PIsData a
-> (forall (s :: S). a s -> Term s (PDataSum (PIsDataReprRepr a)))
-> (forall (s :: S) (b :: PType).
    Term s (PDataSum (PIsDataReprRepr a))
    -> (a s -> Term s b) -> Term s b)
-> PIsDataRepr a
pmatchRepr :: forall (s :: S) (b :: PType).
Term s (PDataSum (PIsDataReprRepr PGovernorDatum))
-> (PGovernorDatum s -> Term s b) -> Term s b
$cpmatchRepr :: forall (s :: S) (b :: PType).
Term s (PDataSum (PIsDataReprRepr PGovernorDatum))
-> (PGovernorDatum s -> Term s b) -> Term s b
pconRepr :: forall (s :: S).
PGovernorDatum s
-> Term s (PDataSum (PIsDataReprRepr PGovernorDatum))
$cpconRepr :: forall (s :: S).
PGovernorDatum s
-> Term s (PDataSum (PIsDataReprRepr PGovernorDatum))
PIsDataRepr
    )
  deriving
    ( -- | @since 0.1.0
      PCon PGovernorDatum
PMatch PGovernorDatum
PCon PGovernorDatum
-> PMatch PGovernorDatum
-> (forall (s :: S) (b :: PType).
    PGovernorDatum s -> Term s (PInner PGovernorDatum b))
-> (forall (s :: S) (b :: PType).
    Term s (PInner PGovernorDatum b)
    -> (PGovernorDatum s -> Term s b) -> Term s b)
-> PlutusType PGovernorDatum
forall (s :: S) (b :: PType).
Term s (PInner PGovernorDatum b)
-> (PGovernorDatum s -> Term s b) -> Term s b
forall (s :: S) (b :: PType).
PGovernorDatum s -> Term s (PInner PGovernorDatum b)
forall (a :: PType).
PCon a
-> PMatch a
-> (forall (s :: S) (b :: PType). a s -> Term s (PInner a b))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a b) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PGovernorDatum b)
-> (PGovernorDatum s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PGovernorDatum b)
-> (PGovernorDatum s -> Term s b) -> Term s b
pcon' :: forall (s :: S) (b :: PType).
PGovernorDatum s -> Term s (PInner PGovernorDatum b)
$cpcon' :: forall (s :: S) (b :: PType).
PGovernorDatum s -> Term s (PInner PGovernorDatum b)
PlutusType
    , -- | @since 0.1.0
      (forall (s :: S).
 Term s (PAsData PGovernorDatum) -> Term s PGovernorDatum)
-> (forall (s :: S). Term s PGovernorDatum -> Term s PData)
-> PIsData PGovernorDatum
forall (s :: S).
Term s (PAsData PGovernorDatum) -> Term s PGovernorDatum
forall (s :: S). Term s PGovernorDatum -> 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 PGovernorDatum -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PGovernorDatum -> Term s PData
pfromDataImpl :: forall (s :: S).
Term s (PAsData PGovernorDatum) -> Term s PGovernorDatum
$cpfromDataImpl :: forall (s :: S).
Term s (PAsData PGovernorDatum) -> Term s PGovernorDatum
PIsData
    , -- | @since 0.1.0
      (forall (s :: S).
 Term s PGovernorDatum
 -> Term s (PDataRecord (PFields PGovernorDatum)))
-> PDataFields PGovernorDatum
forall (s :: S).
Term s PGovernorDatum
-> Term s (PDataRecord (PFields PGovernorDatum))
forall (a :: PType).
(forall (s :: S). Term s a -> Term s (PDataRecord (PFields a)))
-> PDataFields a
ptoFields :: forall (s :: S).
Term s PGovernorDatum
-> Term s (PDataRecord (PFields PGovernorDatum))
$cptoFields :: forall (s :: S).
Term s PGovernorDatum
-> Term s (PDataRecord (PFields PGovernorDatum))
PDataFields
    , -- | @since 0.1.0
      (forall (s :: S).
 Term s PGovernorDatum -> Term s PGovernorDatum -> Term s PBool)
-> PEq PGovernorDatum
forall (s :: S).
Term s PGovernorDatum -> Term s PGovernorDatum -> 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 PGovernorDatum -> Term s PGovernorDatum -> Term s PBool
$c#== :: forall (s :: S).
Term s PGovernorDatum -> Term s PGovernorDatum -> Term s PBool
PEq
    )
    via PIsDataReprInstances PGovernorDatum

-- | @since 0.1.0
instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum

-- | @since 0.1.0
deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstantDecl GovernorDatum)

-- | @since 0.1.0
deriving via PAsData (PIsDataReprInstances PGovernorDatum) instance PTryFrom PData (PAsData PGovernorDatum)

{- | Plutarch-level version of 'GovernorRedeemer'.

     @since 0.1.0
-}
data PGovernorRedeemer (s :: S)
  = PCreateProposal (Term s (PDataRecord '[]))
  | PMintGATs (Term s (PDataRecord '[]))
  | PMutateGovernor (Term s (PDataRecord '[]))
  deriving stock
    ( -- | @since 0.1.0
      (forall x. PGovernorRedeemer s -> Rep (PGovernorRedeemer s) x)
-> (forall x. Rep (PGovernorRedeemer s) x -> PGovernorRedeemer s)
-> Generic (PGovernorRedeemer s)
forall x. Rep (PGovernorRedeemer s) x -> PGovernorRedeemer s
forall x. PGovernorRedeemer s -> Rep (PGovernorRedeemer s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x.
Rep (PGovernorRedeemer s) x -> PGovernorRedeemer s
forall (s :: S) x.
PGovernorRedeemer s -> Rep (PGovernorRedeemer s) x
$cto :: forall (s :: S) x.
Rep (PGovernorRedeemer s) x -> PGovernorRedeemer s
$cfrom :: forall (s :: S) x.
PGovernorRedeemer s -> Rep (PGovernorRedeemer s) x
GHC.Generic
    )
  deriving anyclass
    ( -- | @since 0.1.0
      All @[Type] (SListI @Type) (Code (PGovernorRedeemer s))
All @[Type] (SListI @Type) (Code (PGovernorRedeemer s))
-> (PGovernorRedeemer s -> Rep (PGovernorRedeemer s))
-> (Rep (PGovernorRedeemer s) -> PGovernorRedeemer s)
-> Generic (PGovernorRedeemer s)
Rep (PGovernorRedeemer s) -> PGovernorRedeemer s
PGovernorRedeemer s -> Rep (PGovernorRedeemer s)
forall a.
All @[Type] (SListI @Type) (Code a)
-> (a -> Rep a) -> (Rep a -> a) -> Generic a
forall {s :: S}.
All @[Type] (SListI @Type) (Code (PGovernorRedeemer s))
forall (s :: S). Rep (PGovernorRedeemer s) -> PGovernorRedeemer s
forall (s :: S). PGovernorRedeemer s -> Rep (PGovernorRedeemer s)
to :: Rep (PGovernorRedeemer s) -> PGovernorRedeemer s
$cto :: forall (s :: S). Rep (PGovernorRedeemer s) -> PGovernorRedeemer s
from :: PGovernorRedeemer s -> Rep (PGovernorRedeemer s)
$cfrom :: forall (s :: S). PGovernorRedeemer s -> Rep (PGovernorRedeemer s)
Generic
    )
  deriving anyclass
    ( -- | @since 0.1.0
      PIsData PGovernorRedeemer
PlutusType PGovernorRedeemer
PlutusType PGovernorRedeemer
-> PIsData PGovernorRedeemer
-> (forall (s :: S).
    PGovernorRedeemer s
    -> Term s (PDataSum (PIsDataReprRepr PGovernorRedeemer)))
-> (forall (s :: S) (b :: PType).
    Term s (PDataSum (PIsDataReprRepr PGovernorRedeemer))
    -> (PGovernorRedeemer s -> Term s b) -> Term s b)
-> PIsDataRepr PGovernorRedeemer
forall (s :: S).
PGovernorRedeemer s
-> Term s (PDataSum (PIsDataReprRepr PGovernorRedeemer))
forall (s :: S) (b :: PType).
Term s (PDataSum (PIsDataReprRepr PGovernorRedeemer))
-> (PGovernorRedeemer s -> Term s b) -> Term s b
forall (a :: PType).
PlutusType a
-> PIsData a
-> (forall (s :: S). a s -> Term s (PDataSum (PIsDataReprRepr a)))
-> (forall (s :: S) (b :: PType).
    Term s (PDataSum (PIsDataReprRepr a))
    -> (a s -> Term s b) -> Term s b)
-> PIsDataRepr a
pmatchRepr :: forall (s :: S) (b :: PType).
Term s (PDataSum (PIsDataReprRepr PGovernorRedeemer))
-> (PGovernorRedeemer s -> Term s b) -> Term s b
$cpmatchRepr :: forall (s :: S) (b :: PType).
Term s (PDataSum (PIsDataReprRepr PGovernorRedeemer))
-> (PGovernorRedeemer s -> Term s b) -> Term s b
pconRepr :: forall (s :: S).
PGovernorRedeemer s
-> Term s (PDataSum (PIsDataReprRepr PGovernorRedeemer))
$cpconRepr :: forall (s :: S).
PGovernorRedeemer s
-> Term s (PDataSum (PIsDataReprRepr PGovernorRedeemer))
PIsDataRepr
    )
  deriving
    ( -- | @since 0.1.0
      PCon PGovernorRedeemer
PMatch PGovernorRedeemer
PCon PGovernorRedeemer
-> PMatch PGovernorRedeemer
-> (forall (s :: S) (b :: PType).
    PGovernorRedeemer s -> Term s (PInner PGovernorRedeemer b))
-> (forall (s :: S) (b :: PType).
    Term s (PInner PGovernorRedeemer b)
    -> (PGovernorRedeemer s -> Term s b) -> Term s b)
-> PlutusType PGovernorRedeemer
forall (s :: S) (b :: PType).
Term s (PInner PGovernorRedeemer b)
-> (PGovernorRedeemer s -> Term s b) -> Term s b
forall (s :: S) (b :: PType).
PGovernorRedeemer s -> Term s (PInner PGovernorRedeemer b)
forall (a :: PType).
PCon a
-> PMatch a
-> (forall (s :: S) (b :: PType). a s -> Term s (PInner a b))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a b) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PGovernorRedeemer b)
-> (PGovernorRedeemer s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PGovernorRedeemer b)
-> (PGovernorRedeemer s -> Term s b) -> Term s b
pcon' :: forall (s :: S) (b :: PType).
PGovernorRedeemer s -> Term s (PInner PGovernorRedeemer b)
$cpcon' :: forall (s :: S) (b :: PType).
PGovernorRedeemer s -> Term s (PInner PGovernorRedeemer b)
PlutusType
    , -- | @since 0.1.0
      (forall (s :: S).
 Term s (PAsData PGovernorRedeemer) -> Term s PGovernorRedeemer)
-> (forall (s :: S). Term s PGovernorRedeemer -> Term s PData)
-> PIsData PGovernorRedeemer
forall (s :: S).
Term s (PAsData PGovernorRedeemer) -> Term s PGovernorRedeemer
forall (s :: S). Term s PGovernorRedeemer -> 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 PGovernorRedeemer -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PGovernorRedeemer -> Term s PData
pfromDataImpl :: forall (s :: S).
Term s (PAsData PGovernorRedeemer) -> Term s PGovernorRedeemer
$cpfromDataImpl :: forall (s :: S).
Term s (PAsData PGovernorRedeemer) -> Term s PGovernorRedeemer
PIsData
    )
    via PIsDataReprInstances PGovernorRedeemer

-- | @since 0.1.0
instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer

-- | @since 0.1.0
deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstantDecl GovernorRedeemer)

-- | @since 0.1.0
deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom PData (PAsData PGovernorRedeemer)

--------------------------------------------------------------------------------

{- | Plutrach version of 'getNextProposalId'.

     @since 0.1.0
-}
pgetNextProposalId :: Term s (PProposalId :--> PProposalId)
pgetNextProposalId :: forall (s :: S). Term s (PProposalId :--> PProposalId)
pgetNextProposalId = (forall (s :: S). Term s (PProposalId :--> PProposalId))
-> Term s (PProposalId :--> PProposalId)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PProposalId :--> PProposalId))
 -> Term s (PProposalId :--> PProposalId))
-> (forall (s :: S). Term s (PProposalId :--> PProposalId))
-> Term s (PProposalId :--> PProposalId)
forall a b. (a -> b) -> a -> b
$ (Term s PProposalId -> Term s PProposalId)
-> Term s (PProposalId :--> PProposalId)
forall a (b :: PType) (s :: S) (c :: PType).
PLamN a b s =>
(Term s c -> a) -> Term s (c :--> b)
plam ((Term s PProposalId -> Term s PProposalId)
 -> Term s (PProposalId :--> PProposalId))
-> (Term s PProposalId -> Term s PProposalId)
-> Term s (PProposalId :--> PProposalId)
forall a b. (a -> b) -> a -> b
$ \(Term s PProposalId
-> forall (b :: PType). Term s (PInner PProposalId b)
forall (s :: S) (a :: PType).
Term s a -> forall (b :: PType). Term s (PInner a b)
pto -> forall (b :: PType). Term s (PInner PProposalId b)
pid) -> PProposalId s -> Term s PProposalId
forall (a :: PType) (s :: S). PCon a => a s -> Term s a
pcon (PProposalId s -> Term s PProposalId)
-> PProposalId s -> Term s PProposalId
forall a b. (a -> b) -> a -> b
$ Term s (PInteger @S) -> PProposalId s
forall (s :: S). Term s (PInteger @S) -> PProposalId s
PProposalId (Term s (PInteger @S) -> PProposalId s)
-> Term s (PInteger @S) -> PProposalId s
forall a b. (a -> b) -> a -> b
$ Term s (PInteger @S)
forall (b :: PType). Term s (PInner PProposalId b)
pid Term s (PInteger @S)
-> Term s (PInteger @S) -> Term s (PInteger @S)
forall a. Num a => a -> a -> a
+ Term s (PInteger @S)
1

{- | Get next proposal id.

     @since 0.1.0
-}
getNextProposalId :: ProposalId -> ProposalId
getNextProposalId :: ProposalId -> ProposalId
getNextProposalId (ProposalId Integer
pid) = Integer -> ProposalId
ProposalId (Integer -> ProposalId) -> Integer -> ProposalId
forall a b. (a -> b) -> a -> b
$ Integer
pid Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1

--------------------------------------------------------------------------------

{- | Check whether a particular 'PGovernorDatum' is well-formed.

     @since 0.1.0
-}
governorDatumValid :: Term s (PGovernorDatum :--> PBool)
governorDatumValid :: forall (s :: S). Term s (PGovernorDatum :--> PBool)
governorDatumValid = (forall (s :: S). Term s (PGovernorDatum :--> PBool))
-> Term s (PGovernorDatum :--> PBool)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PGovernorDatum :--> PBool))
 -> Term s (PGovernorDatum :--> PBool))
-> (forall (s :: S). Term s (PGovernorDatum :--> PBool))
-> Term s (PGovernorDatum :--> PBool)
forall a b. (a -> b) -> a -> b
$
  (Term s PGovernorDatum -> Term s PBool)
-> Term s (PGovernorDatum :--> PBool)
forall a (b :: PType) (s :: S) (c :: PType).
PLamN a b s =>
(Term s c -> a) -> Term s (c :--> b)
plam ((Term s PGovernorDatum -> Term s PBool)
 -> Term s (PGovernorDatum :--> PBool))
-> (Term s PGovernorDatum -> Term s PBool)
-> Term s (PGovernorDatum :--> PBool)
forall a b. (a -> b) -> a -> b
$ \Term s PGovernorDatum
datum -> TermCont @PBool s (Term s PBool) -> Term s PBool
forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont (TermCont @PBool s (Term s PBool) -> Term s PBool)
-> TermCont @PBool s (Term s PBool) -> Term s PBool
forall a b. (a -> b) -> a -> b
$ do
    HRec
  (BoundTerms
     (PFields (PAsData PProposalThresholds))
     (Bindings
        (PFields (PAsData PProposalThresholds))
        ((':)
           @Symbol
           "execute"
           ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
     s)
thresholds <-
      ((HRec
    (BoundTerms
       (PFields (PAsData PProposalThresholds))
       (Bindings
          (PFields (PAsData PProposalThresholds))
          ((':)
             @Symbol
             "execute"
             ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
       s)
  -> Term s PBool)
 -> Term s PBool)
-> TermCont
     @PBool
     s
     (HRec
        (BoundTerms
           (PFields (PAsData PProposalThresholds))
           (Bindings
              (PFields (PAsData PProposalThresholds))
              ((':)
                 @Symbol
                 "execute"
                 ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
           s))
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont (((HRec
     (BoundTerms
        (PFields (PAsData PProposalThresholds))
        (Bindings
           (PFields (PAsData PProposalThresholds))
           ((':)
              @Symbol
              "execute"
              ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
        s)
   -> Term s PBool)
  -> Term s PBool)
 -> TermCont
      @PBool
      s
      (HRec
         (BoundTerms
            (PFields (PAsData PProposalThresholds))
            (Bindings
               (PFields (PAsData PProposalThresholds))
               ((':)
                  @Symbol
                  "execute"
                  ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
            s)))
-> ((HRec
       (BoundTerms
          (PFields (PAsData PProposalThresholds))
          (Bindings
             (PFields (PAsData PProposalThresholds))
             ((':)
                @Symbol
                "execute"
                ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
          s)
     -> Term s PBool)
    -> Term s PBool)
-> TermCont
     @PBool
     s
     (HRec
        (BoundTerms
           (PFields (PAsData PProposalThresholds))
           (Bindings
              (PFields (PAsData PProposalThresholds))
              ((':)
                 @Symbol
                 "execute"
                 ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
           s))
forall a b. (a -> b) -> a -> b
$
        forall (fs :: [Symbol]) (a :: PType) (s :: S) (b :: PType)
       (ps :: [PLabeledType]) (bs :: [ToBind]).
(PDataFields a,
 (ps :: [PLabeledType]) ~ (PFields a :: [PLabeledType]),
 (bs :: [ToBind]) ~ (Bindings ps fs :: [ToBind]),
 BindFields ps bs) =>
Term s a -> (HRecOf a fs s -> Term s b) -> Term s b
pletFields @'["execute", "create", "vote"] (Term s (PAsData PProposalThresholds)
 -> (HRec
       (BoundTerms
          (PFields (PAsData PProposalThresholds))
          (Bindings
             (PFields (PAsData PProposalThresholds))
             ((':)
                @Symbol
                "execute"
                ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
          s)
     -> Term s PBool)
 -> Term s PBool)
-> Term s (PAsData PProposalThresholds)
-> (HRec
      (BoundTerms
         (PFields (PAsData PProposalThresholds))
         (Bindings
            (PFields (PAsData PProposalThresholds))
            ((':)
               @Symbol
               "execute"
               ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
         s)
    -> Term s PBool)
-> Term s PBool
forall a b. (a -> b) -> a -> b
$
          forall (name :: Symbol) (p :: PType) (s :: S) (a :: PType)
       (as :: [PLabeledType]) (n :: Nat) (b :: PType).
(PDataFields p,
 (as :: [PLabeledType]) ~ (PFields p :: [PLabeledType]),
 (n :: Nat) ~ (PLabelIndex name as :: Nat), KnownNat n,
 (a :: PType) ~ (PUnLabel (IndexList @PLabeledType n as) :: PType),
 PFromDataable a b) =>
Term s (p :--> b)
pfield @"proposalThresholds" Term s (PGovernorDatum :--> PAsData PProposalThresholds)
-> Term s PGovernorDatum -> Term s (PAsData PProposalThresholds)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PGovernorDatum
datum

    PDiscrete Term s (PTagged @Type GTTag (PInteger @S))
execute' <- Term s (PDiscrete @Type GTTag)
-> TermCont @PBool s (PDiscrete @Type GTTag s)
forall {r :: PType} (a :: PType) (s :: S).
PMatch a =>
Term s a -> TermCont @r s (a s)
pmatchC HRec
  (BoundTerms
     (PFields (PAsData PProposalThresholds))
     (Bindings
        (PFields (PAsData PProposalThresholds))
        ((':)
           @Symbol
           "execute"
           ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
     s)
thresholds.execute
    PDiscrete Term s (PTagged @Type GTTag (PInteger @S))
draft' <- Term s (PDiscrete @Type GTTag)
-> TermCont @PBool s (PDiscrete @Type GTTag s)
forall {r :: PType} (a :: PType) (s :: S).
PMatch a =>
Term s a -> TermCont @r s (a s)
pmatchC HRec
  (BoundTerms
     (PFields (PAsData PProposalThresholds))
     (Bindings
        (PFields (PAsData PProposalThresholds))
        ((':)
           @Symbol
           "execute"
           ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
     s)
thresholds.create
    PDiscrete Term s (PTagged @Type GTTag (PInteger @S))
vote' <- Term s (PDiscrete @Type GTTag)
-> TermCont @PBool s (PDiscrete @Type GTTag s)
forall {r :: PType} (a :: PType) (s :: S).
PMatch a =>
Term s a -> TermCont @r s (a s)
pmatchC HRec
  (BoundTerms
     (PFields (PAsData PProposalThresholds))
     (Bindings
        (PFields (PAsData PProposalThresholds))
        ((':)
           @Symbol
           "execute"
           ((':) @Symbol "create" ((':) @Symbol "vote" ('[] @Symbol)))))
     s)
thresholds.vote

    Term s (PInteger @S)
execute <- Term s (PInteger @S) -> TermCont @PBool s (Term s (PInteger @S))
forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont @r s (Term s a)
pletC (Term s (PInteger @S) -> TermCont @PBool s (Term s (PInteger @S)))
-> Term s (PInteger @S) -> TermCont @PBool s (Term s (PInteger @S))
forall a b. (a -> b) -> a -> b
$ Term s (PTagged @Type GTTag (PInteger @S) :--> PInteger @S)
forall (w :: PType -> PType) (a :: PType) (s :: S).
(PComonad w, PSubcategory w a) =>
Term s (w a :--> a)
pextract Term s (PTagged @Type GTTag (PInteger @S) :--> PInteger @S)
-> Term s (PTagged @Type GTTag (PInteger @S))
-> Term s (PInteger @S)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PTagged @Type GTTag (PInteger @S))
execute'
    Term s (PInteger @S)
draft <- Term s (PInteger @S) -> TermCont @PBool s (Term s (PInteger @S))
forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont @r s (Term s a)
pletC (Term s (PInteger @S) -> TermCont @PBool s (Term s (PInteger @S)))
-> Term s (PInteger @S) -> TermCont @PBool s (Term s (PInteger @S))
forall a b. (a -> b) -> a -> b
$ Term s (PTagged @Type GTTag (PInteger @S) :--> PInteger @S)
forall (w :: PType -> PType) (a :: PType) (s :: S).
(PComonad w, PSubcategory w a) =>
Term s (w a :--> a)
pextract Term s (PTagged @Type GTTag (PInteger @S) :--> PInteger @S)
-> Term s (PTagged @Type GTTag (PInteger @S))
-> Term s (PInteger @S)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PTagged @Type GTTag (PInteger @S))
draft'
    Term s (PInteger @S)
vote <- Term s (PInteger @S) -> TermCont @PBool s (Term s (PInteger @S))
forall {r :: PType} (s :: S) (a :: PType).
Term s a -> TermCont @r s (Term s a)
pletC (Term s (PInteger @S) -> TermCont @PBool s (Term s (PInteger @S)))
-> Term s (PInteger @S) -> TermCont @PBool s (Term s (PInteger @S))
forall a b. (a -> b) -> a -> b
$ Term s (PTagged @Type GTTag (PInteger @S) :--> PInteger @S)
forall (w :: PType -> PType) (a :: PType) (s :: S).
(PComonad w, PSubcategory w a) =>
Term s (w a :--> a)
pextract Term s (PTagged @Type GTTag (PInteger @S) :--> PInteger @S)
-> Term s (PTagged @Type GTTag (PInteger @S))
-> Term s (PInteger @S)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PTagged @Type GTTag (PInteger @S))
vote'

    Term s PBool -> TermCont @PBool s (Term s PBool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Term s PBool -> TermCont @PBool s (Term s PBool))
-> Term s PBool -> TermCont @PBool s (Term s PBool)
forall a b. (a -> b) -> a -> b
$
      (Term s PBool -> Term s PBool -> Term s PBool)
-> [Term s PBool] -> Term s PBool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldr1
        Term s PBool -> Term s PBool -> Term s PBool
forall (s :: S). Term s PBool -> Term s PBool -> Term s PBool
(#&&)
        [ Term s (PString @S) -> Term s PBool -> Term s PBool
forall (s :: S).
Term s (PString @S) -> Term s PBool -> Term s PBool
ptraceIfFalse Term s (PString @S)
"Execute threshold is less than or equal to" (Term s PBool -> Term s PBool) -> Term s PBool -> Term s PBool
forall a b. (a -> b) -> a -> b
$ Term s (PInteger @S)
0 Term s (PInteger @S) -> Term s (PInteger @S) -> Term s PBool
forall (t :: PType) (s :: S).
POrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s (PInteger @S)
execute
        , Term s (PString @S) -> Term s PBool -> Term s PBool
forall (s :: S).
Term s (PString @S) -> Term s PBool -> Term s PBool
ptraceIfFalse Term s (PString @S)
"Draft threshold is less than or equal to " (Term s PBool -> Term s PBool) -> Term s PBool -> Term s PBool
forall a b. (a -> b) -> a -> b
$ Term s (PInteger @S)
0 Term s (PInteger @S) -> Term s (PInteger @S) -> Term s PBool
forall (t :: PType) (s :: S).
POrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s (PInteger @S)
draft
        , Term s (PString @S) -> Term s PBool -> Term s PBool
forall (s :: S).
Term s (PString @S) -> Term s PBool -> Term s PBool
ptraceIfFalse Term s (PString @S)
"Vote threshold is less than or equal to " (Term s PBool -> Term s PBool) -> Term s PBool -> Term s PBool
forall a b. (a -> b) -> a -> b
$ Term s (PInteger @S)
0 Term s (PInteger @S) -> Term s (PInteger @S) -> Term s PBool
forall (t :: PType) (s :: S).
POrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s (PInteger @S)
vote
        , Term s (PString @S) -> Term s PBool -> Term s PBool
forall (s :: S).
Term s (PString @S) -> Term s PBool -> Term s PBool
ptraceIfFalse Term s (PString @S)
"Draft threshold is less than vote threshold" (Term s PBool -> Term s PBool) -> Term s PBool -> Term s PBool
forall a b. (a -> b) -> a -> b
$ Term s (PInteger @S)
draft Term s (PInteger @S) -> Term s (PInteger @S) -> Term s PBool
forall (t :: PType) (s :: S).
POrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s (PInteger @S)
vote
        , Term s (PString @S) -> Term s PBool -> Term s PBool
forall (s :: S).
Term s (PString @S) -> Term s PBool -> Term s PBool
ptraceIfFalse Term s (PString @S)
"Execute threshold is less than vote threshold" (Term s PBool -> Term s PBool) -> Term s PBool -> Term s PBool
forall a b. (a -> b) -> a -> b
$ Term s (PInteger @S)
vote Term s (PInteger @S) -> Term s (PInteger @S) -> Term s PBool
forall (t :: PType) (s :: S).
POrd t =>
Term s t -> Term s t -> Term s PBool
#< Term s (PInteger @S)
execute
        ]