content: 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 #-}
  