add missing asserts to Stake policy

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

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

cabal.project

@@ -2,3 +2,6 @@ packages: ./.
 
 benchmarks: true
 tests: true
+
+package plutarch
+  flags: +development

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

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)