script

commit 376bc8ed61f64550c6b1057e7398e22b89284e7c
parent c3b4d4d041bfaaa66ba433f4f1311aeb21bd63f3
Author: Jared Tobin <jared@jtobin.io>
Date:   Sun, 19 Jan 2025 15:14:06 +0400

test: more property test work

Diffstat:
M
test/Main.hs
 | 
75
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------

1 file changed, 66 insertions(+), 9 deletions(-)
diff --git a/test/Main.hs b/test/Main.hs
@@ -10,6 +10,7 @@ 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.Base16 as B16
 import qualified Data.Primitive.ByteArray as BA
 import Data.Word (Word8)
 import Test.Tasty
@@ -32,6 +33,14 @@ instance Q.Arbitrary BS where
     b <- bytes 20_000
     pure (BS b)
 
+newtype HexBS = HexBS BS.ByteString
+  deriving (Eq, Show)
+
+instance Q.Arbitrary HexBS where
+  arbitrary = do
+    b <- bytes 20_000
+    pure (HexBS (B16.encode b))
+
 instance Q.Arbitrary BA.ByteArray where
   arbitrary = do
     b <- bytes 20_000
@@ -44,7 +53,9 @@ newtype RawScript = RawScript Script
 instance Q.Arbitrary RawScript where
   arbitrary = fmap (RawScript . Script) Q.arbitrary
 
--- will contain no or carefully-inserted pushdata opcodes
+-- XX better generators for valid and invalid redeemscripts would be nice.
+--    pushdata generation needs to be handled carefully.
+
 newtype ValidRedeemScript = ValidRedeemScript Script
   deriving (Eq, Show)
 
@@ -55,12 +66,25 @@ instance Q.Arbitrary ValidRedeemScript where
     bs <- fmap BS.pack (Q.vectorOf l (Q.chooseEnum (100, 255)))
     pure (ValidRedeemScript (Script (bs_to_ba bs)))
 
+-- too large
+newtype InvalidRedeemScript = InvalidRedeemScript Script
+  deriving (Eq, Show)
+
+instance Q.Arbitrary InvalidRedeemScript where
+  arbitrary = do
+    l <- Q.chooseInt (_MAX_REDEEM_SCRIPT_SIZE + 1, 20_000)
+    -- pushdata must be added with care; easy to blow up quickcheck
+    bs <- fmap BS.pack (Q.vectorOf l (Q.chooseEnum (100, 255)))
+    pure (InvalidRedeemScript (Script (bs_to_ba bs)))
+
 -- 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
 
--- to_base16 should work on every script, pathological or no
+bs_to_ba_inverts_ba_to_bs :: BA.ByteArray -> Bool
+bs_to_ba_inverts_ba_to_bs ba = bs_to_ba (ba_to_bs ba) == ba
+
 from_base16_inverts_to_base16 :: RawScript -> Bool
 from_base16_inverts_to_base16 (RawScript s) =
   let mscript = from_base16 (to_base16 s)
@@ -68,13 +92,34 @@ from_base16_inverts_to_base16 (RawScript s) =
         Nothing -> False
         Just script -> script == s
 
+to_base16_inverts_from_base16 :: HexBS -> Bool
+to_base16_inverts_from_base16 (HexBS bs) =
+  let mscript = from_base16 bs
+  in  case mscript of
+        Nothing -> False
+        Just script -> to_base16 script == bs
+
 -- we can only use 'from_script' on non-pathological scripts
+--
+-- note the converse is not true
 to_script_inverts_from_script :: ValidRedeemScript -> Bool
 to_script_inverts_from_script (ValidRedeemScript s) =
   let !terms  = from_script s
       !script = to_script terms
   in  script == s
 
+valid_redeem_script_produces_hash :: ValidRedeemScript -> Bool
+valid_redeem_script_produces_hash (ValidRedeemScript s) =
+  case to_scripthash s of
+    Just {} -> True
+    _ -> False
+
+invalid_redeem_script_doesnt_produce_hash :: InvalidRedeemScript -> Bool
+invalid_redeem_script_doesnt_produce_hash (InvalidRedeemScript s) =
+  case to_scripthash s of
+    Nothing -> True
+    _ -> False
+
 -- assertions -----------------------------------------------------------------
 
 base16_encoded_script_decodes_as_expected :: H.Assertion
@@ -108,13 +153,25 @@ main :: IO ()
 main = defaultMain $
   testGroup "ppad-script" [
     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
-      , Q.testProperty "to_script . from_script ~ id" $
-          Q.withMaxSuccess 1000 to_script_inverts_from_script
-      ]
+      testGroup "inverses" [
+          Q.testProperty "ba_to_bs . bs_to_ba ~ id" $
+            Q.withMaxSuccess 500 ba_to_bs_inverts_bs_to_ba
+        , Q.testProperty "ba_to_bs . bs_to_ba ~ id" $
+            Q.withMaxSuccess 500 bs_to_ba_inverts_ba_to_bs
+        , Q.testProperty "from_base16 . to_base16 ~ id" $
+            Q.withMaxSuccess 500 from_base16_inverts_to_base16
+        , Q.testProperty "to_base16 . from_base16 ~ id" $
+            Q.withMaxSuccess 500 to_base16_inverts_from_base16
+        , Q.testProperty "to_script . from_script ~ id" $
+            Q.withMaxSuccess 1000 to_script_inverts_from_script
+        ]
+    , testGroup "hashes" [
+          Q.testProperty "valid redeem script produces scripthash" $
+            Q.withMaxSuccess 100 valid_redeem_script_produces_hash
+        , Q.testProperty "invalid redeem script doesn't produce scripthash" $
+            Q.withMaxSuccess 100 invalid_redeem_script_doesnt_produce_hash
+        ]
+        ]
   , testGroup "unit tests" [
         H.testCase "base16-encoded script decodes to expected terms"
           base16_encoded_script_decodes_as_expected