remove TreasuryDatum, PTryFrom for PTreasuryRedeemer

agora/Agora/Treasury.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 {- |
 Module: Agora.Treasury
 Maintainer: jack@mlabs.city
@@ -8,23 +10,58 @@ treasury.
 -}
 module Agora.Treasury (module Agora.Treasury) where
 
+import Agora.AuthorityToken (singleAuthorityTokenBurned)
+import Agora.Utils (passert)
 import GHC.Generics qualified as GHC
 import Generics.SOP
+import Plutarch.Api.V1 (PValidator)
 import Plutarch.Api.V1.Contexts (PScriptPurpose (PMinting))
-import Plutarch.Api.V1.Value (PCurrencySymbol, PValue)
+import Plutarch.Api.V1.Value (PValue)
 import Plutarch.DataRepr (
-  PDataFields,
+  DerivePConstantViaData (..),
   PIsDataReprInstances (PIsDataReprInstances),
  )
+import Plutarch.Lift (PConstantDecl (..), PLifted (..), PUnsafeLiftDecl)
 import Plutarch.Monadic qualified as P
+import Plutarch.TryFrom (PTryFrom, ptryFrom)
 import Plutus.V1.Ledger.Value (CurrencySymbol)
+import PlutusTx qualified
 
 --------------------------------------------------------------------------------
 
-import Agora.AuthorityToken (singleAuthorityTokenBurned)
-import Agora.Utils (passert)
-import Plutarch.Api.V1 (PValidator)
-import Plutarch.Unsafe (punsafeCoerce)
+data TreasuryRedeemer
+  = SpendTreasuryGAT
+  deriving stock (Eq, Show, GHC.Generic)
+
+PlutusTx.makeIsDataIndexed
+  ''TreasuryRedeemer
+  [ ('SpendTreasuryGAT, 0)
+  ]
+
+--------------------------------------------------------------------------------
+
+{- | Plutarch level type representing valid redeemers of the
+     treasury.
+-}
+newtype PTreasuryRedeemer (s :: S)
+  = -- | Alters treasury parameters, subject to the burning of a
+    --   governance authority token.
+    PSpendTreasuryGAT (Term s (PDataRecord '[]))
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic, PIsDataRepr)
+  deriving
+    (PlutusType, PIsData)
+    via PIsDataReprInstances PTreasuryRedeemer
+
+deriving via
+  PAsData (PIsDataReprInstances PTreasuryRedeemer)
+  instance
+    PTryFrom PData (PAsData PTreasuryRedeemer)
+
+instance PUnsafeLiftDecl PTreasuryRedeemer where type PLifted PTreasuryRedeemer = TreasuryRedeemer
+deriving via (DerivePConstantViaData TreasuryRedeemer PTreasuryRedeemer) instance (PConstantDecl TreasuryRedeemer)
+
+--------------------------------------------------------------------------------
 
 {- | Validator ensuring that transactions consuming the treasury
      do so in a valid manner.
@@ -32,12 +69,8 @@ import Plutarch.Unsafe (punsafeCoerce)
 treasuryValidator ::
   CurrencySymbol ->
   ClosedTerm PValidator
-treasuryValidator gatCs' = plam $ \datum redeemer ctx' -> P.do
-  -- TODO: Use PTryFrom
-  let treasuryRedeemer :: Term _ (PAsData PTreasuryRedeemer)
-      treasuryRedeemer = punsafeCoerce redeemer
-      _treasuryDatum' :: Term _ (PAsData PTreasuryDatum)
-      _treasuryDatum' = punsafeCoerce datum
+treasuryValidator gatCs' = plam $ \_datum redeemer ctx' -> P.do
+  (treasuryRedeemer, _) <- ptryFrom redeemer
 
   -- plet required fields from script context.
   ctx <- pletFields @["txInfo", "purpose"] ctx'
@@ -46,7 +79,7 @@ treasuryValidator gatCs' = plam $ \datum redeemer ctx' -> P.do
   PMinting _ <- pmatch ctx.purpose
 
   -- Ensure redeemer type is valid.
-  PAlterTreasuryParams _ <- pmatch $ pfromData treasuryRedeemer
+  PSpendTreasuryGAT _ <- pmatch $ pfromData treasuryRedeemer
 
   -- Get the minted value from txInfo.
   txInfo' <- plet ctx.txInfo
@@ -59,37 +92,3 @@ treasuryValidator gatCs' = plam $ \datum redeemer ctx' -> P.do
   passert "A single authority token has been burned" $ singleAuthorityTokenBurned gatCs txInfo' mint
 
   popaque $ pconstant ()
-
-{- | Plutarch level type representing datum of the treasury.
-     Contains:
-
-       - @stateThread@ representing the asset class of the
-         treasury's state thread token.
--}
-newtype PTreasuryDatum (s :: S)
-  = PTreasuryDatum
-      ( Term
-          s
-          ( PDataRecord
-              '[ "stateThread" ':= PCurrencySymbol
-               ]
-          )
-      )
-  deriving stock (GHC.Generic)
-  deriving anyclass (Generic, PIsDataRepr)
-  deriving
-    (PlutusType, PIsData, PDataFields)
-    via PIsDataReprInstances PTreasuryDatum
-
-{- | Plutarch level type representing valid redeemers of the
-     treasury.
--}
-newtype PTreasuryRedeemer (s :: S)
-  = -- | Alters treasury parameters, subject to the burning of a
-    --   governance authority token.
-    PAlterTreasuryParams (Term s (PDataRecord '[]))
-  deriving stock (GHC.Generic)
-  deriving anyclass (Generic, PIsDataRepr)
-  deriving
-    (PlutusType, PIsData)
-    via PIsDataReprInstances PTreasuryRedeemer