commit 155e2b2e2833afc9892ebe72d66812d6b0b0cafd
parent f012f1dbfe06cc5db9ce142df1c7f240db5f2400
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 18 Jan 2025 08:45:37 +0400
test: quickcheck skeleton
Diffstat:
3 files changed, 72 insertions(+), 12 deletions(-)
diff --git a/lib/Bitcoin/Prim/Script.hs b/lib/Bitcoin/Prim/Script.hs
@@ -37,6 +37,8 @@ fi :: (Num a, Integral b) => b -> a
fi = fromIntegral
{-# INLINE fi #-}
+-- XX slow?
+
-- convert a pinned ByteArray to a ByteString
ba_to_bs :: BA.ByteArray -> BS.ByteString
ba_to_bs ba = unsafeDupablePerformIO $ do
@@ -401,6 +403,8 @@ to_script = Script . BA.byteArrayFromList . fmap term_to_byte where
BYTE w8 -> w8
{-# INLINE term_to_byte #-}
+-- XX seems slow
+
-- | Unpack a 'Script' into a list of Script terms.
from_script :: Script -> [Term]
from_script (Script bs) = go 0 where
diff --git a/ppad-btcprim.cabal b/ppad-btcprim.cabal
@@ -27,13 +27,13 @@ library
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
- , primitive >= 0.8 && < 0.10
, ppad-base16 >= 0.1 && < 0.2
, ppad-base58 >= 0.1 && < 0.2
, ppad-bech32 >= 0.2 && < 0.3
, ppad-ripemd160 >= 0.1 && < 0.2
, ppad-secp256k1 >= 0.2.1 && < 0.3
, ppad-sha256 >= 0.2 && < 0.3
+ , primitive >= 0.8 && < 0.10
test-suite btcprim-tests
type: exitcode-stdio-1.0
@@ -53,6 +53,8 @@ test-suite btcprim-tests
, ppad-ripemd160
, ppad-secp256k1
, ppad-sha256
+ , primitive
, tasty
, tasty-hunit
+ , tasty-quickcheck
diff --git a/test/Main.hs b/test/Main.hs
@@ -1,27 +1,81 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
-import qualified Crypto.Curve.Secp256k1 as Secp256k1
+import Bitcoin.Prim.Script
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
import qualified Data.ByteString as BS
-import qualified Data.ByteString.Base58Check as B58
-import Bitcoin.Prim.Script
+import qualified Data.Primitive.ByteArray as BA
+import Data.Word (Word8)
import Test.Tasty
-import Test.Tasty.HUnit
+import qualified Test.Tasty.HUnit as H
+import qualified Test.Tasty.QuickCheck as Q
+
+-- types ----------------------------------------------------------------------
+
+newtype BS = BS BS.ByteString
+ deriving (Eq, Show)
+
+bytes_list :: Int -> Q.Gen [Word8]
+bytes_list k = do
+ l <- Q.chooseInt (0, k)
+ Q.vectorOf l Q.arbitrary
+
+bytes :: Int -> Q.Gen BS.ByteString
+bytes k = do
+ l <- Q.chooseInt (0, k)
+ v <- Q.vectorOf l Q.arbitrary
+ pure (BS.pack v)
+
+instance Q.Arbitrary BS where
+ arbitrary = do
+ b <- bytes 10_000
+ pure (BS b)
+
+instance Q.Arbitrary BA.ByteArray where
+ arbitrary = do
+ b <- bytes_list 10_000
+ pure (BA.byteArrayFromList b)
+
+instance Q.Arbitrary Script where
+ arbitrary = fmap Script Q.arbitrary
+
+-- properties -----------------------------------------------------------------
+
+from_base16_inverts_to_base16 :: Script -> Bool
+from_base16_inverts_to_base16 s =
+ let mscript = from_base16 (to_base16 s)
+ in case mscript of
+ Nothing -> False
+ Just script -> script == s
+
+to_script_inverts_from_script :: Script -> Bool
+to_script_inverts_from_script s =
+ let script = to_script (from_script s)
+ in script == s
+
+-- main -----------------------------------------------------------------------
main :: IO ()
-main = pure ()
+main = defaultMain $
+ testGroup "ppad-base16" [
+ testGroup "property tests" [
+ Q.testProperty "from_base16 . to_base16 ~ id" $
+ Q.withMaxSuccess 100 from_base16_inverts_to_base16
+ -- , Q.testProperty "to_script . from_script ~ id" $
+ -- Q.withMaxSuccess 100 to_script_inverts_from_script
+ ]
+ ]
+
+
+
-sec :: Integer
-sec = 0x05
-pub :: Secp256k1.Pub
-pub = Secp256k1.derive_pub sec
-p2pkh = B58.encode 0x00
- (RIPEMD160.hash (SHA256.hash (Secp256k1.serialize_point pub)))
-- p2pkh
