dns-1.0.0/0000755000000000000000000000000012214470212010455 5ustar0000000000000000dns-1.0.0/dns.cabal0000644000000000000000000000644212214470212012233 0ustar0000000000000000Name: dns Version: 1.0.0 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: DNS library in Haskell Description: A thread-safe DNS library for both clients and servers written in pure Haskell. Category: Network Cabal-Version: >= 1.10 Build-Type: Simple Library Default-Language: Haskell2010 GHC-Options: -Wall Exposed-Modules: Network.DNS Network.DNS.Lookup Network.DNS.Resolver Network.DNS.Types Network.DNS.Encode Network.DNS.Decode Other-Modules: Network.DNS.Internal Network.DNS.StateBinary if impl(ghc >= 7) Build-Depends: base >= 4 && < 5 , attoparsec , attoparsec-conduit , binary , blaze-builder , bytestring , conduit >= 0.5 , containers , iproute >= 1.2.4 , mtl , network >= 2.3 , network-conduit , random else Build-Depends: base >= 4 && < 5 , attoparsec , attoparsec-conduit , binary , blaze-builder , bytestring , conduit , containers , iproute >= 1.2.4 , mtl , network , network-bytestring , network-conduit , random Test-Suite network Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: test2 Ghc-Options: -Wall Main-Is: Spec.hs Other-Modules: LookupSpec Build-Depends: dns , base , bytestring , hspec Test-Suite spec Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: test, . Ghc-Options: -Wall Main-Is: Spec.hs Other-Modules: EncodeSpec Build-Depends: base , attoparsec , attoparsec-conduit , binary , blaze-builder , bytestring , conduit >= 0.5 , containers , dns , hspec , iproute >= 1.2.4 , mtl , network >= 2.3 , network-conduit , random Test-Suite doctest Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: test2 Ghc-Options: -Wall Main-Is: doctests.hs Build-Depends: base , doctest Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/dns.git dns-1.0.0/LICENSE0000644000000000000000000000276512214470212011474 0ustar0000000000000000Copyright (c) 2009, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. dns-1.0.0/Setup.hs0000644000000000000000000000005612214470212012112 0ustar0000000000000000import Distribution.Simple main = defaultMain dns-1.0.0/Network/0000755000000000000000000000000012214470212012106 5ustar0000000000000000dns-1.0.0/Network/DNS.hs0000644000000000000000000000234312214470212013070 0ustar0000000000000000-- | A thread-safe DNS library for both clients and servers written -- in pure Haskell. -- The Network.DNS module re-exports all other exposed modules for -- convenience. -- Applications will most likely use the high-level interface, while -- library/daemon authors may need to use the lower-level one. -- module Network.DNS ( -- * High level module Network.DNS.Lookup -- | The "Network.DNS.Lookup" module contains simple functions to -- perform various DNS lookups. If you simply want to resolve a -- hostname ('lookupA'), or find a domain's MX record -- ('lookupMX'), this is the easiest way to do it. , module Network.DNS.Resolver -- | The "Network.DNS.Resolver" module is slightly more low-level -- than "Network.DNS.Lookup". If you need to do something unusual, -- you may need to use the 'lookup', 'lookupAuth', or 'lookupRaw' -- functions. , module Network.DNS.Types -- | All of the types that the other modules use. -- * Low level , module Network.DNS.Decode -- | Decoding a response. , module Network.DNS.Encode -- | Encoding a query. ) where import Network.DNS.Lookup import Network.DNS.Resolver import Network.DNS.Types import Network.DNS.Decode import Network.DNS.Encode dns-1.0.0/Network/DNS/0000755000000000000000000000000012214470212012532 5ustar0000000000000000dns-1.0.0/Network/DNS/Decode.hs0000644000000000000000000001307612214470212014260 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.DNS.Decode ( decode , receive ) where import Control.Applicative import Control.Monad import Data.Bits import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BL import Data.Conduit import Data.Conduit.Network import Data.IP import Data.Maybe import Network import Network.DNS.Internal import Network.DNS.StateBinary ---------------------------------------------------------------- -- | Receiving DNS data from 'Socket' and parse it. receive :: Socket -> IO DNSFormat receive sock = receiveDNSFormat $ sourceSocket sock ---------------------------------------------------------------- -- | Parsing DNS data. decode :: BL.ByteString -> Either String DNSFormat decode bs = fst <$> runSGet decodeResponse bs ---------------------------------------------------------------- receiveDNSFormat :: Source (ResourceT IO) ByteString -> IO DNSFormat receiveDNSFormat src = fst <$> runResourceT (src $$ sink) where sink = sinkSGet decodeResponse ---------------------------------------------------------------- decodeResponse :: SGet DNSFormat decodeResponse = do hd <- decodeHeader DNSFormat hd <$> decodeQueries (qdCount hd) <*> decodeRRs (anCount hd) <*> decodeRRs (nsCount hd) <*> decodeRRs (arCount hd) ---------------------------------------------------------------- decodeFlags :: SGet DNSFlags decodeFlags = toFlags <$> get16 where toFlags flgs = DNSFlags (getQorR flgs) (getOpcode flgs) (getAuthAnswer flgs) (getTrunCation flgs) (getRecDesired flgs) (getRecAvailable flgs) (getRcode flgs) getQorR w = if testBit w 15 then QR_Response else QR_Query getOpcode w = toEnum $ fromIntegral $ shiftR w 11 .&. 0x0f getAuthAnswer w = testBit w 10 getTrunCation w = testBit w 9 getRecDesired w = testBit w 8 getRecAvailable w = testBit w 7 getRcode w = toEnum $ fromIntegral $ w .&. 0x0f ---------------------------------------------------------------- decodeHeader :: SGet DNSHeader decodeHeader = DNSHeader <$> decodeIdentifier <*> decodeFlags <*> decodeQdCount <*> decodeAnCount <*> decodeNsCount <*> decodeArCount where decodeIdentifier = getInt16 decodeQdCount = getInt16 decodeAnCount = getInt16 decodeNsCount = getInt16 decodeArCount = getInt16 ---------------------------------------------------------------- decodeQueries :: Int -> SGet [Question] decodeQueries n = replicateM n decodeQuery decodeType :: SGet TYPE decodeType = intToType <$> getInt16 decodeQuery :: SGet Question decodeQuery = Question <$> decodeDomain <*> (decodeType <* ignoreClass) decodeRRs :: Int -> SGet [ResourceRecord] decodeRRs n = replicateM n decodeRR decodeRR :: SGet ResourceRecord decodeRR = do Question dom typ <- decodeQuery ttl <- decodeTTL len <- decodeRLen dat <- decodeRData typ len return ResourceRecord { rrname = dom , rrtype = typ , rrttl = ttl , rdlen = len , rdata = dat } where decodeTTL = fromIntegral <$> get32 decodeRLen = getInt16 decodeRData :: TYPE -> Int -> SGet RDATA decodeRData NS _ = RD_NS <$> decodeDomain decodeRData MX _ = RD_MX <$> decodePreference <*> decodeDomain where decodePreference = getInt16 decodeRData CNAME _ = RD_CNAME <$> decodeDomain decodeRData TXT len = (RD_TXT . ignoreLength) <$> getNByteString len where ignoreLength = BS.tail decodeRData A len = (RD_A . toIPv4) <$> getNBytes len decodeRData AAAA len = (RD_AAAA . toIPv6 . combine) <$> getNBytes len where combine [] = [] combine [_] = error "combine" combine (a:b:cs) = a * 256 + b : combine cs decodeRData SOA _ = RD_SOA <$> decodeDomain <*> decodeDomain <*> decodeSerial <*> decodeRefesh <*> decodeRetry <*> decodeExpire <*> decodeMinumun where decodeSerial = getInt32 decodeRefesh = getInt32 decodeRetry = getInt32 decodeExpire = getInt32 decodeMinumun = getInt32 decodeRData PTR _ = RD_PTR <$> decodeDomain decodeRData SRV _ = RD_SRV <$> decodePriority <*> decodeWeight <*> decodePort <*> decodeDomain where decodePriority = getInt16 decodeWeight = getInt16 decodePort = getInt16 decodeRData _ len = RD_OTH <$> getNBytes len ---------------------------------------------------------------- decodeDomain :: SGet Domain decodeDomain = do pos <- getPosition c <- getInt8 if c == 0 then return "" else do let n = getValue c if isPointer c then do d <- getInt8 let offset = n * 256 + d fromMaybe (error $ "decodeDomain: " ++ show offset) <$> pop offset else do hs <- getNByteString n ds <- decodeDomain 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 ignoreClass :: SGet () ignoreClass = () <$ get16 dns-1.0.0/Network/DNS/Encode.hs0000644000000000000000000001167112214470212014271 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Network.DNS.Encode ( encode , composeQuery ) where import qualified Blaze.ByteString.Builder as BB (toByteString, fromWrite, writeInt16be) import qualified Data.ByteString.Lazy.Char8 as BL (ByteString) import qualified Data.ByteString.Char8 as BS (length, null, break, drop) import Network.DNS.StateBinary import Network.DNS.Internal import Data.Monoid import Control.Monad.State import Data.Bits import Data.Word import Data.IP (+++) :: Monoid a => a -> a -> a (+++) = mappend ---------------------------------------------------------------- -- | Composing query. First argument is a number to identify response. composeQuery :: Int -> [Question] -> BL.ByteString composeQuery idt qs = encode qry where hdr = header defaultQuery qry = defaultQuery { header = hdr { identifier = idt , qdCount = length qs } , question = qs } ---------------------------------------------------------------- -- | Composing DNS data. encode :: DNSFormat -> BL.ByteString encode fmt = runSPut (encodeDNSFormat fmt) ---------------------------------------------------------------- encodeDNSFormat :: DNSFormat -> SPut encodeDNSFormat fmt = encodeHeader hdr +++ mconcat (map encodeQuestion qs) +++ mconcat (map encodeRR an) +++ mconcat (map encodeRR au) +++ mconcat (map encodeRR ad) where hdr = header fmt qs = question fmt an = answer fmt au = authority fmt ad = additional fmt encodeHeader :: DNSHeader -> SPut encodeHeader hdr = encodeIdentifier (identifier hdr) +++ encodeFlags (flags hdr) +++ decodeQdCount (qdCount hdr) +++ decodeAnCount (anCount hdr) +++ decodeNsCount (nsCount hdr) +++ decodeArCount (arCount hdr) where encodeIdentifier = putInt16 decodeQdCount = putInt16 decodeAnCount = putInt16 decodeNsCount = putInt16 decodeArCount = putInt16 encodeFlags :: DNSFlags -> SPut encodeFlags DNSFlags{..} = put16 word where word16 :: Enum a => a -> Word16 word16 = toEnum . fromEnum set :: Word16 -> State Word16 () set byte = modify (.|. byte) st :: State Word16 () st = sequence_ [ set (word16 rcode) , when recAvailable $ set (bit 7) , when recDesired $ set (bit 8) , when trunCation $ set (bit 9) , when authAnswer $ set (bit 10) , set (word16 opcode `shiftL` 11) , when (qOrR==QR_Response) $ set (bit 15) ] word = execState st 0 encodeQuestion :: Question -> SPut encodeQuestion Question{..} = encodeDomain qname +++ putInt16 (typeToInt qtype) +++ put16 1 encodeRR :: ResourceRecord -> SPut encodeRR ResourceRecord{..} = mconcat [ encodeDomain rrname , putInt16 (typeToInt rrtype) , put16 1 , putInt32 rrttl , rlenRDATA ] where -- Encoding rdata without using rdlen rlenRDATA = do addPositionW 2 -- "simulate" putInt16 rDataWrite <- encodeRDATA rdata let rdataLength = fromIntegral . BS.length . BB.toByteString . BB.fromWrite $ rDataWrite let rlenWrite = BB.writeInt16be rdataLength return rlenWrite +++ return rDataWrite encodeRDATA :: RDATA -> SPut encodeRDATA rd = case rd of (RD_A ip) -> mconcat $ map putInt8 (fromIPv4 ip) (RD_AAAA ip) -> mconcat $ map putInt16 (fromIPv6 ip) (RD_NS dom) -> encodeDomain dom (RD_CNAME dom) -> encodeDomain dom (RD_PTR dom) -> encodeDomain dom (RD_MX prf dom) -> mconcat [putInt16 prf, encodeDomain dom] (RD_TXT txt) -> putByteString txt (RD_OTH bytes) -> mconcat $ map putInt8 bytes (RD_SOA d1 d2 serial refresh retry expire min') -> mconcat [ encodeDomain d1 , encodeDomain d2 , putInt32 serial , putInt32 refresh , putInt32 retry , putInt32 expire , putInt32 min' ] (RD_SRV prio weight port dom) -> mconcat [ putInt16 prio , putInt16 weight , putInt16 port , encodeDomain dom ] ---------------------------------------------------------------- encodeDomain :: Domain -> SPut encodeDomain dom | BS.null dom = put8 0 encodeDomain dom = do mpos <- wsPop dom cur <- gets wsPosition case mpos of Just pos -> encodePointer pos Nothing -> wsPush dom cur >> mconcat [ encodePartialDomain hd , encodeDomain tl ] where (hd, tl') = BS.break (=='.') dom tl = if BS.null tl' then tl' else BS.drop 1 tl' encodePointer :: Int -> SPut encodePointer pos = let w = (pos .|. 0xc000) in putInt16 w encodePartialDomain :: Domain -> SPut encodePartialDomain sub = putInt8 (BS.length sub) +++ putByteString sub dns-1.0.0/Network/DNS/Internal.hs0000644000000000000000000001270212214470212014644 0ustar0000000000000000module Network.DNS.Internal where import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import Data.Char import Data.IP import Data.Maybe ---------------------------------------------------------------- -- | Type for domain. type Domain = ByteString ---------------------------------------------------------------- -- | Types for resource records. data TYPE = A | AAAA | NS | TXT | MX | CNAME | SOA | PTR | SRV | UNKNOWN Int deriving (Eq, Show, Read) rrDB :: [(TYPE, Int)] rrDB = [ (A, 1) , (NS, 2) , (CNAME, 5) , (SOA, 6) , (PTR, 12) , (MX, 15) , (TXT, 16) , (AAAA, 28) , (SRV, 33) ] rookup :: (Eq b) => b -> [(a,b)] -> Maybe a rookup _ [] = Nothing rookup key ((x,y):xys) | key == y = Just x | otherwise = rookup key xys intToType :: Int -> TYPE intToType n = fromMaybe (UNKNOWN n) $ rookup n rrDB typeToInt :: TYPE -> Int typeToInt (UNKNOWN x) = x typeToInt t = fromMaybe 0 $ lookup t rrDB toType :: String -> TYPE toType = read . map toUpper ---------------------------------------------------------------- -- | An enumeration of all possible DNS errors that can occur. data DNSError = -- | The sequence number of the answer doesn't match our query. This -- could indicate foul play. SequenceNumberMismatch -- | The request simply timed out. | TimeoutExpired -- | The answer has the correct sequence number, but returned an -- unexpected RDATA format. | UnexpectedRDATA deriving (Eq, Show) -- | Raw data format for DNS Query and Response. data DNSFormat = DNSFormat { header :: DNSHeader , question :: [Question] , answer :: [ResourceRecord] , authority :: [ResourceRecord] , additional :: [ResourceRecord] } deriving (Eq, Show) -- | Raw data format for the header of DNS Query and Response. data DNSHeader = DNSHeader { identifier :: Int , flags :: DNSFlags , qdCount :: Int , anCount :: Int , nsCount :: Int , arCount :: Int } deriving (Eq, Show) -- | Raw data format for the flags of DNS Query and Response. data DNSFlags = DNSFlags { qOrR :: QorR , opcode :: OPCODE , authAnswer :: Bool , trunCation :: Bool , recDesired :: Bool , recAvailable :: Bool , rcode :: RCODE } deriving (Eq, Show) ---------------------------------------------------------------- data QorR = QR_Query | QR_Response deriving (Eq, Show) data OPCODE = OP_STD | OP_INV | OP_SSR deriving (Eq, Show, Enum) data RCODE = NoErr | FormatErr | ServFail | NameErr | NotImpl | Refused deriving (Eq, Show, Enum) ---------------------------------------------------------------- -- | Raw data format for DNS questions. data Question = Question { qname :: Domain , qtype :: TYPE } deriving (Eq, Show) -- | Making "Question". makeQuestion :: Domain -> TYPE -> Question makeQuestion = Question ---------------------------------------------------------------- -- | Raw data format for resource records. data ResourceRecord = ResourceRecord { rrname :: Domain , rrtype :: TYPE , rrttl :: Int , rdlen :: Int , rdata :: RDATA } deriving (Eq, Show) -- | Raw data format for each type. data RDATA = RD_NS Domain | RD_CNAME Domain | RD_MX Int Domain | RD_PTR Domain | RD_SOA Domain Domain Int Int Int Int Int | RD_A IPv4 | RD_AAAA IPv6 | RD_TXT ByteString | RD_SRV Int Int Int Domain | RD_OTH [Int] deriving (Eq) instance Show RDATA where 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) = BS.unpack txt show (RD_SOA mn _ _ _ _ _ mi) = BS.unpack mn ++ " " ++ show mi show (RD_PTR dom) = BS.unpack dom show (RD_SRV pri wei prt dom) = show pri ++ " " ++ show wei ++ " " ++ show prt ++ BS.unpack dom show (RD_OTH is) = show is ---------------------------------------------------------------- defaultQuery :: DNSFormat defaultQuery = DNSFormat { header = DNSHeader { identifier = 0 , flags = DNSFlags { qOrR = QR_Query , opcode = OP_STD , authAnswer = False , trunCation = False , recDesired = True , recAvailable = False , rcode = NoErr } , qdCount = 0 , anCount = 0 , nsCount = 0 , arCount = 0 } , question = [] , answer = [] , authority = [] , additional = [] } defaultResponse :: DNSFormat defaultResponse = let hd = header defaultQuery flg = flags hd in defaultQuery { header = hd { flags = flg { qOrR = QR_Response , authAnswer = True , recAvailable = True } } } responseA :: Int -> Question -> IPv4 -> DNSFormat responseA ident q ip = let hd = header defaultResponse dom = qname q an = ResourceRecord dom A 300 4 (RD_A ip) in defaultResponse { header = hd { identifier=ident, qdCount = 1, anCount = 1 } , question = [q] , answer = [an] } responseAAAA :: Int -> Question -> IPv6 -> DNSFormat responseAAAA ident q ip = let hd = header defaultResponse dom = qname q an = ResourceRecord dom AAAA 300 16 (RD_AAAA ip) in defaultResponse { header = hd { identifier=ident, qdCount = 1, anCount = 1 } , question = [q] , answer = [an] } dns-1.0.0/Network/DNS/Lookup.hs0000644000000000000000000003535112214470212014346 0ustar0000000000000000-- | Simple, high-level DNS lookup functions. -- -- All of the lookup functions necessary run in IO, since they -- interact with the network. The return types are similar, but -- differ in what can be returned from a successful lookup. -- -- We can think of the return type as \"either what I asked for, or -- an error\". For example, the 'lookupA' function, if successful, -- will return a list of 'IPv4'. The 'lookupMX' function will -- instead return a list of @('Domain',Int)@ pairs, where each pair -- represents a hostname and its associated priority. -- -- The order of multiple results may not be consistent between -- lookups. If you require consistent results, apply -- 'Data.List.sort' to the returned list. -- -- The errors that can occur are the same for all lookups. Namely: -- -- * Timeout -- -- * Wrong sequence number (foul play?) -- -- * Unexpected data in the response -- -- If an error occurs, you should be able to pattern match on the -- 'DNSError' constructor to determine which of these is the case. -- -- /Note/: A result of \"no records\" is not considered an -- error. If you perform, say, an \'AAAA\' lookup for a domain with -- no such records, the \"success\" result would be @Right []@. -- -- We perform a successful lookup of \"www.example.com\": -- -- >>> let hostname = Data.ByteString.Char8.pack "www.example.com" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupA resolver hostname -- Right [93.184.216.119] -- -- The only error that we can easily cause is a timeout. We do this -- by creating and utilizing a 'ResolvConf' which has a timeout of -- one millisecond: -- -- >>> let hostname = Data.ByteString.Char8.pack "www.example.com" -- >>> let badrc = defaultResolvConf { resolvTimeout = 1 } -- >>> -- >>> rs <- makeResolvSeed badrc -- >>> withResolver rs $ \resolver -> lookupA resolver hostname -- Left TimeoutExpired -- -- As is the convention, successful results will always be wrapped -- in a 'Right', while errors will be wrapped in a 'Left'. -- -- For convenience, you may wish to enable GHC's OverloadedStrings -- extension. This will allow you to avoid calling -- 'Data.ByteString.Char8.pack' on each domain name. See -- -- for more information. -- module Network.DNS.Lookup ( lookupA, lookupAAAA , lookupMX, lookupAviaMX, lookupAAAAviaMX , lookupNS , lookupNSAuth , lookupTXT , lookupPTR , lookupRDNS , lookupSRV ) where import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS (append, intercalate, pack, split) import Data.IP import Network.DNS.Resolver as DNS import Network.DNS.Types ---------------------------------------------------------------- -- | Look up all \'A\' records for the given hostname. -- -- A straightforward example: -- -- >>> let hostname = Data.ByteString.Char8.pack "www.mew.org" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupA resolver hostname -- Right [202.232.15.101] -- -- This function will also follow a CNAME and resolve its target if -- one exists for the queries hostname: -- -- >>> let hostname = Data.ByteString.Char8.pack "www.kame.net" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupA resolver hostname -- Right [203.178.141.194] -- lookupA :: Resolver -> Domain -> IO (Either DNSError [IPv4]) lookupA rlv dom = do erds <- DNS.lookup rlv dom A case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RDATA -> Either DNSError IPv4 unTag (RD_A x) = Right x unTag _ = Left UnexpectedRDATA -- | Look up all (IPv6) \'AAAA\' records for the given hostname. -- -- Examples: -- -- >>> let hostname = Data.ByteString.Char8.pack "www.mew.org" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupAAAA resolver hostname -- Right [2001:240:11e:c00:00:00:00:101] -- lookupAAAA :: Resolver -> Domain -> IO (Either DNSError [IPv6]) lookupAAAA rlv dom = do erds <- DNS.lookup rlv dom AAAA case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RDATA -> Either DNSError IPv6 unTag (RD_AAAA x) = Right x unTag _ = Left UnexpectedRDATA ---------------------------------------------------------------- -- | Look up all \'MX\' records for the given hostname. Two parts -- constitute an MX record: a hostname , and an integer priority. We -- therefore return each record as a @('Domain', Int)@. -- -- In this first example, we look up the MX for the domain -- \"example.com\". It has no MX (to prevent a deluge of spam from -- examples posted on the internet). But remember, \"no results\" is -- still a successful result. -- -- >>> let hostname = Data.ByteString.Char8.pack "example.com" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupMX resolver hostname -- Right [] -- -- The domain \"mew.org\" does however have a single MX: -- -- >>> let hostname = Data.ByteString.Char8.pack "mew.org" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupMX resolver hostname -- Right [("mail.mew.org.",10)] -- -- Also note that all hostnames are returned with a trailing dot to -- indicate the DNS root. -- lookupMX :: Resolver -> Domain -> IO (Either DNSError [(Domain,Int)]) lookupMX rlv dom = do erds <- DNS.lookup rlv dom MX case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RDATA -> Either DNSError (Domain,Int) unTag (RD_MX pr dm) = Right (dm,pr) unTag _ = Left UnexpectedRDATA -- | Look up all \'MX\' records for the given hostname, and then -- resolve their hostnames to IPv4 addresses by calling -- 'lookupA'. The priorities are not retained. -- -- Examples: -- -- >>> import Data.List (sort) -- >>> let hostname = Data.ByteString.Char8.pack "mixi.jp" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> ips <- withResolver rs $ \resolver -> lookupAviaMX resolver hostname -- >>> fmap sort ips -- Right [202.32.29.4,202.32.29.5] -- -- Since there is more than one result, it is necessary to sort the -- list in order to check for equality. -- lookupAviaMX :: Resolver -> Domain -> IO (Either DNSError [IPv4]) lookupAviaMX rlv dom = lookupXviaMX rlv dom (lookupA rlv) -- | Look up all \'MX\' records for the given hostname, and then -- resolve their hostnames to IPv6 addresses by calling -- 'lookupAAAA'. The priorities are not retained. -- lookupAAAAviaMX :: Resolver -> Domain -> IO (Either DNSError [IPv6]) lookupAAAAviaMX rlv dom = lookupXviaMX rlv dom (lookupAAAA rlv) lookupXviaMX :: Show a => Resolver -> Domain -> (Domain -> IO (Either DNSError [a])) -> IO (Either DNSError [a]) lookupXviaMX rlv dom func = do edps <- lookupMX rlv dom case edps of -- We have to deconstruct and reconstruct the error so that the -- typechecker does not conclude that a ~ (Domain, Int). Left err -> return (Left err) Right dps -> do -- We'll get back a [Either DNSError a] here. responses <- mapM (func . fst) dps -- We can use 'sequence' to join all of the Eithers -- together. If any of them are (Left _), we'll get a Left -- overall. Otherwise, we'll get Right [a]. let overall = sequence responses -- Finally, we use (fmap concat) to concatenate the responses -- if there were no errors. return $ fmap concat overall ---------------------------------------------------------------- -- | This function performs the real work for both 'lookupNS' and -- 'lookupNSAuth'. The only difference between those two is which -- function, 'lookup' or 'lookupAuth', is used to perform the -- lookup. We take either of those as our first parameter. lookupNSImpl :: (Resolver -> Domain -> TYPE -> IO (Either DNSError [RDATA])) -> Resolver -> Domain -> IO (Either DNSError [Domain]) lookupNSImpl lookup_function rlv dom = do erds <- lookup_function rlv dom NS case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RDATA -> Either DNSError Domain unTag (RD_NS dm) = Right dm unTag _ = Left UnexpectedRDATA -- | Look up all \'NS\' records for the given hostname. The results -- are taken from the ANSWER section of the response (as opposed to -- AUTHORITY). For details, see e.g. -- . -- -- There will typically be more than one name server for a -- domain. It is therefore extra important to sort the results if -- you prefer them to be at all deterministic. -- -- Examples: -- -- >>> import Data.List (sort) -- >>> let hostname = Data.ByteString.Char8.pack "mew.org" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> ns <- withResolver rs $ \resolver -> lookupNS resolver hostname -- >>> fmap sort ns -- Right ["ns1.mew.org.","ns2.mew.org."] -- lookupNS :: Resolver -> Domain -> IO (Either DNSError [Domain]) lookupNS = lookupNSImpl DNS.lookup -- | Look up all \'NS\' records for the given hostname. The results -- are taken from the AUTHORITY section of the response and not the -- usual ANSWER (use 'lookupNS' for that). For details, see e.g. -- . -- -- There will typically be more than one name server for a -- domain. It is therefore extra important to sort the results if -- you prefer them to be at all deterministic. -- -- For an example, we can look up the nameservers for -- \"example.com\" from one of the root servers, a.gtld-servers.net, -- the IP address of which was found beforehand: -- -- >>> import Data.List (sort) -- >>> let hostname = Data.ByteString.Char8.pack "example.com" -- >>> -- >>> let ri = RCHostName "192.5.6.30" -- a.gtld-servers.net -- >>> let rc = defaultResolvConf { resolvInfo = ri } -- >>> rs <- makeResolvSeed rc -- >>> ns <- withResolver rs $ \resolver -> lookupNSAuth resolver hostname -- >>> fmap sort ns -- Right ["a.iana-servers.net.","b.iana-servers.net."] -- lookupNSAuth :: Resolver -> Domain -> IO (Either DNSError [Domain]) lookupNSAuth = lookupNSImpl DNS.lookupAuth ---------------------------------------------------------------- -- | Look up all \'TXT\' records for the given hostname. The results -- are free-form 'ByteString's. -- -- Two common uses for \'TXT\' records are -- and -- . As an -- example, we find the SPF record for \"mew.org\": -- -- >>> let hostname = Data.ByteString.Char8.pack "mew.org" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupTXT resolver hostname -- Right ["v=spf1 +mx -all"] -- lookupTXT :: Resolver -> Domain -> IO (Either DNSError [ByteString]) lookupTXT rlv dom = do erds <- DNS.lookup rlv dom TXT case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RDATA -> Either DNSError ByteString unTag (RD_TXT x) = Right x unTag _ = Left UnexpectedRDATA ---------------------------------------------------------------- -- | Look up all \'PTR\' records for the given hostname. To perform a -- reverse lookup on an IP address, you must first reverse its -- octets and then append the suffix \".in-addr.arpa.\" -- -- We look up the PTR associated with the IP address -- 210.130.137.80, i.e., 80.137.130.210.in-addr.arpa: -- -- >>> let hostname = Data.ByteString.Char8.pack "80.137.130.210.in-addr.arpa" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupPTR resolver hostname -- Right ["www-v4.iij.ad.jp."] -- -- The 'lookupRDNS' function is more suited to this particular task. -- lookupPTR :: Resolver -> Domain -> IO (Either DNSError [Domain]) lookupPTR rlv dom = do erds <- DNS.lookup rlv dom PTR case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RDATA -> Either DNSError Domain unTag (RD_PTR dm) = Right dm unTag _ = Left UnexpectedRDATA -- | Convenient wrapper around 'lookupPTR' to perform a reverse lookup -- on a single IP address. -- -- We repeat the example from 'lookupPTR', except now we pass the IP -- address directly: -- -- >>> let hostname = Data.ByteString.Char8.pack "210.130.137.80" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupRDNS resolver hostname -- Right ["www-v4.iij.ad.jp."] -- lookupRDNS :: Resolver -> Domain -> IO (Either DNSError [Domain]) lookupRDNS rlv ip = lookupPTR rlv dom where -- ByteString constants. dot = BS.pack "." suffix = BS.pack ".in-addr.arpa" octets = BS.split '.' ip reverse_ip = BS.intercalate dot (reverse octets) dom = reverse_ip `BS.append` suffix ---------------------------------------------------------------- -- | Look up all \'SRV\' records for the given hostname. A SRV record -- comprises four fields, -- -- * Priority (lower is more-preferred) -- -- * Weight (relative frequency with which to use this record -- amongst all results with the same priority) -- -- * Port (the port on which the service is offered) -- -- * Target (the hostname on which the service is offered) -- -- The first three are integral, and the target is another DNS -- hostname. We therefore return a four-tuple -- @(Int,Int,Int,'Domain')@. -- -- Examples: -- -- >>> let hostname = Data.ByteString.Char8.pack "_sip._tcp.cisco.com" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupSRV resolver hostname -- Right [(1,0,5060,"vcsgw.cisco.com.")] -- lookupSRV :: Resolver -> Domain -> IO (Either DNSError [(Int,Int,Int,Domain)]) lookupSRV rlv dom = do erds <- DNS.lookup rlv dom SRV case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RDATA -> Either DNSError (Int,Int,Int,Domain) unTag (RD_SRV pri wei prt dm) = Right (pri,wei,prt,dm) unTag _ = Left UnexpectedRDATA dns-1.0.0/Network/DNS/Resolver.hs0000644000000000000000000002054312214470212014673 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | DNS Resolver and generic (lower-level) lookup functions. module Network.DNS.Resolver ( -- * Documentation -- ** Configuration for resolver FileOrNumericHost(..), ResolvConf(..), defaultResolvConf -- ** Intermediate data type for resolver , ResolvSeed, makeResolvSeed -- ** Type and function for resolver , Resolver(..), withResolver -- ** Looking up functions , lookup, lookupAuth, lookupRaw ) where import Control.Applicative import Control.Exception import Data.Char import Data.Int import Data.List hiding (find, lookup) import Network.BSD import Network.DNS.Decode import Network.DNS.Encode import Network.DNS.Internal import Network.Socket hiding (send, sendTo, recv, recvFrom) import Network.Socket.ByteString.Lazy import Prelude hiding (lookup) import System.Random import System.Timeout #if mingw32_HOST_OS == 1 import Network.Socket (send) import qualified Data.ByteString.Lazy.Char8 as LB import Control.Monad (when) #endif ---------------------------------------------------------------- -- | Union type for 'FilePath' and 'HostName'. Specify 'FilePath' to -- \"resolv.conf\" or numeric IP address in 'String' form. -- -- /Warning/: Only numeric IP addresses are valid @RCHostName@s. -- -- Example (using Google's public DNS cache): -- -- >>> let cache = RCHostName "8.8.8.8" -- data FileOrNumericHost = RCFilePath FilePath | RCHostName HostName -- | Type for resolver configuration. The easiest way to construct a -- @ResolvConf@ object is to modify the 'defaultResolvConf'. data ResolvConf = ResolvConf { resolvInfo :: FileOrNumericHost , resolvTimeout :: Int -- | This field was obsoleted. , resolvBufsize :: Integer } -- | Return a default 'ResolvConf': -- -- * 'resolvInfo' is 'RCFilePath' \"\/etc\/resolv.conf\". -- -- * 'resolvTimeout' is 3,000,000 micro seconds. -- -- * 'resolvBufsize' is 512. (obsoleted) -- -- Example (use Google's public DNS cache instead of resolv.conf): -- -- >>> let cache = RCHostName "8.8.8.8" -- >>> let rc = defaultResolvConf { resolvInfo = cache } -- defaultResolvConf :: ResolvConf defaultResolvConf = ResolvConf { resolvInfo = RCFilePath "/etc/resolv.conf" , resolvTimeout = 3 * 1000 * 1000 , resolvBufsize = 512 } ---------------------------------------------------------------- -- | Abstract data type of DNS Resolver seed data ResolvSeed = ResolvSeed { addrInfo :: AddrInfo , rsTimeout :: Int , rsBufsize :: Integer } -- | Abstract data type of DNS Resolver data Resolver = Resolver { genId :: IO Int , dnsSock :: Socket , dnsTimeout :: Int , dnsBufsize :: Integer } ---------------------------------------------------------------- -- | Make a 'ResolvSeed' from a 'ResolvConf'. -- -- Examples: -- -- >>> rs <- makeResolvSeed defaultResolvConf -- makeResolvSeed :: ResolvConf -> IO ResolvSeed makeResolvSeed conf = ResolvSeed <$> addr <*> pure (resolvTimeout conf) <*> pure (resolvBufsize conf) where addr = case resolvInfo conf of RCHostName numhost -> makeAddrInfo numhost RCFilePath file -> toAddr <$> readFile file >>= makeAddrInfo toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs in extract l extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11 makeAddrInfo :: HostName -> IO AddrInfo makeAddrInfo addr = do proto <- getProtocolNumber "udp" let hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_NUMERICHOST, AI_PASSIVE] , addrSocketType = Datagram , addrProtocol = proto } a:_ <- getAddrInfo (Just hints) (Just addr) (Just "domain") return a ---------------------------------------------------------------- -- | Giving a thread-safe 'Resolver' to the function of the second -- argument. 'withResolver' should be passed to 'forkIO'. For -- examples, see "Network.DNS.Lookup". withResolver :: ResolvSeed -> (Resolver -> IO a) -> IO a withResolver seed func = do let ai = addrInfo seed sock <- socket (addrFamily ai) (addrSocketType ai) (addrProtocol ai) connect sock (addrAddress ai) let resolv = Resolver { genId = getRandom , dnsSock = sock , dnsTimeout = rsTimeout seed , dnsBufsize = rsBufsize seed } func resolv `finally` sClose sock getRandom :: IO Int getRandom = getStdRandom (randomR (0,65535)) ---------------------------------------------------------------- -- | Looking up resource records of a domain. The first parameter is one of -- the field accessors of the 'DNSFormat' type -- this allows you to -- choose which section (answer, authority, or additional) you would like -- to inspect for the result. lookupSection :: (DNSFormat -> [ResourceRecord]) -> Resolver -> Domain -> TYPE -> IO (Either DNSError [RDATA]) lookupSection section rlv dom typ = (>>= toRDATA) <$> lookupRaw rlv dom typ where {- CNAME hack dom' = if "." `isSuffixOf` dom then dom else dom ++ "." correct r = rrname r == dom' && rrtype r == typ -} correct r = rrtype r == typ toRDATA = Right . map rdata . filter correct . section -- | Look up resource records for a domain, collecting the results -- from the ANSWER section of the response. -- -- We repeat an example from "Network.DNS.Lookup": -- -- >>> let hostname = Data.ByteString.Char8.pack "www.example.com" -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookup resolver hostname A -- Right [93.184.216.119] -- lookup :: Resolver -> Domain -> TYPE -> IO (Either DNSError [RDATA]) lookup = lookupSection answer -- | Look up resource records for a domain, collecting the results -- from the AUTHORITY section of the response. lookupAuth :: Resolver -> Domain -> TYPE -> IO (Either DNSError [RDATA]) lookupAuth = lookupSection authority -- | Look up a name and return the entire DNS Response. Sample output -- is included below, however it is /not/ tested -- the sequence -- number is unpredictable (it has to be!). -- -- The example code: -- -- @ -- let hostname = Data.ByteString.Char8.pack \"www.example.com\" -- rs <- makeResolvSeed defaultResolvConf -- withResolver rs $ \resolver -> lookupRaw resolver hostname A -- @ -- -- And the (formatted) expected output: -- -- @ -- Right (DNSFormat -- { header = DNSHeader -- { identifier = 1, -- flags = DNSFlags -- { qOrR = QR_Response, -- opcode = OP_STD, -- authAnswer = False, -- trunCation = False, -- recDesired = True, -- recAvailable = True, -- rcode = NoErr }, -- qdCount = 1, -- anCount = 1, -- nsCount = 0, -- arCount = 0}, -- question = [Question { qname = \"www.example.com.\", -- qtype = A}], -- answer = [ResourceRecord {rrname = \"www.example.com.\", -- rrtype = A, -- rrttl = 800, -- rdlen = 4, -- rdata = 93.184.216.119}], -- authority = [], -- additional = []}) -- @ -- lookupRaw :: Resolver -> Domain -> TYPE -> IO (Either DNSError DNSFormat) lookupRaw rlv dom typ = do seqno <- genId rlv sendAll sock (composeQuery seqno [q]) response <- timeout tm (receive sock) return $ case response of Nothing -> Left TimeoutExpired Just y -> check seqno y where sock = dnsSock rlv tm = dnsTimeout rlv q = makeQuestion dom typ check seqno res = do let hdr = header res if identifier hdr == seqno then Right res else Left SequenceNumberMismatch #if mingw32_HOST_OS == 1 -- Windows does not support sendAll in Network.ByteString.Lazy. -- This implements sendAll with Haskell Strings. sendAll sock bs = do sent <- send sock (LB.unpack bs) when (sent < fromIntegral (LB.length bs)) $ sendAll sock (LB.drop (fromIntegral sent) bs) #endif dns-1.0.0/Network/DNS/StateBinary.hs0000644000000000000000000001050112214470212015310 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Network.DNS.StateBinary where import Blaze.ByteString.Builder import Control.Applicative import Control.Monad.State import Data.Attoparsec.ByteString import qualified Data.Attoparsec.ByteString.Lazy as AL import Data.ByteString (ByteString) import qualified Data.ByteString as BS (unpack, length) import qualified Data.ByteString.Lazy as BL (ByteString) import Data.Conduit import Data.Conduit.Attoparsec import Data.Int import Data.IntMap (IntMap) import qualified Data.IntMap as IM (insert, lookup, empty) import Data.Map (Map) import qualified Data.Map as M (insert, lookup, empty) import Data.Monoid import Data.Word import Network.DNS.Types import Prelude hiding (lookup, take) import qualified Data.Attoparsec.Types as T (Parser) ---------------------------------------------------------------- type SPut = State WState Write data WState = WState { wsDomain :: Map Domain Int , wsPosition :: Int } initialWState :: WState initialWState = WState M.empty 0 instance Monoid SPut where mempty = return mempty mappend a b = mconcat <$> sequence [a, b] put8 :: Word8 -> SPut put8 = fixedSized 1 writeWord8 put16 :: Word16 -> SPut put16 = fixedSized 2 writeWord16be put32 :: Word32 -> SPut put32 = fixedSized 4 writeWord32be putInt8 :: Int -> SPut putInt8 = fixedSized 1 (writeInt8 . fromIntegral) putInt16 :: Int -> SPut putInt16 = fixedSized 2 (writeInt16be . fromIntegral) putInt32 :: Int -> SPut putInt32 = fixedSized 4 (writeInt32be . fromIntegral) putByteString :: ByteString -> SPut putByteString = writeSized BS.length writeByteString addPositionW :: Int -> State WState () addPositionW n = do (WState m cur) <- get put $ WState m (cur+n) fixedSized :: Int -> (a -> Write) -> a -> SPut fixedSized n f a = do addPositionW n return (f a) writeSized :: Show a => (a -> Int) -> (a -> Write) -> a -> SPut writeSized n f a = do addPositionW (n a) return (f a) wsPop :: Domain -> State WState (Maybe Int) wsPop dom = do doms <- gets wsDomain return $ M.lookup dom doms wsPush :: Domain -> Int -> State WState () wsPush dom pos = do (WState m cur) <- get put $ WState (M.insert dom pos m) cur ---------------------------------------------------------------- type SGet = StateT PState (T.Parser ByteString) data PState = PState { psDomain :: IntMap Domain , psPosition :: Int } ---------------------------------------------------------------- getPosition :: SGet Int getPosition = psPosition <$> get addPosition :: Int -> SGet () addPosition n = do PState dom pos <- get put $ PState dom (pos + n) push :: Int -> Domain -> SGet () push n d = do PState dom pos <- get put $ PState (IM.insert n d dom) pos pop :: Int -> SGet (Maybe Domain) pop n = IM.lookup n . psDomain <$> get ---------------------------------------------------------------- get8 :: SGet Word8 get8 = lift anyWord8 <* addPosition 1 get16 :: SGet Word16 get16 = lift getWord16be <* addPosition 2 where word8' = fromIntegral <$> anyWord8 getWord16be = do a <- word8' b <- word8' return $ a * 256 + b get32 :: SGet Word32 get32 = lift getWord32be <* addPosition 4 where word8' = fromIntegral <$> anyWord8 getWord32be = do a <- word8' b <- word8' c <- word8' d <- word8' return $ a * 1677721 + b * 65536 + c * 256 + d getInt8 :: SGet Int getInt8 = fromIntegral <$> get8 getInt16 :: SGet Int getInt16 = fromIntegral <$> get16 getInt32 :: SGet Int getInt32 = fromIntegral <$> get32 ---------------------------------------------------------------- getNBytes :: Int -> SGet [Int] getNBytes len = toInts <$> getNByteString len where toInts = map fromIntegral . BS.unpack getNByteString :: Int -> SGet ByteString getNByteString n = lift (take n) <* addPosition n ---------------------------------------------------------------- initialState :: PState initialState = PState IM.empty 0 sinkSGet :: SGet a -> Sink ByteString (ResourceT IO) (a, PState) sinkSGet parser = sinkParser (runStateT parser initialState) runSGet :: SGet a -> BL.ByteString -> Either String (a, PState) runSGet parser bs = AL.eitherResult $ AL.parse (runStateT parser initialState) bs runSPut :: SPut -> BL.ByteString runSPut = toLazyByteString . fromWrite . flip evalState initialWState dns-1.0.0/Network/DNS/Types.hs0000644000000000000000000000104412214470212014171 0ustar0000000000000000-- | Data types for DNS Query and Response. -- For more information, see . module Network.DNS.Types ( -- * Domain Domain -- * TYPE , TYPE (..), intToType, typeToInt, toType -- * DNS Error , DNSError (..) -- * DNS Format , DNSFormat (..) -- * DNS Header , DNSHeader (..) -- * DNS Flags , DNSFlags (..) -- * DNS Body , QorR (..) , OPCODE (..) , RCODE (..) , ResourceRecord (..) , Question (..) , RDATA (..) , responseA, responseAAAA ) where import Network.DNS.Internal dns-1.0.0/test/0000755000000000000000000000000012214470212011434 5ustar0000000000000000dns-1.0.0/test/EncodeSpec.hs0000644000000000000000000001273412214470212014007 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module EncodeSpec where import Data.IP import Network.DNS import Network.DNS.Internal (defaultQuery, makeQuestion) import Test.Hspec spec :: Spec spec = do describe "encode" $ do it "encodes DNSFormat correctly" $ do check1 testQueryA check1 testQueryAAAA check1 testResponseA describe "decode" $ do it "decodes DNSFormat correctly" $ do check2 testQueryA check2 testQueryAAAA check2 testResponseA check1 :: DNSFormat -> Expectation check1 inp = out `shouldBe` Right inp where bs = encode inp out = decode bs check2 :: DNSFormat -> Expectation check2 inp = bs' `shouldBe` bs where bs = encode inp Right out = decode bs bs' = encode out defaultHeader :: DNSHeader defaultHeader = header defaultQuery testQueryA :: DNSFormat testQueryA = defaultQuery { header = defaultHeader { identifier = 1000 , qdCount = 1 } , question = [makeQuestion "www.mew.org." A] } testQueryAAAA :: DNSFormat testQueryAAAA = defaultQuery { header = defaultHeader { identifier = 1000 , qdCount = 1 } , question = [makeQuestion "www.mew.org." AAAA] } testResponseA :: DNSFormat testResponseA = DNSFormat { header = DNSHeader { identifier = 61046 , flags = DNSFlags { qOrR = QR_Response , opcode = OP_STD , authAnswer = False , trunCation = False , recDesired = True , recAvailable = True , rcode = NoErr } , qdCount = 1 , anCount = 8 , nsCount = 2 , arCount = 4 } , question = [Question { qname = "492056364.qzone.qq.com." , qtype = A } ] , answer = [ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdlen = 4 , rdata = RD_A $ toIPv4 [119, 147, 15, 122] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdlen = 4 , rdata = RD_A $ toIPv4 [119, 147, 79, 106] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdlen = 4 , rdata = RD_A $ toIPv4 [183, 60, 55, 43] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdlen = 4 , rdata = RD_A $ toIPv4 [183, 60, 55, 107] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdlen = 4 , rdata = RD_A $ toIPv4 [113, 108, 7, 172] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdlen = 4 , rdata = RD_A $ toIPv4 [113, 108, 7, 174] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdlen = 4 , rdata = RD_A $ toIPv4 [113, 108, 7, 175] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdlen = 4 , rdata = RD_A $ toIPv4 [119, 147, 15, 100] } ] , authority = [ ResourceRecord { rrname = "qzone.qq.com." , rrtype = NS , rrttl = 45919 , rdlen = 10 , rdata = RD_NS "ns-tel2.qq.com." } , ResourceRecord { rrname = "qzone.qq.com." , rrtype = NS , rrttl = 45919 , rdlen = 10 , rdata = RD_NS "ns-tel1.qq.com." } ] , additional = [ ResourceRecord { rrname = "ns-tel1.qq.com." , rrtype = A , rrttl = 46520 , rdlen = 4 , rdata = RD_A $ toIPv4 [121, 14, 73, 115] } , ResourceRecord { rrname = "ns-tel2.qq.com." , rrtype = A , rrttl = 2890 , rdlen = 4 , rdata = RD_A $ toIPv4 [222, 73, 76, 226] } , ResourceRecord { rrname = "ns-tel2.qq.com." , rrtype = A , rrttl = 2890 , rdlen = 4 , rdata = RD_A $ toIPv4 [183, 60, 3, 202] } , ResourceRecord { rrname = "ns-tel2.qq.com." , rrtype = A , rrttl = 2890 , rdlen = 4 , rdata = RD_A $ toIPv4 [218, 30, 72, 180] } ] } dns-1.0.0/test/Spec.hs0000644000000000000000000000005412214470212012661 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} dns-1.0.0/test2/0000755000000000000000000000000012214470212011516 5ustar0000000000000000dns-1.0.0/test2/doctests.hs0000644000000000000000000000017212214470212013702 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest [ "-XOverloadedStrings" , "Network/DNS.hs" ] dns-1.0.0/test2/LookupSpec.hs0000644000000000000000000000063312214470212014140 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module LookupSpec where import Network.DNS as DNS import Test.Hspec spec :: Spec spec = do describe "lookupAAAA" $ do it "gets IPv6 addresses" $ do rs <- makeResolvSeed defaultResolvConf withResolver rs $ \resolver -> do DNS.lookupAAAA resolver "mew.org" `shouldReturn` Right [] dns-1.0.0/test2/Spec.hs0000644000000000000000000000005412214470212012743 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}