Merge pull request #135 from Liqwid-Labs/emiflake/backport-134

Backport #134
2022-06-28 12:43:18 +02:00 · 2022-06-28 12:43:18 +02:00 · 21825dc897
commit 21825dc897
parent 01e4222026 1d11a29a50
9 changed files with 95 additions and 45 deletions
--- a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs
+++ b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs
@ -23,8 +23,10 @@ import Agora.Effect.TreasuryWithdrawal (
  TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
  treasuryWithdrawalValidator,
 )
+import Crypto.Hash qualified as Crypto
+import Data.ByteArray qualified as BA
+import Data.ByteString qualified as BS
 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),
@ -67,13 +69,16 @@ currSymbol = CurrencySymbol "12312099"
 signer :: PubKeyHash
 signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"

+blake2b_224 :: BS.ByteString -> BS.ByteString
+blake2b_224 = BS.pack . BA.unpack . Crypto.hashWith Crypto.Blake2b_224
+
 -- | List of users who the effect will pay to.
 users :: [Credential]
-users = PubKeyCredential . PubKeyHash . toBuiltin . sha2_256 . C.pack . show <$> ([1 ..] :: [Integer])
+users = PubKeyCredential . PubKeyHash . toBuiltin . blake2b_224 . C.pack . show <$> ([1 ..] :: [Integer])

 -- | List of users who the effect will pay to.
 treasuries :: [Credential]
-treasuries = ScriptCredential . ValidatorHash . toBuiltin . sha2_256 . C.pack . show <$> ([1 ..] :: [Integer])
+treasuries = ScriptCredential . ValidatorHash . toBuiltin . blake2b_224 . C.pack . show <$> ([1 ..] :: [Integer])

 inputGAT :: TxInInfo
 inputGAT =
--- a/agora-specs/Sample/Proposal.hs
+++ b/agora-specs/Sample/Proposal.hs
@ -507,7 +507,7 @@ advanceProposalSuccess' params =
      outcome0WinningVotes =
        ProposalVotes $
          updateMap
-            (\_ -> Just $ untag (def :: ProposalThresholds).vote + 1)
+            (\_ -> Just $ untag (def :: ProposalThresholds).execute + 1)
            (ResultTag 0)
            emptyVotes'

@ -664,16 +664,30 @@ advanceProposalInsufficientVotes =
          ]

      -- Insufficient votes.
-      votes = emptyVotesFor effects
+      votes =
+        ProposalVotes
+          ( AssocMap.fromList
+              [ (ResultTag 0, 1)
+              , (ResultTag 1, 0)
+              ]
+          )

      proposalStartingTime = 0

      -- Valid time range.
-      -- [S + D + 1, S + V - 1]
+      -- [S + D + 1, S + V + 10]
      timeRange =
        closedBoundedInterval
-          (proposalStartingTime + (def :: ProposalTimingConfig).draftTime + 1)
-          (proposalStartingTime + (def :: ProposalTimingConfig).votingTime - 1)
+          ( proposalStartingTime
+              + (def :: ProposalTimingConfig).draftTime
+              + (def :: ProposalTimingConfig).votingTime
+              + 1
+          )
+          ( proposalStartingTime
+              + (def :: ProposalTimingConfig).draftTime
+              + (def :: ProposalTimingConfig).votingTime
+              + 10
+          )
   in mkTransitionTxInfo
        VotingReady
        Locked
--- a/agora-specs/Spec/Proposal.hs
+++ b/agora-specs/Spec/Proposal.hs
@ -181,7 +181,7 @@ specs =
                                      ( ResultTag 0
                                      , case initialState of
                                          Draft -> 0
-                                          _ -> untag (def :: ProposalThresholds).vote + 1
+                                          _ -> untag (def :: ProposalThresholds).execute + 1
                                      )
                                    , (ResultTag 1, 0)
                                    ]
