From 0fa5d283af40eb6d994dde824f3e3beea1dc070b Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Tue, 30 Aug 2011 14:32:46 +0900 Subject: Domain -> ByteString. --- Network/DNS/Internal.hs | 17 +++++++++-------- Network/DNS/Lookup.hs | 6 +++--- Network/DNS/Query.hs | 19 ++++++------------- Network/DNS/Response.hs | 13 ++++++------- Network/DNS/StateBinary.hs | 8 +++++--- 5 files changed, 29 insertions(+), 34 deletions(-) diff --git a/Network/DNS/Internal.hs b/Network/DNS/Internal.hs index ccc8cf7..28063fc 100644 --- a/Network/DNS/Internal.hs +++ b/Network/DNS/Internal.hs @@ -1,6 +1,7 @@ module Network.DNS.Internal where -import qualified Data.ByteString.Lazy.Char8 as L +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS import Data.Char import Data.IP import Data.Maybe @@ -10,7 +11,7 @@ import Data.Maybe {-| Type for domain. -} -type Domain = String +type Domain = ByteString ---------------------------------------------------------------- @@ -126,17 +127,17 @@ data ResourceRecord = ResourceRecord { -} data RDATA = RD_NS Domain | RD_CNAME Domain | RD_MX Int Domain | RD_SOA Domain Domain Int Int Int Int Int - | RD_A IPv4 | RD_AAAA IPv6 | RD_TXT L.ByteString + | RD_A IPv4 | RD_AAAA IPv6 | RD_TXT ByteString | RD_OTH [Int] deriving (Eq) instance Show RDATA where - show (RD_NS dom) = dom - show (RD_MX prf dom) = dom ++ " " ++ show prf - show (RD_CNAME dom) = dom + show (RD_NS dom) = BS.unpack dom + show (RD_MX prf dom) = BS.unpack dom ++ " " ++ show prf + show (RD_CNAME dom) = BS.unpack dom show (RD_A a) = show a show (RD_AAAA aaaa) = show aaaa - show (RD_TXT txt) = L.unpack txt - show (RD_SOA mn _ _ _ _ _ mi) = mn ++ " " ++ show mi + show (RD_TXT txt) = BS.unpack txt + show (RD_SOA mn _ _ _ _ _ mi) = BS.unpack mn ++ " " ++ show mi show (RD_OTH is) = show is ---------------------------------------------------------------- diff --git a/Network/DNS/Lookup.hs b/Network/DNS/Lookup.hs index beb682f..b61d543 100644 --- a/Network/DNS/Lookup.hs +++ b/Network/DNS/Lookup.hs @@ -9,7 +9,7 @@ module Network.DNS.Lookup ( ) where import Control.Applicative -import qualified Data.ByteString.Lazy.Char8 as L +import Data.ByteString (ByteString) import Data.IP import Data.Maybe import Network.DNS.Resolver as DNS @@ -61,7 +61,7 @@ lookupAviaMX rlv dom = lookupXviaMX rlv dom (lookupA rlv) lookupAAAAviaMX :: Resolver -> Domain -> IO (Maybe [IPv6]) lookupAAAAviaMX rlv dom = lookupXviaMX rlv dom (lookupAAAA rlv) -lookupXviaMX :: Resolver -> Domain -> (Domain -> IO (Maybe [a])) -> IO (Maybe [a]) +lookupXviaMX :: Show a => Resolver -> Domain -> (Domain -> IO (Maybe [a])) -> IO (Maybe [a]) lookupXviaMX rlv dom func = do mdps <- lookupMX rlv dom maybe (return Nothing) lookup' mdps @@ -77,7 +77,7 @@ lookupXviaMX rlv dom func = do {-| Resolving 'String' by 'TXT'. -} -lookupTXT :: Resolver -> Domain -> IO (Maybe [L.ByteString]) +lookupTXT :: Resolver -> Domain -> IO (Maybe [ByteString]) lookupTXT rlv dom = toTXT <$> DNS.lookup rlv dom TXT where toTXT = maybe Nothing (Just . map unTag) diff --git a/Network/DNS/Query.hs b/Network/DNS/Query.hs index 3c4852e..12343d9 100644 --- a/Network/DNS/Query.hs +++ b/Network/DNS/Query.hs @@ -1,6 +1,7 @@ module Network.DNS.Query (composeQuery) where -import qualified Data.ByteString.Lazy.Char8 as L +import qualified Data.ByteString.Lazy.Char8 as BL (ByteString) +import qualified Data.ByteString.Char8 as BS (length, split, unpack, null) import Data.Char import Network.DNS.StateBinary import Network.DNS.Internal @@ -11,7 +12,7 @@ import Data.Monoid ---------------------------------------------------------------- -composeQuery :: Int -> [Question] -> L.ByteString +composeQuery :: Int -> [Question] -> BL.ByteString composeQuery idt qs = runSPut (encodeQuery qry) where hdr = header defaultQuery @@ -63,15 +64,7 @@ encodeQuestion qs = encodeDomain dom encodeDomain :: Domain -> SPut encodeDomain dom = foldr (+++) (put8 0) (map encodeSubDomain $ zip ls ss) where - ss = split '.' dom - ls = map length ss + ss = filter (not . BS.null) $ BS.split '.' dom + ls = map BS.length ss encodeSubDomain (len,sub) = putInt8 (fromIntegral len) - +++ foldr (+++) mempty (map (putInt8 . fromIntegral . ord) sub) - -split :: Char -> String -> [String] -split _ "" = [] -split c cs - | null rest = s : split c rest - | otherwise = s : split c (tail rest) - where - (s,rest) = break (c ==) cs + +++ foldr (+++) mempty (map (putInt8 . fromIntegral . ord) (BS.unpack sub)) diff --git a/Network/DNS/Response.hs b/Network/DNS/Response.hs index c62f497..629cd92 100644 --- a/Network/DNS/Response.hs +++ b/Network/DNS/Response.hs @@ -1,9 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} + module Network.DNS.Response (parseResponse) where import Control.Monad import Data.Bits +import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as L -import Data.Char import Data.IP import Data.Maybe import Network.DNS.Internal @@ -100,7 +102,7 @@ decodeRData MX _ = RD_MX <$> decodePreference <*> decodeDomain decodeRData CNAME _ = RD_CNAME <$> decodeDomain decodeRData TXT len = (RD_TXT . ignoreLength) <$> getNByteString len where - ignoreLength = L.tail + ignoreLength = BS.tail decodeRData A len = (RD_A . toIPv4) <$> getNBytes len decodeRData AAAA len = (RD_AAAA . toIPv6 . combine) <$> getNBytes len where @@ -139,17 +141,14 @@ decodeDomain = do let offset = n * 256 + d fromMaybe (error $ "decodeDomain: " ++ show offset) <$> pop offset else do - hs <- decodeString n + hs <- getNByteString n ds <- decodeDomain - let dom = hs ++ "." ++ ds + let dom = hs `BS.append` "." `BS.append` ds push pos dom return dom where getValue c = c .&. 0x3f isPointer c = testBit c 7 && testBit c 6 -decodeString :: Int -> SGet String -decodeString n = map chr <$> getNBytes n - ignoreClass :: SGet () ignoreClass = () <$ get16 diff --git a/Network/DNS/StateBinary.hs b/Network/DNS/StateBinary.hs index 5099104..bd54a75 100644 --- a/Network/DNS/StateBinary.hs +++ b/Network/DNS/StateBinary.hs @@ -3,6 +3,8 @@ module Network.DNS.StateBinary where import Blaze.ByteString.Builder import Control.Monad.State import Data.Binary.Get +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as L import Data.Char import Data.Int @@ -85,10 +87,10 @@ getPosition = fromIntegral <$> lift bytesRead getNBytes :: Int -> SGet [Int] getNBytes len = toInts <$> getNByteString len where - toInts = map ord . L.unpack + toInts = map ord . BS.unpack -getNByteString :: Int -> SGet L.ByteString -getNByteString len = lift . getLazyByteString . fromIntegral $ len +getNByteString :: Int -> SGet ByteString +getNByteString = lift . getByteString . fromIntegral ---------------------------------------------------------------- -- cgit v1.2.3