commit 5aa915e8c53043a7053601c6ce2fb82ef3bc9707
parent efbdc8459547f08304d8ff75c223dfe9bb44c227
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 5 Jan 2025 18:31:49 -0330
test: property tests
Diffstat:
2 files changed, 47 insertions(+), 2 deletions(-)
diff --git a/ppad-base58.cabal b/ppad-base58.cabal
@@ -47,6 +47,7 @@ test-suite base58-tests
, ppad-base58
, tasty
, tasty-hunit
+ , tasty-quickcheck
, text
benchmark base58-bench
diff --git a/test/Main.hs b/test/Main.hs
@@ -12,8 +12,10 @@ import qualified Data.ByteString.Base58 as B58
import qualified Data.ByteString.Base58Check as B58Check
import qualified Data.Text.Encoding as TE
import qualified Data.Text.IO as TIO
+import Data.Word (Word8)
import Test.Tasty
import Test.Tasty.HUnit
+import qualified Test.Tasty.QuickCheck as Q
data Valid_Base58Check = Valid_Base58Check {
vc_string :: !BS.ByteString
@@ -78,6 +80,40 @@ execute_base58 Valid_Base58 {..} = testCase "base58" $ do
let enc = B58.encode vb_decodedHex
assertEqual mempty enc vb_encoded
+newtype BS = BS BS.ByteString
+ deriving (Eq, Show)
+
+bytes :: Int -> Q.Gen BS.ByteString
+bytes k = do
+ l <- Q.chooseInt (0, k)
+ v <- Q.vectorOf l Q.arbitrary
+ pure (BS.pack v)
+
+data B58C = B58C Word8 BS
+ deriving (Eq, Show)
+
+instance Q.Arbitrary BS where
+ arbitrary = do
+ b <- bytes 1024
+ pure (BS b)
+
+instance Q.Arbitrary B58C where
+ arbitrary = do
+ w8 <- Q.arbitrary
+ bs <- Q.arbitrary
+ pure (B58C w8 bs)
+
+base58_decode_inverts_encode :: BS -> Bool
+base58_decode_inverts_encode (BS bs) = case B58.decode (B58.encode bs) of
+ Nothing -> False
+ Just b -> b == bs
+
+base58check_decode_inverts_encode :: B58C -> Bool
+base58check_decode_inverts_encode (B58C w8 (BS bs)) =
+ case B58Check.decode (B58Check.encode w8 bs) of
+ Nothing -> False
+ Just (w8', bs') -> w8 == w8' && bs == bs'
+
main :: IO ()
main = do
scure_base58 <- TIO.readFile "etc/base58.json"
@@ -89,7 +125,15 @@ main = do
case per of
Nothing -> error "couldn't parse vectors"
Just (b58, b58c) -> defaultMain $ testGroup "ppad-base58" [
- testGroup "base58" (fmap execute_base58 b58)
- , execute_base58check b58c
+ testGroup "unit tests" [
+ testGroup "base58" (fmap execute_base58 b58)
+ , execute_base58check b58c
+ ]
+ , testGroup "property tests" [
+ Q.testProperty "(base58) decode . encode ~ id" $
+ Q.withMaxSuccess 250 base58_decode_inverts_encode
+ , Q.testProperty "(base58check) decode . encode ~ id" $
+ Q.withMaxSuccess 250 base58check_decode_inverts_encode
+ ]
]