{-# LANGUAGE CApiFFI            #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE Trustworthy        #-}

-- |
-- Copyright: © 2017 Herbert Valerio Riedel
-- SPDX-License-Identifier: GPL-2.0-or-later
--
-- This module implements an API for accessing
-- the [Domain Name Service (DNS)](https://tools.ietf.org/html/rfc1035)
-- resolver service via the standard @libresolv@ system library
-- on Unix systems.
--
module Network.DNS
    ( -- ** High level API
      queryA
    , queryAAAA
    , queryCNAME
    , querySRV
    , queryTXT

      -- * Mid-level API
    , query
    , DnsException(..)

      -- * Low-level API
    , resIsReentrant
    , queryRaw
    , sendRaw
    , mkQueryRaw

    , decodeMessage
    , encodeMessage
    , mkQueryMsg

      -- * Types
      -- ** Basic types

      -- *** Names/Labels
    , Label
    , Labels(..)
    , IsLabels(..)

    , Name(..)
    , caseFoldName

      -- *** Character strings
    , CharStr(..)

      -- *** IP addresses
    , IPv4(..)
    , IPv6(..)

      -- *** RR TTL & Class
    , TTL(..)

    , Class(..)
    , classIN

      -- *** Message types
    , Type(..)
    , TypeSym(..)
    , typeFromSym
    , typeToSym

      -- ** Messages

    , Msg(..)

    , MsgHeader(..)
    , MsgHeaderFlags(..), QR(..)
    , MsgQuestion(..)
    , MsgRR(..)

    , RData(..)
    , rdType

    , SRV(..)
    )
    where

import           Control.Exception
import           Data.Typeable         (Typeable)
import           Foreign.C
import           Foreign.Marshal.Alloc
import           Prelude

import qualified Data.ByteString       as BS

import           Compat

import           Network.DNS.FFI
import           Network.DNS.Message

-- | Exception thrown in case of errors while encoding or decoding into a 'Msg'.
--
-- @since 0.1.1.0
data DnsException = DnsEncodeException
                  | DnsDecodeException
                  deriving (Int -> DnsException -> ShowS
[DnsException] -> ShowS
DnsException -> String
(Int -> DnsException -> ShowS)
-> (DnsException -> String)
-> ([DnsException] -> ShowS)
-> Show DnsException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DnsException] -> ShowS
$cshowList :: [DnsException] -> ShowS
show :: DnsException -> String
$cshow :: DnsException -> String
showsPrec :: Int -> DnsException -> ShowS
$cshowsPrec :: Int -> DnsException -> ShowS
Show, Typeable)

instance Exception DnsException

-- | 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 ""}]
--       })
--
query :: IsLabels n => Class -> n -> TypeSym -> IO (Msg n)
query :: Class -> n -> TypeSym -> IO (Msg n)
query cls :: Class
cls name0 :: n
name0 qtype :: TypeSym
qtype
  | Just name :: Name
name <- n -> Maybe Name
forall n. IsLabels n => n -> Maybe Name
toName n
name0 = do
      ByteString
bs <- Class -> Name -> Type -> IO ByteString
queryRaw Class
cls Name
name (TypeSym -> Type
typeFromSym TypeSym
qtype)
      Maybe (Msg n)
msg <- Maybe (Msg n) -> IO (Maybe (Msg n))
forall a. a -> IO a
evaluate (ByteString -> Maybe (Msg n)
forall n. IsLabels n => ByteString -> Maybe (Msg n)
decodeMessage ByteString
bs)
      IO (Msg n) -> (Msg n -> IO (Msg n)) -> Maybe (Msg n) -> IO (Msg n)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DnsException -> IO (Msg n)
forall e a. Exception e => e -> IO a
throwIO DnsException
DnsDecodeException) Msg n -> IO (Msg n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Msg n)
msg
  | Bool
otherwise = DnsException -> IO (Msg n)
forall e a. Exception e => e -> IO a
throwIO DnsException
DnsEncodeException

