base64

commit d4c704d005ceedbac7cb11b3b7abec818a22bdb2
parent c84cc9b184e71f455d0cd8d6b829f20f34bf232b
Author: Jared Tobin <jared@jtobin.io>
Date:   Sat, 16 May 2026 11:38:19 -0230

test: property tests and RFC vectors

QuickCheck properties (5000 iters each) for decode-inverts-encode
and agreement with base64-bytestring on both encode and decode.
Unit test covers the seven RFC 4648 §10 vectors ("", "f", "fo",
"foo", "foob", "fooba", "foobar"), checking both directions.

Diffstat:
A
test/Main.hs
 | 
84
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

1 file changed, 84 insertions(+), 0 deletions(-)
diff --git a/test/Main.hs b/test/Main.hs
@@ -0,0 +1,84 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+
+module Main where
+
+import qualified Data.ByteString as BS
+import qualified "ppad-base64" Data.ByteString.Base64 as B64
+import qualified "base64-bytestring" Data.ByteString.Base64 as R0
+import Test.Tasty
+import qualified Test.Tasty.QuickCheck as Q
+import qualified Test.Tasty.HUnit as H
+
+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)
+
+instance Q.Arbitrary BS where
+  arbitrary = do
+    b <- bytes 1024
+    pure (BS b)
+
+decode_inverts_encode :: BS -> Bool
+decode_inverts_encode (BS bs) = case B64.decode (B64.encode bs) of
+  Nothing -> False
+  Just b  -> b == bs
+
+encode_matches_reference :: BS -> Bool
+encode_matches_reference (BS bs) =
+  let us = B64.encode bs
+      r0 = R0.encode bs
+  in  us == r0
+
+decode_matches_reference :: BS -> Bool
+decode_matches_reference (BS bs) =
+  let enc = R0.encode bs
+      us  = B64.decode enc
+      r0  = R0.decode enc
+  in  case us of
+        Nothing -> case r0 of
+          Left _ -> True
+          _ -> False
+        Just du -> case r0 of
+          Left _ -> False
+          Right d0 -> du == d0
+
+case_rfc_vectors :: TestTree
+case_rfc_vectors = H.testCase "RFC 4648 \167 10 vectors" $ do
+  let vectors = [
+          ("",       "")
+        , ("f",      "Zg==")
+        , ("fo",     "Zm8=")
+        , ("foo",    "Zm9v")
+        , ("foob",   "Zm9vYg==")
+        , ("fooba",  "Zm9vYmE=")
+        , ("foobar", "Zm9vYmFy")
+        ]
+      check (input, expected) = do
+        H.assertEqual ("encode " <> show input)
+          expected (B64.encode input)
+        H.assertEqual ("decode " <> show expected)
+          (Just input) (B64.decode expected)
+  mapM_ check vectors
+
+main :: IO ()
+main = defaultMain $
+  testGroup "ppad-base64" [
+    testGroup "property tests" [
+      Q.testProperty "decode . encode ~ id" $
+        Q.withMaxSuccess 5000 decode_inverts_encode
+    , Q.testProperty "encode matches reference" $
+        Q.withMaxSuccess 5000 encode_matches_reference
+    , Q.testProperty "decode matches reference" $
+        Q.withMaxSuccess 5000 decode_matches_reference
+    ]
+  , testGroup "unit tests" [
+      case_rfc_vectors
+    ]
+  ]