module Network.DNS.Internal
( DomainLabel(..)
, Domain(..)
, DList(..)
, toDList
, fromDList
, buildLabel
, buildLabelCF
, singleton
, isLabelChar
)
where
import Data.ByteString.Internal (w2c)
import qualified Data.ByteString.Short as BS
import Data.Function (on)
import GHC.Word (Word8(..))
import Data.Char (isDigit, isLower, isUpper)
data DomainLabel = DomainLabel { DomainLabel -> ShortByteString
getDomainLabel_ :: !BS.ShortByteString
, DomainLabel -> ShortByteString
getDomainLabelCF_ :: !BS.ShortByteString }
newtype Domain = Domain [DomainLabel] deriving (Domain -> Domain -> Bool
(Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool) -> Eq Domain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Domain -> Domain -> Bool
$c/= :: Domain -> Domain -> Bool
== :: Domain -> Domain -> Bool
$c== :: Domain -> Domain -> Bool
Eq, Eq Domain
Eq Domain
-> (Domain -> Domain -> Ordering)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Domain)
-> (Domain -> Domain -> Domain)
-> Ord Domain
Domain -> Domain -> Bool
Domain -> Domain -> Ordering
Domain -> Domain -> Domain
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Domain -> Domain -> Domain
$cmin :: Domain -> Domain -> Domain
max :: Domain -> Domain -> Domain
$cmax :: Domain -> Domain -> Domain
>= :: Domain -> Domain -> Bool
$c>= :: Domain -> Domain -> Bool
> :: Domain -> Domain -> Bool
$c> :: Domain -> Domain -> Bool
<= :: Domain -> Domain -> Bool
$c<= :: Domain -> Domain -> Bool
< :: Domain -> Domain -> Bool
$c< :: Domain -> Domain -> Bool
compare :: Domain -> Domain -> Ordering
$ccompare :: Domain -> Domain -> Ordering
Ord)
instance Ord DomainLabel where
<= :: DomainLabel -> DomainLabel -> Bool
(<=) = ShortByteString -> ShortByteString -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (ShortByteString -> ShortByteString -> Bool)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_
compare :: DomainLabel -> DomainLabel -> Ordering
compare = ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ShortByteString -> ShortByteString -> Ordering)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_
instance Eq DomainLabel where
== :: DomainLabel -> DomainLabel -> Bool
(==) = ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ShortByteString -> ShortByteString -> Bool)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_
newtype DList a = DList ([a] -> [a])
{-# INLINE toDList #-}
toDList :: [a] -> DList a
toDList :: forall a. [a] -> DList a
toDList = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (([a] -> [a]) -> DList a) -> ([a] -> [a] -> [a]) -> [a] -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
{-# INLINE fromDList #-}
fromDList :: DList a -> [a]
fromDList :: forall a. DList a -> [a]
fromDList (DList [a] -> [a]
dl) = [a] -> [a]
dl []
{-# INLINE singleton #-}
singleton :: a -> DList a
singleton :: forall a. a -> DList a
singleton = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (([a] -> [a]) -> DList a) -> (a -> [a] -> [a]) -> a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)
instance Semigroup (DList a) where
{-# INLINE (<>) #-}
DList [a] -> [a]
l <> :: DList a -> DList a -> DList a
<> DList [a] -> [a]
r = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList ([a] -> [a]
l ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
r)
instance Monoid (DList a) where
{-# INLINE mempty #-}
mempty :: DList a
mempty = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList [a] -> [a]
forall a. a -> a
id
{-# INLINE buildLabelCF #-}
buildLabelCF :: DomainLabel -> DList Char
buildLabelCF :: DomainLabel -> DList Char
buildLabelCF = ShortByteString -> DList Char
buildLabel_ (ShortByteString -> DList Char)
-> (DomainLabel -> ShortByteString) -> DomainLabel -> DList Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomainLabel -> ShortByteString
getDomainLabelCF_
{-# INLINE buildLabel #-}
buildLabel :: DomainLabel -> DList Char
buildLabel :: DomainLabel -> DList Char
buildLabel = ShortByteString -> DList Char
buildLabel_ (ShortByteString -> DList Char)
-> (DomainLabel -> ShortByteString) -> DomainLabel -> DList Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomainLabel -> ShortByteString
getDomainLabel_
{-# INLINE buildLabel_ #-}
buildLabel_ :: BS.ShortByteString -> DList Char
buildLabel_ :: ShortByteString -> DList Char
buildLabel_ ShortByteString
bs = [Char] -> DList Char
forall a. [a] -> DList a
toDList ([Word8] -> [Char]
replace (ShortByteString -> [Word8]
BS.unpack ShortByteString
bs))
where
{-# INLINE replace #-}
replace :: [Word8] -> [Char]
replace :: [Word8] -> [Char]
replace (Word8
x:[Word8]
xs) = case Word8
x of
Word8
_ | Char -> Bool
isLabelChar (Word8 -> Char
w2c Word8
x)
-> (Word8 -> Char
w2c Word8
x) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Word8] -> [Char]
replace [Word8]
xs
Word8
0x2e -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'.' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Word8] -> [Char]
replace [Word8]
xs
Word8
0x5c -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Word8] -> [Char]
replace [Word8]
xs
Word8
_ -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
o1 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
o2 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
o3 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Word8] -> [Char]
replace [Word8]
xs
where
(Char
o1, Char
o2, Char
o3) = case Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
quotRem Word8
x Word8
8 of
(Word8
v1, Word8
r3) -> case Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
quotRem Word8
v1 Word8
8 of
(Word8
v2, Word8
r2) -> case Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
quotRem Word8
v2 Word8
8 of
(Word8
_, Word8
r1) -> (Word8 -> Char
showD Word8
r1, Word8 -> Char
showD Word8
r2, Word8 -> Char
showD Word8
r3)
replace [] = []
{-# INLINE showD #-}
showD :: Word8 -> Char
showD :: Word8 -> Char
showD Word8
x = Word8 -> Char
w2c (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
0x30)
{-# INLINABLE isLabelChar #-}
isLabelChar :: Char -> Bool
isLabelChar :: Char -> Bool
isLabelChar Char
x = Char -> Bool
isLower Char
x Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char -> Bool
isUpper Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'