Update types so that ply envlope can be used in Purescript

agora/Agora/AuthorityToken.hs

@@ -146,7 +146,7 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
 
      @since 0.1.0
 -}
-authorityTokenPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy)
+authorityTokenPolicy :: ClosedTerm (PAsData (PTagged GovernorSTTag PAssetClassData) :--> PMintingPolicy)
 authorityTokenPolicy =
   plam $ \gstAssetClass _redeemer ctx -> unTermCont $ do
     ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx
@@ -176,7 +176,7 @@ authorityTokenPolicy =
                     passertPJust
                       # "GST should move"
                       #$ presolveGovernorRedeemer
-                      # (ptoScottEncodingT # gstAssetClass)
+                      # (ptoScottEncodingT # pfromData gstAssetClass)
                       # pfromData txInfoF.inputs
                       # txInfoF.redeemers
               pguardC "Governor redeemr correct" $

agora/Agora/Bootstrap.hs

@@ -4,7 +4,7 @@
 
      Initialize a governance system
 -}
-module Agora.Bootstrap (agoraScripts, alwaysSucceedsPolicyRoledScript) where
+module Agora.Bootstrap (agoraScripts, agoraScripts', alwaysSucceedsPolicyRoledScript) where
 
 import Agora.AuthorityToken (authorityTokenPolicy)
 import Agora.Effect.GovernorMutation (mutateGovernorValidator)
@@ -53,6 +53,30 @@ agoraScripts conf =
       (Text, TypedScriptEnvelope)
     envelope d t = (d, either (error . unpack) id $ mkEnvelope conf d t)
 
+agoraScripts' :: Config -> Either Text [TypedScriptEnvelope]
+agoraScripts' conf =
+  sequenceA
+    [ envelope "agora:governorPolicy" governorPolicy
+    , envelope "agora:governorValidator" governorValidator
+    , envelope "agora:stakePolicy" stakePolicy
+    , envelope "agora:stakeValidator" stakeValidator
+    , envelope "agora:proposalPolicy" proposalPolicy
+    , envelope "agora:proposalValidator" proposalValidator
+    , envelope "agora:treasuryValidator" treasuryValidator
+    , envelope "agora:authorityTokenPolicy" authorityTokenPolicy
+    , envelope "agora:noOpValidator" noOpValidator
+    , envelope "agora:treasuryWithdrawalValidator" treasuryWithdrawalValidator
+    , envelope "agora:mutateGovernorValidator" mutateGovernorValidator
+    ]
+  where
+    envelope ::
+      forall (pt :: S -> Type).
+      TypedWriter pt =>
+      Text ->
+      ClosedTerm pt ->
+      Either Text TypedScriptEnvelope
+    envelope = mkEnvelope conf
+
 {- | A minting policy that always succeeds.
 
   NOTE(Emily, Jan 3rd 2023): Adding this in here because it's useful for testnet GT.

agora/Agora/Effect.hs

@@ -38,10 +38,11 @@ makeEffect ::
     Term s (PAsData PTxInfo) ->
     Term s POpaque
   ) ->
-  Term s (PTagged AuthorityTokenTag PCurrencySymbol) ->
+  Term s (PAsData (PTagged AuthorityTokenTag PCurrencySymbol)) ->
   Term s PValidator
-makeEffect f atSymbol =
+makeEffect f atSymbol' =
   plam $ \datum _redeemer ctx' -> unTermCont $ do
+    atSymbol <- pletC $ pfromData atSymbol'
     ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
 
     -- Convert input datum, PData, into desierable type

agora/Agora/Effect/GovernorMutation.hs

@@ -151,9 +151,9 @@ deriving anyclass instance PTryFrom PData PMutateGovernorDatum
 -}
 mutateGovernorValidator ::
   ClosedTerm
