1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
module Network.DNS.Base32Hex (encode) where
import qualified Data.Array.MArray as A
import qualified Data.Array.IArray as A
import qualified Data.Array.ST as A
import qualified Data.ByteString as B
import Network.DNS.Imports
-- | Encode ByteString using the
-- <https://tools.ietf.org/html/rfc4648#section-7 RFC4648 base32hex>
-- encoding with no padding as specified for the
-- <https://tools.ietf.org/html/rfc5155#section-3.3 RFC5155 Next Hashed Owner Name>
-- field.
--
encode :: B.ByteString -- ^ input buffer
-> B.ByteString -- ^ base32hex output
encode bs =
let len = (8 * B.length bs + 4) `div` 5
ws = B.unpack bs
in B.pack $ A.elems $ A.runSTUArray $ do
a <- A.newArray (0 :: Int, len-1) 0
go ws a 0
where
toHex32 w | w < 10 = 48 + w
| otherwise = 55 + w
load8 a i = A.readArray a i
store8 a i v = A.writeArray a i v
-- Encode a list of 8-bit words at bit offset @n@
-- into an array 'a' of 5-bit words.
go [] a _ = A.mapArray toHex32 a
go (w:ws) a n = do
-- Split 8 bits into left, middle and right parts. The
-- right part only gets written when the 8-bit input word
-- splits across three different 5-bit words.
--
let (q, r) = n `divMod` 5
wl = w `shiftR` ( 3 + r)
wm = (w `shiftL` ( 5 - r)) `shiftR` 3
wr = (w `shiftL` (10 - r)) `shiftR` 3
al <- case r of
0 -> pure wl
_ -> (wl .|.) <$> load8 a q
store8 a q al
store8 a (q + 1) wm
when (r > 2) $ store8 a (q+2) wr
go ws a $ n + 8
{-# INLINE encode #-}
|
