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 :: ByteString -> ByteString
encode ByteString
bs =
    let len :: Int
len = (Int
8 forall a. Num a => a -> a -> a
* ByteString -> Int
B.length ByteString
bs forall a. Num a => a -> a -> a
+ Int
4) forall a. Integral a => a -> a -> a
`div` Int
5
        ws :: [Word8]
ws  = ByteString -> [Word8]
B.unpack ByteString
bs
     in [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems forall a b. (a -> b) -> a -> b
$ forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
A.runSTUArray forall a b. (a -> b) -> a -> b
$ do
        STUArray s Int Word8
a <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
A.newArray (Int
0 :: Int, Int
lenforall a. Num a => a -> a -> a
-Int
1) Word8
0
        forall {a :: * -> * -> *} {e} {m :: * -> *}.
(MArray a e m, Ord e, Num e, Bits e) =>
[e] -> a Int e -> Int -> m (a Int e)
go [Word8]
ws STUArray s Int Word8
a Int
0
  where
    toHex32 :: a -> a
toHex32 a
w | a
w forall a. Ord a => a -> a -> Bool
< a
10    = a
48 forall a. Num a => a -> a -> a
+ a
w
              | Bool
otherwise = a
55 forall a. Num a => a -> a -> a
+ a
w

    load8 :: a i e -> i -> m e
load8  a i e
a i
i   = forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
A.readArray  a i e
a i
i
    store8 :: a i e -> i -> e -> m ()
store8 a i e
a i
i e
v = forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
A.writeArray a i e
a i
i e
v

    -- Encode a list of 8-bit words at bit offset @n@
    -- into an array 'a' of 5-bit words.
    go :: [e] -> a Int e -> Int -> m (a Int e)
go [] a Int e
a Int
_ = forall (a :: * -> * -> *) e' (m :: * -> *) e i.
(MArray a e' m, MArray a e m, Ix i) =>
(e' -> e) -> a i e' -> m (a i e)
A.mapArray forall {a}. (Ord a, Num a) => a -> a
toHex32 a Int e
a
    go (e
w:[e]
ws) a Int e
a Int
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 (Int
q, Int
r) = Int
n forall a. Integral a => a -> a -> (a, a)
`divMod` Int
5
            wl :: e
wl =  e
w forall a. Bits a => a -> Int -> a
`shiftR` ( Int
3 forall a. Num a => a -> a -> a
+ Int
r)
            wm :: e
wm = (e
w forall a. Bits a => a -> Int -> a
`shiftL` ( Int
5 forall a. Num a => a -> a -> a
- Int
r))  forall a. Bits a => a -> Int -> a
`shiftR` Int
3
            wr :: e
wr = (e
w forall a. Bits a => a -> Int -> a
`shiftL` (Int
10 forall a. Num a => a -> a -> a
- Int
r)) forall a. Bits a => a -> Int -> a
`shiftR` Int
3
        e
al <- case Int
r of
              Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure e
wl
              Int
_ -> (e
wl forall a. Bits a => a -> a -> a
.|.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
load8 a Int e
a Int
q
        forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
store8 a Int e
a Int
q e
al
        forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
store8 a Int e
a (Int
q forall a. Num a => a -> a -> a
+ Int
1) e
wm
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
r forall a. Ord a => a -> a -> Bool
> Int
2) forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
store8 a Int e
a (Int
qforall a. Num a => a -> a -> a
+Int
2) e
wr
        [e] -> a Int e -> Int -> m (a Int e)
go [e]
ws a Int e
a forall a b. (a -> b) -> a -> b
$ Int
n forall a. Num a => a -> a -> a
+ Int
8
{-# INLINE encode #-}