resolv-0.1.0.0: Domain Name Service (DNS) lookup via the libresolv standard library routines

Copyright© 2017 Herbert Valerio Riedel
LicenseGPLv3
Safe HaskellTrustworthy
LanguageHaskell2010

Network.DNS

Contents

Description

This module implements an API for accessing the Domain Name Service (DNS) resolver service via the standard libresolv system library on Unix systems.

Synopsis

High level API

queryA :: Name -> IO [(TTL, IPv4)] Source #

Query A record (see RFC 1035, section 3.4.1).

This query returns only exact matches (modulo foldCaseName). E.g. in case of CNAME responses even if the answer section would contain A records for the hostnames pointed to by the CNAME. You can use query if you need more control.

>>> queryA (Name "www.google.com")
[(TTL 72,IPv4 0xd83acde4)]

queryAAAA :: Name -> IO [(TTL, IPv6)] Source #

Query AAAA records (see RFC 3596).

This query returns only exact matches (modulo foldCaseName). E.g. in case of CNAME responses even if the answer section would contain A records for the hostnames pointed to by the CNAME. You can use query if you need more control.

>>> queryAAAA (Name "www.google.com")
[(TTL 299,IPv6 0x2a0014504001081e 0x2004)]

queryCNAME :: Name -> IO [(TTL, Name)] Source #

Query CNAME records (see RFC 1035, section 3.3.1).

>>> queryCNAME (Name "hackage.haskell.org")
[(TTL 299,Name "j.global-ssl.fastly.net.")]

querySRV :: Name -> IO [(TTL, SRV Name)] Source #

Query SRV records (see RFC 2782).

>>> querySRV (Name "_imap._tcp.gmail.com")
[(TTL 21599,SRV {srvPriority = 0, srvWeight = 0, srvPort = 0, srvTarget = Name "."})]

queryTXT :: Name -> IO [(TTL, [CharStr])] Source #

Query TXT records (see RFC 1035, section 3.3.14).

>>> queryTXT (Name "_mirrors.hackage.haskell.org")
[(TTL 299,["0.urlbase=http://hackage.fpcomplete.com/",
           "1.urlbase=http://objects-us-west-1.dream.io/hackage-mirror/"])]

Mid-level API

query :: IsLabels n => Class -> n -> TypeSym -> IO (Msg n) Source #

Send a query via res_query(3) and decode its response into a Msg

Throws DnsException in case of encoding or decoding errors. May throw other IO exceptions in case of network errors.

Example

>>> query classIN (Name "_mirrors.hackage.haskell.org") TypeTXT
Just (Msg{msgHeader = MsgHeader{mhId    = 56694,
                                mhFlags = MsgHeaderFlags{mhQR = IsResponse, mhOpcode = 0, mhAA = False,
                                                         mhTC = False, mhRD = True, mhRA = True, mhZ = False,
                                                         mhAD = False, mhCD = False, mhRCode = 0},
                                mhQDCount = 1, mhANCount = 1, mhNSCount = 0, mhARCount = 1},
          msgQD = [MsgQuestion (Name "_mirrors.hackage.haskell.org.") (Type 16) (Class 1)],
          msgAN = [MsgRR{rrName  = Name "_mirrors.hackage.haskell.org.",
                         rrClass = Class 1, rrTTL = TTL 299,
                         rrData  = RDataTXT ["0.urlbase=http://hackage.fpcomplete.com/",
                                             "1.urlbase=http://objects-us-west-1.dream.io/hackage-mirror/"]}],
          msgNS = [],
          msgAR = [MsgRR{rrName = Name ".", rrClass = Class 512, rrTTL = TTL 32768, rrData = RDataOPT ""}]
      })

Low-level API

queryRaw :: Class -> Name -> Type -> IO ByteString Source #

Send a query via res_query(3), the return value is the raw binary response message.

You can use decodeMessage to decode the response message.

sendRaw :: ByteString -> IO ByteString Source #

Send a raw preformatted query via res_send(3).

mkQueryRaw :: Class -> Name -> Type -> IO ByteString Source #

Use res_mkquery(3) to construct a DNS query message.

decodeMessage :: IsLabels n => ByteString -> Maybe (Msg n) Source #

Decode a raw DNS message (query or response)

