bech32

Pure Haskell bech32, bech32m encoding/decoding (docs.ppad.tech/bech32).
git clone git://git.ppad.tech/bech32.git
Log | Files | Refs | README | LICENSE

Main.hs (3602B)

      1 module Main where
      2 
      3 import qualified Data.Char as C
      4 import qualified Data.ByteString as BS
      5 import qualified Data.ByteString.Char8 as B8
      6 import qualified Data.ByteString.Bech32 as Bech32
      7 import qualified Data.ByteString.Bech32m as Bech32m
      8 import qualified Data.ByteString.Base32 as B32
      9 import Test.Tasty
     10 import qualified Test.Tasty.QuickCheck as Q
     11 import qualified Reference.Bech32 as R
     12 
     13 newtype BS = BS BS.ByteString
     14   deriving (Eq, Show)
     15 
     16 data ValidInput = ValidInput BS.ByteString BS.ByteString
     17   deriving (Eq, Show)
     18 
     19 data InvalidInput = InvalidInput BS.ByteString BS.ByteString
     20   deriving (Eq, Show)
     21 
     22 instance Q.Arbitrary ValidInput where
     23   arbitrary = do
     24     h <- hrp
     25     let l = 83 - BS.length h
     26         a = l * 5 `quot` 8
     27     b <- bytes a
     28     pure (ValidInput h b)
     29 
     30 instance Q.Arbitrary InvalidInput where
     31   arbitrary = do
     32     h <- invalid_hrp
     33     let l = 83 - BS.length h
     34         a = l * 5 `quot` 8
     35     b <- bytes a
     36     pure (InvalidInput h b)
     37 
     38 instance Q.Arbitrary BS where
     39   arbitrary = do
     40     b <- bytes 1024
     41     pure (BS b)
     42 
     43 hrp :: Q.Gen BS.ByteString
     44 hrp = do
     45   l <- Q.chooseInt (1, 83)
     46   v <- Q.vectorOf l (Q.choose (33, 126))
     47   pure (B8.map C.toLower (BS.pack v))
     48 
     49 invalid_hrp :: Q.Gen BS.ByteString
     50 invalid_hrp = do
     51   l <- Q.oneof [pure 0, Q.chooseInt (84, 100)]
     52   v <- Q.vectorOf l (Q.oneof [Q.choose (0, 32), Q.choose (127, 255)])
     53   pure (B8.map C.toLower (BS.pack v))
     54 
     55 bytes :: Int -> Q.Gen BS.ByteString
     56 bytes k = do
     57   l <- Q.chooseInt (0, k)
     58   v <- Q.vectorOf l Q.arbitrary
     59   pure (BS.pack v)
     60 
     61 matches_reference :: ValidInput -> Bool
     62 matches_reference (ValidInput h b) =
     63   let ref = R.bech32Encode h (R.toBase32 (BS.unpack b))
     64       our = Bech32.encode h b
     65   in  ref == our
     66 
     67 bech32_decode_inverts_encode :: ValidInput -> Bool
     68 bech32_decode_inverts_encode (ValidInput h b) = case Bech32.encode h b of
     69   Nothing -> error "generated faulty input"
     70   Just enc -> case Bech32.decode enc of
     71     Nothing -> False
     72     Just (h', dat) -> h == h' && b == dat
     73 
     74 bech32m_decode_inverts_encode :: ValidInput -> Bool
     75 bech32m_decode_inverts_encode (ValidInput h b) = case Bech32m.encode h b of
     76   Nothing -> error "generated faulty input"
     77   Just enc -> case Bech32m.decode enc of
     78     Nothing -> False
     79     Just (h', dat) -> h == h' && b == dat
     80 
     81 base32_decode_inverts_encode :: BS -> Bool
     82 base32_decode_inverts_encode (BS bs) = case B32.decode (B32.encode bs) of
     83   Nothing -> False
     84   Just b  -> b == bs
     85 
     86 bech32_invalid_input_fails_encode :: InvalidInput -> Bool
     87 bech32_invalid_input_fails_encode (InvalidInput h b) =
     88   case Bech32.encode h b of
     89     Nothing -> True
     90     Just _ -> False
     91 
     92 bech32m_invalid_input_fails_encode :: InvalidInput -> Bool
     93 bech32m_invalid_input_fails_encode (InvalidInput h b) =
     94   case Bech32m.encode h b of
     95     Nothing -> True
     96     Just _ -> False
     97 
     98 main :: IO ()
     99 main = defaultMain $ testGroup "ppad-bech32" [
    100     testGroup "base32" [
    101       Q.testProperty "decode . encode ~ id" $
    102         Q.withMaxSuccess 1000 base32_decode_inverts_encode
    103     ]
    104   , testGroup "bech32" [
    105       Q.testProperty "Bech32.encode ~ R.bech32Encode" $
    106         Q.withMaxSuccess 1000 matches_reference
    107     , Q.testProperty "decode . encode ~ id" $
    108         Q.withMaxSuccess 1000 bech32_decode_inverts_encode
    109     , Q.testProperty "invalid bech32 input fails to encode" $
    110         Q.withMaxSuccess 1000 bech32_invalid_input_fails_encode
    111     ]
    112   , testGroup "bech32m" [
    113       Q.testProperty "decode . encode ~ id" $
    114         Q.withMaxSuccess 1000 bech32m_decode_inverts_encode
    115     , Q.testProperty "invalid bech32m input fails to encode" $
    116         Q.withMaxSuccess 1000 bech32_invalid_input_fails_encode
    117     ]
    118   ]
    119