-    ( PScriptHash
-        :--> PTagged GovernorSTTag PCurrencySymbol
-        :--> PTagged AuthorityTokenTag PCurrencySymbol
+    ( PAsData PScriptHash
+        :--> PAsData (PTagged GovernorSTTag PCurrencySymbol)
+        :--> PAsData (PTagged AuthorityTokenTag PCurrencySymbol)
         :--> PValidator
     )
 mutateGovernorValidator =
@@ -189,7 +189,7 @@ mutateGovernorValidator =
                         (#&&)
                         [ ptraceIfFalse "Governor UTxO should carry GST" $
                             ptaggedSymbolValueOf
-                              # gstSymbol
+                              # pfromData gstSymbol
                               # (pfield @"value" # inputF.resolved)
                               #== 1
                         , ptraceIfFalse "Can only modify the pinned governor" $
@@ -200,7 +200,7 @@ mutateGovernorValidator =
                                     #$ pscriptHashFromAddress
                                     #$ pfield @"address"
                                     # inputF.resolved
-                             in inputScriptHash #== govValidatorHash
+                             in inputScriptHash #== pfromData govValidatorHash
                         ]
                  in isGovernorInput
             )

agora/Agora/Effect/NoOp.hs

@@ -40,7 +40,7 @@ instance PTryFrom PData (PAsData PNoOp)
 
      @since 1.0.0
 -}
-noOpValidator :: ClosedTerm (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator)
+noOpValidator :: ClosedTerm (PAsData (PTagged AuthorityTokenTag PCurrencySymbol) :--> PValidator)
 noOpValidator = plam $
   makeEffect $
     \_ (_datum :: Term s (PAsData PNoOp)) _ _ -> popaque (pconstant ())

agora/Agora/Effect/TreasuryWithdrawal.hs

@@ -134,7 +134,7 @@ instance PTryFrom PData PTreasuryWithdrawalDatum
 -}
 treasuryWithdrawalValidator ::
   forall (s :: S).
-  Term s (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator)
+  Term s (PAsData (PTagged AuthorityTokenTag PCurrencySymbol) :--> PValidator)
 treasuryWithdrawalValidator = plam $
   makeEffect $
     \_cs (datum :: Term _ PTreasuryWithdrawalDatum) effectInputRef txInfo -> unTermCont $ do

agora/Agora/Governor/Scripts.hs

@@ -102,7 +102,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
 
   @since 1.0.0
 -}