Returns Nothing on decoding failures.

encodeMessage :: IsLabels n => Msg n -> Maybe ByteString Source #

Construct a raw DNS message (query or response)

May return Nothing in input parameters are detected to be invalid.

mkQueryMsg :: IsLabels n => Class -> n -> Type -> Msg n Source #

Construct a DNS query Msg in the style of mkQueryRaw

Types

Basic types

Names/Labels

type Label = ByteString Source #

A DNS Label

Must be non-empty and at most 63 octets.

class IsLabels s where Source #

Types that represent domain-name as per RFC 1035, section 3.3 and can be converted to and from Labels.

Minimal complete definition

toLabels, fromLabels

newtype Name Source #

<domain-name> as per RFC 1035, section 3.3.

A domain-name represented as a series of labels separated by dots.

See also Labels for list-based representation.

NOTE: The Labels type is able to properly represent domain names whose components contain dots which the Name representation cannot.

Constructors

Name ByteString 

caseFoldName :: Name -> Name Source #

Normalise Name

This function case folds Names as described in in RFC 4343, section 3 by subtracting 0x20 from all octets in the inclusive range [0x61..0x7A] (i.e. mapping ['a'..'z'] to ['A'..'Z']).

This operation is idempotent.

Character strings

newtype CharStr Source #

<character-string> as per RFC 1035, section 3.3.

A sequence of up to 255 octets

The limit of 255 octets is caused by the encoding which uses by a prefixed octet denoting the length.

Constructors

CharStr ByteString 

IP addresses

data IPv4 Source #

An IPv4 address

The IP address is represented in network order, i.e. 127.0.0.1 is represented as (IPv4 0x7f000001).

Constructors

IPv4 !Word32 

Instances

Eq IPv4 Source # 

Methods

(==) :: IPv4 -> IPv4 -> Bool #

(/=) :: IPv4 -> IPv4 -> Bool #

Ord IPv4 Source # 

Methods

compare :: IPv4 -> IPv4 -> Ordering #

(<) :: IPv4 -> IPv4 -> Bool #

(<=) :: IPv4 -> IPv4 -> Bool #

(>) :: IPv4 -> IPv4 -> Bool #

(>=) :: IPv4 -> IPv4 -> Bool #

max :: IPv4 -> IPv4 -> IPv4 #

min :: IPv4 -> IPv4 -> IPv4 #

Read IPv4 Source # 
Show IPv4 Source # 

Methods

showsPrec :: Int -> IPv4 -> ShowS #

show :: IPv4 -> String #

showList :: [IPv4] -> ShowS #

Binary IPv4 Source # 

Methods

put :: IPv4 -> Put #

get :: Get IPv4 #

putList :: [IPv4] -> Put #

data IPv6 Source #

An IPv6 address

The IP address is represented in network order, i.e. 2606:2800:220:1:248:1893:25c8:1946 is represented as (IPv6 0x2606280002200001 0x248189325c81946).

Constructors

IPv6 !Word64 !Word64 

Instances

Eq IPv6 Source # 

Methods

(==) :: IPv6 -> IPv6 -> Bool #

(/=) :: IPv6 -> IPv6 -> Bool #

Ord IPv6 Source # 

Methods

compare :: IPv6 -> IPv6 -> Ordering #

(<) :: IPv6 -> IPv6 -> Bool #

(<=) :: IPv6 -> IPv6 -> Bool #

(>) :: IPv6 -> IPv6 -> Bool #

(>=) :: IPv6 -> IPv6 -> Bool #

max :: IPv6 -> IPv6 -> IPv6 #

min :: IPv6 -> IPv6 -> IPv6 #

Read IPv6 Source # 
Show IPv6 Source # 

Methods

showsPrec :: Int -> IPv6 -> ShowS #

show :: IPv6 -> String #

showList :: [IPv6] -> ShowS #

Binary IPv6 Source # 

Methods

put :: IPv6 -> Put #

get :: Get IPv6 #

putList :: [IPv6] -> Put #

RR TTL & Class

newtype TTL Source #

Cache time-to-live expressed in seconds

Constructors

TTL Int32 

Instances

Eq TTL Source # 

Methods

(==) :: TTL -> TTL -> Bool #

(/=) :: TTL -> TTL -> Bool #

