add some tests for Stake validator

agora-test/Spec/Util.hs

@@ -1,8 +1,17 @@
 module Spec.Util (
+  -- * Testing utils
   scriptSucceeds,
   scriptFails,
   policySucceedsWith,
   policyFailsWith,
+  validatorSucceedsWith,
+  validatorFailsWith,
+
+  -- * Plutus land utils
+  datumHash,
+  toDatum,
+  toDatumHash,
+  datumPair,
 ) where
 
 --------------------------------------------------------------------------------
@@ -11,16 +20,24 @@ import Prelude
 
 --------------------------------------------------------------------------------
 
+import Codec.Serialise (serialise)
+import Data.ByteString.Lazy qualified as LBS
+
+--------------------------------------------------------------------------------
+
 import Test.Tasty (TestTree)
 import Test.Tasty.HUnit (assertFailure, testCase)
 
 --------------------------------------------------------------------------------
 
 import Plutarch
-import Plutarch.Api.V1 (PMintingPolicy)
+import Plutarch.Api.V1 (PMintingPolicy, PValidator)
+import Plutarch.Crypto (pblake2b_256)
 import Plutarch.Evaluate (evalScript)
 import Plutarch.Prelude ()
-import Plutus.V1.Ledger.Scripts (Script)
+import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash (DatumHash), Script)
+import PlutusTx.Builtins qualified as PlutusTx
+import PlutusTx.IsData qualified as PlutusTx
 
 --------------------------------------------------------------------------------
 
@@ -32,6 +49,14 @@ policyFailsWith :: String -> ClosedTerm PMintingPolicy -> ClosedTerm PData -> _
 policyFailsWith tag policy redeemer scriptContext =
   scriptFails tag $ compile (policy # redeemer # pconstant scriptContext)
 
+validatorSucceedsWith :: String -> ClosedTerm PValidator -> ClosedTerm PData -> ClosedTerm PData -> _ -> TestTree
+validatorSucceedsWith tag policy datum redeemer scriptContext =
+  scriptSucceeds tag $ compile (policy # datum # redeemer # pconstant scriptContext)
+
+validatorFailsWith :: String -> ClosedTerm PValidator -> ClosedTerm PData -> ClosedTerm PData -> _ -> TestTree
+validatorFailsWith tag policy datum redeemer scriptContext =
+  scriptFails tag $ compile (policy # datum # redeemer # pconstant scriptContext)
+
 scriptSucceeds :: String -> Script -> TestTree
 scriptSucceeds name script = testCase name $ do
   let (res, _budget, traces) = evalScript script
@@ -51,3 +76,30 @@ scriptFails name script = testCase name $ do
     Right v ->
       assertFailure $
         "Expected failure, but succeeded. " <> show v <> " Traces: " <> show traces
+
+--------------------------------------------------------------------------------
+
+{- | Create a pair from data for use in 'txInfoData'
+
+   Example:
+   @
+     myTxInfo { 'txInfoData' = ['datumPair' myDatum] }
+   @
+-}
+datumPair :: PlutusTx.ToData a => a -> (DatumHash, Datum)
+datumPair = (,) <$> toDatumHash <*> toDatum
+
+datumHash :: Datum -> DatumHash
+datumHash (Datum data') = toDatumHash data'
+
+toDatum :: PlutusTx.ToData a => a -> Datum
+toDatum = Datum . PlutusTx.toBuiltinData
+
+-- Shamelessly go through plutus.
+toDatumHash :: PlutusTx.ToData a => a -> DatumHash
+toDatumHash datum =
+  DatumHash $
+    PlutusTx.toBuiltin $
+      plift $
+        pblake2b_256
+          # pconstant (LBS.toStrict $ serialise $ PlutusTx.toData datum)