Merge pull request #115 from Liqwid-Labs/seungheonoh/govSamplesToPCB

Samples to PCB

agora-specs/Property/Governor.hs

@@ -0,0 +1,121 @@
+{- |
+Module     : Property.Governor
+Maintainer : seungheon.ooh@gmail.com
+Description: Property tests for 'Governor' related functions.
+
+Property model and tests for 'Governor' related functions
+-}
+module Property.Governor (props) where
+
+import Agora.Governor (
+  GovernorDatum (GovernorDatum, proposalThresholds),
+  governorDatumValid,
+ )
+import Agora.Proposal (
+  ProposalId (ProposalId),
+  ProposalThresholds (ProposalThresholds),
+ )
+import Agora.Proposal.Time (
+  MaxTimeRangeWidth (MaxTimeRangeWidth),
+  ProposalTimingConfig (ProposalTimingConfig),
+ )
+import Data.Tagged (Tagged (Tagged), untag)
+import Data.Universe (Finite (..), Universe (..))
+import Test.Tasty (TestTree)
+import Test.Tasty.Plutarch.Property (classifiedPropertyNative)
+import Test.Tasty.QuickCheck (
+  Gen,
+  Property,
+  chooseInteger,
+  testProperty,
+ )
+
+data GovernorDatumCases
+  = ExecuteLE0
+  | CreateLE0
+  | VoteLE0
+  | CreateLEVote
+  | ExecuteLVote
+  | Correct
+  deriving stock (Eq, Show)
+
+instance Universe GovernorDatumCases where
+  universe =
+    [ ExecuteLE0
+    , CreateLE0
+    , VoteLE0
+    , CreateLEVote
+    , ExecuteLVote
+    , Correct
+    ]
+
+instance Finite GovernorDatumCases where
+  universeF = universe
+  cardinality = Tagged 6
+
+{- | Property that checks `governorDatumValid`.
+ `governorDatumValid` determines if given governor datum is valid or not. This property
+ ensures `governorDatumValid` is checking the datum correctly and ruling out improper datum.
+-}
+governorDatumValidProperty :: Property
+governorDatumValidProperty =
+  classifiedPropertyNative gen (const []) expected classifier governorDatumValid
+  where
+    classifier :: GovernorDatum -> GovernorDatumCases
+    classifier (proposalThresholds -> ProposalThresholds e c v)
+      | e < 0 = ExecuteLE0
+      | c < 0 = CreateLE0
+      | v < 0 = VoteLE0
+      | c > v = CreateLEVote
+      | v >= e = ExecuteLVote
+      | otherwise = Correct
+
+    expected :: GovernorDatum -> Maybe Bool
+    expected c = Just $ classifier c == Correct
+
+    gen :: GovernorDatumCases -> Gen GovernorDatum
+    gen c = do
+      thres <- genProposalThresholds c
+
+      let timing = ProposalTimingConfig 0 0 0 0
+      return $ GovernorDatum thres (ProposalId 0) timing (MaxTimeRangeWidth 0)
+      where
+        taggedInteger p = Tagged <$> chooseInteger p
+        genProposalThresholds :: GovernorDatumCases -> Gen ProposalThresholds
+        genProposalThresholds c = do
+          let validGT = taggedInteger (0, 1000000000)
+          execute <- validGT
+          create <- validGT
+          vote <- validGT
+          le0 <- taggedInteger (-1000, -1)
+
+          case c of
+            ExecuteLE0 ->
+              -- execute < 0
+              return $ ProposalThresholds le0 create vote
+            CreateLE0 ->
+              -- c < 0
+              return $ ProposalThresholds execute le0 vote
+            VoteLE0 ->
+              -- vote < 0
+              return $ ProposalThresholds execute create le0
+            CreateLEVote -> do
+              -- c > vote
+              nv <- taggedInteger (0, untag create - 1)
+              ne <- taggedInteger (untag nv + 1, 1000000000)
+              return $ ProposalThresholds ne create nv
+            ExecuteLVote -> do
+              -- vote >= execute
+              ne <- taggedInteger (0, untag vote)
+              nc <- taggedInteger (0, untag vote)
+              return $ ProposalThresholds ne nc vote
+            Correct -> do
+              -- c <= vote < execute
+              nv <- taggedInteger (0, untag execute - 1)
+              nc <- taggedInteger (0, untag nv)
+              return $ ProposalThresholds execute nc nv
+
+props :: [TestTree]
+props =
+  [ testProperty "governorDatumValid" governorDatumValidProperty
+  ]

agora-specs/Property/MultiSig.hs

@@ -12,23 +12,18 @@ import Agora.MultiSig (
   PMultiSig,
   pvalidatedByMultisig,
  )
-import Data.Maybe (fromJust)
 import Data.Tagged (Tagged (Tagged))
 import Data.Universe (Finite (..), Universe (..))
 import Plutarch.Api.V1 (PScriptContext)
-import Plutarch.Context.Config (defaultConfig)
+import Plutarch.Context
-import Plutarch.Context.Spending (
-  ValidatorUTXO (ValidatorUTXO),
-  inputSelfExtra,
-  signedWith,
-  spendingContext,
- )
 import Plutarch.Extra.TermCont (pletC)
 import PlutusLedgerApi.V1 (
-  ScriptContext (scriptContextTxInfo),
+  ScriptContext (..),
+  ScriptPurpose (..),
   TxInfo (txInfoSignatories),
+  TxOutRef (..),
  )