Ord TTL Source # 

Methods

compare :: TTL -> TTL -> Ordering #

(<) :: TTL -> TTL -> Bool #

(<=) :: TTL -> TTL -> Bool #

(>) :: TTL -> TTL -> Bool #

(>=) :: TTL -> TTL -> Bool #

max :: TTL -> TTL -> TTL #

min :: TTL -> TTL -> TTL #

Read TTL Source # 
Show TTL Source # 

Methods

showsPrec :: Int -> TTL -> ShowS #

show :: TTL -> String #

showList :: [TTL] -> ShowS #

Binary TTL Source # 

Methods

put :: TTL -> Put #

get :: Get TTL #

putList :: [TTL] -> Put #

newtype Class Source #

DNS CLASS code as per RFC 1035, section 3.2.4

The most commonly used value is classIN.

Constructors

Class Word16 

classIN :: Class Source #

The Class constant for IN (Internet)

Message types

newtype Type Source #

Raw DNS record type code

See also TypeSym

Constructors

Type Word16 

Instances

Eq Type Source # 

Methods

(==) :: Type -> Type -> Bool #

(/=) :: Type -> Type -> Bool #

Ord Type Source # 

Methods

compare :: Type -> Type -> Ordering #

(<) :: Type -> Type -> Bool #

(<=) :: Type -> Type -> Bool #

(>) :: Type -> Type -> Bool #

(>=) :: Type -> Type -> Bool #

max :: Type -> Type -> Type #

min :: Type -> Type -> Type #

Read Type Source # 
Show Type Source # 

Methods

showsPrec :: Int -> Type -> ShowS #

show :: Type -> String #

showList :: [Type] -> ShowS #

Binary Type Source # 

Methods

put :: Type -> Put #

get :: Get Type #

putList :: [Type] -> Put #

data TypeSym Source #

Symbolic DNS record type

typeFromSym :: TypeSym -> Type Source #

Convert symbolic TypeSym to numeric Type code

typeToSym :: Type -> Maybe TypeSym Source #

Convert Type code to symbolic TypeSym

Messages

data Msg l Source #

Represents a DNS message as per RFC 1035

Constructors

Msg 

Fields

Instances

Functor Msg Source # 

Methods

fmap :: (a -> b) -> Msg a -> Msg b #

(<$) :: a -> Msg b -> Msg a #

Foldable Msg Source # 

Methods

fold :: Monoid m => Msg m -> m #

foldMap :: Monoid m => (a -> m) -> Msg a -> m #

foldr :: (a -> b -> b) -> b -> Msg a -> b #

foldr' :: (a -> b -> b) -> b -> Msg a -> b #

foldl :: (b -> a -> b) -> b -> Msg a -> b #

foldl' :: (b -> a -> b) -> b -> Msg a -> b #

foldr1 :: (a -> a -> a) -> Msg a -> a #

foldl1 :: (a -> a -> a) -> Msg a -> a #

toList :: Msg a -> [a] #

null :: Msg a -> Bool #

length :: Msg a -> Int #

elem :: Eq a => a -> Msg a -> Bool #

maximum :: Ord a => Msg a -> a #

minimum :: Ord a => Msg a -> a #

sum :: Num a => Msg a -> a #

product :: Num a => Msg a -> a #

Traversable Msg Source # 

Methods

traverse :: Applicative f => (a -> f b) -> Msg a -> f (Msg b) #

sequenceA :: Applicative f => Msg (f a) -> f (Msg a) #

mapM :: Monad m => (a -> m b) -> Msg a -> m (Msg b) #

sequence :: Monad m => Msg (m a) -> m (Msg a) #

Read l => Read (Msg l) Source # 
Show l => Show (Msg l) Source # 

Methods

showsPrec :: Int -> Msg l -> ShowS #

show :: Msg l -> String #

showList :: [Msg l] -> ShowS #

Binary l => Binary (Msg l) Source # 

Methods

put :: Msg l -> Put #

get :: Get (Msg l) #

putList :: [Msg l] -> Put #

data MsgQuestion l Source #

DNS message header section as per RFC 1035, section 4.1.2

Constructors

MsgQuestion !l !Type !Class 

Instances

Functor MsgQuestion Source # 

Methods

