Base32.hs (11183B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 4 -- | 5 -- Module: Data.ByteString.Base32 6 -- Copyright: (c) 2024 Jared Tobin 7 -- License: MIT 8 -- Maintainer: Jared Tobin <jared@ppad.tech> 9 -- 10 -- Unpadded base32 encoding & decoding using the bech32 character set. 11 12 module Data.ByteString.Base32 ( 13 -- * base32 encoding and decoding 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 Data.ByteString.Base32.Internal (enc_tab, dec_tab) 22 import qualified Data.ByteString.Internal as BI 23 import Data.Word (Word8) 24 import Foreign.ForeignPtr (withForeignPtr) 25 import Foreign.Ptr (Ptr, plusPtr) 26 import Foreign.Storable (peekElemOff, pokeElemOff) 27 import System.IO.Unsafe (unsafeDupablePerformIO) 28 29 fi :: (Num a, Integral b) => b -> a 30 fi = fromIntegral 31 {-# INLINE fi #-} 32 33 -- | Encode a base256-encoded 'ByteString' as a base32-encoded 34 -- 'ByteString', using the bech32 character set. 35 -- 36 -- >>> encode "jtobin was here!" 37 -- "df6x7cnfdcs8wctnyp5x2un9yy" 38 encode 39 :: BS.ByteString -- ^ base256-encoded bytestring 40 -> BS.ByteString -- ^ base32-encoded bytestring 41 encode (BI.PS sfp soff l) = case enc_tab of 42 BI.PS tfp toff _ -> 43 let !outlen = (l * 8 + 4) `quot` 5 44 in BI.unsafeCreate outlen $ \dst -> 45 withForeignPtr sfp $ \sp0 -> 46 withForeignPtr tfp $ \tp0 -> do 47 let !sp = sp0 `plusPtr` soff :: Ptr Word8 48 !tp = tp0 `plusPtr` toff :: Ptr Word8 49 encode_loop sp tp dst l 0 0 50 51 encode_loop 52 :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 53 -> Int -> Int -> Int -> IO () 54 encode_loop !sp !tp !dst !len !i !j 55 | i + 5 <= len = do 56 a <- peekElemOff sp i 57 b <- peekElemOff sp (i + 1) 58 c <- peekElemOff sp (i + 2) 59 d <- peekElemOff sp (i + 3) 60 e <- peekElemOff sp (i + 4) 61 let !w0 = (a `B.shiftR` 3) .&. 0x1f 62 !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f 63 !w2 = (b `B.shiftR` 1) .&. 0x1f 64 !w3 = (b `B.shiftL` 4 .|. c `B.shiftR` 4) .&. 0x1f 65 !w4 = (c `B.shiftL` 1 .|. d `B.shiftR` 7) .&. 0x1f 66 !w5 = (d `B.shiftR` 2) .&. 0x1f 67 !w6 = (d `B.shiftL` 3 .|. e `B.shiftR` 5) .&. 0x1f 68 !w7 = e .&. 0x1f 69 peekElemOff tp (fi w0) >>= pokeElemOff dst j 70 peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1) 71 peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2) 72 peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3) 73 peekElemOff tp (fi w4) >>= pokeElemOff dst (j + 4) 74 peekElemOff tp (fi w5) >>= pokeElemOff dst (j + 5) 75 peekElemOff tp (fi w6) >>= pokeElemOff dst (j + 6) 76 peekElemOff tp (fi w7) >>= pokeElemOff dst (j + 7) 77 encode_loop sp tp dst len (i + 5) (j + 8) 78 | otherwise = encode_tail sp tp dst len i j 79 80 encode_tail 81 :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 82 -> Int -> Int -> Int -> IO () 83 encode_tail !sp !tp !dst !len !i !j = case len - i of 84 0 -> pure () 85 1 -> do 86 a <- peekElemOff sp i 87 let !w0 = (a `B.shiftR` 3) .&. 0x1f 88 !w1 = (a `B.shiftL` 2) .&. 0x1f 89 peekElemOff tp (fi w0) >>= pokeElemOff dst j 90 peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1) 91 2 -> do 92 a <- peekElemOff sp i 93 b <- peekElemOff sp (i + 1) 94 let !w0 = (a `B.shiftR` 3) .&. 0x1f 95 !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f 96 !w2 = (b `B.shiftR` 1) .&. 0x1f 97 !w3 = (b `B.shiftL` 4) .&. 0x1f 98 peekElemOff tp (fi w0) >>= pokeElemOff dst j 99 peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1) 100 peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2) 101 peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3) 102 3 -> do 103 a <- peekElemOff sp i 104 b <- peekElemOff sp (i + 1) 105 c <- peekElemOff sp (i + 2) 106 let !w0 = (a `B.shiftR` 3) .&. 0x1f 107 !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f 108 !w2 = (b `B.shiftR` 1) .&. 0x1f 109 !w3 = (b `B.shiftL` 4 .|. c `B.shiftR` 4) .&. 0x1f 110 !w4 = (c `B.shiftL` 1) .&. 0x1f 111 peekElemOff tp (fi w0) >>= pokeElemOff dst j 112 peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1) 113 peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2) 114 peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3) 115 peekElemOff tp (fi w4) >>= pokeElemOff dst (j + 4) 116 4 -> do 117 a <- peekElemOff sp i 118 b <- peekElemOff sp (i + 1) 119 c <- peekElemOff sp (i + 2) 120 d <- peekElemOff sp (i + 3) 121 let !w0 = (a `B.shiftR` 3) .&. 0x1f 122 !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f 123 !w2 = (b `B.shiftR` 1) .&. 0x1f 124 !w3 = (b `B.shiftL` 4 .|. c `B.shiftR` 4) .&. 0x1f 125 !w4 = (c `B.shiftL` 1 .|. d `B.shiftR` 7) .&. 0x1f 126 !w5 = (d `B.shiftR` 2) .&. 0x1f 127 !w6 = (d `B.shiftL` 3) .&. 0x1f 128 peekElemOff tp (fi w0) >>= pokeElemOff dst j 129 peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1) 130 peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2) 131 peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3) 132 peekElemOff tp (fi w4) >>= pokeElemOff dst (j + 4) 133 peekElemOff tp (fi w5) >>= pokeElemOff dst (j + 5) 134 peekElemOff tp (fi w6) >>= pokeElemOff dst (j + 6) 135 _ -> pure () -- impossible: 0 <= len - i < 5 136 137 -- | Decode a 'ByteString', encoded as base32 using the bech32 character 138 -- set, to a base256-encoded 'ByteString'. 139 -- 140 -- >>> decode "df6x7cnfdcs8wctnyp5x2un9yy" 141 -- Just "jtobin was here!" 142 -- >>> decode "dfOx7cnfdcs8wctnyp5x2un9yy" -- s/6/O (non-bech32 character) 143 -- Nothing 144 decode 145 :: BS.ByteString -- ^ base32-encoded bytestring 146 -> Maybe BS.ByteString -- ^ base256-encoded bytestring 147 decode (BI.PS sfp soff l) = case l `rem` 8 of 148 1 -> Nothing 149 3 -> Nothing 150 6 -> Nothing 151 _ -> case dec_tab of 152 BI.PS tfp toff _ -> unsafeDupablePerformIO $ do 153 let !n = (l * 5) `B.shiftR` 3 154 fp <- BI.mallocByteString n 155 ok <- withForeignPtr fp $ \dst -> 156 withForeignPtr sfp $ \sp0 -> 157 withForeignPtr tfp $ \tp0 -> do 158 let !sp = sp0 `plusPtr` soff :: Ptr Word8 159 !tp = tp0 `plusPtr` toff :: Ptr Word8 160 decode_loop sp tp dst l 0 0 0 161 pure $! if ok then Just (BI.PS fp 0 n) else Nothing 162 163 decode_loop 164 :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 165 -> Int -> Int -> Int -> Word8 -> IO Bool 166 decode_loop !sp !tp !dst !len !i !j !acc 167 | i + 8 <= len = do 168 c0 <- peekElemOff sp i 169 c1 <- peekElemOff sp (i + 1) 170 c2 <- peekElemOff sp (i + 2) 171 c3 <- peekElemOff sp (i + 3) 172 c4 <- peekElemOff sp (i + 4) 173 c5 <- peekElemOff sp (i + 5) 174 c6 <- peekElemOff sp (i + 6) 175 c7 <- peekElemOff sp (i + 7) 176 n0 <- peekElemOff tp (fi c0) 177 n1 <- peekElemOff tp (fi c1) 178 n2 <- peekElemOff tp (fi c2) 179 n3 <- peekElemOff tp (fi c3) 180 n4 <- peekElemOff tp (fi c4) 181 n5 <- peekElemOff tp (fi c5) 182 n6 <- peekElemOff tp (fi c6) 183 n7 <- peekElemOff tp (fi c7) 184 let !v0 = n0 .&. 0x1f 185 !v1 = n1 .&. 0x1f 186 !v2 = n2 .&. 0x1f 187 !v3 = n3 .&. 0x1f 188 !v4 = n4 .&. 0x1f 189 !v5 = n5 .&. 0x1f 190 !v6 = n6 .&. 0x1f 191 !v7 = n7 .&. 0x1f 192 !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2) 193 !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|. 194 (v3 `B.shiftR` 4) 195 !b2 = (v3 `B.shiftL` 4) .|. (v4 `B.shiftR` 1) 196 !b3 = (v4 `B.shiftL` 7) .|. (v5 `B.shiftL` 2) .|. 197 (v6 `B.shiftR` 3) 198 !b4 = (v6 `B.shiftL` 5) .|. v7 199 pokeElemOff dst j b0 200 pokeElemOff dst (j + 1) b1 201 pokeElemOff dst (j + 2) b2 202 pokeElemOff dst (j + 3) b3 203 pokeElemOff dst (j + 4) b4 204 decode_loop sp tp dst len (i + 8) (j + 5) 205 (acc .|. n0 .|. n1 .|. n2 .|. n3 .|. n4 .|. n5 .|. n6 .|. n7) 206 | otherwise = decode_tail sp tp dst len i j acc 207 208 decode_tail 209 :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 210 -> Int -> Int -> Int -> Word8 -> IO Bool 211 decode_tail !sp !tp !dst !len !i !j !acc = case len - i of 212 0 -> pure $! acc .&. 0x40 == 0 213 2 -> do 214 c0 <- peekElemOff sp i 215 c1 <- peekElemOff sp (i + 1) 216 n0 <- peekElemOff tp (fi c0) 217 n1 <- peekElemOff tp (fi c1) 218 let !v0 = n0 .&. 0x1f 219 !v1 = n1 .&. 0x1f 220 !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2) 221 -- canonical-form check: bits dropped from v1 must be zero 222 !slack = v1 `B.shiftL` 6 223 pokeElemOff dst j b0 224 pure $! (acc .|. n0 .|. n1) .&. 0x40 == 0 && slack == 0 225 4 -> do 226 c0 <- peekElemOff sp i 227 c1 <- peekElemOff sp (i + 1) 228 c2 <- peekElemOff sp (i + 2) 229 c3 <- peekElemOff sp (i + 3) 230 n0 <- peekElemOff tp (fi c0) 231 n1 <- peekElemOff tp (fi c1) 232 n2 <- peekElemOff tp (fi c2) 233 n3 <- peekElemOff tp (fi c3) 234 let !v0 = n0 .&. 0x1f 235 !v1 = n1 .&. 0x1f 236 !v2 = n2 .&. 0x1f 237 !v3 = n3 .&. 0x1f 238 !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2) 239 !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|. 240 (v3 `B.shiftR` 4) 241 !slack = v3 `B.shiftL` 4 242 pokeElemOff dst j b0 243 pokeElemOff dst (j + 1) b1 244 pure $! (acc .|. n0 .|. n1 .|. n2 .|. n3) .&. 0x40 == 0 245 && slack == 0 246 5 -> do 247 c0 <- peekElemOff sp i 248 c1 <- peekElemOff sp (i + 1) 249 c2 <- peekElemOff sp (i + 2) 250 c3 <- peekElemOff sp (i + 3) 251 c4 <- peekElemOff sp (i + 4) 252 n0 <- peekElemOff tp (fi c0) 253 n1 <- peekElemOff tp (fi c1) 254 n2 <- peekElemOff tp (fi c2) 255 n3 <- peekElemOff tp (fi c3) 256 n4 <- peekElemOff tp (fi c4) 257 let !v0 = n0 .&. 0x1f 258 !v1 = n1 .&. 0x1f 259 !v2 = n2 .&. 0x1f 260 !v3 = n3 .&. 0x1f 261 !v4 = n4 .&. 0x1f 262 !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2) 263 !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|. 264 (v3 `B.shiftR` 4) 265 !b2 = (v3 `B.shiftL` 4) .|. (v4 `B.shiftR` 1) 266 !slack = v4 `B.shiftL` 7 267 pokeElemOff dst j b0 268 pokeElemOff dst (j + 1) b1 269 pokeElemOff dst (j + 2) b2 270 pure $! (acc .|. n0 .|. n1 .|. n2 .|. n3 .|. n4) .&. 0x40 == 0 271 && slack == 0 272 7 -> do 273 c0 <- peekElemOff sp i 274 c1 <- peekElemOff sp (i + 1) 275 c2 <- peekElemOff sp (i + 2) 276 c3 <- peekElemOff sp (i + 3) 277 c4 <- peekElemOff sp (i + 4) 278 c5 <- peekElemOff sp (i + 5) 279 c6 <- peekElemOff sp (i + 6) 280 n0 <- peekElemOff tp (fi c0) 281 n1 <- peekElemOff tp (fi c1) 282 n2 <- peekElemOff tp (fi c2) 283 n3 <- peekElemOff tp (fi c3) 284 n4 <- peekElemOff tp (fi c4) 285 n5 <- peekElemOff tp (fi c5) 286 n6 <- peekElemOff tp (fi c6) 287 let !v0 = n0 .&. 0x1f 288 !v1 = n1 .&. 0x1f 289 !v2 = n2 .&. 0x1f 290 !v3 = n3 .&. 0x1f 291 !v4 = n4 .&. 0x1f 292 !v5 = n5 .&. 0x1f 293 !v6 = n6 .&. 0x1f 294 !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2) 295 !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|. 296 (v3 `B.shiftR` 4) 297 !b2 = (v3 `B.shiftL` 4) .|. (v4 `B.shiftR` 1) 298 !b3 = (v4 `B.shiftL` 7) .|. (v5 `B.shiftL` 2) .|. 299 (v6 `B.shiftR` 3) 300 !slack = v6 `B.shiftL` 5 301 pokeElemOff dst j b0 302 pokeElemOff dst (j + 1) b1 303 pokeElemOff dst (j + 2) b2 304 pokeElemOff dst (j + 3) b3 305 pure $! 306 (acc .|. n0 .|. n1 .|. n2 .|. n3 .|. n4 .|. n5 .|. n6) 307 .&. 0x40 == 0 308 && slack == 0 309 _ -> pure False -- impossible: tail-length guard already rejected