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