fmap :: (a -> b) -> MsgQuestion a -> MsgQuestion b #

(<$) :: a -> MsgQuestion b -> MsgQuestion a #

Foldable MsgQuestion Source # 

Methods

fold :: Monoid m => MsgQuestion m -> m #

foldMap :: Monoid m => (a -> m) -> MsgQuestion a -> m #

foldr :: (a -> b -> b) -> b -> MsgQuestion a -> b #

foldr' :: (a -> b -> b) -> b -> MsgQuestion a -> b #

foldl :: (b -> a -> b) -> b -> MsgQuestion a -> b #

foldl' :: (b -> a -> b) -> b -> MsgQuestion a -> b #

foldr1 :: (a -> a -> a) -> MsgQuestion a -> a #

foldl1 :: (a -> a -> a) -> MsgQuestion a -> a #

toList :: MsgQuestion a -> [a] #

null :: MsgQuestion a -> Bool #

length :: MsgQuestion a -> Int #

elem :: Eq a => a -> MsgQuestion a -> Bool #

maximum :: Ord a => MsgQuestion a -> a #

minimum :: Ord a => MsgQuestion a -> a #

sum :: Num a => MsgQuestion a -> a #

product :: Num a => MsgQuestion a -> a #

Traversable MsgQuestion Source # 

Methods

traverse :: Applicative f => (a -> f b) -> MsgQuestion a -> f (MsgQuestion b) #

sequenceA :: Applicative f => MsgQuestion (f a) -> f (MsgQuestion a) #

mapM :: Monad m => (a -> m b) -> MsgQuestion a -> m (MsgQuestion b) #

sequence :: Monad m => MsgQuestion (m a) -> m (MsgQuestion a) #

Eq l => Eq (MsgQuestion l) Source # 
Read l => Read (MsgQuestion l) Source # 
Show l => Show (MsgQuestion l) Source # 
Binary l => Binary (MsgQuestion l) Source # 

Methods

put :: MsgQuestion l -> Put #

get :: Get (MsgQuestion l) #

putList :: [MsgQuestion l] -> Put #

data MsgRR l Source #

DNS resource record section as per RFC 1035, section 4.1.3

Constructors

MsgRR 

Fields

Instances

Functor MsgRR Source # 

Methods

fmap :: (a -> b) -> MsgRR a -> MsgRR b #

(<$) :: a -> MsgRR b -> MsgRR a #

Foldable MsgRR Source # 

Methods

fold :: Monoid m => MsgRR m -> m #

foldMap :: Monoid m => (a -> m) -> MsgRR a -> m #

foldr :: (a -> b -> b) -> b -> MsgRR a -> b #

foldr' :: (a -> b -> b) -> b -> MsgRR a -> b #

foldl :: (b -> a -> b) -> b -> MsgRR a -> b #

foldl' :: (b -> a -> b) -> b -> MsgRR a -> b #

foldr1 :: (a -> a -> a) -> MsgRR a -> a #

foldl1 :: (a -> a -> a) -> MsgRR a -> a #

toList :: MsgRR a -> [a] #

null :: MsgRR a -> Bool #

length :: MsgRR a -> Int #

elem :: Eq a => a -> MsgRR a -> Bool #

maximum :: Ord a => MsgRR a -> a #

minimum :: Ord a => MsgRR a -> a #

sum :: Num a => MsgRR a -> a #

product :: Num a => MsgRR a -> a #

Traversable MsgRR Source # 

Methods

traverse :: Applicative f => (a -> f b) -> MsgRR a -> f (MsgRR b) #

sequenceA :: Applicative f => MsgRR (f a) -> f (MsgRR a) #

mapM :: Monad m => (a -> m b) -> MsgRR a -> m (MsgRR b) #

sequence :: Monad m => MsgRR (m a) -> m (MsgRR a) #

Eq l => Eq (MsgRR l) Source # 

Methods

(==) :: MsgRR l -> MsgRR l -> Bool #

(/=) :: MsgRR l -> MsgRR l -> Bool #

Read l => Read (MsgRR l) Source # 
Show l => Show (MsgRR l) Source # 

Methods

showsPrec :: Int -> MsgRR l -> ShowS #

show :: MsgRR l -> String #

