bech32

commit 4ffe13796b5fb54e0c836c5068971f6021d4fe55
parent a5e139e300d32a4e4b845d0d83d48c4a4da3bdb4
Author: Jared Tobin <jared@jtobin.io>
Date:   Fri,  3 Jan 2025 22:05:08 -0330

test: inversions

Diffstat:
M
lib/Data/ByteString/Bech32.hs
 | 
3
++-
M
test/Main.hs
 | 
47
++++++++++++++++++++++++++++++++++++-----------

2 files changed, 38 insertions(+), 12 deletions(-)
diff --git a/lib/Data/ByteString/Bech32.hs b/lib/Data/ByteString/Bech32.hs
@@ -28,7 +28,7 @@ import qualified Data.ByteString.Bech32.Internal as BI
 import qualified Data.ByteString.Builder as BSB
 import qualified Data.ByteString.Builder.Extra as BE
 import qualified Data.ByteString.Internal as BSI
-import qualified Data.Char as C (toLower)
+import qualified Data.Char as C (toLower, isLower, isAlpha)
 
 -- realization for small builders
 toStrict :: BSB.Builder -> BS.ByteString
@@ -71,6 +71,7 @@ decode
   -> Maybe (BS.ByteString, BS.ByteString) -- ^ (hrp, data less checksum)
 decode bs@(BSI.PS _ _ l) = do
   guard (l <= 90)
+  guard (B8.all (\a -> if C.isAlpha a then C.isLower a else True) bs)
   guard (verify bs)
   sep <- BS.elemIndexEnd 0x31 bs
   case BS.splitAt sep bs of
diff --git a/test/Main.hs b/test/Main.hs
@@ -1,7 +1,10 @@
 module Main where
 
+import qualified Data.Char as C
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Bech32 as Bech32
+import qualified Data.ByteString.Bech32m as Bech32m
 import qualified Data.ByteString.Base32 as B32
 import Test.Tasty
 import qualified Test.Tasty.QuickCheck as Q
@@ -10,14 +13,16 @@ import qualified Reference.Bech32 as R
 newtype BS = BS BS.ByteString
   deriving (Eq, Show)
 
-data Input = Input BS.ByteString BS.ByteString
+data ValidInput = ValidInput BS.ByteString BS.ByteString
   deriving (Eq, Show)
 
-instance Q.Arbitrary Input where
+instance Q.Arbitrary ValidInput where
   arbitrary = do
     h <- hrp
-    b <- bytes (83 - BS.length h)
-    pure (Input h b)
+    let l = 83 - BS.length h
+        a = l * 5 `quot` 8
+    b <- bytes a
+    pure (ValidInput h b)
 
 instance Q.Arbitrary BS where
   arbitrary = do
@@ -28,7 +33,7 @@ hrp :: Q.Gen BS.ByteString
 hrp = do
   l <- Q.chooseInt (1, 83)
   v <- Q.vectorOf l (Q.choose (33, 126))
-  pure (BS.pack v)
+  pure (B8.map C.toLower (BS.pack v))
 
 bytes :: Int -> Q.Gen BS.ByteString
 bytes k = do
@@ -36,14 +41,28 @@ bytes k = do
   v <- Q.vectorOf l Q.arbitrary
   pure (BS.pack v)
 
-matches :: Input -> Bool
-matches (Input h b) =
+matches_reference :: ValidInput -> Bool
+matches_reference (ValidInput h b) =
   let ref = R.bech32Encode h (R.toBase32 (BS.unpack b))
       our = Bech32.encode h b
   in  ref == our
 
-decode_inverts_encode :: BS -> Bool
-decode_inverts_encode (BS bs) = case B32.decode (B32.encode bs) of
+bech32_decode_inverts_encode :: ValidInput -> Bool
+bech32_decode_inverts_encode (ValidInput h b) = case Bech32.encode h b of
+  Nothing -> error "generated faulty input"
+  Just enc -> case Bech32.decode enc of
+    Nothing -> False
+    Just (h', dat) -> h == h' && b == dat
+
+bech32m_decode_inverts_encode :: ValidInput -> Bool
+bech32m_decode_inverts_encode (ValidInput h b) = case Bech32m.encode h b of
+  Nothing -> error "generated faulty input"
+  Just enc -> case Bech32m.decode enc of
+    Nothing -> False
+    Just (h', dat) -> h == h' && b == dat
+
+base32_decode_inverts_encode :: BS -> Bool
+base32_decode_inverts_encode (BS bs) = case B32.decode (B32.encode bs) of
   Nothing -> False
   Just b  -> b == bs
 
@@ -51,11 +70,17 @@ main :: IO ()
 main = defaultMain $ testGroup "ppad-bech32" [
     testGroup "base32" [
       Q.testProperty "decode . encode ~ id" $
-        Q.withMaxSuccess 1000 decode_inverts_encode
+        Q.withMaxSuccess 1000 base32_decode_inverts_encode
     ]
   , testGroup "bech32" [
       Q.testProperty "Bech32.encode ~ R.bech32Encode" $
-        Q.withMaxSuccess 1000 matches
+        Q.withMaxSuccess 1000 matches_reference
+    , Q.testProperty "decode . encode ~ id" $
+        Q.withMaxSuccess 1000 bech32_decode_inverts_encode
+    ]
+  , testGroup "bech32m" [
+      Q.testProperty "decode . encode ~ id" $
+        Q.withMaxSuccess 1000 bech32m_decode_inverts_encode
     ]
   ]