module Network.DNS.Base32Hex (encode) where
import Control.Monad (when)
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 Data.Bits
encode :: B.ByteString
-> B.ByteString
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
go [] a _ = A.mapArray toHex32 a
go (w:ws) a n = do
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 #-}