-- | 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.
queryRaw :: Class -> Name -> Type -> IO BS.ByteString
queryRaw :: Class -> Name -> Type -> IO ByteString
queryRaw (Class cls :: Word16
cls) (Name name :: ByteString
name) qtype :: Type
qtype = (Ptr CResState -> IO ByteString) -> IO ByteString
forall a. (Ptr CResState -> IO a) -> IO a
withCResState ((Ptr CResState -> IO ByteString) -> IO ByteString)
-> (Ptr CResState -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \stptr :: Ptr CResState
stptr -> do
    Int -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
forall a. Num a => a
max_msg_size ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \resptr :: Ptr CChar
resptr -> do
        Ptr CChar
_ <- Ptr CChar -> CInt -> CSize -> IO (Ptr CChar)
forall a. Ptr a -> CInt -> CSize -> IO (Ptr a)
c_memset Ptr CChar
resptr 0 CSize
forall a. Num a => a
max_msg_size
        ByteString -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
name ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \dn :: Ptr CChar
dn -> do

            CInt
rc1 <- Ptr CResState -> IO CInt
c_res_opt_set_use_dnssec Ptr CResState
stptr
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
rc1 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "res_init(3) failed"

            IO ()
resetErrno
            CInt
reslen <- Ptr CResState
-> Ptr CChar -> CInt -> CInt -> Ptr CChar -> CInt -> IO CInt
c_res_query Ptr CResState
stptr Ptr CChar
dn (Word16 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
cls) CInt
qtypeVal Ptr CChar
resptr CInt
forall a. Num a => a
max_msg_size

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
reslen CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
forall a. Num a => a
max_msg_size) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "res_query(3) message size overflow"

            Errno
errno <- IO Errno
getErrno

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
reslen CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eOK) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    String -> IO ()
forall a. String -> IO a
throwErrno "res_query"

                String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "res_query(3) failed"

            CStringLen -> IO ByteString
BS.packCStringLen (Ptr CChar
resptr, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
reslen)

  where
    -- The DNS protocol is inherently 16-bit-offset based; so 64KiB is
    -- a reasonable maximum message size most implementations seem to
    -- support.
    max_msg_size :: Num a => a
    max_msg_size :: a
max_msg_size = 0x10000

    qtypeVal :: CInt
    qtypeVal :: CInt
qtypeVal = case Type
qtype of Type w :: Word16
w -> Word16 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w

-- | Send a raw preformatted query via @res_send(3)@.
sendRaw :: BS.ByteString -> IO BS.ByteString
sendRaw :: ByteString -> IO ByteString
sendRaw req :: ByteString
req = (Ptr CResState -> IO ByteString) -> IO ByteString
forall a. (Ptr CResState -> IO a) -> IO a
withCResState ((Ptr CResState -> IO ByteString) -> IO ByteString)
-> (Ptr CResState -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \stptr :: Ptr CResState
stptr -> do
    Int -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
forall a. Num a => a
max_msg_size ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \resptr :: Ptr CChar
resptr -> do
        Ptr CChar
_ <- Ptr CChar -> CInt -> CSize -> IO (Ptr CChar)
forall a. Ptr a -> CInt -> CSize -> IO (Ptr a)
c_memset Ptr CChar
resptr 0 CSize
forall a. Num a => a
max_msg_size
        ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
req ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(reqptr :: Ptr CChar
reqptr,reqlen :: Int
reqlen) -> do
            CInt
rc1 <- Ptr CResState -> IO CInt
c_res_opt_set_use_dnssec Ptr CResState
stptr
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
rc1 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "res_init(3) failed"

            IO ()
resetErrno
            CInt
reslen <- Ptr CResState -> Ptr CChar -> CInt -> Ptr CChar -> CInt -> IO CInt
c_res_send Ptr CResState
stptr Ptr CChar
reqptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
reqlen) Ptr CChar
resptr CInt
forall a. Num a => a
max_msg_size

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
reslen CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
forall a. Num a => a
max_msg_size) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "res_send(3) message size overflow"

            Errno
errno <- IO Errno
getErrno

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
reslen CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eOK) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    String -> IO ()
forall a. String -> IO a
throwErrno "res_send"

                String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "res_send(3) failed"

            CStringLen -> IO ByteString
BS.packCStringLen (Ptr CChar
resptr, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
reslen)

  where
    -- The DNS protocol is inherently 16-bit-offset based; so 64KiB is
    -- a reasonable maximum message size most implementations seem to
    -- support.
    max_msg_size :: Num a => a
    max_msg_size :: a
max_msg_size = 0x10000