-import Property.Generator (genPubKeyHash, genSingletonValue)
+import Property.Generator (genPubKeyHash)
 import Test.Tasty (TestTree)
 import Test.Tasty.Plutarch.Property (classifiedPropertyNative)
 import Test.Tasty.QuickCheck (
@@ -63,7 +58,6 @@ genMultiSigProp :: MultiSigProp -> Gen MultiSigModel
 genMultiSigProp prop = do
   size <- chooseInt (4, 20)
   pkhs <- vectorOf size genPubKeyHash
-  vutxo <- ValidatorUTXO () <$> genSingletonValue
   minSig <- chooseInt (1, length pkhs)
   othersigners <- take 20 <$> listOf genPubKeyHash
 
@@ -73,9 +67,10 @@ genMultiSigProp prop = do
     MeetsMinSigs -> chooseInt (minSig, length pkhs)
     DoesNotMeetMinSigs -> chooseInt (0, minSig - 1)
 
-  let builder = foldr (<>) (inputSelfExtra mempty ()) (signedWith <$> take n pkhs <> othersigners)
+  let builder :: BaseBuilder
-      ctx = fromJust $ spendingContext defaultConfig builder vutxo
+      builder = mconcat $ signedWith <$> take n pkhs <> othersigners
-  pure (ms, ctx)
+      txinfo = buildTxInfoUnsafe builder
+  pure (ms, ScriptContext txinfo (Spending (TxOutRef "" 0)))
 
 -- | Classify model into propositions.
 classifyMultiSigProp :: MultiSigModel -> MultiSigProp

agora-specs/Sample/Effect/GovernorMutation.hs

@@ -11,17 +11,13 @@ module Sample.Effect.GovernorMutation (
   mkEffectDatum,
 ) where
 
---------------------------------------------------------------------------------
-
 import Agora.Effect.GovernorMutation (
   MutateGovernorDatum (..),
   mutateGovernorValidator,
  )
 import Agora.Governor (GovernorDatum (..))
 import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
-
+import Data.Default.Class (Default (def))
---------------------------------------------------------------------------------
-
 import Data.Tagged (Tagged (..))
 import Plutarch.Api.V1 (mkValidator, validatorHash)
 import PlutusLedgerApi.V1 (
@@ -36,13 +32,13 @@ import PlutusLedgerApi.V1 (
   Validator,
   ValidatorHash (..),
  )
-import PlutusLedgerApi.V1 qualified as Interval
+import PlutusLedgerApi.V1 qualified as Interval (always)
 import PlutusLedgerApi.V1.Address (scriptHashAddress)
 import PlutusLedgerApi.V1.Value (AssetClass, assetClass)
-import PlutusLedgerApi.V1.Value qualified as Value
+import PlutusLedgerApi.V1.Value qualified as Value (
-
+  assetClassValue,
---------------------------------------------------------------------------------
+  singleton,
-
+ )
 import Sample.Shared (
   authorityTokenSymbol,
   govAssetClass,
@@ -53,12 +49,6 @@ import Sample.Shared (
  )
 import Test.Util (datumPair, toDatumHash)
 
---------------------------------------------------------------------------------
-
-import Data.Default.Class (Default (def))
-
---------------------------------------------------------------------------------
-
 -- | The effect validator instance.
 effectValidator :: Validator
 effectValidator = mkValidator $ mutateGovernorValidator governor

agora-specs/Sample/Effect/TreasuryWithdrawal.hs

@@ -19,6 +19,12 @@ module Sample.Effect.TreasuryWithdrawal (
   buildScriptContext,
 ) where
 
+import Agora.Effect.TreasuryWithdrawal (
+  TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
+  treasuryWithdrawalValidator,
+ )
+import Data.ByteString.Char8 qualified as C (pack)
+import Data.ByteString.Hash (sha2_256)
 import Plutarch.Api.V1 (mkValidator, validatorHash)
 import PlutusLedgerApi.V1 (
   Address (Address),
@@ -50,16 +56,8 @@ import PlutusLedgerApi.V1 (
   Value,
   toBuiltin,
  )
-import PlutusLedgerApi.V1.Interval qualified as Interval
+import PlutusLedgerApi.V1.Interval qualified as Interval (always)
-import PlutusLedgerApi.V1.Value qualified as Value
+import PlutusLedgerApi.V1.Value qualified as Value (singleton)
-
-import Data.ByteString.Char8 qualified as C
-import Data.ByteString.Hash (sha2_256)
-
-import Agora.Effect.TreasuryWithdrawal (
-  TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
-  treasuryWithdrawalValidator,
- )
 
 -- | A sample Currency Symbol.
 currSymbol :: CurrencySymbol

agora-specs/Sample/Governor.hs

@@ -12,40 +12,6 @@ module Sample.Governor (
   mintGST,
 ) where
 
---------------------------------------------------------------------------------
-
-import Data.Tagged (Tagged (..), untag)
-import Plutarch.Api.V1 (mkValidator, validatorHash)
-
---------------------------------------------------------------------------------
-
-import PlutusLedgerApi.V1 (
-  Address (..),
-  BuiltinData (BuiltinData),
-  Credential (ScriptCredential),
-  Data (I),
-  Datum (..),
-  ScriptContext (..),
-  ScriptPurpose (Minting, Spending),
-  ToData (toBuiltinData),
-  TokenName (..),
-  TxInInfo (TxInInfo),
-  TxInfo (..),
-  TxOut (..),
-  TxOutRef (..),
-  Validator,
-  ValidatorHash (..),
- )
-import PlutusLedgerApi.V1.Address (scriptHashAddress)
-import PlutusLedgerApi.V1.Interval qualified as Interval
-import PlutusLedgerApi.V1.Value (
-  AssetClass (..),
- )
-import PlutusLedgerApi.V1.Value qualified as Value
-import PlutusTx.AssocMap qualified as AssocMap
-
---------------------------------------------------------------------------------
-
 import Agora.Effect.NoOp (noOpValidator)
 import Agora.Governor (GovernorDatum (..), getNextProposalId)
 import Agora.Proposal (
@@ -56,42 +22,70 @@ import Agora.Proposal (
   ResultTag (..),
   emptyVotesFor,
  )
-import Agora.Proposal qualified as P
+import Agora.Proposal qualified as P (ProposalDatum (proposalId))
 import Agora.Proposal.Time (
   ProposalStartingTime (ProposalStartingTime),
   ProposalTimingConfig (..),
  )
-import Agora.Stake (
+import Agora.Stake (ProposalLock (..), Stake (..), StakeDatum (..))
-  ProposalLock (..),
+import Data.Default.Class (Default (def))
-  Stake (..),
+import Data.Tagged (Tagged (..), untag)
-  StakeDatum (..),
+import Plutarch.Api.V1 (mkValidator, validatorHash)
+import Plutarch.Context (
+  MintingBuilder,
+  SpendingBuilder,
+  buildMintingUnsafe,
+  buildSpendingUnsafe,
+  fee,
+  input,
+  mint,
+  output,
+  script,
+  signedWith,
+  timeRange,
+  txId,
+  withDatum,
+  withRefIndex,
+  withSpending,
+  withTxId,
+  withValue,
+ )
+import PlutusLedgerApi.V1 (
+  BuiltinData (BuiltinData),
+  Data (I),
+  Datum (Datum),
+  ScriptContext,
+  TokenName (TokenName),
+  TxOutRef (txOutRefId),
+  Validator,
+  ValidatorHash (..),
+ )
+import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
+import PlutusLedgerApi.V1.Value qualified as Value (
+  assetClassValue,
+  singleton,
+ )
+import PlutusTx.AssocMap qualified as AssocMap (
+  empty,
+  fromList,
+  singleton,
  )
-
---------------------------------------------------------------------------------
-
 import Sample.Shared (
   authorityTokenSymbol,
   govAssetClass,
-  govSymbol,
+  govValidatorHash,
-  govValidatorAddress,
   gstUTXORef,
   minAda,
   proposalPolicySymbol,
   proposalStartingTimeFromTimeRange,
-  proposalValidatorAddress,
+  proposalValidatorHash,
   signer,
   signer2,
   stake,
-  stakeAddress,
   stakeAssetClass,
+  stakeValidatorHash,
  )
-import Test.Util (closedBoundedInterval, datumPair, toDatumHash)
+import Test.Util (closedBoundedInterval, toDatumHash)
-
---------------------------------------------------------------------------------
-
-import Data.Default.Class (Default (def))
-
---------------------------------------------------------------------------------
 
 -- | Unit datum
 unitDatum :: Datum
@@ -118,65 +112,34 @@ mintGST :: ScriptContext
 mintGST =
   let gst = Value.assetClassValue govAssetClass 1
 
-      ---
+      governorOutputDatum :: GovernorDatum
-
+      governorOutputDatum =
-      governorOutputDatum' :: GovernorDatum
-      governorOutputDatum' =
         GovernorDatum
           { proposalThresholds = def
           , nextProposalId = ProposalId 0
           , proposalTimings = def
           , createProposalTimeRangeMaxWidth = def
           }
-      governorOutputDatum :: Datum
-      governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
-      governorOutput :: TxOut
-      governorOutput =
-        TxOut
-          { txOutAddress = govValidatorAddress
-          , txOutValue = gst <> minAda
-          , txOutDatumHash = Just $ toDatumHash governorOutputDatum
-          }
-
-      ---
 
       witness :: ValidatorHash
       witness = "a926a9a72a0963f428e3252caa8354e655603996fb8892d6b8323fd072345924"
-      witnessAddress :: Address
-      witnessAddress = Address (ScriptCredential witness) Nothing
 
-      ---
+      builder :: MintingBuilder
-
+      builder =
-      -- The witness UTXO must be consumed.
+        mconcat
-      witnessInput :: TxOut
+          [ txId "90906d3e6b4d6dec2e747dcdd9617940ea8358164c7244694cfa39dec18bd9d4"
-      witnessInput =
+          , signedWith signer
-        TxOut
+          , mint gst
-          { txOutAddress = witnessAddress
+          , input $
-          , txOutValue = mempty
+              script witness
-          , txOutDatumHash = Nothing
+                . withTxId (txOutRefId gstUTXORef)
-          }
+                . withRefIndex 0
-      initialSpend :: TxInInfo
+          , output $
-      initialSpend = TxInInfo gstUTXORef witnessInput
+              script govValidatorHash
-   in ScriptContext
+                . withValue (gst <> minAda)
-        { scriptContextTxInfo =
+                . withDatum governorOutputDatum
-            TxInfo
+          ]
-              { txInfoInputs =
+   in buildMintingUnsafe builder
-                  [ initialSpend
-                  ]
-              , txInfoOutputs = [governorOutput]
-              , -- Some ada to cover the transaction fee
-                txInfoFee = Value.singleton "" "" 2
-              , -- Exactly one GST is minted
-                txInfoMint = gst
-              , txInfoDCert = []
-              , txInfoWdrl = []
-              , txInfoValidRange = Interval.always
-              , txInfoSignatories = [signer]
-              , txInfoData = [datumPair governorOutputDatum]
-              , txInfoId = "90906d3e6b4d6dec2e747dcdd9617940ea8358164c7244694cfa39dec18bd9d4"
-              }
-        , scriptContextPurpose = Minting govSymbol
-        }
 
 {- | A valid script context to create a proposal.
 
@@ -213,143 +176,90 @@ createProposal =
       stackedGTs = 424242424242
       thisProposalId = ProposalId 0
 
-      ---
+      governorInputDatum :: GovernorDatum
-
+      governorInputDatum =
-      governorInputDatum' :: GovernorDatum
-      governorInputDatum' =
         GovernorDatum
           { proposalThresholds = def
           , nextProposalId = thisProposalId
           , proposalTimings = def
           , createProposalTimeRangeMaxWidth = def
           }
-      governorInputDatum :: Datum
-      governorInputDatum = Datum $ toBuiltinData governorInputDatum'
-      governorInput :: TxOut
-      governorInput =
-        TxOut
-          { txOutAddress = govValidatorAddress
-          , txOutValue = gst
-          , txOutDatumHash = Just $ toDatumHash governorInputDatum
-          }
-
-      ---
 
       effects =
         AssocMap.fromList
           [ (ResultTag 0, AssocMap.empty)
           , (ResultTag 1, AssocMap.empty)
           ]
-      proposalDatum :: Datum
+      proposalDatum :: ProposalDatum
       proposalDatum =
-        Datum
+        ProposalDatum
-          ( toBuiltinData $
+          { P.proposalId = ProposalId 0
-              ProposalDatum
+          , effects = effects
-                { P.proposalId = ProposalId 0
+          , status = Draft
-                , effects = effects
+          , cosigners = [signer]
-                , status = Draft
+          , thresholds = def
-                , cosigners = [signer]
+          , votes = emptyVotesFor effects
-                , thresholds = def
+          , timingConfig = def
-                , votes = emptyVotesFor effects
+          , startingTime = proposalStartingTimeFromTimeRange validTimeRange
-                , timingConfig = def
-                , startingTime = proposalStartingTimeFromTimeRange validTimeRange
-                }
-          )
-      proposalOutput :: TxOut
-      proposalOutput =
-        TxOut
-          { txOutAddress = proposalValidatorAddress
-          , txOutValue = pst <> minAda
-          , txOutDatumHash = Just (toDatumHash proposalDatum)
           }
 
-      ---
+      stakeInputDatum :: StakeDatum
-
+      stakeInputDatum =
-      stakeInputDatum' :: StakeDatum
-      stakeInputDatum' =
         StakeDatum
           { stakedAmount = Tagged stackedGTs
           , owner = signer
           , lockedBy = []
           }
-      stakeInputDatum :: Datum
-      stakeInputDatum = Datum $ toBuiltinData stakeInputDatum'
-      stakeInput :: TxOut
-      stakeInput =
-        TxOut
-          { txOutAddress = stakeAddress
-          , txOutValue = sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs
-          , txOutDatumHash = Just (toDatumHash stakeInputDatum)
-          }
 
-      ---
+      governorOutputDatum :: GovernorDatum
-      governorOutputDatum' :: GovernorDatum
+      governorOutputDatum = governorInputDatum {nextProposalId = getNextProposalId thisProposalId}
-      governorOutputDatum' = governorInputDatum' {nextProposalId = getNextProposalId thisProposalId}
-      governorOutputDatum :: Datum
-      governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
-      governorOutput :: TxOut
-      governorOutput =
-        governorInput
-          { txOutDatumHash = Just $ toDatumHash governorOutputDatum
-          , txOutValue = gst <> minAda
-          }
-
-      ---
 
       proposalLocks :: [ProposalLock]
       proposalLocks =
         [ ProposalLock (ResultTag 0) thisProposalId
         , ProposalLock (ResultTag 1) thisProposalId
         ]
-      stakeOutputDatum' :: StakeDatum
+      stakeOutputDatum :: StakeDatum
-      stakeOutputDatum' = stakeInputDatum' {lockedBy = proposalLocks}
+      stakeOutputDatum = stakeInputDatum {lockedBy = proposalLocks}
-      stakeOutputDatum :: Datum
-      stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum'
-      stakeOutput :: TxOut
-      stakeOutput =
-        stakeInput
-          { txOutDatumHash = Just $ toDatumHash stakeOutputDatum
-          , txOutValue = sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs <> minAda
-          }
-
-      ---
-
-      ownInputRef :: TxOutRef
-      ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1
-
-      ---
 
       validTimeRange = closedBoundedInterval 10 15
-   in ScriptContext
+
-        { scriptContextTxInfo =
+      builder :: SpendingBuilder
-            TxInfo
+      builder =
-              { txInfoInputs =
+        mconcat
-                  [ TxInInfo
+          [ txId "1ffb9669335c908d9a4774a4bf7aa7bfafec91d015249b4138bc83fde4a3330a"
-                      ownInputRef
+          , fee $ Value.singleton "" "" 2
-                      governorInput
+          , timeRange $ closedBoundedInterval 10 15
-                  , TxInInfo
+          , signedWith signer
-                      (TxOutRef "4262bbd0b3fc926b74eaa8abab5def6ce5e6b94f19cf221c02a16e7da8cd470f" 1)
+          , mint pst
-                      stakeInput
+          , input $
-                  ]
+              script govValidatorHash
-              , txInfoOutputs = [proposalOutput, governorOutput, stakeOutput]
+                . withValue gst
-              , txInfoFee = Value.singleton "" "" 2
+                . withDatum governorInputDatum
-              , txInfoMint = pst
+                . withTxId "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865"
-              , txInfoDCert = []
+          , input $
-              , txInfoWdrl = []
+              script stakeValidatorHash
-              , txInfoValidRange = validTimeRange
+                . withValue (sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs)
-              , txInfoSignatories = [signer]
+                . withDatum stakeInputDatum
-              , txInfoData =
+                . withTxId "4262bbd0b3fc926b74eaa8abab5def6ce5e6b94f19cf221c02a16e7da8cd470f"
-                  datumPair
+          , output $
-                    <$> [ governorInputDatum
+              script proposalValidatorHash
-                        , governorOutputDatum
+                . withValue (pst <> minAda)
-                        , proposalDatum
+                . withDatum proposalDatum
-                        , stakeInputDatum
+          , output $
-                        , stakeOutputDatum
+              script govValidatorHash
-                        ]
+                . withValue (gst <> minAda)
-              , txInfoId = "1ffb9669335c908d9a4774a4bf7aa7bfafec91d015249b4138bc83fde4a3330a"
+                . withDatum governorOutputDatum
-              }
+          , output $
-        , scriptContextPurpose = Spending ownInputRef
+              script stakeValidatorHash
-        }
+                . withValue (sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs <> minAda)
+                . withDatum stakeOutputDatum
+          , withSpending $
+              script govValidatorHash
+                . withValue gst
+                . withDatum governorInputDatum
+          ]
+   in buildSpendingUnsafe builder
 
 {- This script context should be a valid transaction for minting authority for the effect scrips.
 
@@ -374,14 +284,10 @@ mintGATs =
       gst = Value.assetClassValue govAssetClass 1
       gat = Value.assetClassValue atAssetClass 1
 
-      ---
-
       mockEffect :: Validator
       mockEffect = mkValidator $ noOpValidator ""
       mockEffectHash :: ValidatorHash
       mockEffectHash = validatorHash mockEffect
-      mockEffectAddress :: Address
-      mockEffectAddress = scriptHashAddress mockEffectHash
       mockEffectOutputDatum :: Datum
       mockEffectOutputDatum = unitDatum
       atTokenName :: TokenName
@@ -391,27 +297,14 @@ mintGATs =
       atAssetClass :: AssetClass
       atAssetClass = AssetClass (authorityTokenSymbol, atTokenName)
 
-      ---
+      governorInputDatum :: GovernorDatum
-
+      governorInputDatum =
-      governorInputDatum' :: GovernorDatum
-      governorInputDatum' =
         GovernorDatum
           { proposalThresholds = def
           , nextProposalId = ProposalId 5
           , proposalTimings = def
           , createProposalTimeRangeMaxWidth = def
           }
-      governorInputDatum :: Datum
-      governorInputDatum = Datum $ toBuiltinData governorInputDatum'
-      governorInput :: TxOut
-      governorInput =
-        TxOut
-          { txOutAddress = govValidatorAddress
-          , txOutValue = gst
-          , txOutDatumHash = Just $ toDatumHash governorInputDatum
-          }
-
-      ---
 
       effects =
         AssocMap.fromList
@@ -425,8 +318,8 @@ mintGATs =
             [ (ResultTag 0, 100)
             , (ResultTag 1, 2000) -- The winner
             ]
-      proposalInputDatum' :: ProposalDatum
+      proposalInputDatum :: ProposalDatum
-      proposalInputDatum' =
+      proposalInputDatum =
         ProposalDatum
           { P.proposalId = ProposalId 0
           , effects = effects
@@ -437,94 +330,55 @@ mintGATs =
           , timingConfig = def
           , startingTime = ProposalStartingTime 10
           }
-      proposalInputDatum :: Datum
-      proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
-      proposalInput :: TxOut
-      proposalInput =
-        TxOut
-          { txOutAddress = proposalValidatorAddress
-          , txOutValue = pst
-          , txOutDatumHash = Just (toDatumHash proposalInputDatum)
-          }
 
-      ---
+      governorOutputDatum :: GovernorDatum
+      governorOutputDatum = governorInputDatum
 
-      governorOutputDatum' :: GovernorDatum
+      proposalOutputDatum :: ProposalDatum
-      governorOutputDatum' = governorInputDatum'
+      proposalOutputDatum = proposalInputDatum {status = Finished}
-      governorOutputDatum :: Datum
-      governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
-      governorOutput :: TxOut
-      governorOutput =
-        governorInput
-          { txOutDatumHash = Just $ toDatumHash governorOutputDatum
-          , txOutValue = gst <> minAda
-          }
 
-      ---
-
-      proposalOutputDatum' :: ProposalDatum
-      proposalOutputDatum' = proposalInputDatum' {status = Finished}
-      proposalOutputDatum :: Datum
-      proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum'
-      proposalOutput :: TxOut
-      proposalOutput =
-        proposalInput
-          { txOutDatumHash = Just $ toDatumHash proposalOutputDatum
-          , txOutValue = pst <> minAda
-          }
-
-      --
-
-      mockEffectOutput :: TxOut
-      mockEffectOutput =
-        TxOut
-          { txOutAddress = mockEffectAddress
-          , txOutDatumHash = Just $ toDatumHash mockEffectOutputDatum
-          , txOutValue = gat <> minAda
-          }
-
-      --
-
-      ownInputRef :: TxOutRef
-      ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1
-
-      --
       validTimeRange =
         closedBoundedInterval
           ((def :: ProposalTimingConfig).lockingTime + 11)
           ((def :: ProposalTimingConfig).executingTime - 11)
-   in ScriptContext
+
-        { scriptContextTxInfo =
+      builder :: SpendingBuilder
-            TxInfo
+      builder =
-              { txInfoInputs =
+        mconcat
-                  [ TxInInfo ownInputRef governorInput
+          [ txId "ff755f613c1f7487dfbf231325c67f481f7a97e9faf4d8b09ad41176fd65cbe7"
-                  , TxInInfo
+          , signedWith signer
-                      (TxOutRef "11b2162f267614b803761032b6333040fc61478ae788c088614ee9487ab0c1b7" 1)
+          , signedWith signer2
-                      proposalInput
+          , timeRange validTimeRange
-                  ]
+          , fee (Value.singleton "" "" 2)
-              , txInfoOutputs =
+          , mint gat
-                  [ governorOutput
+          , input $
-                  , proposalOutput
+              script govValidatorHash
-                  , mockEffectOutput
+                . withValue gst
-                  ]
+                . withDatum governorInputDatum
-              , txInfoFee = Value.singleton "" "" 2
+                . withTxId "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865"
-              , txInfoMint = gat
+          , input $
-              , txInfoDCert = []
+              script proposalValidatorHash
-              , txInfoWdrl = []
+                . withValue pst
-              , txInfoValidRange = validTimeRange
+                . withDatum proposalInputDatum
-              , txInfoSignatories = [signer, signer2]
+                . withTxId "11b2162f267614b803761032b6333040fc61478ae788c088614ee9487ab0c1b7"
-              , txInfoData =
+          , output $
-                  datumPair
+              script govValidatorHash
-                    <$> [ governorInputDatum
+                . withValue (gst <> minAda)
-                        , governorOutputDatum
+                . withDatum governorOutputDatum
-                        , proposalInputDatum
+          , output $
-                        , proposalOutputDatum
+              script proposalValidatorHash
-                        , mockEffectOutputDatum
+                . withValue (pst <> minAda)
-                        ]
+                . withDatum proposalOutputDatum
-              , txInfoId = "ff755f613c1f7487dfbf231325c67f481f7a97e9faf4d8b09ad41176fd65cbe7"
+          , output $
-              }
+              script mockEffectHash
-        , scriptContextPurpose = Spending ownInputRef
+                . withValue (gat <> minAda)
-        }
+                . withDatum mockEffectOutputDatum
+          , withSpending $
+              script govValidatorHash
+                . withValue gst
+                . withDatum governorInputDatum
+          ]
+   in buildSpendingUnsafe builder
 
 {- | A valid script context for changing the state datum of the governor.
 
@@ -546,110 +400,62 @@ mutateState =
       gat = Value.assetClassValue atAssetClass 1
       burntGAT = Value.assetClassValue atAssetClass (-1)
 
-      ---
-
       -- TODO: Use the *real* effect, see https://github.com/Liqwid-Labs/agora/pull/62
-
       mockEffect :: Validator
       mockEffect = mkValidator $ noOpValidator ""
       mockEffectHash :: ValidatorHash
       mockEffectHash = validatorHash mockEffect
-      mockEffectAddress :: Address
-      mockEffectAddress = scriptHashAddress mockEffectHash
       atTokenName :: TokenName
       atTokenName = TokenName hash
         where
           ValidatorHash hash = mockEffectHash
       atAssetClass :: AssetClass
       atAssetClass = AssetClass (authorityTokenSymbol, atTokenName)
-
-      --
-
       mockEffectInputDatum :: Datum
       mockEffectInputDatum = unitDatum
-      mockEffectInput :: TxOut
-      mockEffectInput =
-        TxOut
-          { txOutAddress = mockEffectAddress
-          , txOutValue = gat -- Will be burnt
-          , txOutDatumHash = Just $ toDatumHash mockEffectInputDatum
-          }
-
-      --
-
       mockEffectOutputDatum :: Datum
       mockEffectOutputDatum = mockEffectInputDatum
-      mockEffectOutput :: TxOut
-      mockEffectOutput =
-        mockEffectInput
-          { txOutValue = minAda
-          , txOutDatumHash = Just $ toDatumHash mockEffectOutputDatum
-          }
 
-      --
+      governorInputDatum :: GovernorDatum
-
+      governorInputDatum =
-      governorInputDatum' :: GovernorDatum
-      governorInputDatum' =
         GovernorDatum
           { proposalThresholds = def
           , nextProposalId = ProposalId 5
           , proposalTimings = def
           , createProposalTimeRangeMaxWidth = def
           }
-      governorInputDatum :: Datum
-      governorInputDatum = Datum $ toBuiltinData governorInputDatum'
-      governorInput :: TxOut
-      governorInput =
-        TxOut
-          { txOutAddress = govValidatorAddress
-          , txOutValue = gst
-          , txOutDatumHash = Just $ toDatumHash governorInputDatum
-          }
 
-      --
+      governorOutputDatum :: GovernorDatum
+      governorOutputDatum = governorInputDatum
 
-      governorOutputDatum' :: GovernorDatum
+      builder :: SpendingBuilder
-      governorOutputDatum' = governorInputDatum'
+      builder =
-      governorOutputDatum :: Datum
+        mconcat
-      governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
+          [ txId "9a12a605086a9f866731869a42d0558036fc739c74fea3849aa41562c015aaf9"
-      governorOutput :: TxOut
+          , signedWith signer
-      governorOutput =
+          , mint burntGAT
-        governorInput
+          , fee $ Value.singleton "" "" 2
-          { txOutDatumHash = Just $ toDatumHash governorOutputDatum
+          , input $
-          , txOutValue = gst <> minAda
+              script govValidatorHash
-          }
+                . withValue gst
-
+                . withDatum governorInputDatum
-      --
+                . withTxId "f867238a04597c99a0b9858746557d305025cca3b9f78ea14d5c88c4cfcf58ff"
-
+          , input $
-      ownInputRef :: TxOutRef
+              script mockEffectHash
-      ownInputRef = TxOutRef "f867238a04597c99a0b9858746557d305025cca3b9f78ea14d5c88c4cfcf58ff" 1
+                . withValue gat
-   in ScriptContext
+                . withDatum mockEffectInputDatum
-        { scriptContextTxInfo =
+                . withTxId "ecff06d7cf99089294569cc8b92609e44927278f9901730715d14634fbc10089"
-            TxInfo
+          , output $
-              { txInfoInputs =
+              script govValidatorHash
-                  [ TxInInfo ownInputRef governorInput
+                . withValue (gst <> minAda)
-                  , TxInInfo
+                . withDatum governorOutputDatum
-                      (TxOutRef "ecff06d7cf99089294569cc8b92609e44927278f9901730715d14634fbc10089" 1)
+          , input $
-                      mockEffectInput
+              script mockEffectHash
-                  ]
+                . withValue minAda
-              , txInfoOutputs =
+                . withDatum mockEffectOutputDatum
-                  [ governorOutput
+          , withSpending $
-                  , mockEffectOutput
+              script govValidatorHash
-                  ]
+                . withValue gst
-              , txInfoFee = Value.singleton "" "" 2
+                . withDatum governorInputDatum
-              , txInfoMint = burntGAT
+          ]
-              , txInfoDCert = []
+   in buildSpendingUnsafe builder
-              , txInfoWdrl = []
-              , txInfoValidRange = Interval.always
-              , txInfoSignatories = [signer]
-              , txInfoData =
-                  datumPair
-                    <$> [ governorInputDatum
-                        , governorOutputDatum
-                        , mockEffectInputDatum
-                        , mockEffectOutputDatum
-                        ]
-              , txInfoId = "9a12a605086a9f866731869a42d0558036fc739c74fea3849aa41562c015aaf9"
-              }
-        , scriptContextPurpose = Spending ownInputRef
-        }

agora-specs/Sample/Proposal.hs

@@ -21,39 +21,7 @@ module Sample.Proposal (
   advancePropsoalWithsStake,
 ) where
 
---------------------------------------------------------------------------------
+import Agora.Governor (GovernorDatum (..))
-
-import Plutarch.Api.V1 (
-  validatorHash,
- )
-
---------------------------------------------------------------------------------
-
-import PlutusLedgerApi.V1 (
-  Address (Address),
-  Credential (ScriptCredential),
-  Datum (Datum),
-  DatumHash,
-  POSIXTime,
-  POSIXTimeRange,
-  PubKeyHash,
-  ScriptContext (..),
-  ScriptPurpose (..),
-  ToData (toBuiltinData),
-  TxInInfo (TxInInfo),
-  TxInfo (..),
-  TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
-  TxOutRef (TxOutRef),
-  ValidatorHash,
- )
-import PlutusLedgerApi.V1.Value qualified as Value
-import PlutusTx.AssocMap qualified as AssocMap
-
---------------------------------------------------------------------------------
-
-import Agora.Governor (
-  GovernorDatum (..),
- )
 import Agora.Proposal (
   Proposal (..),
   ProposalDatum (..),
@@ -64,19 +32,78 @@ import Agora.Proposal (
   ResultTag (..),
   emptyVotesFor,
  )
-import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..))
+import Agora.Proposal.Time (
-import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..))
+  ProposalStartingTime (ProposalStartingTime),
-import Data.Tagged (Tagged (..), untag)
+  ProposalTimingConfig (..),
-import Sample.Shared
+ )
-import Test.Util (closedBoundedInterval, datumPair, toDatumHash, updateMap)
+import Agora.Stake (
-
+  ProposalLock (ProposalLock),
---------------------------------------------------------------------------------
+  Stake (..),
-
+  StakeDatum (..),
+ )
 import Data.Default.Class (Default (def))
+import Data.Tagged (Tagged (..), untag)
+import Plutarch.Context (
+  BaseBuilder,
+  MintingBuilder,
+  buildMintingUnsafe,
+  buildTxInfoUnsafe,
+  input,
+  mint,
+  output,
+  script,
+  signedWith,
+  timeRange,
+  txId,
+  withDatum,
+  withRefIndex,
+  withTxId,
+  withValue,
+ )
+import PlutusLedgerApi.V1 (
+  Datum (Datum),
+  DatumHash,
+  POSIXTime,
+  POSIXTimeRange,
+  PubKeyHash,
+  ScriptContext (..),
+  ToData (toBuiltinData),
+  TxInInfo (TxInInfo),
+  TxInfo (..),
+  TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
+  TxOutRef (..),
+  ValidatorHash,
+ )
+import PlutusLedgerApi.V1.Value qualified as Value (
+  assetClassValue,
+  singleton,
+ )
+import PlutusTx.AssocMap qualified as AssocMap (
+  Map,
+  empty,
+  fromList,
+ )
+import Sample.Shared (
+  govValidatorHash,
+  minAda,
+  proposal,
+  proposalPolicySymbol,
+  proposalStartingTimeFromTimeRange,
+  proposalValidatorHash,
+  signer,
+  signer2,
+  stake,
+  stakeAddress,
+  stakeAssetClass,
+  stakeValidatorHash,
+ )
+import Test.Util (
+  closedBoundedInterval,
+  datumPair,
+  toDatumHash,
+  updateMap,
+ )
 
---------------------------------------------------------------------------------
-
--- | This script context should be a valid transaction.
 proposalCreation :: ScriptContext
 proposalCreation =
   let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST
@@ -85,93 +112,57 @@ proposalCreation =
           [ (ResultTag 0, AssocMap.empty)
           , (ResultTag 1, AssocMap.empty)
           ]
-      proposalDatum :: Datum
+      proposalDatum :: ProposalDatum
       proposalDatum =
-        Datum
+        ProposalDatum
-          ( toBuiltinData $
+          { proposalId = ProposalId 0
-              ProposalDatum
+          , effects = effects
-                { proposalId = ProposalId 0
+          , status = Draft
-                , effects = effects
+          , cosigners = [signer]
-                , status = Draft
+          , thresholds = def
-                , cosigners = [signer]
+          , votes = emptyVotesFor effects
-                , thresholds = def
+          , timingConfig = def
-                , votes = emptyVotesFor effects
+          , startingTime = proposalStartingTimeFromTimeRange validTimeRange
-                , timingConfig = def
+          }
-                , startingTime = proposalStartingTimeFromTimeRange validTimeRange
-                }
-          )
 
-      govBefore :: Datum
+      govBefore :: GovernorDatum
       govBefore =
-        Datum
+        GovernorDatum
-          ( toBuiltinData $
+          { proposalThresholds = def
-              GovernorDatum
+          , nextProposalId = ProposalId 0
-                { proposalThresholds = def
+          , proposalTimings = def
-                , nextProposalId = ProposalId 0
+          , createProposalTimeRangeMaxWidth = def
-                , proposalTimings = def
+          }
-                , createProposalTimeRangeMaxWidth = def
+
-                }
+      govAfter :: GovernorDatum
-          )
+      govAfter = govBefore {nextProposalId = ProposalId 1}
-      govAfter :: Datum
-      govAfter =
-        Datum
-          ( toBuiltinData $
-              GovernorDatum
-                { proposalThresholds = def
-                , nextProposalId = ProposalId 1
-                , proposalTimings = def
-                , createProposalTimeRangeMaxWidth = def
-                }
-          )
 
       validTimeRange = closedBoundedInterval 10 15
-   in ScriptContext
+
-        { scriptContextTxInfo =
+      builder :: MintingBuilder
-            TxInfo
+      builder =
-              { txInfoInputs =
+        mconcat
-                  [ TxInInfo
+          [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-                      (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
+          , signedWith signer
-                      TxOut
+          , mint st
-                        { txOutAddress = Address (ScriptCredential $ validatorHash govValidator) Nothing
+          , input $
-                        , txOutValue = Value.assetClassValue proposal.governorSTAssetClass 1
+              script govValidatorHash
-                        , txOutDatumHash = Just (toDatumHash govBefore)
+                . withValue (Value.assetClassValue proposal.governorSTAssetClass 1)
-                        }
+                . withDatum govBefore
-                  ]
+                . withTxId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-              , txInfoOutputs =
+          , output $
-                  [ TxOut
+              script proposalValidatorHash
-                      { txOutAddress = Address (ScriptCredential proposalValidatorHash) Nothing
+                . withValue (st <> Value.singleton "" "" 10_000_000)
-                      , txOutValue =
+                . withDatum proposalDatum
-                          mconcat
+          , output $
-                            [ st
+              script govValidatorHash
-                            , Value.singleton "" "" 10_000_000
+                . withValue
-                            ]
+                  ( Value.assetClassValue proposal.governorSTAssetClass 1
-                      , txOutDatumHash = Just (toDatumHash proposalDatum)
+                      <> Value.singleton "" "" 10_000_000
-                      }
+                  )
-                  , TxOut
+                . withDatum govAfter
-                      { txOutAddress = Address (ScriptCredential $ validatorHash govValidator) Nothing
+          ]
-                      , txOutValue =
+   in buildMintingUnsafe builder
-                          mconcat
-                            [ Value.assetClassValue proposal.governorSTAssetClass 1
-                            , Value.singleton "" "" 10_000_000
-                            ]
-                      , txOutDatumHash = Just (toDatumHash govAfter)
-                      }
-                  ]
-              , txInfoFee = Value.singleton "" "" 2
-              , txInfoMint = st
-              , txInfoDCert = []
-              , txInfoWdrl = []
-              , txInfoValidRange = validTimeRange
-              , txInfoSignatories = [signer]
-              , txInfoData =
-                  [ datumPair proposalDatum
-                  , datumPair govBefore
-                  , datumPair govAfter
-                  ]
-              , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-              }
-        , scriptContextPurpose = Minting proposalPolicySymbol
-        }
 
 proposalRef :: TxOutRef
 proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1
@@ -209,66 +200,43 @@ cosignProposal newSigners =
         closedBoundedInterval
           10
           ((def :: ProposalTimingConfig).draftTime - 10)
-   in TxInfo
+      builder :: BaseBuilder
-        { txInfoInputs =
+      builder =
-            [ TxInInfo
+        mconcat
-                proposalRef
+          [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-                TxOut
+          , mint st
-                  { txOutAddress = proposalValidatorAddress
+          , mconcat $ signedWith <$> newSigners
-                  , txOutValue =
+          , timeRange validTimeRange
-                      mconcat
+          , input $
-                        [ st
+              script proposalValidatorHash
-                        , Value.singleton "" "" 10_000_000
+                . withValue (st <> Value.singleton "" "" 10_000_000)
-                        ]
+                . withDatum proposalBefore
-                  , txOutDatumHash = Just (toDatumHash proposalBefore)
+                . withTxId (txOutRefId proposalRef)
-                  }
+                . withRefIndex (txOutRefIdx proposalRef)
-            , TxInInfo
+          , input $
-                stakeRef
+              script stakeValidatorHash
-                TxOut
+                . withValue
-                  { txOutAddress = stakeAddress
+                  ( Value.singleton "" "" 10_000_000
-                  , txOutValue =
+                      <> Value.assetClassValue (untag stake.gtClassRef) 50_000_000
-                      mconcat
+                      <> Value.assetClassValue stakeAssetClass 1
-                        [ Value.singleton "" "" 10_000_000
+                  )
-                        , Value.assetClassValue (untag stake.gtClassRef) 50_000_000
+                . withDatum stakeDatum
-                        , Value.assetClassValue stakeAssetClass 1
+                . withTxId (txOutRefId stakeRef)
-                        ]
+                . withRefIndex (txOutRefIdx stakeRef)
-                  , txOutDatumHash = Just (toDatumHash stakeDatum)
+          , output $
-                  }
+              script proposalValidatorHash
-            ]
+                . withValue (st <> Value.singleton "" "" 10_000_000)
-        , txInfoOutputs =
+                . withDatum proposalAfter
-            [ TxOut
+          , output $
-                { txOutAddress = Address (ScriptCredential proposalValidatorHash) Nothing
+              script stakeValidatorHash
-                , txOutValue =
+                . withValue
-                    mconcat
+                  ( Value.singleton "" "" 10_000_000
-                      [ st
+                      <> Value.assetClassValue (untag stake.gtClassRef) 50_000_000
-                      , Value.singleton "" "" 10_000_000
+                      <> Value.assetClassValue stakeAssetClass 1
-                      ]
+                  )
-                , txOutDatumHash = Just (toDatumHash . Datum $ toBuiltinData proposalAfter)
+                . withDatum stakeDatum
-                }
+          ]
-            , TxOut
+   in buildTxInfoUnsafe builder
-                { txOutAddress = stakeAddress
-                , txOutValue =
-                    mconcat
-                      [ Value.singleton "" "" 10_000_000
-                      , Value.assetClassValue (untag stake.gtClassRef) 50_000_000
-                      , Value.assetClassValue stakeAssetClass 1
-                      ]
-                , txOutDatumHash = Just (toDatumHash stakeDatum)
-                }
-            ]
-        , txInfoFee = Value.singleton "" "" 2
-        , txInfoMint = st
-        , txInfoDCert = []
-        , txInfoWdrl = []
-        , txInfoValidRange = validTimeRange
-        , txInfoSignatories = newSigners
-        , txInfoData =
-            [ datumPair . Datum $ toBuiltinData proposalBefore
-            , datumPair . Datum $ toBuiltinData proposalAfter
-            , datumPair . Datum $ toBuiltinData stakeDatum
-            ]
-        , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-        }
 
 --------------------------------------------------------------------------------
 
@@ -309,8 +277,8 @@ voteOnProposal params =
 
       ---
 
-      proposalInputDatum' :: ProposalDatum
+      proposalInputDatum :: ProposalDatum
-      proposalInputDatum' =
+      proposalInputDatum =
         ProposalDatum
           { proposalId = ProposalId 42
           , effects = effects
@@ -321,15 +289,6 @@ voteOnProposal params =
           , timingConfig = def
           , startingTime = ProposalStartingTime 0
           }
-      proposalInputDatum :: Datum
-      proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
-      proposalInput :: TxOut
-      proposalInput =
-        TxOut
-          { txOutAddress = proposalValidatorAddress
-          , txOutValue = pst
-          , txOutDatumHash = Just $ toDatumHash proposalInputDatum
-          }
 
       ---
 
@@ -341,27 +300,13 @@ voteOnProposal params =
 
       ---
 
-      stakeInputDatum' :: StakeDatum
+      stakeInputDatum :: StakeDatum
-      stakeInputDatum' =
+      stakeInputDatum =
         StakeDatum
           { stakedAmount = Tagged params.voteCount
           , owner = stakeOwner
           , lockedBy = existingLocks
           }
-      stakeInputDatum :: Datum
-      stakeInputDatum = Datum $ toBuiltinData stakeInputDatum'
-      stakeInput :: TxOut
-      stakeInput =
-        TxOut
-          { txOutAddress = stakeAddress
-          , txOutValue =
-              mconcat
-                [ sst
-                , Value.assetClassValue (untag stake.gtClassRef) params.voteCount
-                , minAda
-                ]
-          , txOutDatumHash = Just $ toDatumHash stakeInputDatum
-          }
 
       ---
 
@@ -370,39 +315,25 @@ voteOnProposal params =
 
       ---
 
-      proposalOutputDatum' :: ProposalDatum
+      proposalOutputDatum :: ProposalDatum
-      proposalOutputDatum' =
+      proposalOutputDatum =
-        proposalInputDatum'
+        proposalInputDatum
           { votes = ProposalVotes updatedVotes
           }
-      proposalOutputDatum :: Datum
-      proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum'
-      proposalOutput :: TxOut
-      proposalOutput =
-        proposalInput
-          { txOutDatumHash = Just $ toDatumHash proposalOutputDatum
-          }
 
       ---
 
       -- Off-chain code should do exactly like this: prepend new lock toStatus the list.
       updatedLocks :: [ProposalLock]
-      updatedLocks = ProposalLock params.voteFor proposalInputDatum'.proposalId : existingLocks
+      updatedLocks = ProposalLock params.voteFor proposalInputDatum.proposalId : existingLocks
 
       ---
 
-      stakeOutputDatum' :: StakeDatum
+      stakeOutputDatum :: StakeDatum
-      stakeOutputDatum' =
+      stakeOutputDatum =
-        stakeInputDatum'
+        stakeInputDatum
           { lockedBy = updatedLocks
           }
-      stakeOutputDatum :: Datum
-      stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum'
-      stakeOutput :: TxOut
-      stakeOutput =
-        stakeInput
-          { txOutDatumHash = Just $ toDatumHash stakeOutputDatum
-          }
 
       ---
 
@@ -410,21 +341,43 @@ voteOnProposal params =
         closedBoundedInterval
           ((def :: ProposalTimingConfig).draftTime + 1)
           ((def :: ProposalTimingConfig).votingTime - 1)
-   in TxInfo
+
-        { txInfoInputs =
+      builder :: BaseBuilder
-            [ TxInInfo proposalRef proposalInput
+      builder =
-            , TxInInfo stakeRef stakeInput
+        mconcat
-            ]
+          [ txId "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c"
-        , txInfoOutputs = [proposalOutput, stakeOutput]
+          , signedWith stakeOwner
-        , txInfoFee = Value.singleton "" "" 2
+          , timeRange validTimeRange
-        , txInfoMint = mempty
+          , input $
-        , txInfoDCert = []
+              script proposalValidatorHash
-        , txInfoWdrl = []
+                . withValue pst
-        , txInfoValidRange = validTimeRange
+                . withDatum proposalInputDatum
-        , txInfoSignatories = [stakeOwner]
+                . withTxId (txOutRefId proposalRef)
-        , txInfoData = datumPair <$> [proposalInputDatum, proposalOutputDatum, stakeInputDatum, stakeOutputDatum]
+                . withRefIndex (txOutRefIdx proposalRef)
-        , txInfoId = "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c"
+          , input $
-        }
+              script stakeValidatorHash
+                . withValue
+                  ( sst
+                      <> Value.assetClassValue (untag stake.gtClassRef) params.voteCount
+                      <> minAda
+                  )
+                . withDatum stakeInputDatum
+                . withTxId (txOutRefId stakeRef)
+                . withRefIndex (txOutRefIdx stakeRef)
+          , output $
+              script proposalValidatorHash
+                . withValue pst
+                . withDatum proposalOutputDatum
+          , output $
+              script stakeValidatorHash
+                . withValue
+                  ( sst
+                      <> Value.assetClassValue (untag stake.gtClassRef) params.voteCount
+                      <> minAda
+                  )
+                . withDatum stakeOutputDatum
+          ]
+   in buildTxInfoUnsafe builder
 
 --------------------------------------------------------------------------------
 
@@ -451,13 +404,11 @@ mkTransitionTxInfo ::
   -- | Valid time range of the transaction.
   POSIXTimeRange ->
   TxInfo
-mkTransitionTxInfo from to effects votes startingTime timeRange =
+mkTransitionTxInfo from to effects votes startingTime validTime =
   let pst = Value.singleton proposalPolicySymbol "" 1
 
-      ---
+      proposalInputDatum :: ProposalDatum
-
+      proposalInputDatum =
-      proposalInputDatum' :: ProposalDatum
-      proposalInputDatum' =
         ProposalDatum
           { proposalId = ProposalId 0
           , effects = effects
@@ -468,43 +419,30 @@ mkTransitionTxInfo from to effects votes startingTime timeRange =
           , timingConfig = def
           , startingTime = startingTime
           }
-      proposalInputDatum :: Datum
-      proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
-      proposalInput :: TxOut
-      proposalInput =
-        TxOut
-          { txOutAddress = proposalValidatorAddress
-          , txOutValue = pst
-          , txOutDatumHash = Just $ toDatumHash proposalInputDatum
-          }
 
-      ---
+      proposalOutputDatum :: ProposalDatum
-
+      proposalOutputDatum =
-      proposalOutputDatum' :: ProposalDatum
+        proposalInputDatum
-      proposalOutputDatum' =
-        proposalInputDatum'
           { status = to
           }
-      proposalOutputDatum :: Datum
+
-      proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum'
+      builder :: BaseBuilder
-      proposalOutput :: TxOut
+      builder =
-      proposalOutput =
+        mconcat
-        proposalInput
+          [ txId "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a"
-          { txOutValue = proposalInput.txOutValue <> minAda
+          , signedWith signer
-          , txOutDatumHash = Just $ toDatumHash proposalOutputDatum
+          , timeRange validTime
-          }
+          , input $
-   in TxInfo
+              script proposalValidatorHash
-        { txInfoInputs = [TxInInfo proposalRef proposalInput]
+                . withValue pst
-        , txInfoOutputs = [proposalOutput]
+                . withDatum proposalInputDatum
-        , txInfoFee = Value.singleton "" "" 2
+                . withTxId (txOutRefId proposalRef)
-        , txInfoMint = mempty
+          , output $
-        , txInfoDCert = []
+              script proposalValidatorHash
-        , txInfoWdrl = []
+                . withValue (pst <> minAda)
-        , txInfoValidRange = timeRange
+                . withDatum proposalOutputDatum
-        , txInfoSignatories = [signer]
+          ]
-        , txInfoData = datumPair <$> [proposalInputDatum, proposalOutputDatum]
+   in buildTxInfoUnsafe builder
-        , txInfoId = "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a"
-        }
 
 {- | Create a valid 'TxInfo' that advances a proposal, given the parameters.
      Note that 'TransitionParameters.initialProposalStatus' should not be 'Finished'.

agora-specs/Sample/Shared.hs

@@ -48,15 +48,14 @@ module Sample.Shared (
   gatTn,
   gatCs,
   mockTrEffect,
+  mockTrEffectHash,
   trCredential,
   wrongEffHash,
 ) where
 
-import Agora.AuthorityToken
+import Agora.AuthorityToken (AuthorityToken)
 import Agora.Effect.NoOp (noOpValidator)
-import Agora.Governor (
+import Agora.Governor (Governor (Governor))
-  Governor (Governor),
- )
 import Agora.Governor.Scripts (
   authorityTokenFromGovernor,
   authorityTokenSymbolFromGovernor,
@@ -72,10 +71,7 @@ import Agora.Governor.Scripts (
   stakeSTSymbolFromGovernor,
   stakeValidatorHashFromGovernor,
  )
-import Agora.Proposal (
+import Agora.Proposal (Proposal (..), ProposalThresholds (..))
-  Proposal (..),
-  ProposalThresholds (..),
- )
 import Agora.Proposal.Time (
   MaxTimeRangeWidth (..),
   ProposalStartingTime (ProposalStartingTime),
@@ -107,14 +103,13 @@ import PlutusLedgerApi.V1 (
   Value,
  )
 import PlutusLedgerApi.V1.Address (scriptHashAddress)
-import PlutusLedgerApi.V1.Contexts (
+import PlutusLedgerApi.V1.Contexts (TxOut (..))
-  TxOut (..),
- )
 import PlutusLedgerApi.V1.Scripts (Validator, ValidatorHash (..))
 import PlutusLedgerApi.V1.Value (AssetClass, TokenName)
-import PlutusLedgerApi.V1.Value qualified as Value
+import PlutusLedgerApi.V1.Value qualified as Value (
-
+  assetClass,
---------------------------------------------------------------------------------
+  singleton,
+ )
 
 stake :: Stake
 stake = stakeFromGovernor governor
@@ -258,6 +253,10 @@ gatTn = validatorHashToTokenName $ validatorHash mockTrEffect
 mockTrEffect :: Validator
 mockTrEffect = mkValidator $ noOpValidator gatCs
 
+-- | Mock treasury effect validator hash
+mockTrEffectHash :: ValidatorHash
+mockTrEffectHash = validatorHash mockTrEffect
+
 {- | A SHA-256 hash which (in all certainty) should not match the
      hash of the dummy effect script.
 -}

agora-specs/Sample/Stake.hs

@@ -20,39 +20,50 @@ module Sample.Stake (
   DepositWithdrawExample (..),
 ) where
 
---------------------------------------------------------------------------------
+import Agora.SafeMoney (GTTag)
-import Plutarch.Api.V1 (
+import Agora.Stake (
-  mkValidator,
+  Stake (gtClassRef),
-  validatorHash,
+  StakeDatum (StakeDatum, stakedAmount),
+ )
+import Agora.Stake.Scripts (stakeValidator)
+import Data.Tagged (Tagged, untag)
+import Plutarch.Api.V1 (mkValidator, validatorHash)
+import Plutarch.Context (
+  MintingBuilder,
+  SpendingBuilder,
+  buildMintingUnsafe,
+  buildSpendingUnsafe,
+  input,
+  mint,
+  output,
+  script,
+  signedWith,
+  txId,
+  withDatum,
+  withSpending,
+  withTxId,
+  withValue,
  )
 import PlutusLedgerApi.V1 (
-  Address (Address),
-  Credential (ScriptCredential),
   Datum (Datum),
-  DatumHash (DatumHash),
   ScriptContext (..),
-  ScriptPurpose (..),
+  ScriptPurpose (Minting),
   ToData (toBuiltinData),
-  TxInInfo (TxInInfo),
+  TokenName (TokenName),
-  TxInfo (..),
+  TxInfo (txInfoData, txInfoSignatories),
-  TxOut (txOutAddress, txOutDatumHash, txOutValue),
   ValidatorHash (ValidatorHash),
  )
-import PlutusLedgerApi.V1.Contexts (TxOut (TxOut), TxOutRef (TxOutRef))
+import PlutusLedgerApi.V1.Value qualified as Value (
-import PlutusLedgerApi.V1.Interval qualified as Interval
+  assetClassValue,
-import PlutusLedgerApi.V1.Value (TokenName (TokenName))
+  singleton,
-import PlutusLedgerApi.V1.Value qualified as Value
+ )
-
+import Sample.Shared (
---------------------------------------------------------------------------------
+  signer,
-
+  stake,
-import Agora.SafeMoney (GTTag)
+  stakeAssetClass,
-import Agora.Stake
+  stakeSymbol,
-import Agora.Stake.Scripts (stakeValidator)
+  stakeValidatorHash,
-import Data.Tagged (Tagged (..), untag)
+ )
-import Sample.Shared
-import Test.Util (datumPair, toDatumHash)
-
---------------------------------------------------------------------------------
 
 -- | 'TokenName' that represents the hash of the 'Stake' validator.
 validatorHashTN :: TokenName
@@ -62,30 +73,21 @@ validatorHashTN = let ValidatorHash vh = validatorHash (mkValidator $ stakeValid
 stakeCreation :: ScriptContext
 stakeCreation =
   let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
-      datum :: Datum
+      datum :: StakeDatum
-      datum = Datum (toBuiltinData $ StakeDatum 424242424242 signer [])
+      datum = StakeDatum 424242424242 signer []
-   in ScriptContext
+
-        { scriptContextTxInfo =
+      builder :: MintingBuilder
-            TxInfo
+      builder =
-              { txInfoInputs = []
+        mconcat
-              , txInfoOutputs =
+          [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-                  [ TxOut
+          , signedWith signer
-                      { txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
+          , mint st
-                      , txOutValue = st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242
+          , output $
-                      , txOutDatumHash = Just (DatumHash "")
+              script stakeValidatorHash
-                      }
+                . withValue (st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242)
-                  ]
+                . withDatum datum
-              , txInfoFee = Value.singleton "" "" 2
+          ]
-              , txInfoMint = st
+   in buildMintingUnsafe builder
-              , txInfoDCert = []
-              , txInfoWdrl = []
-              , txInfoValidRange = Interval.always
-              , txInfoSignatories = [signer]
-              , txInfoData = [("", datum)]
-              , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-              }
-        , scriptContextPurpose = Minting stakeSymbol
-        }
 
 -- | This ScriptContext should fail because the datum has too much GT.
 stakeCreationWrongDatum :: ScriptContext
@@ -127,36 +129,25 @@ stakeDepositWithdraw config =
 
       stakeAfter :: StakeDatum
       stakeAfter = stakeBefore {stakedAmount = stakeBefore.stakedAmount + config.delta}
-   in ScriptContext
+
-        { scriptContextTxInfo =
+      builder :: SpendingBuilder
-            TxInfo
+      builder =
-              { txInfoInputs =
+        mconcat
-                  [ TxInInfo
+          [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-                      (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
+          , signedWith signer
-                      TxOut
+          , mint st
-                        { txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
+          , input $
-                        , txOutValue =
+              script stakeValidatorHash
-                            st
+                . withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount))
-                              <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount)
+                . withDatum stakeAfter
-                        , txOutDatumHash = Just (toDatumHash stakeAfter)
+                . withTxId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-                        }
+          , output $
-                  ]
+              script stakeValidatorHash
-              , txInfoOutputs =
+                . withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount))
-                  [ TxOut
+                . withDatum stakeAfter
-                      { txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
+          , withSpending $
-                      , txOutValue =
+              script stakeValidatorHash
-                          st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount)
+                . withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount))
-                      , txOutDatumHash = Just (toDatumHash stakeAfter)
+                . withDatum stakeAfter
-                      }
+          ]
-                  ]
+   in buildSpendingUnsafe builder
-              , txInfoFee = Value.singleton "" "" 2
-              , txInfoMint = st
-              , txInfoDCert = []
-              , txInfoWdrl = []
-              , txInfoValidRange = Interval.always
-              , txInfoSignatories = [signer]
-              , txInfoData = [datumPair stakeAfter]
-              , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-              }
-        , scriptContextPurpose = Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
-        }

agora-specs/Sample/Treasury.hs

@@ -17,147 +17,111 @@ module Sample.Treasury (
   trCtxGATNameNotAddress,
 ) where
 
-import Plutarch.Api.V1 (validatorHash)
+import Plutarch.Context (
+  MintingBuilder,
+  UTXO,
+  buildMintingUnsafe,
+  credential,
+  input,
+  mint,
+  output,
+  script,
+  signedWith,
+  txId,
+  withTxId,
+  withValue,
+ )
 import PlutusLedgerApi.V1 (
-  BuiltinByteString,
   Credential (PubKeyCredential),
   PubKeyHash (PubKeyHash),
  )
 import PlutusLedgerApi.V1.Address (Address (..))
 import PlutusLedgerApi.V1.Contexts (
   ScriptContext (..),
-  ScriptPurpose (Minting),
   TxInInfo (..),
-  TxInfo (..),
   TxOut (..),
   TxOutRef (..),
  )
-import PlutusLedgerApi.V1.Credential (Credential (ScriptCredential))
+import PlutusLedgerApi.V1.Scripts (ValidatorHash (ValidatorHash))
-import PlutusLedgerApi.V1.Interval qualified as Interval
+import PlutusLedgerApi.V1.Value qualified as Value (singleton)
-import PlutusLedgerApi.V1.Scripts (
-  ValidatorHash (ValidatorHash),
- )
-import PlutusLedgerApi.V1.Value qualified as Value
 import Sample.Shared (
   gatCs,
   gatTn,
   minAda,
-  mockTrEffect,
+  mockTrEffectHash,
   signer,
-  treasuryOut,
+  trCredential,
   wrongEffHash,
  )
-import Test.Util (datumPair)
+
+baseCtxBuilder :: MintingBuilder
+baseCtxBuilder =
+  let treasury :: UTXO -> UTXO
+      treasury =
+        credential trCredential
+          . withValue minAda
+          . withTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+   in mconcat
+        [ txId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+        , signedWith signer
+        , mint (Value.singleton gatCs gatTn (-1))
+        , input treasury
+        , output treasury
+        ]
 
 {- | A `ScriptContext` that should be compatible with treasury
      transactions.
 -}
 validCtx :: ScriptContext
 validCtx =
-  ScriptContext
+  let builder :: MintingBuilder
-    { scriptContextPurpose = Minting gatCs
+      builder =
-    , scriptContextTxInfo =
+        mconcat
-        TxInfo
+          [ baseCtxBuilder
-          { txInfoInputs =
+          , input $
-              [ treasuryIn
+              script mockTrEffectHash
-              , effectIn
+                . withValue (Value.singleton gatCs gatTn 1 <> minAda)
-              ]
+                . withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
-          , txInfoOutputs =
+          ]
-              [ treasuryOut
+   in buildMintingUnsafe builder
-              ]
-          , -- Ensure sufficient ADA for transaction costs.
-            txInfoFee = Value.singleton "" "" 2 -- 2 ADA.
-          , -- Burn the GAT.
-            txInfoMint = Value.singleton gatCs gatTn (-1)
-          , txInfoDCert = []
-          , txInfoWdrl = []
-          , txInfoValidRange = Interval.always
-          , txInfoSignatories = [signer]
-          , txInfoData =
-              [ datumPair treasuryIn
-              , datumPair treasuryOut
-              , datumPair effectIn
-              ]
-          , txInfoId =
-              "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
-          }
-    }
-  where
-    treasuryIn =
-      TxInInfo
-        { txInInfoOutRef = treasuryRef
-        , txInInfoResolved = treasuryOut
-        }
-    effectIn =
-      TxInInfo
-        { txInInfoOutRef = effectRef
-        , txInInfoResolved =
-            TxOut
-              { txOutAddress =
-                  Address (ScriptCredential $ validatorHash mockTrEffect) Nothing
-              , txOutValue =
-                  mconcat
-                    [ Value.singleton gatCs gatTn 1
-                    , minAda
-                    ]
-              , txOutDatumHash = Nothing
-              }
-        }
 
--- | Reference to treasury output.
 treasuryRef :: TxOutRef
 treasuryRef =
   TxOutRef
     "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
     1
 
--- | Reference to dummy effect output.
+{- | Input representing a user wallet with a valid GAT.
-effectRef :: TxOutRef
+ TODO: Resturcture this part of test.
-effectRef =
+-}
-  TxOutRef
-    "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
-    0
-
--- | Input representing a user wallet with a valid GAT.
 walletIn :: TxInInfo
 walletIn =
-  TxInInfo
+  let (ValidatorHash addressBs) = mockTrEffectHash
-    { txInInfoOutRef =
+   in TxInInfo
-        TxOutRef
+        { txInInfoOutRef =
-          "cf4a8b33dd8e4493187e3339ecc3802d0cc000c947fb5559b7614153947d4e83"
+            TxOutRef
-          0
+              "cf4a8b33dd8e4493187e3339ecc3802d0cc000c947fb5559b7614153947d4e83"
-    , txInInfoResolved =
+              0
-        TxOut
+        , txInInfoResolved =
-          { txOutDatumHash = Nothing
+            TxOut
-          , txOutValue = Value.singleton gatCs gatTn 1
+              { txOutDatumHash = Nothing
-          , txOutAddress =
+              , txOutValue = Value.singleton gatCs gatTn 1
-              Address
+              , txOutAddress =
-                (PubKeyCredential $ PubKeyHash addressBs)
+                  Address
-                Nothing
+                    (PubKeyCredential $ PubKeyHash addressBs)
-          }
+                    Nothing
-    }
+              }
-
+        }
-addressBs :: BuiltinByteString
-(ValidatorHash addressBs) = validatorHash mockTrEffect
 
 trCtxGATNameNotAddress :: ScriptContext
 trCtxGATNameNotAddress =
-  let txInfo = validCtx.scriptContextTxInfo
+  let builder :: MintingBuilder
-      inputs = txInfo.txInfoInputs
+      builder =
-      effectIn = inputs !! 1
+        mconcat
-      invalidEff =
+          [ baseCtxBuilder
-        effectIn
+          , input $
-          { txInInfoResolved =
+              script wrongEffHash
-              effectIn.txInInfoResolved
+                . withValue (Value.singleton gatCs gatTn 1 <> minAda)
-                { txOutAddress = Address (ScriptCredential wrongEffHash) Nothing
+                . withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
-                }
+          ]
-          }
+   in buildMintingUnsafe builder
-   in validCtx
-        { scriptContextTxInfo =
-            txInfo
-              { txInfoInputs =
-                  [ head inputs
-                  , invalidEff
-                  ]
-              }
-        }

agora-specs/Spec/AuthorityToken.hs

@@ -9,14 +9,8 @@ Tests for Authority token functions
 -}
 module Spec.AuthorityToken (specs) where
 
---------------------------------------------------------------------------------
-
 import Agora.AuthorityToken (singleAuthorityTokenBurned)
-import Plutarch
+import Plutarch (ClosedTerm, POpaque, compile, perror, popaque)
-import Prelude
-
---------------------------------------------------------------------------------
-
 import PlutusLedgerApi.V1 (
   Address (Address),
   Credential (PubKeyCredential, ScriptCredential),
@@ -29,15 +23,27 @@ import PlutusLedgerApi.V1 (
   ValidatorHash (ValidatorHash),
   Value,
  )
-import PlutusLedgerApi.V1.Interval qualified as Interval
+import PlutusLedgerApi.V1.Interval qualified as Interval (always)
-import PlutusLedgerApi.V1.Value qualified as Value
+import PlutusLedgerApi.V1.Value qualified as Value (
-import PlutusTx.AssocMap qualified as AssocMap
+  Value (Value),
+  singleton,
+ )
+import PlutusTx.AssocMap qualified as AssocMap (empty)
 import Test.Specification (
   SpecificationTree,
   group,
   scriptFails,
   scriptSucceeds,
  )
+import Prelude (
+  Functor (fmap),
+  Maybe (Nothing),
+  PBool,
+  Semigroup ((<>)),
+  pconstant,
+  pconstantData,
+  pif,
+ )
 
 currencySymbol :: CurrencySymbol
 currencySymbol = "deadbeef"

agora-specs/Spec/Governor.hs

@@ -26,8 +26,6 @@ import Test.Specification (
   validatorSucceedsWith,
  )
 
---------------------------------------------------------------------------------
-
 -- | The SpecificationTree exported by this module.
 specs :: [SpecificationTree]
 specs =

agora-specs/Spec/Proposal.hs

@@ -9,8 +9,6 @@ Tests for Proposal policy and validator
 -}
 module Spec.Proposal (specs) where
 
---------------------------------------------------------------------------------
-
 import Agora.Proposal (
   Proposal (..),
   ProposalDatum (..),
@@ -28,11 +26,10 @@ import Agora.Proposal (
   thresholds,
   votes,
  )
-import Agora.Proposal.Scripts (
+import Agora.Proposal.Scripts (proposalPolicy, proposalValidator)
-  proposalPolicy,
+import Agora.Proposal.Time (
-  proposalValidator,
+  ProposalStartingTime (ProposalStartingTime),
  )
-import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime))
 import Agora.Stake (
   ProposalLock (ProposalLock),
   StakeDatum (StakeDatum),
@@ -42,10 +39,27 @@ import Agora.Stake.Scripts (stakeValidator)
 import Data.Default.Class (Default (def))
 import Data.Tagged (Tagged (Tagged), untag)
 import PlutusLedgerApi.V1 (ScriptContext (..), ScriptPurpose (..))
-import PlutusTx.AssocMap qualified as AssocMap
+import PlutusTx.AssocMap qualified as AssocMap (empty, fromList)
-import Sample.Proposal qualified as Proposal
+import Sample.Proposal qualified as Proposal (
+  TransitionParameters (
+    TransitionParameters,
+    initialProposalStatus,
+    proposalStartingTime
+  ),
+  VotingParameters (VotingParameters, voteCount, voteFor),
+  advanceFinishedPropsoal,
+  advanceProposalFailureTimeout,
+  advanceProposalInsufficientVotes,
+  advanceProposalSuccess,
+  advancePropsoalWithsStake,
+  cosignProposal,
+  proposalCreation,
+  proposalRef,
+  stakeRef,
+  voteOnProposal,
+ )
 import Sample.Shared (signer, signer2)
-import Sample.Shared qualified as Shared
+import Sample.Shared qualified as Shared (proposal, stake)
 import Test.Specification (
   SpecificationTree,
   group,
@@ -54,8 +68,6 @@ import Test.Specification (
   validatorSucceedsWith,
  )
 
---------------------------------------------------------------------------------
-
 -- | Stake specs.
 specs :: [SpecificationTree]
 specs =

agora-specs/Spec/Stake.hs

@@ -9,19 +9,27 @@ Tests for Stake policy and validator
 -}
 module Spec.Stake (specs) where
 
---------------------------------------------------------------------------------
+import Agora.Stake (
-
+  Stake (..),
-import Prelude
+  StakeDatum (StakeDatum),
-
+  StakeRedeemer (DepositWithdraw),
---------------------------------------------------------------------------------
+ )
-
-import Agora.Stake (Stake (..), StakeDatum (StakeDatum), StakeRedeemer (DepositWithdraw))
 import Agora.Stake.Scripts (stakePolicy, stakeValidator)
-
+import Sample.Stake (
---------------------------------------------------------------------------------
+  DepositWithdrawExample (
-
+    DepositWithdrawExample,
-import Sample.Stake (DepositWithdrawExample (DepositWithdrawExample, delta, startAmount), signer)
+    delta,
-import Sample.Stake qualified as Stake
+    startAmount
+  ),
+  signer,
+ )
+import Sample.Stake qualified as Stake (
+  stake,
+  stakeCreation,
+  stakeCreationUnsigned,
+  stakeCreationWrongDatum,
+  stakeDepositWithdraw,
+ )
 import Test.Specification (
   SpecificationTree,
   group,
@@ -31,8 +39,7 @@ import Test.Specification (
   validatorSucceedsWith,
  )
 import Test.Util (toDatum)
-
+import Prelude (Num (negate), ($))
---------------------------------------------------------------------------------
 
 -- | The SpecificationTree exported by this module.
 specs :: [SpecificationTree]

agora-specs/Spec/Treasury.hs

@@ -25,9 +25,7 @@ import Agora.Treasury (
   TreasuryRedeemer (SpendTreasuryGAT),
   treasuryValidator,
  )
-import PlutusLedgerApi.V1 (
+import PlutusLedgerApi.V1 (DCert (DCertDelegRegKey))
-  DCert (DCertDelegRegKey),
- )
 import PlutusLedgerApi.V1.Contexts (
   ScriptContext (scriptContextPurpose, scriptContextTxInfo),
   ScriptPurpose (Certifying, Rewarding, Spending),
@@ -36,10 +34,8 @@ import PlutusLedgerApi.V1.Contexts (
 import PlutusLedgerApi.V1.Credential (
   StakingCredential (StakingHash),
  )
-import PlutusLedgerApi.V1.Value qualified as Value
+import PlutusLedgerApi.V1.Value qualified as Value (singleton)
-import Sample.Shared (
+import Sample.Shared (trCredential)
-  trCredential,
- )
 import Sample.Treasury (
   gatCs,
   gatTn,

agora-specs/Spec/Utils.hs

@@ -9,7 +9,5 @@ module Spec.Utils (tests) where
 
 import Test.Tasty (TestTree)
 
---------------------------------------------------------------------------------
-
 tests :: [TestTree]
 tests = []

agora-test/Spec.hs

@@ -7,6 +7,7 @@ import Test.Tasty (defaultMain, testGroup)
 
 --------------------------------------------------------------------------------
 
+import Property.Governor qualified as Governer
 import Property.MultiSig qualified as MultiSig
 import Spec.AuthorityToken qualified as AuthorityToken
 import Spec.Effect.GovernorMutation qualified as GovernorMutation
@@ -37,6 +38,7 @@ main = do
       , toTestTree $ group "Treasury tests" Treasury.specs
       , toTestTree $ group "AuthorityToken tests" AuthorityToken.specs
       , toTestTree $ group "Governor tests" Governor.specs
+      , testGroup "Governor properties" Governer.props
       , testGroup
           "Utility tests"
           Utils.tests

agora.cabal

@@ -176,6 +176,7 @@ library agora-specs
   import:          lang, deps, test-deps
   exposed-modules:
     Property.Generator
+    Property.Governor
     Property.MultiSig
     Sample.Effect.GovernorMutation
     Sample.Effect.TreasuryWithdrawal

bench.csv

@@ -4,26 +4,26 @@ Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries
 Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,408085321,966048,3383
 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7665
 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,97345575,266935,3358
-Agora/Stake/policy/stakeCreation,43114609,124549,2094
+Agora/Stake/policy/stakeCreation,43114795,124549,2156
-Agora/Stake/validator/stakeDepositWithdraw deposit,171823342,464745,4069
+Agora/Stake/validator/stakeDepositWithdraw deposit,171823342,464745,4144
-Agora/Stake/validator/stakeDepositWithdraw withdraw,171823342,464745,4061
+Agora/Stake/validator/stakeDepositWithdraw withdraw,171823342,464745,4132
-Agora/Proposal/policy/proposalCreation,23140177,69194,1525
+Agora/Proposal/policy/proposalCreation,23140177,69194,1517
-Agora/Proposal/validator/cosignature/proposal,147258436,403167,5646
+Agora/Proposal/validator/cosignature/proposal,145357978,397941,5721
-Agora/Proposal/validator/cosignature/stake,117270039,287783,4606
+Agora/Proposal/validator/cosignature/stake,115369581,282557,4681
-Agora/Proposal/validator/voting/proposal,154824944,415642,5654
+Agora/Proposal/validator/voting/proposal,154824944,415642,5650
-Agora/Proposal/validator/voting/stake,99545453,256941,4659
+Agora/Proposal/validator/voting/stake,99545453,256941,4655
-Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,94701799,249495,5031
+Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,94701799,249495,5027
-Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,93858377,247992,5034
+Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,93858377,247992,5030
-Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,95554844,251598,5034
+Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,95554844,251598,5030
-Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,93571998,246765,5033
+Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,93571998,246765,5029
-Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,92163087,244060,5034
+Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,92163087,244060,5030
-Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,93294065,246464,5034
+Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,93294065,246464,5030
 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
-Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1841
+Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390
 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
-Agora/Governor/policy/GST minting,43087287,120125,1833
+Agora/Governor/policy/GST minting,43087287,120125,1829
 Agora/Governor/validator/proposal creation,261928725,689487,8181
-Agora/Governor/validator/GATs minting,351749811,938560,8302
+Agora/Governor/validator/GATs minting,349849353,933334,8302
-Agora/Governor/validator/mutate governor state,81730538,223502,7718
+Agora/Governor/validator/mutate governor state,84905433,234687,7766

flake.lock

@@ -6339,11 +6339,11 @@
         "plutarch-quickcheck": "plutarch-quickcheck"
       },
       "locked": {
-        "lastModified": 1655470312,
+        "lastModified": 1655492974,
-        "narHash": "sha256-O4Dy803SFOS+S1OFEecfCRkjWc8y0iHbO+EVKtBqsGk=",
+        "narHash": "sha256-FNshUKtfs8tbxAUlqhP3AgmkjKMiKyw+kEBULmg6bVM=",
         "owner": "Liqwid-Labs",
         "repo": "liqwid-plutarch-extra",
-        "rev": "fd9b2e6e713c36efef30bcef8d97a069fda7d71a",
+        "rev": "4a9cdc642b85e16e487b789012bb8417c3e197d8",
         "type": "github"
       },
       "original": {
@@ -7459,11 +7459,11 @@
     },
     "nixpkgs-2111_5": {
       "locked": {
-        "lastModified": 1654115789,
+        "lastModified": 1655415671,
-        "narHash": "sha256-k9Qr8dLrmgEn+xIVbneJdQgCYG8FbbqOrTVaExUrLFI=",
+        "narHash": "sha256-WD7HxxW1m8D/fkV1QlCYlZvnE5gQdg7ckq3myI4gPtE=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "bce6d15455f8c15c9ef511368947e7ef789c5316",
+        "rev": "f96729212602f15a6a226d2f27f5de70492ad095",
         "type": "github"
       },
       "original": {
@@ -9286,16 +9286,16 @@
         "plutarch": "plutarch_4"
       },
       "locked": {
-        "lastModified": 1654950895,
+        "lastModified": 1655492019,
-        "narHash": "sha256-HfTdkaPkyGDUiw+E8tUb/CHRzumuF+sDNcpuNRusVqM=",
+        "narHash": "sha256-ZwU9wjSaC1BCukLqx3swqD30mwppVr7Fg2Y8jEkQ2c8=",
         "owner": "Liqwid-Labs",
         "repo": "plutarch-context-builder",
-        "rev": "ae73a43ecfc51475376d2f8a9928cf27f7f10b4c",
+        "rev": "fa0e90bf0cdb258c5be500d066d5698fb360cfc3",
         "type": "github"
       },
       "original": {
         "owner": "Liqwid-Labs",
-        "ref": "main",
+        "ref": "staging",
         "repo": "plutarch-context-builder",
         "type": "github"
       }
@@ -9418,11 +9418,11 @@
         "plutarch": "plutarch_6"
       },
       "locked": {
-        "lastModified": 1654293728,
+        "lastModified": 1655307888,
-        "narHash": "sha256-6Pd410I03CetLM4YYrJmMldOYDyqGPATlmorhKKWU0Q=",
+        "narHash": "sha256-hv9tzB3IGvga6/SBDnk16S3Sfp03tvtkWd8COW0It30=",
         "owner": "liqwid-labs",
         "repo": "plutarch-quickcheck",
-        "rev": "cd7df08176e0ee5111980ead903764979d920147",
+        "rev": "541c57675eefc2ecd0fb6c6477d0b7fb8900b5fc",
         "type": "github"
       },
       "original": {

flake.nix

@@ -27,7 +27,7 @@
   inputs.plutarch-quickcheck.url =
     "github:liqwid-labs/plutarch-quickcheck?ref=staging";
   inputs.plutarch-context-builder.url =
-    "github:Liqwid-Labs/plutarch-context-builder?ref=main";
+    "github:Liqwid-Labs/plutarch-context-builder?ref=staging";
 
   outputs = inputs@{ self, nixpkgs, nixpkgs-latest, haskell-nix, plutarch, ... }:
     let