base58

commit 9778ead4667bd6290f3c117eb7a523038d23a396
parent b36e36e9dfbd793dec2908b3640394b8f47860db
Author: Jared Tobin <jared@jtobin.io>
Date:   Sat, 10 Oct 2026 15:24:32 +0400

test: decode vectors, invalid inputs, labels

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

1 file changed, 99 insertions(+), 20 deletions(-)
diff --git a/test/Main.hs b/test/Main.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -6,7 +5,9 @@ module Main where
 
 import Data.Aeson ((.:))
 import qualified Data.Aeson as A
+import qualified Data.Aeson.Types as AT
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Base58 as B58
 import qualified Data.ByteString.Base58Check as B58Check
@@ -21,15 +22,15 @@ data Valid_Base58Check = Valid_Base58Check {
   , vc_payload :: !BS.ByteString
   } deriving Show
 
-decodeLenient :: BS.ByteString -> BS.ByteString
-decodeLenient bs = case B16.decode bs of
-  Nothing -> error "boom"
-  Just v -> v
+hex :: BS.ByteString -> AT.Parser BS.ByteString
+hex bs = case B16.decode bs of
+  Nothing -> fail "invalid hex"
+  Just v  -> pure v
 
 instance A.FromJSON Valid_Base58Check where
   parseJSON = A.withObject "Valid_Base58Check" $ \m -> Valid_Base58Check
     <$> fmap TE.encodeUtf8 (m .: "string")