-governorPolicy :: ClosedTerm (PTxOutRef :--> PMintingPolicy)
+governorPolicy :: ClosedTerm (PAsData PTxOutRef :--> PMintingPolicy)
 governorPolicy =
   plam $ \initialSpend _ ctx -> unTermCont $ do
     PMinting ((pfield @"_0" #) -> gstSymbol) <-
@@ -121,7 +121,7 @@ governorPolicy =
         txInfo
 
     pguardC "Referenced utxo should be spent" $
-      pisUTXOSpent # initialSpend # txInfoF.inputs
+      pisUTXOSpent # pfromData initialSpend # txInfoF.inputs
 
     pguardC "Exactly one token should be minted" $
       let vMap = pfromData $ pto txInfoF.mint
@@ -257,15 +257,17 @@ governorPolicy =
 governorValidator ::
   -- | Lazy precompiled scripts.
   ClosedTerm
-    ( PScriptHash
-        :--> PTagged StakeSTTag PAssetClassData
-        :--> PTagged GovernorSTTag PCurrencySymbol
-        :--> PTagged ProposalSTTag PCurrencySymbol
-        :--> PTagged AuthorityTokenTag PCurrencySymbol
+    ( PAsData PScriptHash
+        :--> PAsData (PTagged StakeSTTag PAssetClassData)
+        :--> PAsData (PTagged GovernorSTTag PCurrencySymbol)
+        :--> PAsData (PTagged ProposalSTTag PCurrencySymbol)
+        :--> PAsData (PTagged AuthorityTokenTag PCurrencySymbol)
         :--> PValidator
     )
 governorValidator =
-  plam $ \proposalScriptHash sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do
+  plam $ \proposalScriptHash sstClass gstSymbol pstSymbol' atSymbol' datum redeemer ctx -> unTermCont $ do
+    atSymbol <- pletC $ pfromData atSymbol'
+    pstSymbol <- pletC $ pfromData pstSymbol'
     ctxF <- pletAllC ctx
     txInfo <- pletC $ pfromData ctxF.txInfo
     txInfoF <-
@@ -314,7 +316,7 @@ governorValidator =
                               outputF.address
                               governorInputF.address
                         , ptraceIfFalse "Has governor ST" $
-                            ptaggedSymbolValueOf # gstSymbol # outputF.value #== 1
+                            ptaggedSymbolValueOf # pfromData gstSymbol # outputF.value #== 1
                         ]
 
                     datum =
@@ -339,7 +341,7 @@ governorValidator =
           flip (pletFields @'["value", "datum", "address"]) $ \txOutF ->
             let isProposalUTxO =
                   (pfromJust #$ pscriptHashFromAddress # pfromData txOutF.address)
-                    #== proposalScriptHash
+                    #== pfromData proposalScriptHash
                     #&& passetClassValueOf
                     # pstClass
                     # txOutF.value
@@ -396,7 +398,7 @@ governorValidator =
                   # "Stake input should present"
                   #$ pfindJust
                   # ( presolveStakeInputDatum
-                        # (ptoScottEncodingT # sstClass)
+                        # (ptoScottEncodingT # pfromData sstClass)
                         # txInfoF.datums
                     )
                   # pfromData txInfoF.inputs

agora/Agora/Proposal/Scripts.hs

@@ -113,7 +113,7 @@ import "plutarch-extra" Plutarch.Extra.Map (pupdate)
 
      @since 1.0.0
 -}
-proposalPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy)
+proposalPolicy :: ClosedTerm (PAsData (PTagged GovernorSTTag PAssetClassData) :--> PMintingPolicy)
 proposalPolicy =
   plam $ \gstAssetClass _redeemer ctx -> unTermCont $ do
     ctxF <- pletAllC ctx
@@ -137,7 +137,7 @@ proposalPolicy =
           passertPJust
             # "GST should move"
             #$ presolveGovernorRedeemer
-            # (ptoScottEncodingT # gstAssetClass)
+            # (ptoScottEncodingT # pfromData gstAssetClass)
             # pfromData txInfoF.inputs
             # txInfoF.redeemers
 
@@ -224,10 +224,10 @@ instance DerivePlutusType PStakeInputsContext where
 -}
 proposalValidator ::
   ClosedTerm
-    ( PTagged StakeSTTag PAssetClassData
-        :--> PTagged GovernorSTTag PCurrencySymbol
-        :--> PTagged ProposalSTTag PCurrencySymbol
-        :--> PInteger
+    ( PAsData (PTagged StakeSTTag PAssetClassData)
+        :--> PAsData (PTagged GovernorSTTag PCurrencySymbol)
+        :--> PAsData (PTagged ProposalSTTag PCurrencySymbol)
+        :--> PAsData PInteger
         :--> PValidator
     )
 proposalValidator =
@@ -289,7 +289,7 @@ proposalValidator =
                               outputF.address
                               proposalInputF.address
                         , ptraceIfFalse "Has proposal ST" $
-                            ptaggedSymbolValueOf # pstSymbol # outputF.value #== 1
+                            ptaggedSymbolValueOf # pfromData pstSymbol # outputF.value #== 1
                         ]
 
                     handleProposalUTxO =
@@ -335,7 +335,7 @@ proposalValidator =
     resolveStakeInputDatum <-
       pletC $
         presolveStakeInputDatum
-          # (ptoScottEncodingT # sstClass)
+          # (ptoScottEncodingT # pfromData sstClass)
           # txInfoF.datums
 
     spendStakes' :: Term _ ((PStakeInputsContext :--> PUnit) :--> PUnit) <-
@@ -450,7 +450,7 @@ proposalValidator =
                     # proposalInputDatumF.cosigners
 
             pguardC "Less cosigners than maximum limit" $
-              plength # updatedSigs #<= maximumCosigners
+              plength # updatedSigs #<= pfromData maximumCosigners
 
             pguardC "Meet minimum GT requirement" $
               pfromData thresholdsF.cosign #<= stakeF.stakedAmount
@@ -741,7 +741,7 @@ proposalValidator =
                                   . (pfield @"resolved" #) ->
                                   value
                                 ) ->
