script

commit 05576c52bf4eb3bdda52fb0a3570efd51bb871b9
parent fe2c1c45df0d0bdc54989754a8a8bc6381267a3f
Author: Jared Tobin <jared@jtobin.io>
Date:   Sat, 18 Jan 2025 18:29:10 +0400

lib: update benchmarks, tests

Diffstat:
M
bench/Main.hs
 | 
56
+++++++++++++++++++++++++++++++++++++++++++++++++++++++-
M
ppad-script.cabal
 | 
2
++
M
test/Main.hs
 | 
13
++++++++-----

3 files changed, 65 insertions(+), 6 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,4 +1,58 @@
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
 module Main where
 
+import Bitcoin.Prim.Script (Term(..), Opcode(..))
+import qualified Bitcoin.Prim.Script as S
+import Control.DeepSeq
+import Criterion.Main
+import qualified Data.ByteString as BS
+import qualified Data.Primitive.ByteArray as BA
+import GHC.Generics
+
+deriving stock instance Generic S.Script
+deriving newtype instance NFData S.Script
+
+ba_to_bs :: Benchmark
+ba_to_bs = env setup $ \ba ->
+    bench "ba_to_bs" $ nf S.ba_to_bs ba
+  where
+    setup = do
+      let s = 1024 :: Int
+      ba <- BA.newPinnedByteArray s
+      let go !j
+            | j == s = pure ()
+            | otherwise = do
+                BA.writeByteArray ba j (j `rem` 256)
+                go (j + 1)
+      go 0
+      BA.unsafeFreezeByteArray ba
+
+bs_to_ba :: Benchmark
+bs_to_ba = bench "bs_to_ba" $ nf S.bs_to_ba (BS.replicate 1024 0x00)
+
+to_script :: Benchmark
+to_script = bench "to_script" $ nf S.to_script script where
+  script = [
+      OPCODE OP_DUP,OPCODE OP_HASH160,OPCODE OP_PUSHBYTES_20,BYTE 0x89,BYTE 0xab
+    , BYTE 0xcd,BYTE 0xef,BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba,BYTE 0xab
+    , BYTE 0xba,BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba
+    , BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba,OPCODE OP_EQUALVERIFY
+    , OPCODE OP_CHECKSIG
+    ]
+
+
 main :: IO ()
-main = pure ()
+main = defaultMain [
+    ba_to_bs
+  , bs_to_ba
+  ]
+
+
diff --git a/ppad-script.cabal b/ppad-script.cabal
@@ -71,7 +71,9 @@ benchmark script-bench
       base
     , bytestring
     , criterion
+    , deepseq
     , ppad-script
+    , primitive
 
 benchmark script-weigh
   type:                exitcode-stdio-1.0
diff --git a/test/Main.hs b/test/Main.hs
@@ -46,6 +46,9 @@ instance Q.Arbitrary Script where
 
 -- properties -----------------------------------------------------------------
 
+ba_to_bs_inverts_bs_to_ba :: BS -> Bool
+ba_to_bs_inverts_bs_to_ba (BS bs) = ba_to_bs (bs_to_ba bs) == bs
+
 from_base16_inverts_to_base16 :: Script -> Bool
 from_base16_inverts_to_base16 s =
   let mscript = from_base16 (to_base16 s)
@@ -62,15 +65,15 @@ to_script_inverts_from_script s =
 
 main :: IO ()
 main = defaultMain $
-  testGroup "ppad-base16" [
-    testGroup "property tests" [
-      Q.testProperty "from_base16 . to_base16 ~ id" $
-        Q.withMaxSuccess 100 from_base16_inverts_to_base16
+  testGroup "property tests" [
+      Q.testProperty "ba_to_bs . bs_to_ba ~ id" $
+        Q.withMaxSuccess 500 ba_to_bs_inverts_bs_to_ba
+    , Q.testProperty "from_base16 . to_base16 ~ id" $
+        Q.withMaxSuccess 500 from_base16_inverts_to_base16
     --  XX slow
     -- , Q.testProperty "to_script . from_script ~ id" $
     --     Q.withMaxSuccess 100 to_script_inverts_from_script
     ]
-  ]
 
 -- p2pkh