-- | Construct a DNS query 'Msg' in the style of 'mkQueryRaw'
mkQueryMsg :: IsLabels n => Class -> n -> Type -> Msg n
mkQueryMsg :: Class -> n -> Type -> Msg n
mkQueryMsg cls :: Class
cls l :: n
l qtype :: Type
qtype = MsgHeader
-> [MsgQuestion n] -> [MsgRR n] -> [MsgRR n] -> [MsgRR n] -> Msg n
forall l.
MsgHeader
-> [MsgQuestion l] -> [MsgRR l] -> [MsgRR l] -> [MsgRR l] -> Msg l
Msg ($WMsgHeader :: Word16
-> MsgHeaderFlags
-> Word16
-> Word16
-> Word16
-> Word16
-> MsgHeader
MsgHeader{..})
                             [n -> Type -> Class -> MsgQuestion n
forall l. l -> Type -> Class -> MsgQuestion l
MsgQuestion n
l Type
qtype Class
cls]
                             []
                             []
                             [$WMsgRR :: forall l. l -> Class -> TTL -> RData l -> MsgRR l
MsgRR {..}]
  where
    mhId :: Word16
mhId      = 31337
    mhFlags :: MsgHeaderFlags
mhFlags   = $WMsgHeaderFlags :: QR
-> Word8
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Word8
-> MsgHeaderFlags
MsgHeaderFlags
      { mhQR :: QR
mhQR     = QR
IsQuery
      , mhOpcode :: Word8
mhOpcode = 0
      , mhAA :: Bool
mhAA     = Bool
False
      , mhTC :: Bool
mhTC     = Bool
False
      , mhRD :: Bool
mhRD     = Bool
True
      , mhRA :: Bool
mhRA     = Bool
False
      , mhZ :: Bool
mhZ      = Bool
False
      , mhAD :: Bool
mhAD     = Bool
True
      , mhCD :: Bool
mhCD     = Bool
False
      , mhRCode :: Word8
mhRCode  = 0
      }

    mhQDCount :: Word16
mhQDCount = 1
    mhANCount :: Word16
mhANCount = 0
    mhNSCount :: Word16
mhNSCount = 0
    mhARCount :: Word16
mhARCount = 1

    rrName :: n
rrName  = Labels -> n
forall s. IsLabels s => Labels -> s
fromLabels Labels
Root
    rrClass :: Class
rrClass = Word16 -> Class
Class 512
    rrTTL :: TTL
rrTTL   = Int32 -> TTL
TTL 0x8000
    rrData :: RData l
rrData  = ByteString -> RData l
forall l. ByteString -> RData l
RDataOPT ""



-- | Use @res_mkquery(3)@ to construct a DNS query message.
mkQueryRaw :: Class -> Name -> Type -> IO BS.ByteString
mkQueryRaw :: Class -> Name -> Type -> IO ByteString
mkQueryRaw (Class cls :: Word16
cls) (Name name :: ByteString
name) qtype :: Type
qtype = (Ptr CResState -> IO ByteString) -> IO ByteString
forall a. (Ptr CResState -> IO a) -> IO a
withCResState ((Ptr CResState -> IO ByteString) -> IO ByteString)
-> (Ptr CResState -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \stptr :: Ptr CResState
stptr -> do
    Int -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
forall a. Num a => a
max_msg_size ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \resptr :: Ptr CChar
resptr -> do
        Ptr CChar
_ <- Ptr CChar -> CInt -> CSize -> IO (Ptr CChar)
forall a. Ptr a -> CInt -> CSize -> IO (Ptr a)
c_memset Ptr CChar
resptr 0 CSize
forall a. Num a => a
max_msg_size
        ByteString -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
name ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \dn :: Ptr CChar
dn -> do

            CInt
rc1 <- Ptr CResState -> IO CInt
c_res_opt_set_use_dnssec Ptr CResState
stptr
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
rc1 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "res_init(3) failed"

            IO ()
resetErrno
            CInt
reslen <- Ptr CResState
-> Ptr CChar -> CInt -> CInt -> Ptr CChar -> CInt -> IO CInt
c_res_mkquery Ptr CResState
stptr Ptr CChar
dn (Word16 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
cls) CInt
qtypeVal Ptr CChar
resptr CInt
forall a. Num a => a
max_msg_size

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
reslen CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
forall a. Num a => a
max_msg_size) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "res_mkquery(3) message size overflow"

            Errno
