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 :: B.ByteString
-> B.ByteString
encode :: ByteString -> ByteString
encode ByteString
bs =
let len :: Int
len = (Int
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
+ Int
4) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
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 (Int
0 :: Int, Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Word8
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 Int
0
where
toHex32 :: a -> a
toHex32 a
w | a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 = a
48 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w
| Bool
otherwise = a
55 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w
load8 :: a i e -> i -> m e
load8 a i e
a 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 i e
a i
i 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
go :: [e] -> a Int e -> Int -> m (a Int e)
go [] a Int e
a Int
_ = (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 (e
w:[e]
ws) a Int e
a Int
n = do
let (Int
q, Int
r) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
5
wl :: e
wl = e
w e -> Int -> e
forall a. Bits a => a -> Int -> a
`shiftR` ( Int
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` ( Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r)) e -> Int -> e
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
wr :: e
wr = (e
w e -> Int -> e
forall a. Bits a => a -> Int -> a
`shiftL` (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r)) e -> Int -> e
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
e
al <- case Int
r of
Int
0 -> e -> m e
forall (f :: * -> *) a. Applicative f => a -> f a
pure e
wl
Int
_ -> (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
+ Int
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
> Int
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
+Int
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
+ Int
8
{-# INLINE encode #-}