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

Copyright© 2017 Herbert Valerio Riedel
Safe HaskellTrustworthy
LanguageHaskell2010

Network.DNS

Contents

Description

SPDX-License-Identifier: GPL-2.0-or-later

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)] #

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)] #

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)] #

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)] #

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])] #

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) #

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 ""}]
      })

data DnsException #

Exception thrown in case of errors while encoding or decoding into a Msg.

Since: 0.1.1.0

Low-level API

resIsReentrant :: Bool #

Whether the reentrant DNS resolver C API (e.g. res_nquery(3), res_nsend(3)) is being used.

If this this False, then as a fall-back res_query(3)/res_send(3) are used, protected by a global mutex.

Since: 0.1.1.0

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

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 #

Send a raw preformatted query via res_send(3).

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

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

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

Decode a raw DNS message (query or response)

Returns Nothing on decoding failures.

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

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 #

Construct a DNS query Msg in the style of mkQueryRaw

Types

Basic types

Names/Labels

type Label = ByteString #

A DNS Label

Must be non-empty and at most 63 octets.

data Labels #

A domain-name as per RFC 1035, section 3.3 expressed as list of Labels.

See also Name

Constructors

!Label :.: !Labels infixr 5 
Root 

class IsLabels s where #

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

Methods

toLabels :: s -> Maybe Labels #

fromLabels :: Labels -> s #

newtype Name #

<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 

Instances

Eq Name # 

Methods

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

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

Ord Name # 

Methods

compare :: Name -> Name -> Ordering #

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

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

(>) :: Name -> Name -> Bool #

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

max :: Name -> Name -> Name #

min :: Name -> Name -> Name #

Read Name # 
Show Name # 

Methods

showsPrec :: Int -> Name -> ShowS #

show :: Name -> String #

showList :: [Name] -> ShowS #

IsLabels Name # 

caseFoldName :: Name -> Name #

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 #

<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 #

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 # 

Methods

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

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

Ord IPv4 # 

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 # 
Show IPv4 # 

Methods

showsPrec :: Int -> IPv4 -> ShowS #

show :: IPv4 -> String #

showList :: [IPv4] -> ShowS #

Binary IPv4 # 

Methods

put :: IPv4 -> Put #

get :: Get IPv4 #

putList :: [IPv4] -> Put #

data IPv6 #

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 # 

Methods

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

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

Ord IPv6 # 

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 # 
Show IPv6 # 

Methods

showsPrec :: Int -> IPv6 -> ShowS #

show :: IPv6 -> String #

showList :: [IPv6] -> ShowS #

Binary IPv6 # 

Methods

put :: IPv6 -> Put #

get :: Get IPv6 #

putList :: [IPv6] -> Put #

RR TTL & Class

newtype TTL #

Cache time-to-live expressed in seconds

Constructors

TTL Int32 

Instances

Eq TTL # 

Methods

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

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

Ord TTL # 

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 # 
Show TTL # 

Methods

showsPrec :: Int -> TTL -> ShowS #

show :: TTL -> String #

showList :: [TTL] -> ShowS #

Binary TTL # 

Methods

put :: TTL -> Put #

get :: Get TTL #

putList :: [TTL] -> Put #

newtype Class #

DNS CLASS code as per RFC 1035, section 3.2.4

The most commonly used value is classIN.

Constructors

Class Word16 

Instances

classIN :: Class #

The Class constant for IN (Internet)

Message types

newtype Type #

Raw DNS record type code

See also TypeSym

Constructors

Type Word16 

Instances

Eq Type # 

Methods

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

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

Ord Type # 

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 # 
Show Type # 

Methods

showsPrec :: Int -> Type -> ShowS #

show :: Type -> String #

showList :: [Type] -> ShowS #

Binary Type # 

Methods

put :: Type -> Put #

get :: Get Type #

putList :: [Type] -> Put #

data TypeSym #

Symbolic DNS record type

typeFromSym :: TypeSym -> Type #

Convert symbolic TypeSym to numeric Type code

typeToSym :: Type -> Maybe TypeSym #

Convert Type code to symbolic TypeSym

Messages

data Msg l #

Represents a DNS message as per RFC 1035

Constructors

Msg 

Fields

Instances

Functor Msg # 

Methods

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

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

Foldable Msg # 

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 # 

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) # 
Show l => Show (Msg l) # 

Methods

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

show :: Msg l -> String #

showList :: [Msg l] -> ShowS #

Binary l => Binary (Msg l) # 

Methods

put :: Msg l -> Put #

get :: Get (Msg l) #

putList :: [Msg l] -> Put #

data QR #

Encodes whether message is a query or a response

Since: 0.1.1.0

Constructors

IsQuery 
IsResponse 

Instances

Eq QR # 

Methods

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

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

Read QR # 
Show QR # 

Methods

showsPrec :: Int -> QR -> ShowS #

show :: QR -> String #

showList :: [QR] -> ShowS #

data MsgQuestion l #

DNS message header section as per RFC 1035, section 4.1.2

Constructors

MsgQuestion !l !Type !Class 

Instances

Functor MsgQuestion # 

Methods

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

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

Foldable MsgQuestion # 

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 # 

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) # 
Read l => Read (MsgQuestion l) # 
Show l => Show (MsgQuestion l) # 
Binary l => Binary (MsgQuestion l) # 

Methods

put :: MsgQuestion l -> Put #

get :: Get (MsgQuestion l) #

putList :: [MsgQuestion l] -> Put #

data MsgRR l #

DNS resource record section as per RFC 1035, section 4.1.3

Constructors

MsgRR 

Fields

Instances

Functor MsgRR # 

Methods

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

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

Foldable MsgRR # 

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 # 

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) # 

Methods

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

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

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

Methods

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

show :: MsgRR l -> String #

showList :: [MsgRR l] -> ShowS #

Binary l => Binary (MsgRR l) # 

Methods

put :: MsgRR l -> Put #

get :: Get (MsgRR l) #

putList :: [MsgRR l] -> Put #

data RData l #

DNS resource record data (see also MsgRR and TypeSym)

Instances

Functor RData # 

Methods

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

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

Foldable RData # 

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 # 

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) # 

Methods

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

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

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

Methods

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

show :: RData l -> String #

showList :: [RData l] -> ShowS #

rdType :: RData l -> Either Type TypeSym #

Extract the resource record type of a RData object

data SRV l #

SRV Record data as per RFC 2782

Constructors

SRV 

Instances

Functor SRV # 

Methods

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

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

Foldable SRV # 

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 # 

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) # 

Methods

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

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

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

Methods

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

show :: SRV l -> String #

showList :: [SRV l] -> ShowS #

Binary l => Binary (SRV l) # 

Methods

put :: SRV l -> Put #

get :: Get (SRV l) #

putList :: [SRV l] -> Put #