@ -268,7 +268,7 @@ specs =
                  , votes =
                      ProposalVotes
                        ( AssocMap.fromList
-                            [ (ResultTag 0, 0)
+                            [ (ResultTag 0, 1)
                            , (ResultTag 1, 0)
                            ]
                        )
--- a/agora.cabal
+++ b/agora.cabal
@ -116,7 +116,9 @@ common deps
 common test-deps
  build-depends:
    , agora
+    , cryptonite
    , data-default-class
+    , memory
    , mtl
    , plutarch-context-builder
    , plutarch-quickcheck
--- a/agora/Agora/Plutarch/Orphans.hs
+++ b/agora/Agora/Plutarch/Orphans.hs
@ -88,8 +88,8 @@ instance PTryFrom PData (PAsData PDatumHash) where
  type PTryFromExcess PData (PAsData PDatumHash) = Flip Term PDatumHash
  ptryFrom' opq = runTermCont $ do
    (wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
-      ptryFromC @(PAsData PByteString) opq
-    tcont $ \f -> pif (plengthBS # unwrapped #== 64) (f ()) (ptraceError "a DatumHash should be 64 bytes long")
+      tcont $ ptryFrom @(PAsData PByteString) opq
+    tcont $ \f -> pif (plengthBS # unwrapped #== 32) (f ()) (ptraceError "a DatumHash should be 32 bytes long")
    pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)

 -- | @since 0.1.0
--- a/agora/Agora/Proposal.hs
+++ b/agora/Agora/Proposal.hs
@ -32,6 +32,7 @@ module Agora.Proposal (
  proposalDatumValid,
  pemptyVotesFor,
  pwinner,
+  pwinner',
  pneutralOption,
  pretractVotes,
 ) where
@ -709,10 +710,8 @@ proposalDatumValid proposal =
          , ptraceIfFalse "Proposal votes and effects are compatible with each other" $ PUM.pkeysEqual # datum.effects # pto (pfromData datum.votes)
          ]

-{- | Find the winner result tag, given the votes, the quorum the "neutral" result tag.
-
-     The winner should be unambiguous, meaning that if two options have the same highest votes,
-       the "neutral" option will be the winner.
+{- | Wrapper for 'pwinner''. When the winner cannot be found,
+      the 'neutral' option will be returned.

     @since 0.1.0
 -}
@ -725,7 +724,26 @@ pwinner ::
        :--> PResultTag
    )
 pwinner = phoistAcyclic $
-  plam $ \votes quorum neutral -> unTermCont $ do
+  plam $ \votes quorum neutral -> pmatch (pwinner' # votes # quorum) $ \case
+    PNothing -> neutral
+    PJust winner -> winner
+
+{- | Find the winner result tag, given the votes and the quorum.
+
+     The winner should be unambiguous, meaning that if two options have the same highest votes,
+       the function will return 'PNothing'.
+
+     @since 0.1.0
+-}
+pwinner' ::
+  Term
+    s
+    ( PProposalVotes
+        :--> PInteger
+        :--> PMaybe PResultTag
+    )
+pwinner' = phoistAcyclic $
+  plam $ \votes quorum -> unTermCont $ do
    winner <- pletC $ phighestVotes # votes
    winnerResultTag <- pletC $ pfromData $ pfstBuiltin # winner
    highestVotes <- pletC $ pfromData $ psndBuiltin # winner
@ -757,10 +775,10 @@ pwinner = phoistAcyclic $
    pure $
      pif
        (noDuplicateHighestVotes #&& exceedQuorum)
-        winnerResultTag
-        neutral
+        (pcon $ PJust winnerResultTag)
+        (pcon PNothing)

-{- | Find the winning outcome (and the corresponding vote count) given the votes.
+{- | Find the outcome with the highest vote count given the votes.

     @since 0.1.0
 -}
--- a/agora/Agora/Proposal/Scripts.hs
+++ b/agora/Agora/Proposal/Scripts.hs
@ -18,6 +18,7 @@ import Agora.Proposal (
  Proposal (governorSTAssetClass, stakeSTAssetClass),
  ProposalStatus (..),
  pretractVotes,
+  pwinner',
 )
 import Agora.Proposal.Time (
  currentProposalTime,
@ -66,6 +67,7 @@ import Plutarch.Extra.TermCont (
  ptryFromC,
 )
 import Plutarch.SafeMoney (PDiscrete (..))
+import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))

 {- | Policy for Proposals.
@ -526,6 +528,8 @@ proposalValidator proposal =
          pguardC "Cannot advance ahead of time" notTooEarly
          pguardC "Finished proposals cannot be advanced" $ pnot # isFinished

+          thresholdsF <- pletFieldsC @'["execute"] proposalF.thresholds
+
          pure $
            pif
              notTooLate
@ -544,6 +548,11 @@ proposalValidator proposal =
                    pguardC "Proposal status set to Locked" $
                      proposalOutStatus #== pconstantData Locked

+                    pguardC "Winner outcome not found" $
+                      pisJust #$ pwinner' # proposalF.votes
+                        #$ punsafeCoerce
+                        $ pfromData thresholdsF.execute
+
                    pure $ popaque (pconstant ())
                  PLocked _ -> unTermCont $ do
                    -- 'Locked' -> 'Finished'
--- a/bench.csv
+++ b/bench.csv
@ -1,37 +1,37 @@
 name,cpu,mem,size
-Agora/Effects/Treasury Withdrawal Effect/effect/Simple,68035487,187575,3723
-Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,82245885,228733,4050
-Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,81358886,228858,3915
-Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,90397270,249528,8799
+Agora/Effects/Treasury Withdrawal Effect/effect/Simple,333327612,830203,3674
+Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,492387542,1197315,3986
+Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,456007605,1104500,3859
+Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,90397270,249528,8807
 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,106082031,292993,3609
 Agora/Stake/policy/stakeCreation,52241265,152127,2514
 Agora/Stake/validator/stakeDepositWithdraw deposit,180880812,492023,4431
 Agora/Stake/validator/stakeDepositWithdraw withdraw,180880812,492023,4419
 Agora/Proposal/policy/proposalCreation,23140177,69194,1519
-Agora/Proposal/validator/cosignature/proposal,338414402,960812,8364
+Agora/Proposal/validator/cosignature/proposal,338483402,961112,8620
 Agora/Proposal/validator/cosignature/stake,126327509,315061,4968
-Agora/Proposal/validator/voting/proposal,298791918,833990,8293
-Agora/Proposal/validator/voting/stake,125076577,331847,4942
-Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,292475323,820090,8191
-Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,291631901,818587,8194
-Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,293328368,822193,8194
-Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,291345522,817360,8193
-Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,289936611,814655,8194
-Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,291067589,817059,8194
-"Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",304637691,851452,8244
-"Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",275360000,776686,8248
-"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",270836329,766331,8248
-"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",270836329,766331,8248
-"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",3074171496,8538583,29762
-"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",2782286591,7741684,30031
-"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",2630541760,7294679,29931
-"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",2630541760,7294679,29931
+Agora/Proposal/validator/voting/proposal,296656410,830692,8549
+Agora/Proposal/validator/voting/stake,121170376,320853,4942
+Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,294340341,825452,8447
+Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,306801371,861382,8456
+Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,295193386,827555,8456
+Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,293210540,822722,8449
+Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,291801629,820017,8450
+Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,292932607,822421,8450
+"Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",302502183,848154,8500
+"Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",273224492,773388,8504
+"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",268700821,763033,8504
+"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",268700821,763033,8504
+"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",2908014422,8180225,30018
+"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",2616129517,7383326,30287
+"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",2464384686,6936321,30187
+"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",2464384686,6936321,30187
 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,1391
 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
 Agora/Governor/policy/GST minting,51007235,144191,2034
-Agora/Governor/validator/proposal creation,317651809,854963,9315
-Agora/Governor/validator/GATs minting,122322162,331416,9436
-Agora/Governor/validator/mutate governor state,91544121,254987,8900
+Agora/Governor/validator/proposal creation,317651809,854963,9323
+Agora/Governor/validator/GATs minting,423756405,1151000,9444
+Agora/Governor/validator/mutate governor state,91544121,254987,8908
--- a/cabal.project
+++ b/cabal.project
@ -4,4 +4,6 @@ benchmarks: true
 tests: true

 package plutarch
-  flags: +development
+  flags: +development
+
+test-show-details: direct