base58

commit 5aa915e8c53043a7053601c6ce2fb82ef3bc9707
parent efbdc8459547f08304d8ff75c223dfe9bb44c227
Author: Jared Tobin <jared@jtobin.io>
Date:   Sun,  5 Jan 2025 18:31:49 -0330

test: property tests

Diffstat:
M
ppad-base58.cabal
 | 
1
+
M
test/Main.hs
 | 
48
++++++++++++++++++++++++++++++++++++++++++++++--

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
+        ]
       ]