-    <*> fmap (decodeLenient . TE.encodeUtf8) (m .: "payload")
+    <*> (hex . TE.encodeUtf8 =<< (m .: "payload"))
 
 data Invalid_Base58Check = Invalid_Base58Check {
     ic_string  :: !BS.ByteString
@@ -56,16 +57,16 @@ execute_base58check Base58Check {..} = testGroup "base58check" [
     , testGroup "invalid" (fmap execute_invalid b58c_invalid)
     ]
   where
-    execute_valid Valid_Base58Check {..} = testCase "valid" $ do -- label
-      let enc = B58Check.encode vc_payload
-      assertEqual mempty enc vc_string
+    execute_valid Valid_Base58Check {..} = testGroup (label vc_string) [
+        testCase "encode" $
+          assertEqual mempty vc_string (B58Check.encode vc_payload)
+      , testCase "decode" $
+          assertEqual mempty (Just vc_payload) (B58Check.decode vc_string)
+      ]
 
-    execute_invalid Invalid_Base58Check {..} = testCase "invalid" $ do -- label
-      let dec = B58Check.decode ic_string
-          is_just = \case
-            Nothing -> False
-            Just _ -> True
-      assertBool mempty (not (is_just dec))
+    execute_invalid Invalid_Base58Check {..} =
+      testCase (label ic_string) $
+        assertEqual mempty Nothing (B58Check.decode ic_string)
 
 data Valid_Base58 = Valid_Base58 {
     vb_decodedHex  :: !BS.ByteString
@@ -74,13 +75,59 @@ data Valid_Base58 = Valid_Base58 {
 
 instance A.FromJSON Valid_Base58 where
   parseJSON = A.withObject "Valid_Base58" $ \m -> Valid_Base58
-    <$> fmap (decodeLenient . TE.encodeUtf8) (m .: "decodedHex")
+    <$> (hex . TE.encodeUtf8 =<< (m .: "decodedHex"))
     <*> fmap TE.encodeUtf8 (m .: "encoded")
 
-execute_base58 :: Valid_Base58 -> TestTree -- XX label
-execute_base58 Valid_Base58 {..} = testCase "base58" $ do
-  let enc = B58.encode vb_decodedHex
-  assertEqual mempty enc vb_encoded
+execute_base58 :: Valid_Base58 -> TestTree
+execute_base58 Valid_Base58 {..} = testGroup (label vb_encoded) [
+    testCase "encode" $
+      assertEqual mempty vb_encoded (B58.encode vb_decodedHex)
+  , testCase "decode" $
+      assertEqual mempty (Just vb_decodedHex) (B58.decode vb_encoded)
+  ]
+
+-- test label for an encoded string
+label :: BS.ByteString -> String
+label bs
+  | BS.null bs = "(empty)"
+  | otherwise  = show (B8.unpack bs)
+
+-- strings containing non-base58 characters
+invalid_base58 :: [BS.ByteString]
+invalid_base58 = [
+    "0"
+  , "O"
+  , "I"
+  , "l"
+  , " "
+  , "\NUL"
+  , "+"
+  , "/"
+  , "\xff"
+  , "\xc3\xa9"
+  , "StV1DL0CwTryKyV"
+  , "StV1DLOCwTryKyV"
+  , "StV1DLICwTryKyV"
+  , "StV1DLlCwTryKyV"
+  , " StV1DL6CwTryKyV"
+  , "StV1DL6CwTryKyV "
+  , "StV1DL6CwTryKyV\n"
+  , "11110"
+  , "111l"
+  , "11 1"
+  ]
+
+execute_invalid_base58 :: BS.ByteString -> TestTree
+execute_invalid_base58 bs = testCase (label bs) $
+  assertEqual mempty Nothing (B58.decode bs)
+
+-- strings that base58-decode to fewer than four bytes
+short_base58check :: [BS.ByteString]
+short_base58check = ["", "1", "11", "111", "2g", "a3gV"]
+
+execute_short_base58check :: BS.ByteString -> TestTree
+execute_short_base58check bs = testCase (label bs) $
+  assertEqual mempty Nothing (B58Check.decode bs)
 
 newtype BS = BS BS.ByteString
   deriving (Eq, Show)
@@ -96,6 +143,32 @@ instance Q.Arbitrary BS where
     b <- bytes 1024
     pure (BS b)
 
+-- arbitrary strings over the base58 alphabet, plus some invalid
+-- characters
+newtype B58Str = B58Str BS.ByteString
+  deriving (Eq, Show)
+
+instance Q.Arbitrary B58Str where
+  arbitrary = do
+    l <- Q.chooseInt (0, 64)
+    v <- Q.vectorOf l $ Q.frequency [
+        (16, Q.elements alphabet)
+      , (1, Q.elements (BS.unpack "0OIl +/\NUL\xff"))
+      ]
+    pure (B58Str (BS.pack v))
+    where
+      alphabet = BS.unpack
+        "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
+
+-- decoding succeeds exactly on strings over the alphabet, and every
+-- such string is canonical
+base58_decode_canonical :: B58Str -> Bool
+base58_decode_canonical (B58Str bs) = case B58.decode bs of
+  Nothing -> BS.any (`BS.notElem` alphabet) bs
+  Just d  -> B58.encode d == bs
+  where
+    alphabet = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
+
 base58_decode_inverts_encode :: BS -> Bool
 base58_decode_inverts_encode (BS bs) = case B58.decode (B58.encode bs) of
   Nothing -> False
@@ -120,11 +193,17 @@ main = do
     Just (b58, b58c) -> defaultMain $ testGroup "ppad-base58" [
         testGroup "unit tests" [
             testGroup "base58" (fmap execute_base58 b58)
+          , testGroup "base58 (invalid)"
+              (fmap execute_invalid_base58 invalid_base58)
           , execute_base58check b58c
+          , testGroup "base58check (short)"
+              (fmap execute_short_base58check short_base58check)
           ]
       , testGroup "property tests" [
           Q.testProperty "(base58) decode . encode ~ id" $
             Q.withMaxSuccess 250 base58_decode_inverts_encode
+        , Q.testProperty "(base58) decode succeeds iff canonical" $
+            Q.withMaxSuccess 1000 base58_decode_canonical
         , Q.testProperty "(base58check) decode . encode ~ id" $
             Q.withMaxSuccess 250 base58check_decode_inverts_encode
         ]