Base32.hs (7262B)
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, encode_with) 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 = encode_with enc_tab 42 43 -- | Decode a 'ByteString', encoded as base32 using the bech32 character 44 -- set, to a base256-encoded 'ByteString'. 45 -- 46 -- >>> decode "df6x7cnfdcs8wctnyp5x2un9yy" 47 -- Just "jtobin was here!" 48 -- >>> decode "dfOx7cnfdcs8wctnyp5x2un9yy" -- s/6/O (non-bech32 character) 49 -- Nothing 50 decode 51 :: BS.ByteString -- ^ base32-encoded bytestring 52 -> Maybe BS.ByteString -- ^ base256-encoded bytestring 53 decode (BI.PS sfp soff l) = case l `rem` 8 of 54 1 -> Nothing 55 3 -> Nothing 56 6 -> Nothing 57 _ -> case dec_tab of 58 BI.PS tfp toff _ -> unsafeDupablePerformIO $ do 59 let !n = (l * 5) `B.shiftR` 3 60 fp <- BI.mallocByteString n 61 ok <- withForeignPtr fp $ \dst -> 62 withForeignPtr sfp $ \sp0 -> 63 withForeignPtr tfp $ \tp0 -> do 64 let !sp = sp0 `plusPtr` soff :: Ptr Word8 65 !tp = tp0 `plusPtr` toff :: Ptr Word8 66 decode_loop sp tp dst l 0 0 0 67 pure $! if ok then Just (BI.PS fp 0 n) else Nothing 68 69 decode_loop 70 :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 71 -> Int -> Int -> Int -> Word8 -> IO Bool 72 decode_loop !sp !tp !dst !len !i !j !acc 73 | i + 8 <= len = do 74 c0 <- peekElemOff sp i 75 c1 <- peekElemOff sp (i + 1) 76 c2 <- peekElemOff sp (i + 2) 77 c3 <- peekElemOff sp (i + 3) 78 c4 <- peekElemOff sp (i + 4) 79 c5 <- peekElemOff sp (i + 5) 80 c6 <- peekElemOff sp (i + 6) 81 c7 <- peekElemOff sp (i + 7) 82 n0 <- peekElemOff tp (fi c0) 83 n1 <- peekElemOff tp (fi c1) 84 n2 <- peekElemOff tp (fi c2) 85 n3 <- peekElemOff tp (fi c3) 86 n4 <- peekElemOff tp (fi c4) 87 n5 <- peekElemOff tp (fi c5) 88 n6 <- peekElemOff tp (fi c6) 89 n7 <- peekElemOff tp (fi c7) 90 let !v0 = n0 .&. 0x1f 91 !v1 = n1 .&. 0x1f 92 !v2 = n2 .&. 0x1f 93 !v3 = n3 .&. 0x1f 94 !v4 = n4 .&. 0x1f 95 !v5 = n5 .&. 0x1f 96 !v6 = n6 .&. 0x1f 97 !v7 = n7 .&. 0x1f 98 !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2) 99 !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|. 100 (v3 `B.shiftR` 4) 101 !b2 = (v3 `B.shiftL` 4) .|. (v4 `B.shiftR` 1) 102 !b3 = (v4 `B.shiftL` 7) .|. (v5 `B.shiftL` 2) .|. 103 (v6 `B.shiftR` 3) 104 !b4 = (v6 `B.shiftL` 5) .|. v7 105 pokeElemOff dst j b0 106 pokeElemOff dst (j + 1) b1 107 pokeElemOff dst (j + 2) b2 108 pokeElemOff dst (j + 3) b3 109 pokeElemOff dst (j + 4) b4 110 decode_loop sp tp dst len (i + 8) (j + 5) 111 (acc .|. n0 .|. n1 .|. n2 .|. n3 .|. n4 .|. n5 .|. n6 .|. n7) 112 | otherwise = decode_tail sp tp dst len i j acc 113 114 decode_tail 115 :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 116 -> Int -> Int -> Int -> Word8 -> IO Bool 117 decode_tail !sp !tp !dst !len !i !j !acc = case len - i of 118 0 -> pure $! acc .&. 0x40 == 0 119 2 -> do 120 c0 <- peekElemOff sp i 121 c1 <- peekElemOff sp (i + 1) 122 n0 <- peekElemOff tp (fi c0) 123 n1 <- peekElemOff tp (fi c1) 124 let !v0 = n0 .&. 0x1f 125 !v1 = n1 .&. 0x1f 126 !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2) 127 -- canonical-form check: bits dropped from v1 must be zero 128 !slack = v1 `B.shiftL` 6 129 pokeElemOff dst j b0 130 pure $! (acc .|. n0 .|. n1) .&. 0x40 == 0 && slack == 0 131 4 -> do 132 c0 <- peekElemOff sp i 133 c1 <- peekElemOff sp (i + 1) 134 c2 <- peekElemOff sp (i + 2) 135 c3 <- peekElemOff sp (i + 3) 136 n0 <- peekElemOff tp (fi c0) 137 n1 <- peekElemOff tp (fi c1) 138 n2 <- peekElemOff tp (fi c2) 139 n3 <- peekElemOff tp (fi c3) 140 let !v0 = n0 .&. 0x1f 141 !v1 = n1 .&. 0x1f 142 !v2 = n2 .&. 0x1f 143 !v3 = n3 .&. 0x1f 144 !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2) 145 !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|. 146 (v3 `B.shiftR` 4) 147 !slack = v3 `B.shiftL` 4 148 pokeElemOff dst j b0 149 pokeElemOff dst (j + 1) b1 150 pure $! (acc .|. n0 .|. n1 .|. n2 .|. n3) .&. 0x40 == 0 151 && slack == 0 152 5 -> do 153 c0 <- peekElemOff sp i 154 c1 <- peekElemOff sp (i + 1) 155 c2 <- peekElemOff sp (i + 2) 156 c3 <- peekElemOff sp (i + 3) 157 c4 <- peekElemOff sp (i + 4) 158 n0 <- peekElemOff tp (fi c0) 159 n1 <- peekElemOff tp (fi c1) 160 n2 <- peekElemOff tp (fi c2) 161 n3 <- peekElemOff tp (fi c3) 162 n4 <- peekElemOff tp (fi c4) 163 let !v0 = n0 .&. 0x1f 164 !v1 = n1 .&. 0x1f 165 !v2 = n2 .&. 0x1f 166 !v3 = n3 .&. 0x1f 167 !v4 = n4 .&. 0x1f 168 !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2) 169 !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|. 170 (v3 `B.shiftR` 4) 171 !b2 = (v3 `B.shiftL` 4) .|. (v4 `B.shiftR` 1) 172 !slack = v4 `B.shiftL` 7 173 pokeElemOff dst j b0 174 pokeElemOff dst (j + 1) b1 175 pokeElemOff dst (j + 2) b2 176 pure $! (acc .|. n0 .|. n1 .|. n2 .|. n3 .|. n4) .&. 0x40 == 0 177 && slack == 0 178 7 -> do 179 c0 <- peekElemOff sp i 180 c1 <- peekElemOff sp (i + 1) 181 c2 <- peekElemOff sp (i + 2) 182 c3 <- peekElemOff sp (i + 3) 183 c4 <- peekElemOff sp (i + 4) 184 c5 <- peekElemOff sp (i + 5) 185 c6 <- peekElemOff sp (i + 6) 186 n0 <- peekElemOff tp (fi c0) 187 n1 <- peekElemOff tp (fi c1) 188 n2 <- peekElemOff tp (fi c2) 189 n3 <- peekElemOff tp (fi c3) 190 n4 <- peekElemOff tp (fi c4) 191 n5 <- peekElemOff tp (fi c5) 192 n6 <- peekElemOff tp (fi c6) 193 let !v0 = n0 .&. 0x1f 194 !v1 = n1 .&. 0x1f 195 !v2 = n2 .&. 0x1f 196 !v3 = n3 .&. 0x1f 197 !v4 = n4 .&. 0x1f 198 !v5 = n5 .&. 0x1f 199 !v6 = n6 .&. 0x1f 200 !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2) 201 !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|. 202 (v3 `B.shiftR` 4) 203 !b2 = (v3 `B.shiftL` 4) .|. (v4 `B.shiftR` 1) 204 !b3 = (v4 `B.shiftL` 7) .|. (v5 `B.shiftL` 2) .|. 205 (v6 `B.shiftR` 3) 206 !slack = v6 `B.shiftL` 5 207 pokeElemOff dst j b0 208 pokeElemOff dst (j + 1) b1 209 pokeElemOff dst (j + 2) b2 210 pokeElemOff dst (j + 3) b3 211 pure $! 212 (acc .|. n0 .|. n1 .|. n2 .|. n3 .|. n4 .|. n5 .|. n6) 213 .&. 0x40 == 0 214 && slack == 0 215 _ -> pure False -- impossible: tail-length guard already rejected