Pure.hs (6104B)
1 {-# OPTIONS_HADDOCK hide #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 5 -- | 6 -- Module: Data.ByteString.Base16.Pure 7 -- Copyright: (c) 2025 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Pure Haskell base16 encoding and decoding of strict bytestrings. 12 13 module Data.ByteString.Base16.Pure ( 14 encode 15 , decode 16 ) where 17 18 import qualified Data.Bits as B 19 import Data.Bits ((.&.), (.|.)) 20 import qualified Data.ByteString as BS 21 import qualified Data.ByteString.Internal as BI 22 import Data.Word (Word8, Word16) 23 import Foreign.ForeignPtr (withForeignPtr) 24 import Foreign.Ptr (Ptr, castPtr, plusPtr) 25 import Foreign.Storable (peekElemOff, pokeElemOff) 26 import System.IO.Unsafe (unsafeDupablePerformIO) 27 28 fi :: (Num a, Integral b) => b -> a 29 fi = fromIntegral 30 {-# INLINE fi #-} 31 32 -- 512-byte table. Bytes [2k] and [2k+1] are the two lowercase ASCII 33 -- hex characters representing the value k. All-ASCII content means 34 -- the bytestring 'IsString' rule rewrites this to 'unsafePackAddress' 35 -- and the bytes live in static rodata. 36 enc_tab :: BS.ByteString 37 enc_tab = 38 "000102030405060708090a0b0c0d0e0f\ 39 \101112131415161718191a1b1c1d1e1f\ 40 \202122232425262728292a2b2c2d2e2f\ 41 \303132333435363738393a3b3c3d3e3f\ 42 \404142434445464748494a4b4c4d4e4f\ 43 \505152535455565758595a5b5c5d5e5f\ 44 \606162636465666768696a6b6c6d6e6f\ 45 \707172737475767778797a7b7c7d7e7f\ 46 \808182838485868788898a8b8c8d8e8f\ 47 \909192939495969798999a9b9c9d9e9f\ 48 \a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\ 49 \b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\ 50 \c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\ 51 \d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\ 52 \e0e1e2e3e4e5e6e7e8e9eaebecedeeef\ 53 \f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff" 54 {-# NOINLINE enc_tab #-} 55 56 -- 256-byte table. Index by an ASCII byte to obtain its nibble; valid 57 -- hex chars ('0'..'9', 'a'..'f', 'A'..'F') map to 0x10..0x1f, every 58 -- other byte maps to 0x20. 59 -- 60 -- The encoding is chosen so the literal is strictly ASCII and contains 61 -- no embedded NUL, which is what the bytestring 'IsString' rule needs 62 -- to rewrite it into 'unsafePackAddress' (cf. 'enc_tab') — the bytes 63 -- end up in static rodata, with no CAF allocation. 64 -- 65 -- The 0x20 sentinel is distinguished by bit 5; no value 0x10..0x1f 66 -- carries that bit, so 'decode' OR-folds every lookup into an 67 -- accumulator and tests 'acc .&. 0x20 == 0' once at the end. The 68 -- output byte is '(n0 `shiftL` 4) .|. (n1 .&. 0x0f)': in 'Word8' the 69 -- shift naturally drops bit 4, and the mask isolates the low nibble. 70 dec_tab :: BS.ByteString 71 dec_tab = 72 "\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 73 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 74 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 75 \\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x20\x20\x20\x20\x20\x20\ 76 \\x20\x1a\x1b\x1c\x1d\x1e\x1f\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 77 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 78 \\x20\x1a\x1b\x1c\x1d\x1e\x1f\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 79 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 80 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 81 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 82 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 83 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 84 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 85 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 86 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\ 87 \\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20\x20" 88 {-# NOINLINE dec_tab #-} 89 90 -- | Encode a base256 'ByteString' as base16. 91 encode :: BS.ByteString -> BS.ByteString 92 encode (BI.PS sfp soff l) = 93 case enc_tab of 94 BI.PS tfp toff _ -> 95 BI.unsafeCreate (l `B.shiftL` 1) $ \dst -> 96 withForeignPtr sfp $ \sp0 -> 97 withForeignPtr tfp $ \tp0 -> do 98 -- read 'enc_tab' and write 'dst' as 'Word16' pairs. The 99 -- two-byte block at 'enc_tab[2*b]' and the two-byte block 100 -- at 'dst[2*i]' share the same byte layout in memory, so 101 -- this is endianness-safe: we never inspect the numerical 102 -- value of the 'Word16', we just shuffle 16 bits between 103 -- two locations. 104 let !sp = sp0 `plusPtr` soff :: Ptr Word8 105 !tp = tp0 `plusPtr` toff :: Ptr Word16 106 !dp = castPtr dst :: Ptr Word16 107 loop !i 108 | i == l = pure () 109 | otherwise = do 110 b <- peekElemOff sp i 111 w <- peekElemOff tp (fi b) 112 pokeElemOff dp i (w :: Word16) 113 loop (i + 1) 114 loop 0 115 116 -- | Decode a base16 'ByteString' to base256. Invalid inputs 117 -- (including odd-length inputs) will produce 'Nothing'. 118 decode :: BS.ByteString -> Maybe BS.ByteString 119 decode (BI.PS sfp soff l) 120 | B.testBit l 0 = Nothing 121 | otherwise = case dec_tab of 122 BI.PS tfp toff _ -> unsafeDupablePerformIO $ do 123 let !n = l `B.shiftR` 1 124 fp <- BI.mallocByteString n 125 ok <- withForeignPtr fp $ \dst -> 126 withForeignPtr sfp $ \sp0 -> 127 withForeignPtr tfp $ \tp0 -> do 128 let !sp = sp0 `plusPtr` soff :: Ptr Word8 129 !tp = tp0 `plusPtr` toff :: Ptr Word8 130 loop !i !acc 131 | i == n = 132 pure $! acc .&. 0x20 == 0 133 | otherwise = do 134 let !o = i `B.shiftL` 1 135 c0 <- peekElemOff sp o 136 c1 <- peekElemOff sp (o + 1) 137 n0 <- peekElemOff tp (fi c0) 138 n1 <- peekElemOff tp (fi c1) 139 let !b = (n0 `B.shiftL` 4) 140 .|. (n1 .&. 0x0f) 141 pokeElemOff dst i b 142 loop (i + 1) (acc .|. n0 .|. n1) 143 loop 0 0 144 pure $! if ok then Just (BI.PS fp 0 n) else Nothing