LookupResult,
lookupMX',
lookupNS',
- normalize
- )
+ resolve_address )
where
-import Control.Monad (liftM)
-import qualified Data.ByteString.Char8 as BS (
- append,
- last,
- map,
- pack )
-import Data.Char (toLower)
+import Control.Monad ( liftM )
+import qualified Data.ByteString.Char8 as BS ( pack )
+import Data.IP (IPv4)
import Network.DNS (
Domain,
+ DNSError,
Resolver,
+ defaultResolvConf,
+ lookupA,
lookupMX,
- lookupNS )
+ lookupNS,
+ lookupNSAuth,
+ makeResolvSeed,
+ withResolver )
+import Text.Read ( readMaybe )
-type LookupResult = (Domain, Maybe [Domain])
+type LookupResult = (Domain, Either DNSError [Domain])
+-- | Takes a String representing either a hostname or an IP
+-- address. If a hostname was supplied, it is resolved to either an
+-- [IPv4] or an error. If an IP address is supplied, it is returned
+-- as a singleton [IPv4].
+--
+-- Examples:
+--
+-- >>> resolve_address "example.com"
+-- Right [93.184.216.34]
+-- >>> resolve_address "93.184.216.34"
+-- Right [93.184.216.34]
+--
+resolve_address :: String -> IO (Either DNSError [IPv4])
+resolve_address s =
+ case read_result of
+ Just addr -> return $ Right [addr]
+ Nothing -> do
+ default_rs <- makeResolvSeed defaultResolvConf
+ withResolver default_rs $ \resolver ->
+ lookupA resolver (BS.pack s)
+ where
+ read_result :: Maybe IPv4
+ read_result = readMaybe s
+
+
+-- | This calls lookupMX, and returns the result as the second
+-- component of a tuple whose first component is the domain name
+-- itself.
+--
+-- Examples:
+--
+-- The example domain, example.com, has no MX record.
+--
+-- >>> rs <- makeResolvSeed defaultResolvConf
+-- >>> let domain = BS.pack "example.com."
+-- >>> withResolver rs $ \resolver -> lookupMX' resolver domain
+-- ("example.com.",Right [])
+--
lookupMX' :: Resolver -> Domain -> IO LookupResult
lookupMX' resolver domain =
liftM (pair_em . drop_priority) $ lookupMX resolver domain
where
- drop_priority :: Maybe [(Domain, Int)] -> Maybe [Domain]
+ drop_priority :: Either DNSError [(Domain, Int)]
+ -> Either DNSError [Domain]
drop_priority = fmap (map fst)
pair_em :: a -> (Domain, a)
pair_em = (,) domain
--- This function keeps the domain matches with its NS records.
+
+-- | This calls lookupNS, and returns the result as the second
+-- component of a tuple whose first component is the domain name
+-- itself.
+--
+-- Examples:
+--
+-- The example domain, example.com, does have NS records, but the
+-- order in which they are returned is variable, so we have to sort
+-- them to get a reliable result.
+--
+-- >>> import Data.List (sort)
+-- >>> import Control.Applicative ((<$>))
+-- >>>
+-- >>> let sort_snd (x,y) = (x, sort <$> y)
+-- >>> rs <- makeResolvSeed defaultResolvConf
+-- >>> let domain = BS.pack "example.com."
+-- >>> withResolver rs $ \resolver -> sort_snd <$> lookupNS' resolver domain
+-- ("example.com.",Right ["a.iana-servers.net.","b.iana-servers.net."])
+--
lookupNS' :: Resolver -> Domain -> IO LookupResult
-lookupNS' resolver domain =
- liftM pair_em $ lookupNS resolver domain
+lookupNS' resolver domain = do
+ answer_result <- lookupNS resolver domain
+ auth_result <- lookupNSAuth resolver domain
+ liftM pair_em $ return $ combine answer_result auth_result
where
pair_em :: a -> (Domain, a)
pair_em = (,) domain
--- | Normalize the given name by lowercasing and appending a trailing
--- dot (the root) if necessary.
-normalize :: Domain -> Domain
-normalize = normalize_case . normalize_root
-
-
-normalize_root :: Domain -> Domain
-normalize_root d
- | BS.last d == '.' = d
- | otherwise = d `BS.append` trailing_dot
- where
- trailing_dot = BS.pack "."
-
-
-normalize_case :: Domain -> Domain
-normalize_case = BS.map toLower
+ combine :: (Either DNSError [Domain])
+ -> (Either DNSError [Domain])
+ -> (Either DNSError [Domain])
+ combine e1 e2 = do
+ l1 <- e1
+ l2 <- e2
+ return (l1 ++ l2)