showList :: [MsgRR l] -> ShowS #

Binary l => Binary (MsgRR l) Source # 

Methods

put :: MsgRR l -> Put #

get :: Get (MsgRR l) #

putList :: [MsgRR l] -> Put #

data RData l Source #

DNS resource record data (see also MsgRR and TypeSym)

Instances

Functor RData Source # 

Methods

fmap :: (a -> b) -> RData a -> RData b #

(<$) :: a -> RData b -> RData a #

Foldable RData Source # 

Methods

fold :: Monoid m => RData m -> m #

foldMap :: Monoid m => (a -> m) -> RData a -> m #

foldr :: (a -> b -> b) -> b -> RData a -> b #

foldr' :: (a -> b -> b) -> b -> RData a -> b #

foldl :: (b -> a -> b) -> b -> RData a -> b #

foldl' :: (b -> a -> b) -> b -> RData a -> b #

foldr1 :: (a -> a -> a) -> RData a -> a #

foldl1 :: (a -> a -> a) -> RData a -> a #

toList :: RData a -> [a] #

null :: RData a -> Bool #

length :: RData a -> Int #

elem :: Eq a => a -> RData a -> Bool #

maximum :: Ord a => RData a -> a #

minimum :: Ord a => RData a -> a #

sum :: Num a => RData a -> a #

product :: Num a => RData a -> a #

Traversable RData Source # 

Methods

traverse :: Applicative f => (a -> f b) -> RData a -> f (RData b) #

sequenceA :: Applicative f => RData (f a) -> f (RData a) #

mapM :: Monad m => (a -> m b) -> RData a -> m (RData b) #

sequence :: Monad m => RData (m a) -> m (RData a) #

Eq l => Eq (RData l) Source # 

Methods

(==) :: RData l -> RData l -> Bool #

(/=) :: RData l -> RData l -> Bool #

Read l => Read (RData l) Source # 
Show l => Show (RData l) Source # 

Methods

showsPrec :: Int -> RData l -> ShowS #

show :: RData l -> String #

showList :: [RData l] -> ShowS #

rdType :: RData l -> Either Type TypeSym Source #

Extract the resource record type of a RData object

data SRV l Source #

SRV Record data as per RFC 2782

Constructors

SRV 

Instances

Functor SRV Source # 

Methods

fmap :: (a -> b) -> SRV a -> SRV b #

(<$) :: a -> SRV b -> SRV a #

Foldable SRV Source # 

Methods

fold :: Monoid m => SRV m -> m #

foldMap :: Monoid m => (a -> m) -> SRV a -> m #

foldr :: (a -> b -> b) -> b -> SRV a -> b #

foldr' :: (a -> b -> b) -> b -> SRV a -> b #

foldl :: (b -> a -> b) -> b -> SRV a -> b #

foldl' :: (b -> a -> b) -> b -> SRV a -> b #

foldr1 :: (a -> a -> a) -> SRV a -> a #

foldl1 :: (a -> a -> a) -> SRV a -> a #

toList :: SRV a -> [a] #

null :: SRV a -> Bool #

length :: SRV a -> Int #

elem :: Eq a => a -> SRV a -> Bool #

maximum :: Ord a => SRV a -> a #

minimum :: Ord a => SRV a -> a #

sum :: Num a => SRV a -> a #

product :: Num a => SRV a -> a #

Traversable SRV Source # 

Methods

traverse :: Applicative f => (a -> f b) -> SRV a -> f (SRV b) #

sequenceA :: Applicative f => SRV (f a) -> f (SRV a) #

mapM :: Monad m => (a -> m b) -> SRV a -> m (SRV b) #

sequence :: Monad m => SRV (m a) -> m (SRV a) #

Eq l => Eq (SRV l) Source # 

Methods

(==) :: SRV l -> SRV l -> Bool #

(/=) :: SRV l -> SRV l -> Bool #

Read l => Read (SRV l) Source # 
Show l => Show (SRV l) Source # 

Methods

showsPrec :: Int -> SRV l -> ShowS #

show :: SRV l -> String #

showList :: [SRV l] -> ShowS #

Binary l => Binary (SRV l) Source # 

Methods

put :: SRV l -> Put #

get :: Get (SRV l) #

putList :: [SRV l] -> Put #