errno <- IO Errno
getErrno

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
reslen CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eOK) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    String -> IO ()
forall a. String -> IO a
throwErrno "res_query"

                String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "res_mkquery(3) failed"

            CStringLen -> IO ByteString
BS.packCStringLen (Ptr CChar
resptr, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
reslen)

  where
    -- The DNS protocol is inherently 16-bit-offset based; so 64KiB is
    -- a reasonable maximum message size most implementations seem to
    -- support.
    max_msg_size :: Num a => a
    max_msg_size :: a
max_msg_size = 0x10000

    qtypeVal :: CInt
    qtypeVal :: CInt
qtypeVal = case Type
qtype of Type w :: Word16
w -> Word16 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w


----------------------------------------------------------------------------
-- Common High-level queries

-- | Normalise 'Name'
--
-- This function case folds 'Name's as described in
-- in [RFC 4343, section 3](https://tools.ietf.org/html/rfc4343#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.
caseFoldName :: Name -> Name
caseFoldName :: Name -> Name
caseFoldName (Name n :: ByteString
n) = (ByteString -> Name
Name ByteString
n'')
  where
    n' :: ByteString
n' = (Word8 -> Word8) -> ByteString -> ByteString
BS.map Word8 -> Word8
forall p. (Ord p, Num p) => p -> p
cf ByteString
n
    n'' :: ByteString
n'' | ByteString -> Bool
BS.null ByteString
n' = "."
        | ByteString -> Word8
BS.last ByteString
n' Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x2e {- '.' -} = ByteString
n'
        | Bool
otherwise  = ByteString
n' ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` "."

    -- case fold (c.f. RFC4343)
    cf :: p -> p
cf w :: p
w | 0x61 p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
w Bool -> Bool -> Bool
&& p
w p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x7a  = p
w p -> p -> p
forall a. Num a => a -> a -> a
- 0x20
         | Bool
otherwise               = p
w

----------------------------------------------------------------------------

-- | Query @A@ record (see [RFC 1035, section 3.4.1](https://tools.ietf.org/html/rfc1035#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)]
--
queryA :: Name -> IO [(TTL,IPv4)]
queryA :: Name -> IO [(TTL, IPv4)]
queryA n :: Name
n = do
    Msg Name
res <- Class -> Name -> TypeSym -> IO (Msg Name)
forall n. IsLabels n => Class -> n -> TypeSym -> IO (Msg n)
query Class
classIN Name
n' TypeSym
TypeA
    [(TTL, IPv4)] -> IO [(TTL, IPv4)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ (TTL
ttl,IPv4
ip4) | MsgRR { rrData :: forall l. MsgRR l -> RData l
rrData = RDataA ip4 :: IPv4
ip4, rrTTL :: forall l. MsgRR l -> TTL
rrTTL = TTL
ttl, rrName :: forall l. MsgRR l -> l
rrName = Name
n1, rrClass :: forall l. MsgRR l -> Class
rrClass = Class 1 } <- Msg Name -> [MsgRR Name]
forall l. Msg l -> [MsgRR l]
msgAN Msg Name
res, Name -> Name
caseFoldName Name
n1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' ]
  where
    n' :: Name
n' = Name -> Name
caseFoldName Name
n

-- | Query @AAAA@ records (see [RFC 3596](https://tools.ietf.org/html/rfc3596)).
--
-- 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)]
--
queryAAAA :: Name -> IO [(TTL,IPv6)]
queryAAAA :: Name -> IO [(TTL, IPv6)]
queryAAAA n :: Name
n = do
    Msg Name
res <- Class -> Name -> TypeSym -> IO (Msg Name)
forall n. IsLabels n => Class -> n -> TypeSym -> IO (Msg n)
query Class
classIN Name
n' TypeSym
TypeAAAA
    [(TTL, IPv6)] -> IO [(TTL, IPv6)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ (TTL
ttl,IPv6
ip6) | MsgRR { rrData :: forall l. MsgRR l -> RData l
rrData = RDataAAAA ip6 :: IPv6
ip6, rrTTL :: forall l. MsgRR l -> TTL
rrTTL = TTL
ttl, rrName :: forall l. MsgRR l -> l
rrName = Name
n1, rrClass :: forall l. MsgRR l -> Class
rrClass = Class 1 } <- Msg Name -> [MsgRR Name]
forall l. Msg l -> [MsgRR l]
msgAN Msg Name
res, Name -> Name
caseFoldName Name
n1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' ]
  where
    n' :: Name
n' = Name -> Name
caseFoldName Name
n

-- | Query @CNAME@ records (see [RFC 1035, section 3.3.1](https://tools.ietf.org/html/rfc1035#section-3.3.1)).
--
-- >>> queryCNAME (Name "hackage.haskell.org")
-- [(TTL 299,Name "j.global-ssl.fastly.net.")]
--
queryCNAME :: Name -> IO [(TTL,Name)]
queryCNAME :: Name -> IO [(TTL, Name)]
queryCNAME n :: Name
n = do
    Msg Name
res <- Class -> Name -> TypeSym -> IO (Msg Name)
forall n. IsLabels n => Class -> n -> TypeSym -> IO (Msg n)
query Class
classIN Name
n' TypeSym
TypeAAAA
    [(TTL, Name)] -> IO [(TTL, Name)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ (TTL
ttl,Name
cname) | MsgRR { rrData :: forall l. MsgRR l -> RData l
rrData = RDataCNAME cname :: Name
cname, rrTTL :: forall l. MsgRR l -> TTL
rrTTL = TTL
ttl, rrName :: forall l. MsgRR l -> l
rrName = Name
n1, rrClass :: forall l. MsgRR l -> Class
rrClass = Class 1 } <- Msg Name -> [MsgRR Name]
forall l. Msg l -> [MsgRR l]
msgAN Msg Name
res, Name -> Name
caseFoldName Name
n1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' ]
  where
    n' :: Name
n' = Name -> Name
caseFoldName Name
n

-- | Query @TXT@ records (see [RFC 1035, section 3.3.14](https://tools.ietf.org/html/rfc1035#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/"])]
--
queryTXT :: Name -> IO [(TTL,[CharStr])]
queryTXT :: Name -> IO [(TTL, [CharStr])]
queryTXT n :: Name
n = do
    Msg Name
res <- Class -> Name -> TypeSym -> IO (Msg Name)
forall n. IsLabels n => Class -> n -> TypeSym -> IO (Msg n)
query Class
classIN Name
n' TypeSym
TypeTXT
    [(TTL, [CharStr])] -> IO [(TTL, [CharStr])]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ (TTL
ttl,[CharStr]
txts) | MsgRR { rrData :: forall l. MsgRR l -> RData l
rrData = RDataTXT txts :: [CharStr]
txts, rrTTL :: forall l. MsgRR l -> TTL
rrTTL = TTL
ttl, rrName :: forall l. MsgRR l -> l
rrName = Name
n1, rrClass :: forall l. MsgRR l -> Class
rrClass = Class 1 } <- Msg Name -> [MsgRR Name]
forall l. Msg l -> [MsgRR l]
msgAN Msg Name
res, Name -> Name
caseFoldName Name
n1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' ]
  where
    n' :: Name
n' = Name -> Name
caseFoldName Name
n

-- | Query @SRV@ records (see [RFC 2782](https://tools.ietf.org/html/rfc2782)).
--
-- >>> querySRV (Name "_imap._tcp.gmail.com")
-- [(TTL 21599,SRV {srvPriority = 0, srvWeight = 0, srvPort = 0, srvTarget = Name "."})]
--
querySRV :: Name -> IO [(TTL,SRV Name)]
querySRV :: Name -> IO [(TTL, SRV Name)]
querySRV n :: Name
n = do
    Msg Name
res <- Class -> Name -> TypeSym -> IO (Msg Name)
forall n. IsLabels n => Class -> n -> TypeSym -> IO (Msg n)
query Class
classIN Name
n' TypeSym
TypeSRV
    [(TTL, SRV Name)] -> IO [(TTL, SRV Name)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ (TTL
ttl,SRV Name
srv) | MsgRR { rrData :: forall l. MsgRR l -> RData l
rrData = RDataSRV srv :: SRV Name
srv, rrTTL :: forall l. MsgRR l -> TTL
rrTTL = TTL
ttl, rrName :: forall l. MsgRR l -> l
rrName = Name
n1, rrClass :: forall l. MsgRR l -> Class
rrClass = Class 1 } <- Msg Name -> [MsgRR Name]
forall l. Msg l -> [MsgRR l]
msgAN Msg Name
res, Name -> Name
caseFoldName Name
n1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' ]
  where
    n' :: Name
n' = Name -> Name
caseFoldName Name
n