5222cbec3f3a54c1d8b334bb52b615e56b1cc2e2
[haeredes.git] / src / DNS.hs
1 module DNS (
2 LookupResult,
3 lookupMX',
4 lookupNS',
5 normalize
6 )
7 where
8
9 import qualified Data.ByteString.Char8 as BS (
10 append,
11 last,
12 map,
13 pack )
14 import Data.Char (toLower)
15 import Network.DNS (
16 Domain,
17 Resolver,
18 lookupMX,
19 lookupNS )
20
21 type LookupResult = (Domain, Maybe [Domain])
22
23 lookupMX' :: Resolver -> Domain -> IO LookupResult
24 lookupMX' resolver domain =
25 lookupMX resolver domain >>= return . pair_em . drop_priority
26 where
27 drop_priority :: Maybe [(Domain, Int)] -> Maybe [Domain]
28 drop_priority = fmap (map fst)
29
30 pair_em :: a -> (Domain, a)
31 pair_em = (,) domain
32
33 -- This function keeps the domain matches with its NS records.
34 lookupNS' :: Resolver -> Domain -> IO LookupResult
35 lookupNS' resolver domain =
36 lookupNS resolver domain >>= return . pair_em
37 where
38 pair_em :: a -> (Domain, a)
39 pair_em = (,) domain
40
41 -- | Normalize the given name by lowercasing and appending a trailing
42 -- dot (the root) if necessary.
43 normalize :: Domain -> Domain
44 normalize = normalize_case . normalize_root
45
46
47 normalize_root :: Domain -> Domain
48 normalize_root d
49 | BS.last d == '.' = d
50 | otherwise = d `BS.append` trailing_dot
51 where
52 trailing_dot = BS.pack "."
53
54
55 normalize_case :: Domain -> Domain
56 normalize_case = BS.map toLower