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

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