Version bump to v0.4.1.
[haeredes.git] / src / DNS.hs
1 module DNS (
2 LookupResult,
3 lookupMX',
4 lookupNS',
5 resolve_address )
6 where
7
8 import Control.Monad ( liftM )
9 import qualified Data.ByteString.Char8 as BS ( pack )
10 import Data.IP (IPv4)
11 import Network.DNS (
12 Domain,
13 DNSError,
14 Resolver,
15 defaultResolvConf,
16 lookupA,
17 lookupMX,
18 lookupNS,
19 lookupNSAuth,
20 makeResolvSeed,
21 withResolver )
22 import Text.Read ( readMaybe )
23
24 type LookupResult = (Domain, Either DNSError [Domain])
25
26 -- | Takes a String representing either a hostname or an IP
27 -- address. If a hostname was supplied, it is resolved to either an
28 -- [IPv4] or an error. If an IP address is supplied, it is returned
29 -- as a singleton [IPv4].
30 --
31 -- Examples:
32 --
33 -- >>> resolve_address "example.com"
34 -- Right [93.184.216.119]
35 -- >>> resolve_address "93.184.216.119"
36 -- Right [93.184.216.119]
37 --
38 resolve_address :: String -> IO (Either DNSError [IPv4])
39 resolve_address s =
40 case read_result of
41 Just addr -> return $ Right [addr]
42 Nothing -> do
43 default_rs <- makeResolvSeed defaultResolvConf
44 withResolver default_rs $ \resolver ->
45 lookupA resolver (BS.pack s)
46 where
47 read_result :: Maybe IPv4
48 read_result = readMaybe s
49
50
51 -- | This calls lookupMX, and returns the result as the second
52 -- component of a tuple whose first component is the domain name
53 -- itself.
54 --
55 -- Examples:
56 --
57 -- The example domain, example.com, has no MX record.
58 --
59 -- >>> rs <- makeResolvSeed defaultResolvConf
60 -- >>> let domain = BS.pack "example.com."
61 -- >>> withResolver rs $ \resolver -> lookupMX' resolver domain
62 -- ("example.com.",Right [])
63 --
64 lookupMX' :: Resolver -> Domain -> IO LookupResult
65 lookupMX' resolver domain =
66 liftM (pair_em . drop_priority) $ lookupMX resolver domain
67 where
68 drop_priority :: Either DNSError [(Domain, Int)]
69 -> Either DNSError [Domain]
70 drop_priority = fmap (map fst)
71
72 pair_em :: a -> (Domain, a)
73 pair_em = (,) domain
74
75
76 -- | This calls lookupNS, and returns the result as the second
77 -- component of a tuple whose first component is the domain name
78 -- itself.
79 --
80 -- Examples:
81 --
82 -- The example domain, example.com, does have NS records, but the
83 -- order in which they are returned is variable, so we have to sort
84 -- them to get a reliable result.
85 --
86 -- >>> import Data.List (sort)
87 -- >>> import Control.Applicative ((<$>))
88 -- >>>
89 -- >>> let sort_snd (x,y) = (x, sort <$> y)
90 -- >>> rs <- makeResolvSeed defaultResolvConf
91 -- >>> let domain = BS.pack "example.com."
92 -- >>> withResolver rs $ \resolver -> sort_snd <$> lookupNS' resolver domain
93 -- ("example.com.",Right ["a.iana-servers.net.","b.iana-servers.net."])
94 --
95 lookupNS' :: Resolver -> Domain -> IO LookupResult
96 lookupNS' resolver domain = do
97 answer_result <- lookupNS resolver domain
98 auth_result <- lookupNSAuth resolver domain
99 liftM pair_em $ return $ combine answer_result auth_result
100 where
101 pair_em :: a -> (Domain, a)
102 pair_em = (,) domain
103
104 combine :: (Either DNSError [Domain])
105 -> (Either DNSError [Domain])
106 -> (Either DNSError [Domain])
107 combine e1 e2 = do
108 l1 <- e1
109 l2 <- e2
110 return (l1 ++ l2)