Merge pull request #157 from Liqwid-Labs/connor/effect-ref-script

Store `ScriptHash`es in the effects
2022-08-17 12:52:37 +08:00 · 2022-08-17 12:52:37 +08:00 · 3ea03a6665
commit 3ea03a6665
parent ba10132e1e 6d4fe92b30
12 changed files with 897 additions and 574 deletions
--- a/agora-specs/Sample/Proposal/Advance.hs
+++ b/agora-specs/Sample/Proposal/Advance.hs
@ -44,6 +44,7 @@ import Agora.Governor (
 )
 import Agora.Proposal (
  ProposalDatum (..),
+  ProposalEffectGroup,
  ProposalId (ProposalId),
  ProposalRedeemer (AdvanceProposal),
  ProposalStatus (..),
@ -67,10 +68,11 @@ import Agora.Stake (
  StakeRedeemer (WitnessStake),
 )
 import Agora.Utils (validatorHashToTokenName)
+import Control.Applicative (liftA2)
 import Control.Monad.State (execState, modify, when)
 import Data.Default (def)
-import Data.List (sort)
-import Data.Maybe (catMaybes, fromJust)
+import Data.List (singleton, sort)
+import Data.Maybe (fromJust)
 import Data.Tagged (Tagged (..), untag)
 import Plutarch.Context (
  input,
@ -81,6 +83,7 @@ import Plutarch.Context (
  timeRange,
  withDatum,
  withRef,
+  withReferenceScript,
  withValue,
 )
 import Plutarch.Lift (PLifted, PUnsafeLiftDecl)
@ -91,6 +94,7 @@ import PlutusLedgerApi.V2 (
  POSIXTime,
  POSIXTimeRange,
  PubKeyHash,
+  ScriptHash,
  TxOutRef (TxOutRef),
  ValidatorHash,
 )
@ -127,6 +131,7 @@ import Test.Util (
  mkMinting,
  mkSpending,
  pubKeyHashes,
+  scriptHashes,
  sortValue,
  toDatum,
  updateMap,
@ -144,7 +149,7 @@ data ParameterBundle = ParameterBundle
  , governorParameters :: Maybe GovernorParameters
  -- ^ Parameters related to GST moving. If set to 'Nothing', the GST won't
  --   be moved, thus the governor validator won't be run in 'mkTestTree'.
-  , authorityTokenParameters :: Maybe AuthorityTokenParameters
+  , authorityTokenParameters :: [AuthorityTokenParameters]
  -- ^ Parameters related to GAT minting. If set to 'Nothing', no GAT will
  --     be minted, thus the GAT minting policy won't be run in 'mkTestTree'.
  , transactionTimeRange :: POSIXTimeRange
@ -171,10 +176,12 @@ data AuthorityTokenParameters = forall
  , PIsData pdatum
  ) =>
  AuthorityTokenParameters
-  { mintGATsFor :: [ValidatorHash]
+  { mintGATsFor :: ValidatorHash
  -- ^ GATs will be minted and sent to the given group of effects.
  , carryDatum :: Maybe datum
  -- ^ The datum that GAT UTxOs will be carrying.
+  , carryRefScript :: Maybe ScriptHash
+  -- ^ The reference script that GAT UTxOs will be carrying.
  , invalidTokenName :: Bool
  -- ^ If set to true, GATs won't be tagged by their corresponding effect
  --    hashes.
@ -193,7 +200,7 @@ data ProposalParameters = ProposalParameters
  -- ^ What status is the proposal advancing from
  , toStatus :: ProposalStatus
  -- ^ What status is the proposal advancing to
-  , effectList :: [AssocMap.Map ValidatorHash DatumHash]
+  , effectList :: [ProposalEffectGroup]
  -- ^ The effect groups of the proposal. A neutral effect group is not
  --    required here.
  , winnerAndVotes :: Maybe (Winner, Integer)
@ -244,7 +251,7 @@ outcomeIdxToResultTag = ResultTag . fromIntegral
 -- | Add a neutral effect group and allocate result tags for the effect groups.
 mkEffects ::
  ProposalParameters ->
-  AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
+  AssocMap.Map ResultTag ProposalEffectGroup
 mkEffects ps =
  let resultTags = map ResultTag [0 ..]
      neutralEffect = AssocMap.empty
@ -492,27 +499,24 @@ mkAuthorityTokenBuilder ::
  CombinableBuilder b =>
  AuthorityTokenParameters ->
  b
-mkAuthorityTokenBuilder (AuthorityTokenParameters es mdt invalidTokenName) =
-  foldMap perEffect es
-  where
-    perEffect :: ValidatorHash -> b
-    perEffect vh =
-      let tn =
-            if invalidTokenName
-              then ""
-              else validatorHashToTokenName vh
-          ac = AssetClass (authorityTokenSymbol, tn)
-          minted = Value.assetClassValue ac 1
-          value = sortValue $ minAda <> minted
-       in mconcat
-            [ mint minted
-            , output $
-                mconcat
-                  [ script vh
-                  , maybe mempty withDatum mdt
-                  , withValue value
-                  ]
-            ]
+mkAuthorityTokenBuilder ps@AuthorityTokenParameters {carryDatum} =
+  let tn =
+        if ps.invalidTokenName
+          then ""
+          else validatorHashToTokenName ps.mintGATsFor
+      ac = AssetClass (authorityTokenSymbol, tn)
+      minted = Value.assetClassValue ac 1
+      value = sortValue $ minAda <> minted
+   in mconcat
+        [ mint minted
+        , output $
+            mconcat
+              [ script ps.mintGATsFor
+              , maybe mempty withDatum carryDatum
+              , maybe mempty withReferenceScript ps.carryRefScript
+              , withValue value
+              ]
+        ]

 -- | The redeemer used while running the authority token policy.
 authorityTokenRedeemer :: ()
@ -532,7 +536,7 @@ advance pb =
        [ mkProposalBuilder pb.proposalParameters
        , mkStakeBuilder pb.stakeParameters
        , mkBuilderMaybe mkGovernorBuilder pb.governorParameters
-        , mkBuilderMaybe mkAuthorityTokenBuilder pb.authorityTokenParameters
+        , foldMap mkAuthorityTokenBuilder pb.authorityTokenParameters
        , timeRange pb.transactionTimeRange
        , maybe mempty signedWith pb.extraSignature
        ]
@ -548,14 +552,13 @@ mkTestTree ::
  Validity ->
  SpecificationTree
 mkTestTree name pb val =
-  group name $ catMaybes [proposal, stake, governor, authority]
+  group name $ mconcat [proposal, stake, governor, authority]
  where
    spend = mkSpending advance pb
-    mint = mkMinting advance pb

    proposal =
      let proposalInputDatum = mkProposalInputDatum pb.proposalParameters
-       in Just $
+       in singleton $
            testValidator
              val.forProposalValidator
              "proposal"
@ -566,7 +569,7 @@ mkTestTree name pb val =

    stake =
      let idx = 0
-       in Just $
+       in singleton $
            testValidator
              val.forStakeValidator
              "stake"
@ -577,23 +580,27 @@ mkTestTree name pb val =
              )

    governor =
-      testValidator
-        (fromJust val.forGovernorValidator)
-        "governor"
-        agoraScripts.compiledGovernorValidator
-        governorInputDatum
-        governorRedeemer
-        (spend governorRef)
-        <$ pb.governorParameters
+      maybe [] singleton $
+        testValidator
+          (fromJust val.forGovernorValidator)
+          "governor"
+          agoraScripts.compiledGovernorValidator
+          governorInputDatum
+          governorRedeemer
+          (spend governorRef)
+          <$ pb.governorParameters

-    authority =
-      testPolicy
-        (fromJust val.forAuthorityTokenPolicy)
-        "authority"
-        agoraScripts.compiledAuthorityTokenPolicy
-        authorityTokenRedeemer
-        (mint authorityTokenSymbol)
-        <$ (pb.authorityTokenParameters)
+    authority = case pb.authorityTokenParameters of
+      [] -> []
+      _ ->
+        singleton
+          ( testPolicy
+              (fromJust val.forAuthorityTokenPolicy)
+              "authority"
+              agoraScripts.compiledAuthorityTokenPolicy
+              authorityTokenRedeemer
+              (mkMinting advance pb authorityTokenSymbol)
+          )

 {- | Create a test tree that runs a bunch of parameter bundles. These bundles
      should have the same validity.
@ -725,14 +732,26 @@ dummyDatumHash :: DatumHash
 dummyDatumHash = datumHash $ toDatum dummyDatum

 -- | Create given number of effect groups. Each group will have 3 effects.
-mkMockEffects :: Int -> [AssocMap.Map ValidatorHash DatumHash]
-mkMockEffects =
-  flip
-    take
-    ( AssocMap.fromList
-        . flip zip (repeat dummyDatumHash)
-        <$> groupsOfN 3 validatorHashes
-    )
+mkMockEffects :: Bool -> Int -> [ProposalEffectGroup]
+mkMockEffects useRefScript n = effects
+  where
+    effectsPerGroup = 3
+
+    mkRefScripts True = Just <$> scriptHashes
+    mkRefScripts False = repeat Nothing
+    refScripts = mkRefScripts useRefScript
+
+    datums = repeat dummyDatumHash
+
+    effectMetadata = zip datums refScripts
+    effectScripts = validatorHashes
+
+    effects =
+      take n $
+        AssocMap.fromList
+          <$> groupsOfN
+            effectsPerGroup
+            (zip effectScripts effectMetadata)

 numberOfVotesThatExceedsTheMinimumRequirement :: Integer
 numberOfVotesThatExceedsTheMinimumRequirement =
@ -767,16 +786,18 @@ defaultWinnerIdx = 0
 mkValidToNextStateBundle ::
  -- | Number of cosigners.
  Word ->
-  -- | Number of effects
+  -- | Number of effects.
  Word ->
+  -- | Toggle the referenc script in GAT UTXO.
+  Bool ->
  -- | The initial proposal state, should not be 'Finished'.
  ProposalStatus ->
  ParameterBundle
-mkValidToNextStateBundle _ _ Finished =
+mkValidToNextStateBundle _ _ _ Finished =
  error "Cannot advance from Finished"
-mkValidToNextStateBundle nCosigners nEffects from =
+mkValidToNextStateBundle nCosigners nEffects refScript from =
  let next = getNextState from
-      effects = mkMockEffects $ fromIntegral nEffects
+      effects = mkMockEffects refScript $ fromIntegral nEffects
      winner = defaultWinnerIdx

      template =
@ -800,7 +821,7 @@ mkValidToNextStateBundle nCosigners nEffects from =
                , invalidStakeOutputDatum = False
                }
          , governorParameters = Nothing
-          , authorityTokenParameters = Nothing
+          , authorityTokenParameters = []
          , transactionTimeRange = mkInTimeTimeRange from
          , extraSignature = Just signer
          }
@ -830,18 +851,24 @@ mkValidToNextStateBundle nCosigners nEffects from =
        when (from == Locked) $
          modify $ \b ->
            let aut =
-                  AuthorityTokenParameters
-                    { mintGATsFor = AssocMap.keys $ effects !! winner
-                    , carryDatum = Just dummyDatum
-                    , invalidTokenName = False
-                    }
+                  AssocMap.elems $
+                    AssocMap.mapWithKey
+                      ( \vh (_, refScript) ->
+                          AuthorityTokenParameters
+                            { mintGATsFor = vh
+                            , carryDatum = Just dummyDatum
+                            , carryRefScript = refScript
+                            , invalidTokenName = False
+                            }
+                      )
+                      (effects !! winner)
                gov =
                  GovernorParameters
                    { invalidGovernorOutputDatum = False
                    }
             in b
                  { governorParameters = Just gov
-                  , authorityTokenParameters = Just aut
+                  , authorityTokenParameters = aut
                  }
   in execState modifyTemplate template

@ -852,11 +879,10 @@ mkValidToNextStateBundles ::
  Word ->
  [ParameterBundle]
 mkValidToNextStateBundles nCosigners nEffects =
-  mkValidToNextStateBundle nCosigners nEffects
-    <$> [ Draft
-        , VotingReady
-        , Locked
-        ]
+  liftA2
+    (mkValidToNextStateBundle nCosigners nEffects)
+    [True, False]
+    [Draft, VotingReady, Locked]

 mkValidToFailedStateBundles ::
  -- | Number of cosigners
@ -865,15 +891,14 @@ mkValidToFailedStateBundles ::
  Word ->
  [ParameterBundle]
 mkValidToFailedStateBundles nCosigners nEffects =
-  mkBundle
-    <$> [ Draft
-        , VotingReady
-        , Locked
-        ]
+  liftA2
+    mkBundle
+    [True, False]
+    [Draft, VotingReady, Locked]
  where
-    mkBundle from =
+    mkBundle refScript from =
      let next = Finished
-          effects = mkMockEffects $ fromIntegral nEffects
+          effects = mkMockEffects refScript $ fromIntegral nEffects
       in ParameterBundle
            { proposalParameters =
                ProposalParameters
@ -894,7 +919,7 @@ mkValidToFailedStateBundles nCosigners nEffects =
                  , invalidStakeOutputDatum = False
                  }
            , governorParameters = Nothing
-            , authorityTokenParameters = Nothing
+            , authorityTokenParameters = []
            , transactionTimeRange = mkTooLateTimeRange from
            , extraSignature = Just signer
            }
@ -908,14 +933,13 @@ mkFromFinishedBundles ::
  Word ->
  [ParameterBundle]
 mkFromFinishedBundles nCosigners nEffects =
-  mkBundle
-    <$> [ Draft
-        , VotingReady
-        , Locked
-        ]
+  liftA2
+    mkBundle
+    [True, False]
+    [Draft, VotingReady, Locked]
  where
-    mkBundle from =
-      let template = mkValidToNextStateBundle nCosigners nEffects from
+    mkBundle refScript from =
+      let template = mkValidToNextStateBundle nCosigners nEffects refScript from
       in template
            { proposalParameters =
                template.proposalParameters
@ -926,24 +950,26 @@ mkFromFinishedBundles nCosigners nEffects =

 mkToNextStateTooLateBundles :: Word -> Word -> [ParameterBundle]
 mkToNextStateTooLateBundles nCosigners nEffects =
-  mkBundle
-    <$> [ Draft
-        , VotingReady
-        , Locked
-        ]
+  liftA2
+    mkBundle
+    [True, False]
+    [Draft, VotingReady, Locked]
  where
-    mkBundle from =
-      let template = mkValidToNextStateBundle nCosigners nEffects from
+    mkBundle refScript from =
+      let template = mkValidToNextStateBundle nCosigners nEffects refScript from
       in template
            { transactionTimeRange = mkTooLateTimeRange from
            }

 mkInvalidOutputStakeBundles :: Word -> Word -> [ParameterBundle]
 mkInvalidOutputStakeBundles nCosigners nEffects =
-  mkBundle <$> [Draft, VotingReady, Locked]
+  liftA2
+    mkBundle
+    [True, False]
+    [Draft, VotingReady, Locked]
  where
-    mkBundle from =
-      let template = mkValidToNextStateBundle nCosigners nEffects from
+    mkBundle refScript from =
+      let template = mkValidToNextStateBundle nCosigners nEffects refScript from
       in template
            { stakeParameters =
                template.stakeParameters
@ -965,7 +991,7 @@ mkInsufficientCosignsBundle nCosigners nEffects =
    insuffcientPerStakeGTs =
      untag (def :: ProposalThresholds).vote
        `div` fromIntegral nCosigners - 1
-    template = mkValidToNextStateBundle nCosigners nEffects Draft
+    template = mkValidToNextStateBundle nCosigners nEffects False Draft

 -- * From VotingReady

@ -986,7 +1012,7 @@ mkInsufficientVotesBundle ::
  Word ->
  ParameterBundle
 mkInsufficientVotesBundle nCosigners nEffects =
-  mkValidToNextStateBundle nCosigners nEffects VotingReady
+  mkValidToNextStateBundle nCosigners nEffects False VotingReady
    `setWinnerAndVotes` Nothing

 mkAmbiguousWinnerBundle ::
@ -994,14 +1020,14 @@ mkAmbiguousWinnerBundle ::
  Word ->
  ParameterBundle
 mkAmbiguousWinnerBundle nCosigners nEffects =
-  mkValidToNextStateBundle nCosigners nEffects VotingReady
+  mkValidToNextStateBundle nCosigners nEffects False VotingReady
    `setWinnerAndVotes` Just ambiguousWinnerVotes

 -- * From Locked

 mkValidFromLockedBundle :: Word -> Word -> ParameterBundle
 mkValidFromLockedBundle nCosigners nEffects =
-  mkValidToNextStateBundle nCosigners nEffects Locked
+  mkValidToNextStateBundle nCosigners nEffects False Locked

 mkMintGATsForWrongEffectsBundle ::
  Word ->
@ -1010,17 +1036,11 @@ mkMintGATsForWrongEffectsBundle ::
 mkMintGATsForWrongEffectsBundle nCosigners nEffects =
  template
    { authorityTokenParameters =
-        ( \aut ->
-            aut
-              { mintGATsFor =
-                  [ validatorHashes !! 1
-                  , validatorHashes !! 3
-                  , validatorHashes !! 5
-                  , validatorHashes !! 7
-                  ]
-              }
-        )
-          <$> template.authorityTokenParameters
+        take 4 $
+          zipWith
+            (\a i -> a {mintGATsFor = validatorHashes !! i})
+            template.authorityTokenParameters
+            [1, 3 ..]
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects
@ -1031,7 +1051,7 @@ mkNoGATMintedBundle ::
  ParameterBundle
 mkNoGATMintedBundle nCosigners nEffects =
  template
-    { authorityTokenParameters = Nothing
+    { authorityTokenParameters = []
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects
@ -1059,16 +1079,19 @@ mkGATsWithWrongDatumBundle ::
  ParameterBundle
 mkGATsWithWrongDatumBundle nCosigners nEffects =
  template
-    { authorityTokenParameters = Just newAut
+    { authorityTokenParameters = newAut
    }
  where
    template = mkValidFromLockedBundle nCosigners nEffects
-    aut = fromJust template.authorityTokenParameters
    newAut =
-      AuthorityTokenParameters
-        aut.mintGATsFor
-        (Just (1 :: Integer))
-        False
+      ( \aut ->
+          AuthorityTokenParameters
+            aut.mintGATsFor
+            (Just (1 :: Integer))
+            aut.carryRefScript
+            False
+      )
+        <$> template.authorityTokenParameters

 mkBadGovernorOutputDatumBundle ::
  Word ->
--- a/agora-specs/Sample/Proposal/Create.hs
+++ b/agora-specs/Sample/Proposal/Create.hs
@ -26,6 +26,7 @@ import Agora.Governor (
 )
 import Agora.Proposal (
  ProposalDatum (..),
+  ProposalEffectGroup,
  ProposalId (ProposalId),
  ProposalStatus (..),
  ResultTag (ResultTag),
@ -60,12 +61,10 @@ import Plutarch.Context (
 )
 import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusLedgerApi.V2 (
-  DatumHash,
  POSIXTime (POSIXTime),
  POSIXTimeRange,
  PubKeyHash,
  TxOutRef (TxOutRef),
-  ValidatorHash,
  always,
 )
 import PlutusTx.AssocMap qualified as AssocMap
@ -136,7 +135,7 @@ defLocks :: [ProposalLock]
 defLocks = [Created (ProposalId 0)]

 -- | The effect of the newly created proposal.
-defEffects :: AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
+defEffects :: AssocMap.Map ResultTag ProposalEffectGroup
 defEffects =
  AssocMap.fromList
    [ (ResultTag 0, AssocMap.empty)
--- a/agora-specs/Sample/Proposal/UnlockStake.hs
+++ b/agora-specs/Sample/Proposal/UnlockStake.hs
@ -28,6 +28,7 @@ module Sample.Proposal.UnlockStake (
 import Agora.Governor (Governor (..))
 import Agora.Proposal (
  ProposalDatum (..),
+  ProposalEffectGroup,
  ProposalId (..),
  ProposalRedeemer (Unlock),
  ProposalStatus (..),
@ -51,10 +52,8 @@ import Plutarch.Context (
 )
 import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusLedgerApi.V2 (
-  DatumHash,
  PubKeyHash,
  TxOutRef (..),
-  ValidatorHash,
 )
 import PlutusTx.AssocMap qualified as AssocMap
 import Sample.Proposal.Shared (stakeTxRef)
@ -85,7 +84,7 @@ votesTemplate =
 -- | Create empty effects for every result tag given the votes.
 emptyEffectFor ::
  ProposalVotes ->
-  AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
+  AssocMap.Map ResultTag ProposalEffectGroup
 emptyEffectFor (ProposalVotes vs) =
  AssocMap.fromList $
    map (,AssocMap.empty) (AssocMap.keys vs)
--- a/agora-testlib/Test/Util.hs
+++ b/agora-testlib/Test/Util.hs
@ -15,6 +15,7 @@ module Test.Util (
  sortValue,
  blake2b_224,
  pubKeyHashes,
+  scriptHashes,
  userCredentials,
  scriptCredentials,
  validatorHashes,
@ -43,7 +44,6 @@ import Plutarch.Context (
 )
 import Plutarch.Crypto (pblake2b_256)
 import PlutusLedgerApi.V1.Interval qualified as PlutusTx
-import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash))
 import PlutusLedgerApi.V1.Value (Value (..))
 import PlutusLedgerApi.V2 (
  Credential (
@ -51,8 +51,11 @@ import PlutusLedgerApi.V2 (
    ScriptCredential
  ),
  CurrencySymbol,
+  Datum (Datum),
+  DatumHash (DatumHash),
  PubKeyHash (..),
  ScriptContext,
+  ScriptHash (ScriptHash),
  TxOutRef,
  ValidatorHash (ValidatorHash),
 )
@ -162,6 +165,10 @@ validatorHashes = ValidatorHash . PlutusTx.toBuiltin <$> blake2b_224Hashes
 scriptCredentials :: [Credential]
 scriptCredentials = ScriptCredential <$> validatorHashes

+-- | An infinite list of *valid* script hashes.
+scriptHashes :: [ScriptHash]
+scriptHashes = ScriptHash . PlutusTx.toBuiltin <$> blake2b_224Hashes
+
 --------------------------------------------------------------------------------

 -- | Turn the given list in to groups which have the given length.
--- a/agora/Agora/Governor/Scripts.hs
+++ b/agora/Agora/Governor/Scripts.hs
@ -28,6 +28,7 @@ import Agora.Governor (
 )
 import Agora.Proposal (
  PProposalDatum (..),
+  PProposalEffectGroup,
  ProposalStatus (Draft, Locked),
  phasNeutralEffect,
  pisEffectsVotesCompatible,
@ -36,7 +37,14 @@ import Agora.Proposal (
  pwinner,
 )
 import Agora.Proposal.Time (createProposalStartingTime)
-import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTSymbol, proposalSTSymbol, proposalValidatoHash, stakeSTSymbol)
+import Agora.Scripts (
+  AgoraScripts,
+  authorityTokenSymbol,
+  governorSTSymbol,
+  proposalSTSymbol,
+  proposalValidatoHash,
+  stakeSTSymbol,
+ )
 import Agora.Stake (
  PProposalLock (..),
  PStakeDatum (..),
@ -45,17 +53,17 @@ import Agora.Stake (
 import Agora.Utils (
  pfindDatum,
  pfromDatumHash,
+  pfstTuple,
  pmustFindDatum,
+  psndTuple,
  validatorHashToAddress,
 )
 import Plutarch.Api.V1 (
  PCurrencySymbol,
-  PMap,
-  PValidatorHash,
 )
+import Plutarch.Api.V1.AssocMap qualified as AssocMap
 import Plutarch.Api.V2 (
  PAddress,
-  PDatumHash,
  PMintingPolicy,
  PScriptPurpose (PMinting, PSpending),
  PTxOut,
@ -66,10 +74,9 @@ import Plutarch.Extra.Field (pletAllC)
 import Plutarch.Extra.IsData (pmatchEnumFromData)
 import Plutarch.Extra.List (pfirstJust)
 import Plutarch.Extra.Map (
-  plookup,
  plookup',
 )
-import Plutarch.Extra.Maybe (passertPJust, pfromJust, pnothing)
+import Plutarch.Extra.Maybe (passertPDJust, passertPJust, pfromJust, pmaybeData, pnothing)
 import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
 import Plutarch.Extra.ScriptContext (
  pfindOutputsToAddress,
@ -489,35 +496,44 @@ governorValidator as =
          pguardC "Output GATs is more than minted GATs" $
            plength # outputsWithGAT #== gatCount

-          let gatOutputValidator' :: Term s (PMap _ PValidatorHash PDatumHash :--> PTxOut :--> PBool)
-              gatOutputValidator' =
+          let validateGATOutput' :: Term s (PProposalEffectGroup :--> PTxOut :--> PBool)
+              validateGATOutput' =
                phoistAcyclic $
                  plam
-                    ( \effects output' -> unTermCont $ do
-                        output <- pletFieldsC @'["address", "datum"] output'
+                    ( \effects output -> unTermCont $ do
+                        outputF <- pletFieldsC @'["address", "datum", "referenceScript"] output

-                        let scriptHash =
-                              passertPJust # "GAT receiver is not a script"
-                                #$ pscriptHashFromAddress # output.address
-                            datumHash =
-                              ptrace
-                                "Output to effect should have datum"
-                                pfromDatumHash
-                                # output.datum
-
-                            expectedDatumHash =
-                              passertPJust # "Receiver is not in the effect list"
-                                #$ plookup # scriptHash # effects
+                        let receiverScriptHash =
+                              passertPJust # "GAT receiver should be a script"
+                                #$ pscriptHashFromAddress # outputF.address
+                            effect =
+                              passertPJust # "Receiver should be in the effect group"
+                                #$ AssocMap.plookup # receiverScriptHash # effects
+                            hasCorrectReferenceScript =
+                              pmaybeData
+                                # pconstant True
+                                # plam
+                                  ( ( passertPDJust
+                                        # "Output UTXO should have a reference script"
+                                        # outputF.referenceScript
+                                        #==
+                                    )
+                                      . pfromData
+                                  )
+                                # (psndTuple # effect)
+                            hasCorrectDatum =
+                              pfstTuple # effect #== pfromDatumHash # outputF.datum

                        pure $
                          foldr1
                            (#&&)
-                            [ ptraceIfFalse "GAT must be tagged by the effect hash" $ authorityTokensValidIn # patSymbol # output'
-                            , ptraceIfFalse "Unexpected datum" $ datumHash #== expectedDatumHash
+                            [ ptraceIfFalse "GAT valid" $ authorityTokensValidIn # patSymbol # output
+                            , ptraceIfFalse "Correct datum" hasCorrectDatum
+                            , ptraceIfFalse "Reference script correct" hasCorrectReferenceScript
                            ]
                    )

-              gatOutputValidator = gatOutputValidator' # effectGroup
+              validateGATOutput = validateGATOutput' # effectGroup

          pguardC "GATs valid" $
            pfoldr
@ -526,7 +542,7 @@ governorValidator as =
                    let value = pfield @"value" # txOut
                        atValue = psymbolValueOf # patSymbol # value
                     in pif (atValue #== 0) r $
-                          pif (atValue #== 1) (r #&& gatOutputValidator # txOut) $ pconstant False
+                          pif (atValue #== 1) (r #&& validateGATOutput # txOut) $ pconstant False
                )
              # pconstant True
              # pfromData txInfoF.outputs
--- a/agora/Agora/Plutarch/Orphans.hs
+++ b/agora/Agora/Plutarch/Orphans.hs
@ -7,7 +7,7 @@

 module Agora.Plutarch.Orphans () where

-import Plutarch.Api.V1 (PDatumHash (..))
+import Plutarch.Api.V2 (PDatumHash (..), PScriptHash (..))
 import Plutarch.Builtin (PIsData (..))
 import Plutarch.Extra.TermCont (ptryFromC)
 import Plutarch.TryFrom (PTryFrom (..))
@ -37,3 +37,18 @@ instance PTryFrom PData (PAsData PUnit)
 instance (PIsData a) => PIsData (PAsData a) where
  pfromDataImpl = punsafeCoerce
  pdataImpl = pdataImpl . pfromData
+
+-- | @since 1.0.0
+instance PTryFrom PData (PAsData PScriptHash) where
+  type PTryFromExcess PData (PAsData PScriptHash) = Flip Term PScriptHash
+  ptryFrom' opq = runTermCont $ do
+    (pfromData -> unwrapped, _) <- ptryFromC @(PAsData PByteString) opq
+
+    tcont $ \f ->
+      pif
+        -- Blake2b_224 hash: 224 bits/28 bytes.
+        (plengthBS # unwrapped #== 28)
+        (f ())
+        (ptraceError "ptryFrom(PScriptHash): must be 32 bytes long")
+
+    pure (punsafeCoerce opq, pcon $ PScriptHash unwrapped)
--- a/agora/Agora/Proposal.hs
+++ b/agora/Agora/Proposal.hs
@ -11,6 +11,7 @@ module Agora.Proposal (
  -- * Haskell-land

  -- Proposal (..),
+  ProposalEffectGroup,
  ProposalDatum (..),
  ProposalRedeemer (..),
  ProposalStatus (..),
@ -21,6 +22,7 @@ module Agora.Proposal (
  emptyVotesFor,

  -- * Plutarch-land
+  PProposalEffectGroup,
  PProposalDatum (..),
  PProposalRedeemer (..),
  PProposalStatus (..),
@ -41,7 +43,12 @@ module Agora.Proposal (
 ) where

 import Agora.Plutarch.Orphans ()
-import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, ProposalStartingTime, ProposalTimingConfig)
+import Agora.Proposal.Time (
+  PProposalStartingTime,
+  PProposalTimingConfig,
+  ProposalStartingTime,
+  ProposalTimingConfig,
+ )
 import Agora.SafeMoney (GTTag)
 import Data.Tagged (Tagged)
 import Generics.SOP qualified as SOP
@ -50,7 +57,10 @@ import Plutarch.Api.V1.AssocMap qualified as PAssocMap
 import Plutarch.Api.V2 (
  KeyGuarantees (Unsorted),
  PDatumHash,
+  PMaybeData,
  PPubKeyHash,
+  PScriptHash,
+  PTuple,
 )
 import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields)
 import Plutarch.Extra.Comonad (pextract)
@ -75,7 +85,7 @@ import Plutarch.Lift (
 )
 import Plutarch.SafeMoney (PDiscrete (..))
 import Plutarch.Show (PShow (..))
-import PlutusLedgerApi.V1 (DatumHash, PubKeyHash, ValidatorHash)
+import PlutusLedgerApi.V2 (DatumHash, PubKeyHash, ScriptHash, ValidatorHash)
 import PlutusTx qualified
 import PlutusTx.AssocMap qualified as AssocMap

@ -272,6 +282,9 @@ newtype ProposalVotes = ProposalVotes
 emptyVotesFor :: forall a. AssocMap.Map ResultTag a -> ProposalVotes
 emptyVotesFor = ProposalVotes . AssocMap.mapWithKey (const . const 0)

+-- | @since 0.3.0
+type ProposalEffectGroup = AssocMap.Map ValidatorHash (DatumHash, Maybe ScriptHash)
+
 {- | Haskell-level datum for Proposal scripts.

     @since 0.1.0
@ -282,7 +295,7 @@ data ProposalDatum = ProposalDatum
  -- TODO: could we encode this more efficiently?
  -- This is shaped this way for future proofing.
  -- See https://github.com/Liqwid-Labs/agora/issues/39
-  , effects :: AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
+  , effects :: AssocMap.Map ResultTag ProposalEffectGroup
  -- ^ Effect lookup table. First by result, then by effect hash.
  , status :: ProposalStatus
  -- ^ The status the proposal is in.
@ -583,6 +596,15 @@ deriving via
  instance
    (PConstantDecl ProposalVotes)

+type PProposalEffectGroup =
+  PMap
+    'Unsorted
+    PValidatorHash
+    ( PTuple
+        PDatumHash
+        (PMaybeData (PAsData PScriptHash))
+    )
+
 {- | Plutarch-level version of 'ProposalDatum'.

     @since 0.1.0
@ -593,7 +615,7 @@ newtype PProposalDatum (s :: S) = PProposalDatum
        s
        ( PDataRecord
            '[ "proposalId" ':= PProposalId
-             , "effects" ':= PMap 'Unsorted PResultTag (PMap 'Unsorted PValidatorHash PDatumHash)
+             , "effects" ':= PMap 'Unsorted PResultTag PProposalEffectGroup
             , "status" ':= PProposalStatus
             , "cosigners" ':= PBuiltinList (PAsData PPubKeyHash)
             , "thresholds" ':= PProposalThresholds
@ -678,7 +700,7 @@ phasNeutralEffect ::
  forall (s :: S).
  Term
    s
-    ( PMap 'Unsorted PResultTag (PMap 'Unsorted PValidatorHash PDatumHash)
+    ( PMap 'Unsorted PResultTag PProposalEffectGroup
        :--> PBool
    )
 phasNeutralEffect = phoistAcyclic $ PAssocMap.pany # PAssocMap.pnull
@ -691,7 +713,7 @@ pisEffectsVotesCompatible ::
  forall (s :: S).
  Term
    s
-    ( PMap 'Unsorted PResultTag (PMap 'Unsorted PValidatorHash PDatumHash)
+    ( PMap 'Unsorted PResultTag PProposalEffectGroup
        :--> PProposalVotes
        :--> PBool
    )
@ -811,7 +833,7 @@ phighestVotes = phoistAcyclic $
 pneutralOption ::
  Term
    s
-    ( PMap 'Unsorted PResultTag (PMap 'Unsorted PValidatorHash PDatumHash)
+    ( PMap 'Unsorted PResultTag PProposalEffectGroup
        :--> PResultTag
    )
 pneutralOption = phoistAcyclic $
--- a/agora/Agora/Proposal/Time.hs
+++ b/agora/Agora/Proposal/Time.hs
@ -44,8 +44,9 @@ import Plutarch.DataRepr (
  PDataFields,
 )
 import Plutarch.Extra.Applicative (PApply (pliftA2))
+import Plutarch.Extra.Bind ((#>>=))
 import Plutarch.Extra.Field (pletAll, pletAllC)
-import Plutarch.Extra.Maybe (pjust, pmaybe, pnothing)
+import Plutarch.Extra.Maybe (pjust, pnothing)
 import Plutarch.Extra.TermCont (pmatchC)
 import Plutarch.Lift (
  DerivePConstantViaNewtype (..),
@ -357,8 +358,7 @@ createProposalStartingTime = phoistAcyclic $
                      "createProposalStartingTime: given time range should be tight enough"
                      pnothing
                  )
-     in -- TODO: PMonad when?
-        pmaybe # pnothing # f # ct
+     in ct #>>= f

 {- | Get the current proposal time, from the 'PlutusLedgerApi.V1.txInfoValidPeriod' field.

--- a/agora/Agora/Utils.hs
+++ b/agora/Agora/Utils.hs
@ -24,6 +24,8 @@ module Agora.Utils (
  pfromDatumHash,
  pfromInlineDatum,
  ptryFindDatum,
+  pfstTuple,
+  psndTuple,
 ) where

 import Plutarch.Api.V1.AssocMap (KeyGuarantees (Unsorted), PMap)
@ -32,6 +34,7 @@ import Plutarch.Api.V2 (
  PDatum,
  PDatumHash,
  POutputDatum (..),
+  PTuple,
 )
 import Plutarch.Extra.Functor (pfmap)
 import Plutarch.Extra.Maybe (passertPJust, pjust, pnothing)
@ -235,3 +238,17 @@ infixr 8 #.**
  Term s c ->
  Term s e
 (#.**) f g x y z = f #$ g # x # y # z
+
+{- | Extract the first component of a 'PTuple'.
+
+     @since 1.0.0
+-}
+pfstTuple :: forall a b s. (PIsData a) => Term s (PTuple a b :--> a)
+pfstTuple = phoistAcyclic $ plam $ pfromData . (pfield @"_0" #)
+
+{- | Extract the second component of a 'PTuple'.
+
+     @since 1.0.0
+-}
+psndTuple :: forall b a s. (PIsData b) => Term s (PTuple a b :--> b)
+psndTuple = phoistAcyclic $ plam $ pfromData . (pfield @"_1" #)
--- a/bench.csv
+++ b/bench.csv
--- a/flake.lock
+++ b/flake.lock
@ -12940,16 +12940,16 @@
        "plutarch": "plutarch_7"
      },
      "locked": {
-        "lastModified": 1660151677,
-        "narHash": "sha256-sUdXtVdCpm7pgmw0f+b0FyF4Bf0VX+1kTY5U8O3H4uk=",
+        "lastModified": 1660709756,
+        "narHash": "sha256-L9S9UYtpeTVGFmKNj8c/H3i17Jx8asCiW43xblN5nBo=",
        "owner": "Liqwid-Labs",
        "repo": "plutarch-context-builder",
-        "rev": "7033ca3c18968cfd206afbbd40861a0a778b414c",
+        "rev": "cc91cd134ce01e280df3b0ce09a25ede54dbf9b6",
        "type": "github"
      },
      "original": {
        "owner": "Liqwid-Labs",
-        "ref": "staging",
+        "ref": "main",
        "repo": "plutarch-context-builder",
        "type": "github"
      }
--- a/flake.nix
+++ b/flake.nix
@ -32,7 +32,7 @@
    plutarch-quickcheck.url =
      "github:liqwid-labs/plutarch-quickcheck?ref=staging";
    plutarch-context-builder.url =
-      "github:Liqwid-Labs/plutarch-context-builder?ref=staging";
+      "github:Liqwid-Labs/plutarch-context-builder?ref=main";
    plutarch-script-export.url =
      "github:Liqwid-Labs/plutarch-script-export?ref=main";