Internal.hs (7492B)
1 {-# OPTIONS_HADDOCK hide, prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 5 -- | 6 -- Module: Data.ByteString.Base32.Internal 7 -- Copyright: (c) 2024 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Tables and the table-driven encoding loop for the bech32 base32 12 -- charset, shared by 'Data.ByteString.Base32' and 13 -- 'Data.ByteString.Bech32.Internal'. 14 15 module Data.ByteString.Base32.Internal ( 16 enc_tab 17 , dec_tab 18 , w5_tab 19 , encode_with 20 ) where 21 22 import qualified Data.Bits as B 23 import Data.Bits ((.&.), (.|.)) 24 import qualified Data.ByteString as BS 25 import qualified Data.ByteString.Internal as BI 26 import Data.Word (Word8) 27 import Foreign.ForeignPtr (withForeignPtr) 28 import Foreign.Ptr (Ptr, plusPtr) 29 import Foreign.Storable (peekElemOff, pokeElemOff) 30 31 fi :: (Num a, Integral b) => b -> a 32 fi = fromIntegral 33 {-# INLINE fi #-} 34 35 -- 32-byte encoding table: the bech32 character set. Maps a 5-bit 36 -- value (0..31) to its bech32 character. ASCII-only with no embedded 37 -- NUL, so the bytestring 'IsString' rule rewrites the literal to 38 -- 'unsafePackAddress' and the bytes live in static rodata. 39 enc_tab :: BS.ByteString 40 enc_tab = "qpzry9x8gf2tvdw0s3jn54khce6mua7l" 41 {-# NOINLINE enc_tab #-} 42 43 -- 256-byte reverse table. Index by an ASCII byte to obtain its 44 -- 5-bit value (biased into bit 5); valid bech32 chars map to 45 -- 0x20..0x3f, every other byte maps to 0x40. 46 -- 47 -- The encoding is chosen so the literal is strictly ASCII and 48 -- contains no embedded NUL, which is what the bytestring 'IsString' 49 -- rule needs to rewrite it into 'unsafePackAddress' (cf. 'enc_tab') 50 -- - the bytes end up in static rodata, with no CAF allocation. 51 -- 52 -- The 0x40 sentinel is distinguished by bit 6; no value 0x20..0x3f 53 -- carries that bit, so callers OR-fold every lookup into an 54 -- accumulator and test 'acc .&. 0x40 == 0' once at the end. The 55 -- 5-bit value is extracted as 'b .&. 0x1f'. 56 dec_tab :: BS.ByteString 57 dec_tab = 58 "\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 59 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 60 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 61 \\x2f\x40\x2a\x31\x35\x34\x3a\x3e\x27\x25\x40\x40\x40\x40\x40\x40\ 62 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 63 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 64 \\x40\x3d\x40\x38\x2d\x39\x29\x28\x37\x40\x32\x36\x3f\x3b\x33\x40\ 65 \\x21\x20\x23\x30\x2b\x3c\x2c\x2e\x26\x24\x22\x40\x40\x40\x40\x40\ 66 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 67 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 68 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 69 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 70 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 71 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 72 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\ 73 \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40" 74 {-# NOINLINE dec_tab #-} 75 76 -- 32-byte identity table: maps a 5-bit value to itself. Encoding 77 -- through it yields the 5-bit values themselves rather than their 78 -- bech32 characters. 79 w5_tab :: BS.ByteString 80 w5_tab = BS.pack [0 .. 31] 81 {-# NOINLINE w5_tab #-} 82 83 -- | Regroup a base256 'ByteString' into 5-bit values, mapping each 84 -- through the supplied 32-byte table. 85 encode_with 86 :: BS.ByteString -- ^ 32-byte table 87 -> BS.ByteString -- ^ base256-encoded bytestring 88 -> BS.ByteString 89 encode_with (BI.PS tfp toff _) (BI.PS sfp soff l) = 90 let !outlen = (l * 8 + 4) `quot` 5 91 in BI.unsafeCreate outlen $ \dst -> 92 withForeignPtr sfp $ \sp0 -> 93 withForeignPtr tfp $ \tp0 -> do 94 let !sp = sp0 `plusPtr` soff :: Ptr Word8 95 !tp = tp0 `plusPtr` toff :: Ptr Word8 96 encode_loop sp tp dst l 0 0 97 98 encode_loop 99 :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 100 -> Int -> Int -> Int -> IO () 101 encode_loop !sp !tp !dst !len !i !j 102 | i + 5 <= len = do 103 a <- peekElemOff sp i 104 b <- peekElemOff sp (i + 1) 105 c <- peekElemOff sp (i + 2) 106 d <- peekElemOff sp (i + 3) 107 e <- peekElemOff sp (i + 4) 108 let !w0 = (a `B.shiftR` 3) .&. 0x1f 109 !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f 110 !w2 = (b `B.shiftR` 1) .&. 0x1f 111 !w3 = (b `B.shiftL` 4 .|. c `B.shiftR` 4) .&. 0x1f 112 !w4 = (c `B.shiftL` 1 .|. d `B.shiftR` 7) .&. 0x1f 113 !w5 = (d `B.shiftR` 2) .&. 0x1f 114 !w6 = (d `B.shiftL` 3 .|. e `B.shiftR` 5) .&. 0x1f 115 !w7 = e .&. 0x1f 116 peekElemOff tp (fi w0) >>= pokeElemOff dst j 117 peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1) 118 peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2) 119 peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3) 120 peekElemOff tp (fi w4) >>= pokeElemOff dst (j + 4) 121 peekElemOff tp (fi w5) >>= pokeElemOff dst (j + 5) 122 peekElemOff tp (fi w6) >>= pokeElemOff dst (j + 6) 123 peekElemOff tp (fi w7) >>= pokeElemOff dst (j + 7) 124 encode_loop sp tp dst len (i + 5) (j + 8) 125 | otherwise = encode_tail sp tp dst len i j 126 127 encode_tail 128 :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 129 -> Int -> Int -> Int -> IO () 130 encode_tail !sp !tp !dst !len !i !j = case len - i of 131 0 -> pure () 132 1 -> do 133 a <- peekElemOff sp i 134 let !w0 = (a `B.shiftR` 3) .&. 0x1f 135 !w1 = (a `B.shiftL` 2) .&. 0x1f 136 peekElemOff tp (fi w0) >>= pokeElemOff dst j 137 peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1) 138 2 -> do 139 a <- peekElemOff sp i 140 b <- peekElemOff sp (i + 1) 141 let !w0 = (a `B.shiftR` 3) .&. 0x1f 142 !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f 143 !w2 = (b `B.shiftR` 1) .&. 0x1f 144 !w3 = (b `B.shiftL` 4) .&. 0x1f 145 peekElemOff tp (fi w0) >>= pokeElemOff dst j 146 peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1) 147 peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2) 148 peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3) 149 3 -> do 150 a <- peekElemOff sp i 151 b <- peekElemOff sp (i + 1) 152 c <- peekElemOff sp (i + 2) 153 let !w0 = (a `B.shiftR` 3) .&. 0x1f 154 !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f 155 !w2 = (b `B.shiftR` 1) .&. 0x1f 156 !w3 = (b `B.shiftL` 4 .|. c `B.shiftR` 4) .&. 0x1f 157 !w4 = (c `B.shiftL` 1) .&. 0x1f 158 peekElemOff tp (fi w0) >>= pokeElemOff dst j 159 peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1) 160 peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2) 161 peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3) 162 peekElemOff tp (fi w4) >>= pokeElemOff dst (j + 4) 163 4 -> do 164 a <- peekElemOff sp i 165 b <- peekElemOff sp (i + 1) 166 c <- peekElemOff sp (i + 2) 167 d <- peekElemOff sp (i + 3) 168 let !w0 = (a `B.shiftR` 3) .&. 0x1f 169 !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f 170 !w2 = (b `B.shiftR` 1) .&. 0x1f 171 !w3 = (b `B.shiftL` 4 .|. c `B.shiftR` 4) .&. 0x1f 172 !w4 = (c `B.shiftL` 1 .|. d `B.shiftR` 7) .&. 0x1f 173 !w5 = (d `B.shiftR` 2) .&. 0x1f 174 !w6 = (d `B.shiftL` 3) .&. 0x1f 175 peekElemOff tp (fi w0) >>= pokeElemOff dst j 176 peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1) 177 peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2) 178 peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3) 179 peekElemOff tp (fi w4) >>= pokeElemOff dst (j + 4) 180 peekElemOff tp (fi w5) >>= pokeElemOff dst (j + 5) 181 peekElemOff tp (fi w6) >>= pokeElemOff dst (j + 6) 182 _ -> pure () -- impossible: 0 <= len - i < 5