ppad-base16 0.3.0 → 0.3.1
raw patch · 7 files changed
+283/−168 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG +8/−0
- bench/Main.hs +6/−2
- bench/Weight.hs +1/−1
- lib/Data/ByteString/Base16.hs +4/−128
- lib/Data/ByteString/Base16/Pure.hs +144/−0
- ppad-base16.cabal +5/−4
- test/Main.hs +115/−33
CHANGELOG view
@@ -1,5 +1,13 @@ # Changelog +- 0.3.1 (2026-10-10)+ * The portable implementation now lives in an internal+ 'Data.ByteString.Base16.Pure' module, and+ 'Data.ByteString.Base16.Arm' is no longer exposed. Both are hidden+ internal modules; the public API is unchanged.+ * Expands the test suite to exercise both the NEON and portable+ implementations, including on invalid inputs.+ - 0.3.0 (2026-05-16) * Features order-of-magnitude performance improvements in both encoding and decoding, especially on ARM platforms where NEON
bench/Main.hs view
@@ -15,6 +15,10 @@ main = defaultMain [ minimal_encode , minimal_decode+ , encode+ , decode+ , encode_various+ , decode_various ] minimal_encode :: Benchmark@@ -47,7 +51,7 @@ ] decode_various :: Benchmark-decode_various = bgroup "base16" [+decode_various = bgroup "decode (input size)" [ bench "1024B input" $ nf B16.decode (B16.encode (BS.replicate 512 0x00)) , bench "1026B input" $ nf B16.decode (B16.encode (BS.replicate 513 0x00)) , bench "1028B input" $ nf B16.decode (B16.encode (BS.replicate 514 0x00))@@ -60,7 +64,7 @@ ] encode_various :: Benchmark-encode_various = bgroup "base16" [+encode_various = bgroup "encode (input size)" [ bench "1024B input" $ nf B16.encode (BS.replicate 1024 0x00) , bench "1023B input" $ nf B16.encode (BS.replicate 1023 0x00) , bench "1022B input" $ nf B16.encode (BS.replicate 1022 0x00)
bench/Weight.hs view
@@ -23,4 +23,4 @@ W.func "ppad-base16 (decode)" B16.decode hinp W.func "base16-bytestring (decode)" R0.decode hinp- W.func "base16 (decode)" R1.decodeBase16Untyped inp+ W.func "base16 (decode)" R1.decodeBase16Untyped hinp
lib/Data/ByteString/Base16.hs view
@@ -1,6 +1,4 @@ {-# OPTIONS_HADDOCK prune #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-} -- | -- Module: Data.ByteString.Base16@@ -8,85 +6,16 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Pure base16 encoding and decoding of strict bytestrings.+-- Base16 encoding and decoding of strict bytestrings. module Data.ByteString.Base16 ( encode , decode ) where -import qualified Data.Bits as B-import Data.Bits ((.&.), (.|.)) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16.Arm as Arm-import qualified Data.ByteString.Internal as BI-import Data.Word (Word8, Word16)-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (Ptr, castPtr, plusPtr)-import Foreign.Storable (peekElemOff, pokeElemOff)-import System.IO.Unsafe (unsafeDupablePerformIO)--fi :: (Num a, Integral b) => b -> a-fi = fromIntegral-{-# INLINE fi #-}---- 512-byte table. Bytes [2k] and [2k+1] are the two lowercase ASCII--- hex characters representing the value k. All-ASCII content means--- the bytestring 'IsString' rule rewrites this to 'unsafePackAddress'--- and the bytes live in static rodata.-enc_tab :: BS.ByteString-enc_tab =- "000102030405060708090a0b0c0d0e0f\- \101112131415161718191a1b1c1d1e1f\- \202122232425262728292a2b2c2d2e2f\- \303132333435363738393a3b3c3d3e3f\- \404142434445464748494a4b4c4d4e4f\- \505152535455565758595a5b5c5d5e5f\- \606162636465666768696a6b6c6d6e6f\- \707172737475767778797a7b7c7d7e7f\- \808182838485868788898a8b8c8d8e8f\- \909192939495969798999a9b9c9d9e9f\- \a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\- \b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\- \c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\- \d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\- \e0e1e2e3e4e5e6e7e8e9eaebecedeeef\- \f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"-{-# NOINLINE enc_tab #-}---- 256-byte table. Index by an ASCII byte to obtain its nibble; valid--- hex chars ('0'..'9', 'a'..'f', 'A'..'F') map to 0x10..0x1f, every--- other byte maps to 0x20.------ The encoding is chosen so the literal is strictly ASCII and contains--- no embedded NUL, which is what the bytestring 'IsString' rule needs--- to rewrite it into 'unsafePackAddress' (cf. 'enc_tab') — the bytes--- end up in static rodata, with no CAF allocation.------ The 0x20 sentinel is distinguished by bit 5; no value 0x10..0x1f--- carries that bit, so 'decode' OR-folds every lookup into an--- accumulator and tests 'acc .&. 0x20 == 0' once at the end. The--- output byte is '(n0 `shiftL` 4) .|. (n1 .&. 0x0f)': in 'Word8' the--- shift naturally drops bit 4, and the mask isolates the low nibble.-dec_tab :: BS.ByteString-dec_tab =- "\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x20\x20\x20\x20\x20\x20\- \\x20\x1a\x1b\x1c\x1d\x1e\x1f\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x1a\x1b\x1c\x1d\x1e\x1f\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\- \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20"-{-# NOINLINE dec_tab #-}+import qualified Data.ByteString.Base16.Pure as Pure -- | Encode a base256 'ByteString' as base16. --@@ -98,7 +27,7 @@ encode :: BS.ByteString -> BS.ByteString encode bs | Arm.base16_arm_available = Arm.encode bs- | otherwise = encode_scalar bs+ | otherwise = Pure.encode bs {-# INLINABLE encode #-} -- | Decode a base16 'ByteString' to base256.@@ -114,58 +43,5 @@ decode :: BS.ByteString -> Maybe BS.ByteString decode bs | Arm.base16_arm_available = Arm.decode bs- | otherwise = decode_scalar bs+ | otherwise = Pure.decode bs {-# INLINABLE decode #-}--encode_scalar :: BS.ByteString -> BS.ByteString-encode_scalar (BI.PS sfp soff l) =- case enc_tab of- BI.PS tfp toff _ ->- BI.unsafeCreate (l `B.shiftL` 1) $ \dst ->- withForeignPtr sfp $ \sp0 ->- withForeignPtr tfp $ \tp0 -> do- -- read 'enc_tab' and write 'dst' as 'Word16' pairs. The- -- two-byte block at 'enc_tab[2*b]' and the two-byte block- -- at 'dst[2*i]' share the same byte layout in memory, so- -- this is endianness-safe: we never inspect the numerical- -- value of the 'Word16', we just shuffle 16 bits between- -- two locations.- let !sp = sp0 `plusPtr` soff :: Ptr Word8- !tp = tp0 `plusPtr` toff :: Ptr Word16- !dp = castPtr dst :: Ptr Word16- loop !i- | i == l = pure ()- | otherwise = do- b <- peekElemOff sp i- w <- peekElemOff tp (fi b)- pokeElemOff dp i (w :: Word16)- loop (i + 1)- loop 0--decode_scalar :: BS.ByteString -> Maybe BS.ByteString-decode_scalar (BI.PS sfp soff l)- | B.testBit l 0 = Nothing- | otherwise = case dec_tab of- BI.PS tfp toff _ -> unsafeDupablePerformIO $ do- let !n = l `B.shiftR` 1- fp <- BI.mallocByteString n- ok <- withForeignPtr fp $ \dst ->- withForeignPtr sfp $ \sp0 ->- withForeignPtr tfp $ \tp0 -> do- let !sp = sp0 `plusPtr` soff :: Ptr Word8- !tp = tp0 `plusPtr` toff :: Ptr Word8- loop !i !acc- | i == n =- pure $! acc .&. 0x20 == 0- | otherwise = do- let !o = i `B.shiftL` 1- c0 <- peekElemOff sp o- c1 <- peekElemOff sp (o + 1)- n0 <- peekElemOff tp (fi c0)- n1 <- peekElemOff tp (fi c1)- let !b = (n0 `B.shiftL` 4)- .|. (n1 .&. 0x0f)- pokeElemOff dst i b- loop (i + 1) (acc .|. n0 .|. n1)- loop 0 0- pure $! if ok then Just (BI.PS fp 0 n) else Nothing
+ lib/Data/ByteString/Base16/Pure.hs view
@@ -0,0 +1,144 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module: Data.ByteString.Base16.Pure+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Pure Haskell base16 encoding and decoding of strict bytestrings.++module Data.ByteString.Base16.Pure (+ encode+ , decode+ ) where++import qualified Data.Bits as B+import Data.Bits ((.&.), (.|.))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BI+import Data.Word (Word8, Word16)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, castPtr, plusPtr)+import Foreign.Storable (peekElemOff, pokeElemOff)+import System.IO.Unsafe (unsafeDupablePerformIO)++fi :: (Num a, Integral b) => b -> a+fi = fromIntegral+{-# INLINE fi #-}++-- 512-byte table. Bytes [2k] and [2k+1] are the two lowercase ASCII+-- hex characters representing the value k. All-ASCII content means+-- the bytestring 'IsString' rule rewrites this to 'unsafePackAddress'+-- and the bytes live in static rodata.+enc_tab :: BS.ByteString+enc_tab =+ "000102030405060708090a0b0c0d0e0f\+ \101112131415161718191a1b1c1d1e1f\+ \202122232425262728292a2b2c2d2e2f\+ \303132333435363738393a3b3c3d3e3f\+ \404142434445464748494a4b4c4d4e4f\+ \505152535455565758595a5b5c5d5e5f\+ \606162636465666768696a6b6c6d6e6f\+ \707172737475767778797a7b7c7d7e7f\+ \808182838485868788898a8b8c8d8e8f\+ \909192939495969798999a9b9c9d9e9f\+ \a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\+ \b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\+ \c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\+ \d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\+ \e0e1e2e3e4e5e6e7e8e9eaebecedeeef\+ \f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"+{-# NOINLINE enc_tab #-}++-- 256-byte table. Index by an ASCII byte to obtain its nibble; valid+-- hex chars ('0'..'9', 'a'..'f', 'A'..'F') map to 0x10..0x1f, every+-- other byte maps to 0x20.+--+-- The encoding is chosen so the literal is strictly ASCII and contains+-- no embedded NUL, which is what the bytestring 'IsString' rule needs+-- to rewrite it into 'unsafePackAddress' (cf. 'enc_tab') — the bytes+-- end up in static rodata, with no CAF allocation.+--+-- The 0x20 sentinel is distinguished by bit 5; no value 0x10..0x1f+-- carries that bit, so 'decode' OR-folds every lookup into an+-- accumulator and tests 'acc .&. 0x20 == 0' once at the end. The+-- output byte is '(n0 `shiftL` 4) .|. (n1 .&. 0x0f)': in 'Word8' the+-- shift naturally drops bit 4, and the mask isolates the low nibble.+dec_tab :: BS.ByteString+dec_tab =+ "\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x20\x20\x20\x20\x20\x20\+ \\x20\x1a\x1b\x1c\x1d\x1e\x1f\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x1a\x1b\x1c\x1d\x1e\x1f\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\+ \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20"+{-# NOINLINE dec_tab #-}++-- | Encode a base256 'ByteString' as base16.+encode :: BS.ByteString -> BS.ByteString+encode (BI.PS sfp soff l) =+ case enc_tab of+ BI.PS tfp toff _ ->+ BI.unsafeCreate (l `B.shiftL` 1) $ \dst ->+ withForeignPtr sfp $ \sp0 ->+ withForeignPtr tfp $ \tp0 -> do+ -- read 'enc_tab' and write 'dst' as 'Word16' pairs. The+ -- two-byte block at 'enc_tab[2*b]' and the two-byte block+ -- at 'dst[2*i]' share the same byte layout in memory, so+ -- this is endianness-safe: we never inspect the numerical+ -- value of the 'Word16', we just shuffle 16 bits between+ -- two locations.+ let !sp = sp0 `plusPtr` soff :: Ptr Word8+ !tp = tp0 `plusPtr` toff :: Ptr Word16+ !dp = castPtr dst :: Ptr Word16+ loop !i+ | i == l = pure ()+ | otherwise = do+ b <- peekElemOff sp i+ w <- peekElemOff tp (fi b)+ pokeElemOff dp i (w :: Word16)+ loop (i + 1)+ loop 0++-- | Decode a base16 'ByteString' to base256. Invalid inputs+-- (including odd-length inputs) will produce 'Nothing'.+decode :: BS.ByteString -> Maybe BS.ByteString+decode (BI.PS sfp soff l)+ | B.testBit l 0 = Nothing+ | otherwise = case dec_tab of+ BI.PS tfp toff _ -> unsafeDupablePerformIO $ do+ let !n = l `B.shiftR` 1+ fp <- BI.mallocByteString n+ ok <- withForeignPtr fp $ \dst ->+ withForeignPtr sfp $ \sp0 ->+ withForeignPtr tfp $ \tp0 -> do+ let !sp = sp0 `plusPtr` soff :: Ptr Word8+ !tp = tp0 `plusPtr` toff :: Ptr Word8+ loop !i !acc+ | i == n =+ pure $! acc .&. 0x20 == 0+ | otherwise = do+ let !o = i `B.shiftL` 1+ c0 <- peekElemOff sp o+ c1 <- peekElemOff sp (o + 1)+ n0 <- peekElemOff tp (fi c0)+ n1 <- peekElemOff tp (fi c1)+ let !b = (n0 `B.shiftL` 4)+ .|. (n1 .&. 0x0f)+ pokeElemOff dst i b+ loop (i + 1) (acc .|. n0 .|. n1)+ loop 0 0+ pure $! if ok then Just (BI.PS fp 0 n) else Nothing
ppad-base16.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: ppad-base16-version: 0.3.0-synopsis: Pure base16 encoding and decoding on bytestrings.+version: 0.3.1+synopsis: Fast base16 encoding and decoding on bytestrings. license: MIT license-file: LICENSE author: Jared Tobin@@ -11,7 +11,7 @@ tested-with: GHC == { 9.10.3 } extra-doc-files: CHANGELOG description:- Pure base16 (hexadecimal) encoding and decoding on bytestrings.+ Fast base16 (hexadecimal) encoding and decoding on bytestrings. flag llvm description: Use GHC's LLVM backend.@@ -36,6 +36,8 @@ ghc-options: -fllvm -O2 exposed-modules: Data.ByteString.Base16+ Data.ByteString.Base16.Pure+ other-modules: Data.ByteString.Base16.Arm build-depends: base >= 4.9 && < 5@@ -99,7 +101,6 @@ , base16 , base16-bytestring , bytestring- , criterion , ppad-base16 , weigh
test/Main.hs view
@@ -4,72 +4,154 @@ module Main where +import Control.Monad (forM_) import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B8 import qualified "ppad-base16" Data.ByteString.Base16 as B16+import qualified "ppad-base16" Data.ByteString.Base16.Pure as Pure import qualified "base16-bytestring" Data.ByteString.Base16 as R0+import Data.Word (Word8) 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)+-- generators ----------------------------------------------------------------- +-- random bytes, as a slice at a random offset into a larger buffer, so+-- that inputs with a non-zero 'ByteString' offset are exercised bytes :: Int -> Q.Gen BS.ByteString bytes k = do l <- Q.chooseInt (0, k)- v <- Q.vectorOf l Q.arbitrary- pure (BS.pack v)+ o <- Q.chooseInt (0, 32)+ v <- Q.vectorOf (o + l) Q.arbitrary+ pure (BS.drop o (BS.pack v)) +newtype BS = BS BS.ByteString+ deriving (Eq, Show)+ instance Q.Arbitrary BS where arbitrary = do b <- bytes 1024 pure (BS b) -decode_inverts_encode :: BS -> Bool-decode_inverts_encode (BS bs) = case B16.decode (B16.encode bs) of- Nothing -> False- Just b -> b == bs+hex_chars :: BS.ByteString+hex_chars = "0123456789abcdefABCDEF" +-- mostly-hex strings of arbitrary (including odd) length: each byte is+-- a hex char with high probability, otherwise an arbitrary byte+newtype Hexish = Hexish BS.ByteString+ deriving (Eq, Show)++instance Q.Arbitrary Hexish where+ arbitrary = do+ l <- Q.chooseInt (0, 256)+ o <- Q.chooseInt (0, 32)+ junk <- Q.elements [0, 1, 50 :: Int]+ v <- Q.vectorOf (o + l) $ do+ p <- Q.chooseInt (1, 100)+ if p <= junk+ then Q.arbitrary+ else Q.elements (BS.unpack hex_chars)+ pure (Hexish (BS.drop o (BS.pack v)))++-- decoders under test --------------------------------------------------------++decoders :: [(String, BS.ByteString -> Maybe BS.ByteString)]+decoders = [("public", B16.decode), ("pure", Pure.decode)]++ref_decode :: BS.ByteString -> Maybe BS.ByteString+ref_decode bs = case R0.decode bs of+ Left _ -> Nothing+ Right d -> Just d++is_hex :: Word8 -> Bool+is_hex c = BS.elem c hex_chars++-- properties -----------------------------------------------------------------+ encode_matches_reference :: BS -> Bool encode_matches_reference (BS bs) =- let us = B16.encode bs- r0 = R0.encode bs- in us == r0+ let r0 = R0.encode bs+ in B16.encode bs == r0 && Pure.encode bs == r0 -decode_matches_reference :: BS -> Bool-decode_matches_reference (BS bs) =- let enc = R0.encode bs- us = B16.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+decode_inverts_encode :: BS -> Bool+decode_inverts_encode (BS bs) =+ let enc = B16.encode bs+ in all (\(_, dec) -> dec enc == Just bs) decoders +decode_matches_reference :: Hexish -> Bool+decode_matches_reference (Hexish bs) =+ let r0 = ref_decode bs+ in B16.decode bs == r0 && Pure.decode bs == r0++-- unit tests -----------------------------------------------------------------+ case_handled :: TestTree-case_handled = H.testCase "decodes uppercase hex" $ do- let lhex = "deadbeef"- uhex = "DEADBEEF"- case liftA2 (,) (B16.decode lhex) (B16.decode uhex) of- Nothing -> H.assertBool mempty False- Just (a, b) -> H.assertEqual mempty a b+case_handled = H.testCase "decodes uppercase and mixed-case hex" $+ forM_ decoders $ \(nam, dec) -> do+ let l = dec "deadbeef"+ H.assertEqual nam (Just "\xde\xad\xbe\xef") l+ H.assertEqual nam l (dec "DEADBEEF")+ H.assertEqual nam l (dec "DeAdBeEf") +-- every byte value, at every position of a string spanning one full NEON+-- block plus a scalar tail, is accepted iff it is a hex char+every_byte_every_position :: TestTree+every_byte_every_position =+ H.testCase "every byte at every position" $ do+ let base = B8.replicate 34 '0'+ forM_ [0 .. 255 :: Int] $ \c ->+ forM_ [0 .. BS.length base - 1] $ \i -> do+ let w = fromIntegral c :: Word8+ inp = BS.take i base <> BS.singleton w <> BS.drop (i + 1) base+ pec = if is_hex w then ref_decode inp else Nothing+ msg = "byte " <> show c <> ", position " <> show i+ forM_ decoders $ \(nam, dec) ->+ H.assertEqual (nam <> ", " <> msg) pec (dec inp)++-- for every length spanning several NEON blocks and every tail length,+-- a single invalid byte at any position causes decoding to fail+single_corruption :: TestTree+single_corruption = H.testCase "single invalid byte anywhere" $ do+ let bad = BS.pack [0x00, 0x20, 0x7f, 0x80, 0xff] <> "/:@G`g"+ forM_ [1 .. 80 :: Int] $ \n -> do+ let raw = BS.pack (fmap fromIntegral [7 * j + 3 | j <- [1 .. n]])+ enc = upper_odd (B16.encode raw)+ upper_odd = BS.pack . zipWith up [0 :: Int ..] . BS.unpack+ up j c | odd j && c >= 0x61 = c - 0x20+ | otherwise = c+ forM_ decoders $ \(nam, dec) ->+ H.assertEqual (nam <> ", intact, n = " <> show n) (Just raw) (dec enc)+ forM_ [0 .. BS.length enc - 1] $ \i ->+ forM_ (BS.unpack bad) $ \w -> do+ let inp = BS.take i enc <> BS.singleton w <> BS.drop (i + 1) enc+ msg = "n = " <> show n <> ", position " <> show i+ <> ", byte " <> show w+ forM_ decoders $ \(nam, dec) ->+ H.assertEqual (nam <> ", " <> msg) Nothing (dec inp)++odd_lengths :: TestTree+odd_lengths = H.testCase "odd-length inputs" $+ forM_ [1, 3 .. 99 :: Int] $ \l ->+ forM_ decoders $ \(nam, dec) ->+ H.assertEqual (nam <> ", length " <> show l) Nothing+ (dec (B8.replicate l 'a'))+ main :: IO () main = defaultMain $ testGroup "ppad-base16" [ testGroup "property tests" [- Q.testProperty "decode . encode ~ id" $- Q.withMaxSuccess 5000 decode_inverts_encode- , Q.testProperty "encode matches reference" $+ Q.testProperty "encode matches reference" $ Q.withMaxSuccess 5000 encode_matches_reference+ , Q.testProperty "decode . encode ~ id" $+ Q.withMaxSuccess 5000 decode_inverts_encode , Q.testProperty "decode matches reference" $ Q.withMaxSuccess 5000 decode_matches_reference ] , testGroup "unit tests" [ case_handled+ , every_byte_every_position+ , single_corruption+ , odd_lengths ] ]-