-                                  ptaggedSymbolValueOf # gstSymbol # value #== 1
+                                  ptaggedSymbolValueOf # pfromData gstSymbol # value #== 1
                             )
                           # pfromData txInfoF.inputs
 

agora/Agora/SafeMoney.hs

@@ -22,37 +22,37 @@ import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
 
      @since 0.1.0
 -}
-data GTTag
+type GTTag = "GTTag"
 
 {- | ADA.
 
      @since 0.1.0
 -}
-data ADATag
+type ADATag = "ADATag"
 
 {- | Governor ST token.
 
      @since 0.1.0
 -}
-data GovernorSTTag
+type GovernorSTTag = "GovernorSTTag"
 
 {- | Stake ST token.
 
      @since 0.1.0
 -}
-data StakeSTTag
+type StakeSTTag = "StakeSTTag"
 
 {- | Proposal ST token.
 
      @since 0.1.0
 -}
-data ProposalSTTag
+type ProposalSTTag = "ProposalSTTag"
 
 {- | Authority token.
 
      @since 1.0.0
 -}
-data AuthorityTokenTag
+type AuthorityTokenTag = "AuthorityTokenTag"
 
 {- | Resolves ada tags.
 

agora/Agora/Stake/Scripts.hs

@@ -138,7 +138,7 @@ import Prelude hiding (Num ((+)))
    @since 1.0.0
 -}
 stakePolicy ::
-  ClosedTerm (PTagged GTTag PAssetClassData :--> PMintingPolicy)
+  ClosedTerm (PAsData (PTagged GTTag PAssetClassData) :--> PMintingPolicy)
 stakePolicy =
   plam $ \gtClass _redeemer ctx' -> unTermCont $ do
     ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
@@ -207,7 +207,7 @@ stakePolicy =
                   (#&&)
                   [ ptraceIfFalse "Stake ouput has expected amount of stake token" $
                       passetClassValueOfT
-                        # (ptoScottEncodingT # gtClass)
+                        # (ptoScottEncodingT # pfromData gtClass)
                         # outputF.value
                         #== pfromData datumF.stakedAmount
                   , ptraceIfFalse "Stake Owner should sign the transaction" $
@@ -656,9 +656,9 @@ mkStakeValidator impl sstSymbol pstClass gtClass =
 -}
 stakeValidator ::
   ClosedTerm
-    ( PTagged StakeSTTag PCurrencySymbol
-        :--> PTagged ProposalSTTag PAssetClassData
-        :--> PTagged GTTag PAssetClassData
+    ( PAsData (PTagged StakeSTTag PCurrencySymbol)
+        :--> PAsData (PTagged ProposalSTTag PAssetClassData)
+        :--> PAsData (PTagged GTTag PAssetClassData)
         :--> PValidator
     )
 stakeValidator =
@@ -673,6 +673,6 @@ stakeValidator =
           , onClearDelegate = pclearDelegate
           }
       )
-      sstSymbol
-      (ptoScottEncodingT # pstClass)
-      (ptoScottEncodingT # gstClass)
+      (pfromData sstSymbol)
+      (ptoScottEncodingT # pfromData pstClass)
+      (ptoScottEncodingT # pfromData gstClass)

agora/Agora/Treasury.hs

@@ -30,7 +30,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletFieldsC, pm
      @since 1.0.0
 -}
 treasuryValidator ::
-  ClosedTerm (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator)
+  ClosedTerm (PAsData (PTagged AuthorityTokenTag PCurrencySymbol) :--> PValidator)
 treasuryValidator = plam $ \atSymbol _ _ ctx' -> unTermCont $ do
   -- plet required fields from script context.
   ctx <- pletFieldsC @["txInfo", "purpose"] ctx'
@@ -44,6 +44,6 @@ treasuryValidator = plam $ \atSymbol _ _ ctx' -> unTermCont $ do
       mint = txInfo.mint
 
   pguardC "A single authority token has been burned" $
-    singleAuthorityTokenBurned atSymbol txInfo.inputs mint
+    singleAuthorityTokenBurned (pfromData atSymbol) txInfo.inputs mint
 
   pure . popaque $ pconstant ()