dns 0.3.8 → 1.0.0

raw patch · 10 files changed

+568/−248 lines, 10 filesdep +doctestdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: doctest

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Network/DNS.hs +23/−20
• Network/DNS/Decode.hs +4/−5
• Network/DNS/Encode.hs +5/−4
• Network/DNS/Internal.hs +21/−27
• Network/DNS/Lookup.hs +366/−78
• Network/DNS/Resolver.hs +120/−57
• Network/DNS/Types.hs +4/−3
• dns.cabal +13/−2
• test2/LookupSpec.hs +3/−52
• test2/doctests.hs +9/−0

@@ -1,29 +1,34 @@-{-|-  Thread-safe DNS library written in Haskell.--  This code is written in Haskell, not using FFI.--  Sample code for DNS lookup:--@-    import qualified Network.DNS as DNS (lookup)-    import Network.DNS hiding (lookup)-    main :: IO ()-    main = do-        rs <- makeResolvSeed defaultResolvConf-        withResolver rs $ \\resolver -> do-            DNS.lookup resolver \"www.example.com\" A >>= print-@--}-+-- | 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@@ -31,5 +36,3 @@ import Network.DNS.Types import Network.DNS.Decode import Network.DNS.Encode--

@@ -21,16 +21,15 @@  ---------------------------------------------------------------- -{-| Receiving DNS data from 'Socket' and parse it.-    The second argument is a buffer size for the socket.--}+-- | Receiving DNS data from 'Socket' and parse it.+ receive :: Socket -> IO DNSFormat receive sock = receiveDNSFormat $ sourceSocket sock  ---------------------------------------------------------------- -{-| Parsing DNS data.--}+-- | Parsing DNS data.+ decode :: BL.ByteString -> Either String DNSFormat decode bs = fst <$> runSGet decodeResponse bs 

@@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-}+ module Network.DNS.Encode (     encode   , composeQuery@@ -20,8 +21,8 @@  ---------------------------------------------------------------- -{-| Composing query. First argument is a number to identify response.--}+-- | Composing query. First argument is a number to identify response.+ composeQuery :: Int -> [Question] -> BL.ByteString composeQuery idt qs = encode qry   where@@ -36,8 +37,8 @@  ---------------------------------------------------------------- -{-| Composing DNS data.--}+-- | Composing DNS data.+ encode :: DNSFormat -> BL.ByteString encode fmt = runSPut (encodeDNSFormat fmt) 

@@ -8,16 +8,12 @@  ---------------------------------------------------------------- -{-|-  Type for domain.--}+-- | Type for domain. type Domain = ByteString  ---------------------------------------------------------------- -{-|-  Types for resource records.--}+-- | Types for resource records. data TYPE = A | AAAA | NS | TXT | MX | CNAME | SOA | PTR | SRV           | UNKNOWN Int deriving (Eq, Show, Read) @@ -51,9 +47,19 @@  ---------------------------------------------------------------- -{-|-  Raw data format for DNS Query and Response.--}+-- | 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]@@ -62,9 +68,7 @@   , additional :: [ResourceRecord]   } deriving (Eq, Show) -{-|-  Raw data format for the header of DNS Query and Response.--}+-- | Raw data format for the header of DNS Query and Response. data DNSHeader = DNSHeader {     identifier :: Int   , flags      :: DNSFlags@@ -74,9 +78,7 @@   , arCount    :: Int   } deriving (Eq, Show) -{-|-  Raw data format for the flags of DNS Query and Response.--}+-- | Raw data format for the flags of DNS Query and Response. data DNSFlags = DNSFlags {     qOrR         :: QorR   , opcode       :: OPCODE@@ -97,25 +99,19 @@  ---------------------------------------------------------------- -{-|-  Raw data format for DNS questions.--}+-- | Raw data format for DNS questions. data Question = Question {     qname  :: Domain   , qtype  :: TYPE   } deriving (Eq, Show) -{-|-  Making "Question".--}+-- | Making "Question". makeQuestion :: Domain -> TYPE -> Question makeQuestion = Question  ---------------------------------------------------------------- -{-|-  Raw data format for resource records.--}+-- | Raw data format for resource records. data ResourceRecord = ResourceRecord {     rrname :: Domain   , rrtype :: TYPE@@ -124,9 +120,7 @@   , rdata  :: RDATA   } deriving (Eq, Show) -{-|-  Raw data format for each type.--}+-- | 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

@@ -1,123 +1,411 @@-{-|-  Upper level DNS lookup functions.--}-+-- | 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+--   <http://www.haskell.org/ghc/docs/7.6.3/html/users_guide/type-class-extensions.html#overloaded-strings>+--   for more information.+-- module Network.DNS.Lookup (     lookupA, lookupAAAA   , lookupMX, lookupAviaMX, lookupAAAAviaMX   , lookupNS+  , lookupNSAuth   , lookupTXT   , lookupPTR+  , lookupRDNS   , lookupSRV   ) where -import Control.Applicative import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS (append, intercalate, pack, split) import Data.IP-import Data.Maybe import Network.DNS.Resolver as DNS import Network.DNS.Types  ---------------------------------------------------------------- -{-|-  Resolving 'IPv4' by 'A'.--}-lookupA :: Resolver -> Domain -> IO (Maybe [IPv4])-lookupA rlv dom = toV4 <$> DNS.lookup rlv dom A+-- | 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-    toV4 = fmap (map unTag)-    unTag (RD_A x) = x-    unTag _ = error "lookupA"+    unTag :: RDATA -> Either DNSError IPv4+    unTag (RD_A x) = Right x+    unTag _ = Left UnexpectedRDATA -{-|-  Resolving 'IPv6' by 'AAAA'.--}-lookupAAAA :: Resolver -> Domain -> IO (Maybe [IPv6])-lookupAAAA rlv dom = toV6 <$> DNS.lookup rlv dom AAAA++-- | 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-    toV6 = fmap (map unTag)-    unTag (RD_AAAA x) = x-    unTag _ = error "lookupAAAA"+    unTag :: RDATA -> Either DNSError IPv6+    unTag (RD_AAAA x) = Right x+    unTag _ = Left UnexpectedRDATA  ---------------------------------------------------------------- -{-|-  Resolving 'Domain' and its preference by 'MX'.--}-lookupMX :: Resolver -> Domain -> IO (Maybe [(Domain,Int)])-lookupMX rlv dom = toMX <$> DNS.lookup rlv dom MX+-- | 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-    toMX = fmap (map unTag)-    unTag (RD_MX pr dm) = (dm,pr)-    unTag _ = error "lookupMX"+    unTag :: RDATA -> Either DNSError (Domain,Int)+    unTag (RD_MX pr dm) = Right (dm,pr)+    unTag _ = Left UnexpectedRDATA -{-|-  Resolving 'IPv4' by 'A' via 'MX'.--}-lookupAviaMX :: Resolver -> Domain -> IO (Maybe [IPv4])+-- | 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) -{-|-  Resolving 'IPv6' by 'AAAA' via 'MX'.--}-lookupAAAAviaMX :: Resolver -> Domain -> IO (Maybe [IPv6])+-- | 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 (Maybe [a])) -> IO (Maybe [a])+lookupXviaMX :: Show a+             => Resolver+             -> Domain+             -> (Domain -> IO (Either DNSError [a]))+             -> IO (Either DNSError [a]) lookupXviaMX rlv dom func = do-    mdps <- lookupMX rlv dom-    maybe (return Nothing) lookup' mdps-  where-    lookup' dps = check . catMaybes <$> mapM (func . fst) dps-    check as = case as of-        []  -> Nothing-        ass -> Just (concat ass)+    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 ++ ---------------------------------------------------------------- -{-|-  Resolving 'Domain' by 'NS'.--}-lookupNS :: Resolver -> Domain -> IO (Maybe [Domain])-lookupNS rlv dom = toNS <$> DNS.lookup rlv dom NS+-- | 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-    toNS = fmap (map unTag)-    unTag (RD_NS dm) = dm-    unTag _ = error "lookupNS"+    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.+--   <http://www.zytrax.com/books/dns/ch15/>.+--+--   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.+--   <http://www.zytrax.com/books/dns/ch15/>.+--+--   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++ ---------------------------------------------------------------- -{-|-  Resolving 'String' by 'TXT'.--}-lookupTXT :: Resolver -> Domain -> IO (Maybe [ByteString])-lookupTXT rlv dom = toTXT <$> DNS.lookup rlv dom TXT+-- | Look up all \'TXT\' records for the given hostname. The results+--   are free-form 'ByteString's.+--+--   Two common uses for \'TXT\' records are+--   <http://en.wikipedia.org/wiki/Sender_Policy_Framework> and+--   <http://en.wikipedia.org/wiki/DomainKeys_Identified_Mail>. 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-    toTXT = fmap (map unTag)-    unTag (RD_TXT x) = x-    unTag _ = error "lookupTXT"+    unTag :: RDATA -> Either DNSError ByteString+    unTag (RD_TXT x) = Right x+    unTag _ = Left UnexpectedRDATA  ---------------------------------------------------------------- -{-|-  Resolving 'Domain' and its preference by 'PTR'.--}-lookupPTR :: Resolver -> Domain -> IO (Maybe [Domain])-lookupPTR rlv dom = toPTR <$> DNS.lookup rlv dom PTR+-- | 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-    toPTR = fmap (map unTag)-    unTag (RD_PTR dm) = dm-    unTag _ = error "lookupPTR"+    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+ ---------------------------------------------------------------- -{-|-  Resolving 'Domain' and its preference by 'SRV'.--}-lookupSRV :: Resolver -> Domain -> IO (Maybe [(Int,Int,Int,Domain)])-lookupSRV rlv dom = toSRV <$> DNS.lookup rlv dom SRV+-- | 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-    toSRV = fmap (map unTag)-    unTag (RD_SRV pri wei prt dm) = (pri,wei,prt,dm)-    unTag _ = error "lookupSRV"+    unTag :: RDATA -> Either DNSError (Int,Int,Int,Domain)+    unTag (RD_SRV pri wei prt dm) = Right (pri,wei,prt,dm)+    unTag _ = Left UnexpectedRDATA

@@ -1,20 +1,6 @@ {-# LANGUAGE CPP #-}-{-|-  DNS Resolver and lookup functions. -  Sample code:--@-    import qualified Network.DNS as DNS (lookup)-    import Network.DNS hiding (lookup)-    main :: IO ()-    main = do-        rs <- makeResolvSeed defaultResolvConf-        withResolver rs $ \\resolver -> do-            DNS.lookup resolver \"www.example.com\" A >>= print-@--}-+-- | DNS Resolver and generic (lower-level) lookup functions. module Network.DNS.Resolver (   -- * Documentation   -- ** Configuration for resolver@@ -24,7 +10,7 @@   -- ** Type and function for resolver   , Resolver(..), withResolver   -- ** Looking up functions-  , lookup, lookupRaw+  , lookup, lookupAuth, lookupRaw   ) where  import Control.Applicative@@ -49,15 +35,21 @@ #endif ---------------------------------------------------------------- -{-|-  Union type for 'FilePath' and 'HostName'. Specify 'FilePath' to-  \"resolv.conf\" or numeric IP address in 'String' form.--}++-- | 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--}++-- | Type for resolver configuration. The easiest way to construct a+--   @ResolvConf@ object is to modify the 'defaultResolvConf'. data ResolvConf = ResolvConf {     resolvInfo :: FileOrNumericHost   , resolvTimeout :: Int@@ -65,12 +57,20 @@   , resolvBufsize :: Integer } -{-|-  Default 'ResolvConf'.-  'resolvInfo' is 'RCFilePath' \"\/etc\/resolv.conf\".-  'resolvTimeout' is 3,000,000 micro seconds.-  'resolvBufsize' is 512. (obsoleted)--}++-- | 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"@@ -80,18 +80,14 @@  ---------------------------------------------------------------- -{-|-  Abstract data type of DNS Resolver seed--}+-- | Abstract data type of DNS Resolver seed data ResolvSeed = ResolvSeed {     addrInfo :: AddrInfo   , rsTimeout :: Int   , rsBufsize :: Integer } -{-|-  Abstract data type of DNS Resolver--}+-- | Abstract data type of DNS Resolver data Resolver = Resolver {     genId   :: IO Int   , dnsSock :: Socket@@ -101,9 +97,13 @@  ---------------------------------------------------------------- -{-|-  Making 'ResolvSeed' from an IP address of a DNS cache server.--}++-- |  Make a 'ResolvSeed' from a 'ResolvConf'.+--+--    Examples:+--+--    >>> rs <- makeResolvSeed defaultResolvConf+-- makeResolvSeed :: ResolvConf -> IO ResolvSeed makeResolvSeed conf = ResolvSeed <$> addr                                  <*> pure (resolvTimeout conf)@@ -129,11 +129,10 @@  ---------------------------------------------------------------- -{-|-  Giving a thread-safe 'Resolver' to the function of the second-  argument. 'withResolver' should be passed to 'forkIO'.--} +-- | 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@@ -152,29 +151,93 @@  ---------------------------------------------------------------- -{-|-  Looking up resource records of a domain.--}-lookup :: Resolver -> Domain -> TYPE -> IO (Maybe [RDATA])-lookup rlv dom typ = (>>= toRDATA) <$> lookupRaw rlv dom typ+-- | 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-    listToMaybe [] = Nothing-    listToMaybe xs = Just xs-    toRDATA = listToMaybe . map rdata . filter correct . answer+    toRDATA = Right . map rdata . filter correct . section -{-|-  Looking up a domain and returning an entire DNS Response.--}-lookupRaw :: Resolver -> Domain -> TYPE -> IO (Maybe DNSFormat)+-- | 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])-    (>>= check seqno) <$> timeout tm (receive sock)+    response <- timeout tm (receive sock)+    return $ case response of+               Nothing -> Left TimeoutExpired+               Just y  -> check seqno y   where     sock = dnsSock rlv     tm = dnsTimeout rlv@@ -182,9 +245,9 @@     check seqno res = do         let hdr = header res         if identifier hdr == seqno then-            Just res+            Right res           else-            Nothing+            Left SequenceNumberMismatch  #if mingw32_HOST_OS == 1     -- Windows does not support sendAll in Network.ByteString.Lazy.

@@ -1,12 +1,13 @@-{-|-  Data types for DNS Query and Response. For more information, see <http://www.ietf.org/rfc/rfc1035>.--}+-- | Data types for DNS Query and Response.+--   For more information, see <http://www.ietf.org/rfc/rfc1035>.  module Network.DNS.Types (   -- * Domain     Domain   -- * TYPE   , TYPE (..), intToType, typeToInt, toType+  -- * DNS Error+  , DNSError (..)   -- * DNS Format   , DNSFormat (..)   -- * DNS Header

@@ -1,11 +1,13 @@ Name:                   dns-Version:                0.3.8+Version:                1.0.0 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3 License-File:           LICENSE Synopsis:               DNS library in Haskell-Description:            DNS library for clients and servers.+Description:+  A thread-safe DNS library for both clients and servers written+  in pure Haskell. Category:               Network Cabal-Version:          >= 1.10 Build-Type:             Simple@@ -85,6 +87,15 @@                       , 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

@@ -2,66 +2,17 @@  module LookupSpec where -import Control.Applicative-import qualified Data.ByteString.Char8 as BS-import Data.List import Network.DNS as DNS import Test.Hspec  spec :: Spec spec = do-    describe "lookupA" $ do-        it "gets IPv4 addresses" $ do-            rs <- makeResolvSeed defaultResolvConf-            withResolver rs $ \resolver ->-                DNS.lookupA resolver "www.mew.org" `shouldReturn` Just ["202.232.15.101"] -        it "gets IPv4 addresses via CNAME" $ do-            rs <- makeResolvSeed defaultResolvConf-            withResolver rs $ \resolver ->-                DNS.lookupA resolver "www.kame.net" `shouldReturn` Just ["203.178.141.194"]-     describe "lookupAAAA" $ do         it "gets IPv6 addresses" $ do             rs <- makeResolvSeed defaultResolvConf             withResolver rs $ \resolver -> do-                DNS.lookupAAAA resolver "mew.org" `shouldReturn` Nothing-                DNS.lookupAAAA resolver "www.mew.org" `shouldReturn` Just ["2001:240:11e:c00::101"]--    describe "lookupNS" $ do-        it "gets NS" $ do-            rs <- makeResolvSeed defaultResolvConf-            withResolver rs $ \resolver -> do-                actual <- DNS.lookupNS resolver "mew.org"-                let expected = Just ["ns1.mew.org.", "ns2.mew.org."]-                -- The order of NS records is variable, so we sort the-                -- result.-                sort <$> actual `shouldBe` expected--    describe "lookupTXT" $ do-        it "gets TXT" $ do-            rs <- makeResolvSeed defaultResolvConf-            withResolver rs $ \resolver ->-                DNS.lookupTXT resolver "mew.org" `shouldReturn` Just ["v=spf1 +mx -all"]--    describe "lookupAviaMX" $ do-        it "gets IPv4 addresses via MX" $ do-            rs <- makeResolvSeed defaultResolvConf-            withResolver rs $ \resolver -> do-                as <- DNS.lookupAviaMX resolver "mixi.jp"-                sort <$> as `shouldBe` Just ["202.32.29.4", "202.32.29.5"]--    describe "lookupPTR" $ do-        it "gets PTR" $ do-            rs <- makeResolvSeed defaultResolvConf-            withResolver rs $ \resolver -> do-                let target = "210.130.137.80"-                    rev = BS.intercalate "." (reverse (BS.split '.' target))-                            `BS.append` ".in-addr.arpa"-                DNS.lookupPTR resolver rev `shouldReturn` Just ["www-v4.iij.ad.jp."]+                DNS.lookupAAAA resolver "mew.org"+                    `shouldReturn`+                    Right [] -    describe "lookupSRV" $ do-        it "gets SRV" $ do-            rs <- makeResolvSeed defaultResolvConf-            withResolver rs $ \resolver ->-                DNS.lookupSRV resolver "_sip._tcp.cisco.com" `shouldReturn` Just [(1,0,5060,"vcsgw.cisco.com.")]

@@ -0,0 +1,9 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest [+    "-XOverloadedStrings"+  , "Network/DNS.hs"+  ]