diff --git a/agora.cabal b/agora.cabal index 6f1b244..12cd819 100644 --- a/agora.cabal +++ b/agora.cabal @@ -120,8 +120,7 @@ library Agora.Stake Agora.Voting - other-modules: - Agora.Utils + other-modules: Agora.Utils hs-source-dirs: src library pprelude @@ -145,5 +144,5 @@ benchmark agora-bench main-is: Main.hs type: exitcode-stdio-1.0 build-depends: + , agora , plutarch-benchmark - , agora \ No newline at end of file diff --git a/bench.csv b/bench.csv index 867f837..2655634 100644 --- a/bench.csv +++ b/bench.csv @@ -1,3 +1,3 @@ name,cpu,mem,size full_scripts:authorityTokenPolicy,1280339,4400,276 -full_scripts:stakePolicy,2649897,9000,786 +full_scripts:stakePolicy,3007173,10200,937 diff --git a/cabal.project b/cabal.project index ec42141..86a0b28 100644 --- a/cabal.project +++ b/cabal.project @@ -2,3 +2,6 @@ packages: ./. benchmarks: true tests: true + +package plutarch + flags: +development \ No newline at end of file diff --git a/src/Agora/Stake.hs b/src/Agora/Stake.hs index 8e46218..467f6ce 100644 --- a/src/Agora/Stake.hs +++ b/src/Agora/Stake.hs @@ -88,6 +88,17 @@ anyOutput = phoistAcyclic $ ) # pfromData txInfo.outputs +-------------------------------------------------------------------------------- +-- +-- What this Policy does +-- +-- - Check that exactly 1 state thread is minted +-- - Check that an output exists with a state thread and a valid datum +-- - Check that no state thread is an input +-- +-- Question: +-- +-------------------------------------------------------------------------------- stakePolicy :: forall (gt :: MoneyClass) ac n scale s. ( KnownSymbol ac @@ -101,12 +112,21 @@ stakePolicy _stake = plam $ \_redeemer ctx'' -> P.do PScriptContext ctx' <- pmatch ctx'' ctx <- pletFields @'["txInfo", "purpose"] ctx' + txInfo' <- plet ctx.txInfo + txInfo <- pletFields @'["mint", "inputs"] txInfo' - PMinting ownSymbol <- pmatch $ pfromData ctx.purpose - let stValue = psingletonValue # (pfield @"_0" # ownSymbol) # pconstant "ST" # 1 + PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose + ownSymbol <- plet $ pfield @"_0" # ownSymbol' + let stValue = psingletonValue # ownSymbol # pconstant "ST" # 1 + + passert "ST at inputs must be 0" $ + (passetClassValueOf # ownSymbol # pconstant "ST" # (pvalueSpent # pfromData txInfo')) #== 0 + + passert "Minted ST must be exactly 1" $ + pdata txInfo.mint #== pdata stValue passert "A UTXO must exist with the correct output" $ - anyOutput @(StakeDatum gt) # pfromData ctx.txInfo + anyOutput @(StakeDatum gt) # pfromData txInfo' # ( plam $ \value stakeDatum' -> P.do stakeDatum <- pletFields @'["owner", "stakedAmount"] stakeDatum' let expectedValue = paddValue # (discreteValue # stakeDatum.stakedAmount) # stValue diff --git a/src/Agora/Utils.hs b/src/Agora/Utils.hs index 7a81cd8..97e49ba 100644 --- a/src/Agora/Utils.hs +++ b/src/Agora/Utils.hs @@ -15,7 +15,9 @@ import Plutarch.Api.V1 ( PPubKeyHash, PTokenName, PTuple, + PTxInInfo (PTxInInfo), PTxInfo (PTxInfo), + PTxOut (PTxOut), PValue (PValue), ) import Plutarch.Builtin (ppairDataBuiltin) @@ -146,3 +148,20 @@ paddValue = phoistAcyclic $ ( PValue $ pmapUnionWith # (plam $ \a' b' -> pmapUnionWith # (plam (+)) # a' # b') # a # b ) + +-- | Sum of all value at input +pvalueSpent :: Term s (PTxInfo :--> PValue) +pvalueSpent = phoistAcyclic $ + plam $ \txInfo' -> + pmatch txInfo' $ \(PTxInfo txInfo) -> + pfoldr + # ( plam $ \txInInfo' v -> + pmatch + (pfromData txInInfo') + $ \(PTxInInfo txInInfo) -> + paddValue + # (pmatch (pfield @"resolved" # txInInfo) $ \(PTxOut o) -> pfromData $ pfield @"value" # o) + # v + ) + # pconstant mempty + # (pfield @"inputs" # txInfo)