{-|
Module      : Net.DNSBase.Resolver
Description : Stub resolver configuration and per-thread handles
Copyright   : (c) IIJ Innovation Institute Inc., 2009
              (c) Viktor Dukhovni, 2020-2026
License     : BSD-3-Clause
Maintainer  : ietf-dane@dukhovni.org
Stability   : unstable

The resolver is built in three stages:

1. 'ResolverConf' carries the caller's choices: nameserver
   source, per-attempt timeout, retry budget, default
   'QueryControls', and any user-registered RR-type or EDNS
   option codecs.  Build one by adjusting fields of
   'defaultResolvConf'.

2. 'makeResolvSeed' turns a 'ResolverConf' into a 'ResolvSeed':
   nameserver hostnames are resolved to addresses, and the
   user's codec registrations are merged with the library's
   built-in defaults.  The seed is immutable and safe to share
   across threads.

3. 'withResolver' produces a per-thread 'Resolver' handle from
   a shared seed.  A 'Resolver' carries thread-local mutable
   state (a CSPRNG for query IDs) and /must not/ be shared
   between threads — programs that issue queries concurrently
   should call 'withResolver' once per worker thread.

A minimal example:

> main :: IO ()
> main = do
>     seed <- makeResolvSeed defaultResolvConf >>= either throwIO pure
>     withResolver seed \ r ->
>         lookupA r $$(dnLit8 "example.com") >>= \ case
>             Left  e -> throwIO e
>             Right a -> print a

The codec set baked into the seed can be extended at
conf-build time via 'registerRRtype' / 'registerEdnsOption'
(new RR-type or EDNS-option codecs) and the four
'extendRRwithType' / 'extendRRwithValue' /
'extendEdnsOptionWithType' / 'extendEdnsOptionWithValue'
combinators (extensions onto codecs that admit them).  See
"Net.DNSBase.Extensible" for worked examples.
-}
{-# LANGUAGE RecordWildCards #-}

module Net.DNSBase.Resolver
  ( -- * Resolver configuration
    ResolverConf
  , defaultResolvConf
  , setResolverConfTimeout
  , setResolverConfRetries
  , setResolverConfQueryControls
  , setResolverConfSource
  , NameserverConf(..)
  , NameserverSpec(..)
  -- * Resolver seed
  , ResolvSeed
  , makeResolvSeed
  -- * Resolver instance
  , Resolver(resolvSeed, resolvRng)
  , withResolver
  -- * Look up 'RRTYPE' by name.
  , RRtypeNames
  , confTypeNames
  , rrtypeLookup
  -- * Controls.
  -- ** Query controls.
  , QueryControls(..)
  , EdnsControls
  -- ** Extending the codec set.
  --
  -- $extending
  , TypeExtensible(..)
  , KnownRData(..)
  , registerRRtype
  , extendRRwithType
  , extendRRwithValue
  , KnownEdnsOption(..)
  , registerEdnsOption
  , extendEdnsOptionWithType
  , extendEdnsOptionWithValue
  -- * Chained-composition opt-in
  --
  -- $dnsio
  , DNSIO
  , runDNSIO
  , liftDNS
  ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Builder.Extra as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Short as SB
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import qualified Data.Type.Equality as R
import qualified Type.Reflection as R
import Data.Char (chr)
import Data.String (fromString)
import Data.Void (Void)
import Network.Socket ( AddrInfo(..), AddrInfoFlag(..), HostName, PortNumber )
import Network.Socket ( ServiceName, SocketType(Datagram) )
import Network.Socket ( defaultHints, getAddrInfo )
import Numeric (readDec)
import Numeric.Natural (Natural)
import GHC.IO.Exception (IOErrorType(..))
import System.IO.Error (ioeSetErrorString, mkIOError, tryIOError)

import Net.DNSBase.Decode.Internal.Option
import Net.DNSBase.Decode.Internal.State
import Net.DNSBase.EDNS.Internal.Option
import Net.DNSBase.EDNS.Internal.OptNum
import Net.DNSBase.Encode.Internal.State
import Net.DNSBase.Internal.Error
import Net.DNSBase.Internal.Present
import Net.DNSBase.Internal.RData
import Net.DNSBase.Internal.RRTYPE
import Net.DNSBase.Internal.Util
import Net.DNSBase.Nat16
import Net.DNSBase.Resolver.Internal.Parser
import Net.DNSBase.Resolver.Internal.Types

import Net.DNSBase.EDNS.Option.ECS
import Net.DNSBase.EDNS.Option.EDE
import Net.DNSBase.EDNS.Option.NSID
import Net.DNSBase.EDNS.Option.Secalgs
import Net.DNSBase.Extensible (TypeExtensible(..), ValueExtensible(..))

-- Built-in RData type modules
import Net.DNSBase.RData.A
import Net.DNSBase.RData.CAA
import Net.DNSBase.RData.CSYNC
import Net.DNSBase.RData.Dnssec
-- Re-exported by Dnssec
-- import Net.DNSBase.RData.NSEC
import Net.DNSBase.RData.Obsolete
import Net.DNSBase.RData.SOA
import Net.DNSBase.RData.SRV
import Net.DNSBase.RData.SVCB
import Net.DNSBase.RData.TLSA
import Net.DNSBase.RData.TXT
-- Re-exported by Obsolete
-- import Net.DNSBase.RData.WKS
import Net.DNSBase.RData.XNAME

----

-- $dnsio
-- The primary API (e.g. 'makeResolvSeed', 'Net.DNSBase.Lookup.lookupAnswers') returns
-- @'IO' ('Either' 'DNSError' a)@: each call's error half is explicit
-- at the type level and the user's surrounding code stays in plain
-- 'IO'.  For programs that prefer transformer-style composition of
-- many DNS calls with short-circuit error handling, 'DNSIO' is a thin
-- alias for @'ExceptT' 'DNSError' 'IO'@; 'runDNSIO' and 'liftDNS'
-- convert between the two forms.

-- Set Resolver timeout
setResolverConfTimeout :: Int -> ResolverConf -> ResolverConf
setResolverConfTimeout :: Int -> ResolverConf -> ResolverConf
setResolverConfTimeout Int
t ResolverConf
rc = ResolverConf
rc {rcTimeout = t}

-- Set Resolver retries
setResolverConfRetries :: Int -> ResolverConf -> ResolverConf
setResolverConfRetries :: Int -> ResolverConf -> ResolverConf
setResolverConfRetries Int
n ResolverConf
rc = ResolverConf
rc {rcRetries = n}

-- Set Resolver configuration source
setResolverConfSource :: NameserverConf -> ResolverConf -> ResolverConf
setResolverConfSource :: NameserverConf -> ResolverConf -> ResolverConf
setResolverConfSource NameserverConf
s ResolverConf
rc = ResolverConf
rc {rcSource = s}

-- Set Resolver query controls
setResolverConfQueryControls :: QueryControls -> ResolverConf -> ResolverConf
setResolverConfQueryControls :: QueryControls -> ResolverConf -> ResolverConf
setResolverConfQueryControls QueryControls
q ResolverConf
rc = ResolverConf
rc {rcQryCtls = q}

-- $extending
-- The resolver knows about a set of RR-type and EDNS-option
-- codecs at conf-build time.  'registerRRtype' and
-- 'registerEdnsOption' install a fresh codec entry at the
-- type's default extension value; the four
-- 'extendRRwithType' / 'extendRRwithValue' /
-- 'extendEdnsOptionWithType' / 'extendEdnsOptionWithValue'
-- combinators fold typed or value-driven extensions onto an
-- already-extensible codec's existing entry.  See
-- "Net.DNSBase.Extensible" for worked examples and the design
-- behind the two extension flavours.
--
-- User registrations take precedence over the library's
-- built-in codec set, except at a small number of /protected/
-- code points (e.g. the SVCB @mandatory@ key), where attempted
-- user additions are silently ignored.

-- | Register a decoder for an RR-type.
-- If the RR's data type is itself extensible, you can
-- use 'extendRRwithType' or 'extendRRwithValue' to
-- apply additional extensions on top.
--
-- The registration takes precedence over the library's built-in
-- codec at the same RR-type code, except at protected code
-- points (e.g. RR-type 0 and 65535, or the OPT pseudo-RR), where
-- the registration is silently ignored.
registerRRtype :: forall a -> KnownRData a
               => ResolverConf -> ResolverConf
registerRRtype :: forall a -> KnownRData a => ResolverConf -> ResolverConf
registerRRtype a ResolverConf
rc =
    ResolverConf
rc { rcRDataMap = IM.insert key entry (rcRDataMap rc) }
  where
    key :: Int
key   = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (RRTYPE -> Word16) -> RRTYPE -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RRTYPE -> Word16
forall a b. Coercible a b => a -> b
coerce (RRTYPE -> Int) -> RRTYPE -> Int
forall a b. (a -> b) -> a -> b
$ rdType a
    entry :: RDataCodec
entry = Proxy a -> RDataExtensionVal a -> RDataCodec
forall a.
KnownRData a =>
Proxy a -> RDataExtensionVal a -> RDataCodec
RDataCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (rdataExtensionVal a)

-- | Extend the registered codec of a type-extensible RR type @t@
-- with an additional typed extension @b@.  If @t@ is not yet
-- known it is automatically registered, in either case 'extendByType'
-- is then applied to the existing decoder state to fold in @b@.
--
-- This is how one adds an extra SvcParam-key decoder for SVCB
-- and/or HTTPS records.
--
-- > conf
-- >     & extendRRwithType T_svcb  MyParamType
-- >     & extendRRwithType T_https MyParamType
--
extendRRwithType :: forall t ->
                    ( KnownRData t
                    , TypeExtensible t (RDataExtensionVal t)
                    )
                 => forall b -> TypeExtensionArg t b
                 => ResolverConf -> ResolverConf
extendRRwithType :: forall t ->
(KnownRData t, TypeExtensible t (RDataExtensionVal t)) =>
forall b -> TypeExtensionArg t b => ResolverConf -> ResolverConf
extendRRwithType t b ResolverConf
rc =
    ResolverConf
rc { rcRDataMap = IM.insert key entry (rcRDataMap rc) }
  where
    key :: Int
key      = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (RRTYPE -> Word16) -> RRTYPE -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RRTYPE -> Word16
forall a b. Coercible a b => a -> b
coerce (RRTYPE -> Int) -> RRTYPE -> Int
forall a b. (a -> b) -> a -> b
$ rdType t
    baseline :: RDataExtensionVal t
baseline = case Int -> IntMap RDataCodec -> Maybe RDataCodec
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key (ResolverConf -> IntMap RDataCodec
rcRDataMap ResolverConf
rc) of
        Just (RDataCodec (Proxy a
_ :: Proxy a) RDataExtensionVal a
opts)
            | Just t :~: a
R.Refl <- TypeRep t -> TypeRep a -> Maybe (t :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
R.testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @t) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
            -> RDataExtensionVal t
RDataExtensionVal a
opts
        Maybe RDataCodec
_   -> rdataExtensionVal t
    entry :: RDataCodec
entry    = Proxy t -> RDataExtensionVal t -> RDataCodec
forall a.
KnownRData a =>
Proxy a -> RDataExtensionVal a -> RDataCodec
RDataCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t) ((t ~ t, TypeExtensionArg t b) =>
RDataExtensionVal t -> RDataExtensionVal t
RDataExtensionVal t -> RDataExtensionVal t
forall b ->
(t ~ t, TypeExtensionArg t b) =>
RDataExtensionVal t -> RDataExtensionVal t
forall t b ->
(t ~ t, TypeExtensionArg t b) =>
RDataExtensionVal t -> RDataExtensionVal t
forall a v.
TypeExtensible a v =>
forall t b -> (t ~ a, TypeExtensionArg t b) => v -> v
extendByType t b RDataExtensionVal t
baseline)

-- | Register an EDNS option decoder.
-- If the EDNS option\'s data type is itself extensible, you can
-- use 'extendEdnsOptionWithType' or 'extendEdnsOptionWithValue' to
-- apply additional extensions on top.
--
-- The registration takes precedence over the library's built-in
-- decoder at the same option code (if any) after the merge step
-- in 'makeResolvSeed'.
registerEdnsOption :: forall a -> KnownEdnsOption a
                   => ResolverConf -> ResolverConf
registerEdnsOption :: forall a -> KnownEdnsOption a => ResolverConf -> ResolverConf
registerEdnsOption a ResolverConf
rc =
    ResolverConf
rc { rcOptionMap = IM.insert key entry (rcOptionMap rc) }
  where
    key :: Int
key   = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (OptNum -> Word16) -> OptNum -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptNum -> Word16
forall a b. Coercible a b => a -> b
coerce (OptNum -> Int) -> OptNum -> Int
forall a b. (a -> b) -> a -> b
$ optNum a
    entry :: OptionCodec
entry = Proxy a -> OptionExtensionVal a -> OptionCodec
forall a.
KnownEdnsOption a =>
Proxy a -> OptionExtensionVal a -> OptionCodec
OptionCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (optionExtensionVal a)

-- | Extend the registered decoder for a type-extensible EDNS option
-- type @t@ with an additional typed extension @b@.  If @t@ is not
-- yet present in the resolver configuration, it is first registered,
-- in either case 'extendByType' is then applied fold in @b@.
--
-- This is the EDNS-option-side parallel to 'extendRRwithType'.
extendEdnsOptionWithType :: forall t ->
                            ( KnownEdnsOption t
                            , TypeExtensible t (OptionExtensionVal t)
                            )
                         => forall b -> TypeExtensionArg t b
                         => ResolverConf -> ResolverConf
extendEdnsOptionWithType :: forall t ->
(KnownEdnsOption t, TypeExtensible t (OptionExtensionVal t)) =>
forall b -> TypeExtensionArg t b => ResolverConf -> ResolverConf
extendEdnsOptionWithType t b ResolverConf
rc =
    ResolverConf
rc { rcOptionMap = IM.insert key entry (rcOptionMap rc) }
  where
    key :: Int
key      = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (OptNum -> Word16) -> OptNum -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptNum -> Word16
forall a b. Coercible a b => a -> b
coerce (OptNum -> Int) -> OptNum -> Int
forall a b. (a -> b) -> a -> b
$ optNum t
    baseline :: OptionExtensionVal t
baseline = case Int -> IntMap OptionCodec -> Maybe OptionCodec
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key (ResolverConf -> IntMap OptionCodec
rcOptionMap ResolverConf
rc) of
        Just (OptionCodec (Proxy a
_ :: Proxy a) OptionExtensionVal a
opts)
            | Just t :~: a
R.Refl <- TypeRep t -> TypeRep a -> Maybe (t :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
R.testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @t) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
            -> OptionExtensionVal t
OptionExtensionVal a
opts
        Maybe OptionCodec
_   -> optionExtensionVal t
    entry :: OptionCodec
entry    = Proxy t -> OptionExtensionVal t -> OptionCodec
forall a.
KnownEdnsOption a =>
Proxy a -> OptionExtensionVal a -> OptionCodec
OptionCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t) ((t ~ t, TypeExtensionArg t b) =>
OptionExtensionVal t -> OptionExtensionVal t
OptionExtensionVal t -> OptionExtensionVal t
forall b ->
(t ~ t, TypeExtensionArg t b) =>
OptionExtensionVal t -> OptionExtensionVal t
forall t b ->
(t ~ t, TypeExtensionArg t b) =>
OptionExtensionVal t -> OptionExtensionVal t
forall a v.
TypeExtensible a v =>
forall t b -> (t ~ a, TypeExtensionArg t b) => v -> v
extendByType t b OptionExtensionVal t
baseline)

-- | Extend the registered codec for RR type @t@ with a
-- caller-supplied value @v@, whose type satisfies @t@'s
-- 'ValueExtensionArg' constraint.  Parallel to
-- 'extendRRwithType', but for instances whose extension table
-- is keyed by runtime data rather than user-supplied types.
extendRRwithValue :: forall t ->
                     ( KnownRData t
                     , ValueExtensible t (RDataExtensionVal t)
                     )
                  => forall b. ValueExtensionArg t b
                  => b -> ResolverConf -> ResolverConf
extendRRwithValue :: forall t ->
forall b.
(KnownRData t, ValueExtensible t (RDataExtensionVal t),
 ValueExtensionArg t b) =>
b -> ResolverConf -> ResolverConf
extendRRwithValue t b
v ResolverConf
rc =
    ResolverConf
rc { rcRDataMap = IM.insert key entry (rcRDataMap rc) }
  where
    key :: Int
key      = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (RRTYPE -> Word16) -> RRTYPE -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RRTYPE -> Word16
forall a b. Coercible a b => a -> b
coerce (RRTYPE -> Int) -> RRTYPE -> Int
forall a b. (a -> b) -> a -> b
$ rdType t
    baseline :: RDataExtensionVal t
baseline = case Int -> IntMap RDataCodec -> Maybe RDataCodec
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key (ResolverConf -> IntMap RDataCodec
rcRDataMap ResolverConf
rc) of
        Just (RDataCodec (Proxy a
_ :: Proxy a) RDataExtensionVal a
opts)
            | Just t :~: a
R.Refl <- TypeRep t -> TypeRep a -> Maybe (t :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
R.testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @t) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
            -> RDataExtensionVal t
RDataExtensionVal a
opts
        Maybe RDataCodec
_   -> rdataExtensionVal t
    entry :: RDataCodec
entry    = Proxy t -> RDataExtensionVal t -> RDataCodec
forall a.
KnownRData a =>
Proxy a -> RDataExtensionVal a -> RDataCodec
RDataCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t) (b -> RDataExtensionVal t -> RDataExtensionVal t
forall b.
(t ~ t, ValueExtensionArg t b) =>
b -> RDataExtensionVal t -> RDataExtensionVal t
forall t ->
forall b.
(t ~ t, ValueExtensionArg t b) =>
b -> RDataExtensionVal t -> RDataExtensionVal t
forall b.
ValueExtensionArg t b =>
b -> RDataExtensionVal t -> RDataExtensionVal t
forall a v.
ValueExtensible a v =>
forall t -> forall b. (t ~ a, ValueExtensionArg t b) => b -> v -> v
extendByValue t b
v RDataExtensionVal t
baseline)

-- | Extend the registered codec for EDNS option type @t@ with
-- a caller-supplied value @v@, whose type satisfies @t@'s
-- 'ValueExtensionArg' constraint.  The EDNS-option-side
-- parallel to 'extendRRwithValue'.  This is the canonical way
-- to add an EDE info-code → friendly-name mapping:
--
-- > conf
-- >     & extendEdnsOptionWithValue O_ede (33, "Frobnicated")
-- >     & extendEdnsOptionWithValue O_ede (34, "Bogosity")
extendEdnsOptionWithValue :: forall t ->
                             ( KnownEdnsOption t
                             , ValueExtensible t (OptionExtensionVal t)
                             )
                          => forall b. ValueExtensionArg t b
                          => b -> ResolverConf -> ResolverConf
extendEdnsOptionWithValue :: forall t ->
forall b.
(KnownEdnsOption t, ValueExtensible t (OptionExtensionVal t),
 ValueExtensionArg t b) =>
b -> ResolverConf -> ResolverConf
extendEdnsOptionWithValue t b
v ResolverConf
rc =
    ResolverConf
rc { rcOptionMap = IM.insert key entry (rcOptionMap rc) }
  where
    key :: Int
key      = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (OptNum -> Word16) -> OptNum -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptNum -> Word16
forall a b. Coercible a b => a -> b
coerce (OptNum -> Int) -> OptNum -> Int
forall a b. (a -> b) -> a -> b
$ optNum t
    baseline :: OptionExtensionVal t
baseline = case Int -> IntMap OptionCodec -> Maybe OptionCodec
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key (ResolverConf -> IntMap OptionCodec
rcOptionMap ResolverConf
rc) of
        Just (OptionCodec (Proxy a
_ :: Proxy a) OptionExtensionVal a
opts)
            | Just t :~: a
R.Refl <- TypeRep t -> TypeRep a -> Maybe (t :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
R.testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @t) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @a)
            -> OptionExtensionVal t
OptionExtensionVal a
opts
        Maybe OptionCodec
_   -> optionExtensionVal t
    entry :: OptionCodec
entry    = Proxy t -> OptionExtensionVal t -> OptionCodec
forall a.
KnownEdnsOption a =>
Proxy a -> OptionExtensionVal a -> OptionCodec
OptionCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t) (b -> OptionExtensionVal t -> OptionExtensionVal t
forall b.
(t ~ t, ValueExtensionArg t b) =>
b -> OptionExtensionVal t -> OptionExtensionVal t
forall t ->
forall b.
(t ~ t, ValueExtensionArg t b) =>
b -> OptionExtensionVal t -> OptionExtensionVal t
forall b.
ValueExtensionArg t b =>
b -> OptionExtensionVal t -> OptionExtensionVal t
forall a v.
ValueExtensible a v =>
forall t -> forall b. (t ~ a, ValueExtensionArg t b) => b -> v -> v
extendByValue t b
v OptionExtensionVal t
baseline)


-- | Build a 'ResolvSeed' from a 'ResolverConf'.  The seed is
-- immutable and safely shared across threads; each thread then
-- calls 'withResolver' to obtain its own 'Resolver'.
--
-- The configured nameservers are resolved to socket addresses,
-- and the user's codec registrations (from 'registerRRtype',
-- 'extendRRwithType' and 'registerEdnsOption') are combined with the
-- library's built-in codec set.  At each RR-type or EDNS option
-- code point, the user-registered codec takes precedence over the
-- library default — except at a small set of /protected/ code
-- points (e.g. the SVCB @mandatory@ key), where any attempted
-- user override is silently ignored.
--
-- Returns @'Left' err@ if the configured nameservers cannot be
-- resolved or the configuration file cannot be parsed.
--
-- Example:
--
-- >>> seed <- makeResolvSeed defaultResolvConf >>= either throwIO pure
--
makeResolvSeed :: ResolverConf -> IO (Either DNSError ResolvSeed)
makeResolvSeed :: ResolverConf -> IO (Either DNSError ResolvSeed)
makeResolvSeed ResolverConf
conf = DNSIO ResolvSeed -> IO (Either DNSError ResolvSeed)
forall a. DNSIO a -> IO (Either DNSError a)
runDNSIO do
    seedServers <- DNSIO (NonEmpty Nameserver)
findAddresses
    let !seedRDataMap  = IntMap RDataCodec
reservedCodecs
                        IntMap RDataCodec -> IntMap RDataCodec -> IntMap RDataCodec
forall a. IntMap a -> IntMap a -> IntMap a
`IM.union` (ResolverConf -> IntMap RDataCodec
rcRDataMap ResolverConf
conf IntMap RDataCodec -> IntMap RDataCodec -> IntMap RDataCodec
forall a. IntMap a -> IntMap a -> IntMap a
`IM.union` IntMap RDataCodec
defaultCodecs)
        !seedOptionMap = ResolverConf -> IntMap OptionCodec
rcOptionMap ResolverConf
conf IntMap OptionCodec -> IntMap OptionCodec -> IntMap OptionCodec
forall a. IntMap a -> IntMap a -> IntMap a
`IM.union` IntMap OptionCodec
baseOptions
        seedConfig     = ResolverConf
conf
    pure ResolvSeed{..}
  where
    findAddresses :: DNSIO (NonEmpty Nameserver)
    findAddresses :: DNSIO (NonEmpty Nameserver)
findAddresses = case ResolverConf -> NameserverConf
rcSource ResolverConf
conf of
        HostList NonEmpty NameserverSpec
rs     -> NonEmpty (NonEmpty Nameserver) -> NonEmpty Nameserver
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (NonEmpty (NonEmpty Nameserver) -> NonEmpty Nameserver)
-> ExceptT DNSError IO (NonEmpty (NonEmpty Nameserver))
-> DNSIO (NonEmpty Nameserver)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NameserverSpec -> DNSIO (NonEmpty Nameserver))
-> NonEmpty NameserverSpec
-> ExceptT DNSError IO (NonEmpty (NonEmpty Nameserver))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM NameserverSpec -> DNSIO (NonEmpty Nameserver)
getNameserverAddresses NonEmpty NameserverSpec
rs
        SourceFile FilePath
file -> FilePath -> DNSIO [NameserverSpec]
getDefaultNameservers FilePath
file DNSIO [NameserverSpec]
-> ([NameserverSpec] -> DNSIO (NonEmpty Nameserver))
-> DNSIO (NonEmpty Nameserver)
forall a b.
ExceptT DNSError IO a
-> (a -> ExceptT DNSError IO b) -> ExceptT DNSError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [NameserverSpec] -> DNSIO (NonEmpty Nameserver)
mkAddrs

    getNameserverAddresses :: NameserverSpec -> DNSIO (NonEmpty Nameserver)
getNameserverAddresses (NameserverSpec FilePath
h Maybe PortNumber
mp) = Maybe FilePath -> Maybe PortNumber -> DNSIO (NonEmpty Nameserver)
makeAddrInfo (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
h) Maybe PortNumber
mp

    -- When /etc/resolv.conf contains no addresses, default to the loopback address,
    -- by passing 'Nothing' for the server name.
    mkAddrs :: [NameserverSpec] -> DNSIO (NonEmpty Nameserver)
mkAddrs []     = Maybe FilePath -> Maybe PortNumber -> DNSIO (NonEmpty Nameserver)
makeAddrInfo Maybe FilePath
forall a. Maybe a
Nothing Maybe PortNumber
forall a. Maybe a
Nothing
    mkAddrs (NameserverSpec
l:[NameserverSpec]
ls) = NonEmpty (NonEmpty Nameserver) -> NonEmpty Nameserver
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (NonEmpty (NonEmpty Nameserver) -> NonEmpty Nameserver)
-> ExceptT DNSError IO (NonEmpty (NonEmpty Nameserver))
-> DNSIO (NonEmpty Nameserver)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NameserverSpec -> DNSIO (NonEmpty Nameserver))
-> NonEmpty NameserverSpec
-> ExceptT DNSError IO (NonEmpty (NonEmpty Nameserver))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM NameserverSpec -> DNSIO (NonEmpty Nameserver)
getNameserverAddresses (NameserverSpec
l NameserverSpec -> [NameserverSpec] -> NonEmpty NameserverSpec
forall a. a -> [a] -> NonEmpty a
:| [NameserverSpec]
ls)


-- | Default resolver configuration, with nameserver list from
-- @\/etc\/resolv.conf@ and no user-registered codec extensions.
defaultResolvConf :: ResolverConf
defaultResolvConf :: ResolverConf
defaultResolvConf = ResolverConf
    { rcSource :: NameserverConf
rcSource    = FilePath -> NameserverConf
SourceFile FilePath
"/etc/resolv.conf"
    , rcTimeout :: Int
rcTimeout   = Int
3_000_000  -- 3 seconds
    , rcRetries :: Int
rcRetries   = Int
3
    , rcQryCtls :: QueryControls
rcQryCtls   = QueryControls
forall a. Monoid a => a
mempty
    , rcRDataMap :: IntMap RDataCodec
rcRDataMap  = IntMap RDataCodec
forall a. IntMap a
IM.empty
    , rcOptionMap :: IntMap OptionCodec
rcOptionMap = IntMap OptionCodec
forall a. IntMap a
IM.empty
    }

-- | Determines whether a HostName is a valid IPv4 or IPv6 address
--
-- Also false if input is an IPv4 or IPv6 address with trailing characters,
-- or in the (impossible) case of multiple valid parses
isAddr :: HostName -> Bool
isAddr :: FilePath -> Bool
isAddr FilePath
addr =
    case forall a. Read a => ReadS a
reads @IP FilePath
addr of
        [(IP
_,FilePath
r)] -> FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r
        [(IP, FilePath)]
_       -> Bool
False

makeAddrInfo :: Maybe HostName -> Maybe PortNumber -> DNSIO (NonEmpty Nameserver)
makeAddrInfo :: Maybe FilePath -> Maybe PortNumber -> DNSIO (NonEmpty Nameserver)
makeAddrInfo Maybe FilePath
maddr Maybe PortNumber
mport = do
    let flags :: [AddrInfoFlag]
flags | Bool
addrLiteral = AddrInfoFlag
AI_NUMERICHOST AddrInfoFlag -> [AddrInfoFlag] -> [AddrInfoFlag]
forall a. a -> [a] -> [a]
: [AddrInfoFlag]
defaultFlags
              | Bool
otherwise   = [AddrInfoFlag]
defaultFlags
        hints :: AddrInfo
hints = AddrInfo
defaultHints {addrFlags = flags, addrSocketType = Datagram}
        serv :: FilePath
serv = FilePath
-> (PortNumber -> FilePath) -> Maybe PortNumber -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"53" PortNumber -> FilePath
forall a. Show a => a -> FilePath
show Maybe PortNumber
mport

    -- getAddrInfo should never return an empty list (it raises an IO exception instead),
    -- but just in case, handle empty results.
    (IOException -> DNSError)
-> ExceptT IOException IO [AddrInfo]
-> ExceptT DNSError IO [AddrInfo]
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT IOException -> DNSError
BadNameserver (AddrInfo
-> Maybe FilePath -> FilePath -> ExceptT IOException IO [AddrInfo]
getAddrInfo' AddrInfo
hints Maybe FilePath
maddr FilePath
serv) ExceptT DNSError IO [AddrInfo]
-> ([AddrInfo] -> DNSIO (NonEmpty Nameserver))
-> DNSIO (NonEmpty Nameserver)
forall a b.
ExceptT DNSError IO a
-> (a -> ExceptT DNSError IO b) -> ExceptT DNSError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
        AddrInfo
a : [AddrInfo]
as -> NonEmpty Nameserver -> DNSIO (NonEmpty Nameserver)
forall a. a -> ExceptT DNSError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty Nameserver -> DNSIO (NonEmpty Nameserver))
-> NonEmpty Nameserver -> DNSIO (NonEmpty Nameserver)
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> AddrInfo -> Nameserver
Nameserver Maybe FilePath
addrName (AddrInfo -> Nameserver)
-> NonEmpty AddrInfo -> NonEmpty Nameserver
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddrInfo
a AddrInfo -> [AddrInfo] -> NonEmpty AddrInfo
forall a. a -> [a] -> NonEmpty a
:| [AddrInfo]
as
        [AddrInfo]
_      -> let host :: FilePath
host = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultHostName Maybe FilePath
maddr
                      ioe :: IOException
ioe = IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOException
mkIOError IOErrorType
NoSuchThing FilePath
host Maybe Handle
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing
                   in DNSError -> DNSIO (NonEmpty Nameserver)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (DNSError -> DNSIO (NonEmpty Nameserver))
-> DNSError -> DNSIO (NonEmpty Nameserver)
forall a b. (a -> b) -> a -> b
$ IOException -> DNSError
BadNameserver (IOException -> DNSError) -> IOException -> DNSError
forall a b. (a -> b) -> a -> b
$ IOException -> FilePath -> IOException
ioeSetErrorString IOException
ioe FilePath
"Host unknown"
  where
    defaultFlags :: [AddrInfoFlag]
defaultFlags = [AddrInfoFlag
AI_NUMERICSERV, AddrInfoFlag
AI_ADDRCONFIG]
    defaultHostName :: FilePath
defaultHostName = FilePath
"localhost"
    addrLiteral :: Bool
addrLiteral = Bool -> (FilePath -> Bool) -> Maybe FilePath -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False FilePath -> Bool
isAddr Maybe FilePath
maddr
    addrName :: Maybe FilePath
addrName | Bool
addrLiteral = Maybe FilePath
forall a. Maybe a
Nothing
             | Bool
otherwise   = Maybe FilePath
maddr Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
defaultHostName

getAddrInfo' :: AddrInfo -> Maybe HostName -> ServiceName -> ExceptT IOError IO [AddrInfo]
getAddrInfo' :: AddrInfo
-> Maybe FilePath -> FilePath -> ExceptT IOException IO [AddrInfo]
getAddrInfo' AddrInfo
h Maybe FilePath
a FilePath
s = IO (Either IOException [AddrInfo])
-> ExceptT IOException IO [AddrInfo]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either IOException [AddrInfo])
 -> ExceptT IOException IO [AddrInfo])
-> IO (Either IOException [AddrInfo])
-> ExceptT IOException IO [AddrInfo]
forall a b. (a -> b) -> a -> b
$ IO [AddrInfo] -> IO (Either IOException [AddrInfo])
forall a. IO a -> IO (Either IOException a)
tryIOError (Maybe AddrInfo -> Maybe FilePath -> Maybe FilePath -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo
-> Maybe FilePath -> Maybe FilePath -> IO (t AddrInfo)
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
h) Maybe FilePath
a (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
s))

---------- RRTYPE lookups

-- | Mapping from @RRTYPE@ name to 'RRTYPE' code.
newtype RRtypeNames = RRNames_ (M.Map SB.ShortByteString RRTYPE)

-- | Attempt to find an RRTYPE' by name.  The lookup map can be constructed
-- via 'confTypeNames', and should be reused for multiple lookups when
-- possible.
--
-- - The input name is not case-senstive.
-- - Names of the form @TYPE@/num/ (with /num/ the type number) are supported,
--   and return the corresponding 'RRTYPE'.
rrtypeLookup :: B.ByteString
             -> RRtypeNames
             -> Maybe RRTYPE
rrtypeLookup :: ByteString -> RRtypeNames -> Maybe RRTYPE
rrtypeLookup ((,) (Int -> [Word8] -> (Int, [Word8]))
-> (ByteString -> Int) -> ByteString -> [Word8] -> (Int, [Word8])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Int
B.length (ByteString -> [Word8] -> (Int, [Word8]))
-> (ByteString -> [Word8]) -> ByteString -> (Int, [Word8])
forall a b.
(ByteString -> a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> [Word8]
B.unpack -> (Int
len, [Word8]
ws)) (RRtypeNames -> Map ShortByteString RRTYPE
forall a b. Coercible a b => a -> b
coerce -> Map ShortByteString RRTYPE
m)
    | t :: Maybe RRTYPE
t@(Just RRTYPE
_) <- ShortByteString -> Map ShortByteString RRTYPE -> Maybe RRTYPE
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ShortByteString
name Map ShortByteString RRTYPE
m
    = Maybe RRTYPE
t
    | ShortByteString -> ShortByteString -> Bool
SB.isPrefixOf ShortByteString
rrtypePrefix ShortByteString
name
    , FilePath
digits <- (Word8 -> Char) -> [Word8] -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> FilePath) -> [Word8] -> FilePath
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop (ShortByteString -> Int
SB.length ShortByteString
rrtypePrefix) [Word8]
ws
    , [(Natural
w, FilePath
"")] <- forall a. (Eq a, Num a) => ReadS a
readDec @Natural FilePath
digits
    , Natural
w Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Natural Word16
forall a. Bounded a => a
maxBound
    = RRTYPE -> Maybe RRTYPE
forall a. a -> Maybe a
Just (RRTYPE -> Maybe RRTYPE) -> RRTYPE -> Maybe RRTYPE
forall a b. (a -> b) -> a -> b
$! Word16 -> RRTYPE
RRTYPE (Word16 -> RRTYPE) -> Word16 -> RRTYPE
forall a b. (a -> b) -> a -> b
$ Natural -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
w
    | Bool
otherwise
    = Maybe RRTYPE
forall a. Maybe a
Nothing
  where
    name :: ShortByteString
name = Int -> [Word8] -> ShortByteString
forall a. Integral a => a -> [Word8] -> ShortByteString
foldShort Int
len [Word8]
ws

-- | Construct a map of type names to 'RRTYPE' from a given
-- 'ResolvSeed' value.  This will include both the names of all
-- the registered known types and the names of all known RRtypes,
-- whether implemented or not.
--
-- The map is is not cached, compute it once and reuse for
-- repeated queries.
--
confTypeNames :: Maybe ResolvSeed -> RRtypeNames
confTypeNames :: Maybe ResolvSeed -> RRtypeNames
confTypeNames Maybe ResolvSeed
cnf =
    Map ShortByteString RRTYPE -> RRtypeNames
forall a b. Coercible a b => a -> b
coerce (Map ShortByteString RRTYPE -> RRtypeNames)
-> Map ShortByteString RRTYPE -> RRtypeNames
forall a b. (a -> b) -> a -> b
$ Map ShortByteString RRTYPE
-> (ResolvSeed -> Map ShortByteString RRTYPE)
-> Maybe ResolvSeed
-> Map ShortByteString RRTYPE
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map ShortByteString RRTYPE
forall k a. Map k a
M.empty ResolvSeed -> Map ShortByteString RRTYPE
cnfMap Maybe ResolvSeed
cnf Map ShortByteString RRTYPE
-> Map ShortByteString RRTYPE -> Map ShortByteString RRTYPE
forall a. Semigroup a => a -> a -> a
<> [(ShortByteString, RRTYPE)] -> Map ShortByteString RRTYPE
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(ShortByteString, RRTYPE)]
knownNames
  where
    cnfMap :: ResolvSeed -> Map ShortByteString RRTYPE
cnfMap ResolvSeed {seedRDataMap :: ResolvSeed -> IntMap RDataCodec
seedRDataMap = IntMap RDataCodec
dm} =
        [(ShortByteString, RRTYPE)] -> Map ShortByteString RRTYPE
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ShortByteString, RRTYPE)] -> Map ShortByteString RRTYPE)
-> [(ShortByteString, RRTYPE)] -> Map ShortByteString RRTYPE
forall a b. (a -> b) -> a -> b
$ ((Int, RDataCodec) -> (ShortByteString, RRTYPE))
-> [(Int, RDataCodec)] -> [(ShortByteString, RRTYPE)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> RDataCodec -> (ShortByteString, RRTYPE))
-> (Int, RDataCodec) -> (ShortByteString, RRTYPE)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> RDataCodec -> (ShortByteString, RRTYPE)
forall {p}.
Integral p =>
p -> RDataCodec -> (ShortByteString, RRTYPE)
mkPair) ([(Int, RDataCodec)] -> [(ShortByteString, RRTYPE)])
-> [(Int, RDataCodec)] -> [(ShortByteString, RRTYPE)]
forall a b. (a -> b) -> a -> b
$ IntMap RDataCodec -> [(Int, RDataCodec)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap RDataCodec
dm
      where
        mkPair :: p -> RDataCodec -> (ShortByteString, RRTYPE)
mkPair p
k (RDataCodec Proxy a
p RDataExtensionVal a
_) =
            (Proxy a -> ShortByteString
forall a. KnownRData a => Proxy a -> ShortByteString
proxyName Proxy a
p, Word16 -> RRTYPE
RRTYPE (Word16 -> RRTYPE) -> Word16 -> RRTYPE
forall a b. (a -> b) -> a -> b
$ p -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
k)
        proxyName :: forall a. KnownRData a
                  => Proxy a -> SB.ShortByteString
        proxyName :: forall a. KnownRData a => Proxy a -> ShortByteString
proxyName Proxy a
_ = Builder -> ShortByteString
buildShort (Builder -> ShortByteString) -> Builder -> ShortByteString
forall a b. (a -> b) -> a -> b
$ (a ~ a) => Builder -> Builder
Builder -> Builder
forall b -> (b ~ a) => Builder -> Builder
forall a. KnownRData a => forall b -> (b ~ a) => Builder -> Builder
rdTypePres a Builder
forall a. Monoid a => a
mempty

    knownNames :: [(ShortByteString, RRTYPE)]
knownNames = [ (ShortByteString
name, RRTYPE
t)
                 | RRTYPE
t <- [RRTYPE
A .. RRTYPE
rrtypeMax]
                 , let name :: ShortByteString
name = Builder -> ShortByteString
buildShort (Builder -> ShortByteString) -> Builder -> ShortByteString
forall a b. (a -> b) -> a -> b
$ RRTYPE -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present RRTYPE
t Builder
forall a. Monoid a => a
mempty
                 , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ShortByteString -> Bool
SB.isPrefixOf ShortByteString
rrtypePrefix ShortByteString
name ]

    buildShort :: Builder -> ShortByteString
buildShort = (Int64 -> [Word8] -> ShortByteString
forall a. Integral a => a -> [Word8] -> ShortByteString
foldShort (Int64 -> [Word8] -> ShortByteString)
-> (LazyByteString -> Int64)
-> LazyByteString
-> [Word8]
-> ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LazyByteString -> Int64
LB.length (LazyByteString -> [Word8] -> ShortByteString)
-> (LazyByteString -> [Word8]) -> LazyByteString -> ShortByteString
forall a b.
(LazyByteString -> a -> b)
-> (LazyByteString -> a) -> LazyByteString -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LazyByteString -> [Word8]
LB.unpack) (LazyByteString -> ShortByteString)
-> (Builder -> LazyByteString) -> Builder -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
buildLazy
    buildLazy :: Builder -> LazyByteString
buildLazy = AllocationStrategy -> LazyByteString -> Builder -> LazyByteString
B.toLazyByteStringWith (Int -> Int -> AllocationStrategy
B.untrimmedStrategy Int
16 Int
32) LazyByteString
forall a. Monoid a => a
mempty

foldShort :: Integral a => a -> [Word8] -> SB.ShortByteString
foldShort :: forall a. Integral a => a -> [Word8] -> ShortByteString
foldShort a
len = (ShortByteString, Maybe [Word8]) -> ShortByteString
forall a b. (a, b) -> a
fst ((ShortByteString, Maybe [Word8]) -> ShortByteString)
-> ([Word8] -> (ShortByteString, Maybe [Word8]))
-> [Word8]
-> ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ([Word8] -> Maybe (Word8, [Word8]))
-> [Word8]
-> (ShortByteString, Maybe [Word8])
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ShortByteString, Maybe a)
SB.unfoldrN (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len) [Word8] -> Maybe (Word8, [Word8])
forall {a}. (Ord a, Num a) => [a] -> Maybe (a, [a])
low8
  where
    low8 :: [a] -> Maybe (a, [a])
low8 [] = Maybe (a, [a])
forall a. Maybe a
Nothing
    low8 (a
w:[a]
ws) | a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
0x41 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
26 = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
w a -> a -> a
forall a. Num a => a -> a -> a
+ a
0x20, [a]
ws)
                | Bool
otherwise     = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
w, [a]
ws)

rrtypePrefix :: SB.ShortByteString
rrtypePrefix :: ShortByteString
rrtypePrefix = FilePath -> ShortByteString
forall a. IsString a => FilePath -> a
fromString FilePath
"type"

-------------------------------
--- RData and Option codec maps

-- | Placeholder for reserved RRTYPEs.
type Reserved :: Nat -> Type
data Reserved n = Reserved_ Void deriving (Reserved n -> Reserved n -> Bool
(Reserved n -> Reserved n -> Bool)
-> (Reserved n -> Reserved n -> Bool) -> Eq (Reserved n)
forall (n :: Natural). Reserved n -> Reserved n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (n :: Natural). Reserved n -> Reserved n -> Bool
== :: Reserved n -> Reserved n -> Bool
$c/= :: forall (n :: Natural). Reserved n -> Reserved n -> Bool
/= :: Reserved n -> Reserved n -> Bool
Eq, Eq (Reserved n)
Eq (Reserved n) =>
(Reserved n -> Reserved n -> Ordering)
-> (Reserved n -> Reserved n -> Bool)
-> (Reserved n -> Reserved n -> Bool)
-> (Reserved n -> Reserved n -> Bool)
-> (Reserved n -> Reserved n -> Bool)
-> (Reserved n -> Reserved n -> Reserved n)
-> (Reserved n -> Reserved n -> Reserved n)
-> Ord (Reserved n)
Reserved n -> Reserved n -> Bool
Reserved n -> Reserved n -> Ordering
Reserved n -> Reserved n -> Reserved n
forall (n :: Natural). Eq (Reserved n)
forall (n :: Natural). Reserved n -> Reserved n -> Bool
forall (n :: Natural). Reserved n -> Reserved n -> Ordering
forall (n :: Natural). Reserved n -> Reserved n -> Reserved n
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: forall (n :: Natural). Reserved n -> Reserved n -> Ordering
compare :: Reserved n -> Reserved n -> Ordering
$c< :: forall (n :: Natural). Reserved n -> Reserved n -> Bool
< :: Reserved n -> Reserved n -> Bool
$c<= :: forall (n :: Natural). Reserved n -> Reserved n -> Bool
<= :: Reserved n -> Reserved n -> Bool
$c> :: forall (n :: Natural). Reserved n -> Reserved n -> Bool
> :: Reserved n -> Reserved n -> Bool
$c>= :: forall (n :: Natural). Reserved n -> Reserved n -> Bool
>= :: Reserved n -> Reserved n -> Bool
$cmax :: forall (n :: Natural). Reserved n -> Reserved n -> Reserved n
max :: Reserved n -> Reserved n -> Reserved n
$cmin :: forall (n :: Natural). Reserved n -> Reserved n -> Reserved n
min :: Reserved n -> Reserved n -> Reserved n
Ord, Int -> Reserved n -> ShowS
[Reserved n] -> ShowS
Reserved n -> FilePath
(Int -> Reserved n -> ShowS)
-> (Reserved n -> FilePath)
-> ([Reserved n] -> ShowS)
-> Show (Reserved n)
forall (n :: Natural). Int -> Reserved n -> ShowS
forall (n :: Natural). [Reserved n] -> ShowS
forall (n :: Natural). Reserved n -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (n :: Natural). Int -> Reserved n -> ShowS
showsPrec :: Int -> Reserved n -> ShowS
$cshow :: forall (n :: Natural). Reserved n -> FilePath
show :: Reserved n -> FilePath
$cshowList :: forall (n :: Natural). [Reserved n] -> ShowS
showList :: [Reserved n] -> ShowS
Show)
instance (Nat16 n) => KnownRData (Reserved n) where
    rdType :: forall b -> (b ~ Reserved n) => RRTYPE
rdType _ = Word16 -> RRTYPE
RRTYPE (Word16 -> RRTYPE) -> Word16 -> RRTYPE
forall a b. (a -> b) -> a -> b
$ natToWord16 n
    rdTypePres :: forall b -> (b ~ Reserved n) => Builder -> Builder
rdTypePres _ = forall a. Presentable a => a -> Builder -> Builder
present @String FilePath
"Reserved" (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present (natToWord16 n)
    rdEncode :: forall s. Reserved n -> SPut s RData
rdEncode Reserved n
_   = (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s RData
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith ((forall a. ErrorContext a => a -> EncodeErr a) -> SPut s RData)
-> (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s RData
forall a b. (a -> b) -> a -> b
$ RRTYPE -> a -> EncodeErr a
forall r. (Typeable r, Show r, Eq r) => RRTYPE -> r -> EncodeErr r
ReservedType (RRTYPE -> a -> EncodeErr a) -> RRTYPE -> a -> EncodeErr a
forall a b. (a -> b) -> a -> b
$ Word16 -> RRTYPE
RRTYPE (Word16 -> RRTYPE) -> Word16 -> RRTYPE
forall a b. (a -> b) -> a -> b
$ natToWord16 n
    rdDecode :: forall b ->
(b ~ Reserved n) =>
RDataExtensionVal (Reserved n) -> Int -> SGet RData
rdDecode _ RDataExtensionVal (Reserved n)
_ = SGet RData -> Int -> SGet RData
forall a b. a -> b -> a
const do
        FilePath -> SGet RData
forall a. FilePath -> SGet a
failSGet (FilePath -> SGet RData) -> FilePath -> SGet RData
forall a b. (a -> b) -> a -> b
$ FilePath
"Reserved RDATA type: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> FilePath
forall a. Show a => a -> FilePath
show (natToWord16 n)
instance (Nat16 n) => Presentable (Reserved n) where
    present :: Reserved n -> Builder -> Builder
present Reserved n
_ = Builder -> Builder
forall a. HasCallStack => a
undefined

-- Internal helper: build the 'RDataMap' entry for type @a@ from
-- its 'Net.DNSBase.RData.rdataExtensionVal'.
rdataMapEntry :: forall a -> KnownRData a => (Int, RDataCodec)
rdataMapEntry :: forall a -> KnownRData a => (Int, RDataCodec)
rdataMapEntry a =
    ( forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (RRTYPE -> Word16) -> RRTYPE -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RRTYPE -> Word16
forall a b. Coercible a b => a -> b
coerce (RRTYPE -> Int) -> RRTYPE -> Int
forall a b. (a -> b) -> a -> b
$ rdType a
    , Proxy a -> RDataExtensionVal a -> RDataCodec
forall a.
KnownRData a =>
Proxy a -> RDataExtensionVal a -> RDataCodec
RDataCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (rdataExtensionVal a)
    )

-- | Reserved RR-type slots: codes that the protocol forbids as
-- RDATA (RFC 6895 reserved code 0 and sentinel 65535), that the
-- library handles outside the RDATA codec map (OPT, code 41), or
-- that are meta-query types with no carriable RDATA (NXNAME,
-- TKEY, TSIG, IXFR, AXFR, MAILB, MAILA, ANY).
--
-- The merge step in 'Net.DNSBase.Resolver.makeResolvSeed' protects these entries from
-- user override: any user-supplied registration at one of these
-- codes is dropped in favour of the reserved entry.
reservedCodecs :: RDataMap
reservedCodecs :: IntMap RDataCodec
reservedCodecs = [(Int, RDataCodec)] -> IntMap RDataCodec
forall a. [(Int, a)] -> IntMap a
IM.fromList
    [ rdataMapEntry (Reserved 0)         -- 0 RFC6895
    , rdataMapEntry (Reserved 41)        -- 41 OPT (hardwired)
      ---- Special-use types
    , rdataMapEntry (Reserved 128)       -- NXNAME
    , rdataMapEntry (Reserved 249)       -- TKEY
    , rdataMapEntry (Reserved 250)       -- TSIG
    , rdataMapEntry (Reserved 251)       -- IXFR
    , rdataMapEntry (Reserved 252)       -- AXFR
      ---- Query-only types
    , rdataMapEntry (Reserved 253)       -- MAILB
    , rdataMapEntry (Reserved 254)       -- MAILA
    , rdataMapEntry (Reserved 255)       -- ANY
      ----
    , rdataMapEntry (Reserved 65535)     -- Reserved
    ]

-- | Built-in default codecs for the RR-types the library decodes
-- natively.  Disjoint from 'reservedCodecs'.
--
-- These act as fallbacks: a user-supplied registration for any
-- of these RR-types takes precedence over the built-in entry.
-- The merge step in 'Net.DNSBase.Resolver.makeResolvSeed' resolves overlaps in the
-- user's favour, so a caller can replace a built-in decoder with
-- their own without forking the library.
defaultCodecs :: RDataMap
defaultCodecs :: IntMap RDataCodec
defaultCodecs = [(Int, RDataCodec)] -> IntMap RDataCodec
forall a. [(Int, a)] -> IntMap a
IM.fromList
    [ rdataMapEntry T_a                  -- 1
    , rdataMapEntry T_ns                 -- 2
    , rdataMapEntry T_md                 -- 3
    , rdataMapEntry T_mf                 -- 4
    , rdataMapEntry T_cname              -- 5
    , rdataMapEntry T_soa                -- 6
    , rdataMapEntry T_mb                 -- 7
    , rdataMapEntry T_mg                 -- 8
    , rdataMapEntry T_mr                 -- 9
    , rdataMapEntry T_null               -- 10
    , rdataMapEntry T_wks                -- 11
    , rdataMapEntry T_ptr                -- 12
    , rdataMapEntry T_hinfo              -- 13
    , rdataMapEntry T_minfo              -- 14
    , rdataMapEntry T_mx                 -- 15
    , rdataMapEntry T_txt                -- 16
    , rdataMapEntry T_rp                 -- 17
    , rdataMapEntry T_afsdb              -- 18
    , rdataMapEntry T_x25                -- 19
    , rdataMapEntry T_isdn               -- 20
    , rdataMapEntry T_rt                 -- 21
    , rdataMapEntry T_nsap               -- 22
    , rdataMapEntry T_nsapptr            -- 23
    , rdataMapEntry T_sig                -- 24
    , rdataMapEntry T_key                -- 25
    , rdataMapEntry T_px                 -- 26
    , rdataMapEntry T_gpos               -- 27
    , rdataMapEntry T_aaaa               -- 28
                                         -- 29 LOC
    , rdataMapEntry T_nxt                -- 30
                                         -- 31 EID
                                         -- 32 NIMLOC
    , rdataMapEntry T_srv                -- 33
                                         -- 34 ATMA
    , rdataMapEntry T_naptr              -- 35
    , rdataMapEntry T_kx                 -- 36
                                         -- 37 CERT
    , rdataMapEntry T_a6                 -- 38
    , rdataMapEntry T_dname              -- 39
                                         -- 40 SINK
                                         -- 42 APL
    , rdataMapEntry T_ds                 -- 43
    , rdataMapEntry T_sshfp              -- 44
    , rdataMapEntry T_ipseckey           -- 45 IPSECKEY
    , rdataMapEntry T_rrsig              -- 46
    , rdataMapEntry T_nsec               -- 47
    , rdataMapEntry T_dnskey             -- 48
                                         -- 49 DHCID
    , rdataMapEntry T_nsec3              -- 50
    , rdataMapEntry T_nsec3param         -- 51
    , rdataMapEntry T_tlsa               -- 52
    , rdataMapEntry T_smimea             -- 53
                                         -- 54 Unassigned
                                         -- 55 HIP
                                         -- 56 NINFO
                                         -- 57 RKEY
                                         -- 58 TALINK
    , rdataMapEntry T_cds                -- 59
    , rdataMapEntry T_cdnskey            -- 60
    , rdataMapEntry T_openpgpkey         -- 61
    , rdataMapEntry T_csync              -- 62 CSYNC
    , rdataMapEntry T_zonemd             -- 63
    , rdataMapEntry T_svcb               -- 64
    , rdataMapEntry T_https              -- 65
    , rdataMapEntry T_dsync              -- 66
                                         -- 67 HHIT
                                         -- 68 BRID
                                         -- 99 SPF
    , rdataMapEntry T_nid                -- 104 NID
    , rdataMapEntry T_l32                -- 105 L32
    , rdataMapEntry T_l64                -- 106 L64
    , rdataMapEntry T_lp                 -- 107 LP
                                         -- 108 EUI48 [RFC7043]
                                         -- 109 EUI64 [RFC7043]
    , rdataMapEntry T_caa                -- 257
    , rdataMapEntry T_amtrelay           -- 260
                                         -- 261 RESINFO
                                         -- 262 WALLET
                                         -- 263 CLA
                                         -- 264 IPN
    ]

-- | Built-in EDNS option codecs.  User registrations from
-- 'Net.DNSBase.Resolver.registerEdnsOption' /
-- 'Net.DNSBase.Resolver.extendEdnsOptionWithType' take
-- precedence over entries here after the merge step in
-- 'Net.DNSBase.Resolver.makeResolvSeed'.
baseOptions :: OptionMap
baseOptions :: IntMap OptionCodec
baseOptions = [(Int, OptionCodec)] -> IntMap OptionCodec
forall a. [(Int, a)] -> IntMap a
IM.fromList
    [ optMapEntry O_nsid                                 -- 3 NSID
    , optMapEntry O_dau                                  -- 5 DAU
    , optMapEntry O_dhu                                  -- 6 DHU
    , optMapEntry O_n3u                                  -- 7 N3U
    , optMapEntry O_ecs                                  -- 8 ECS
    , optMapEntry O_ede                                  -- 15 EDE
    ]
  where
    optMapEntry :: forall a -> KnownEdnsOption a => (Int, OptionCodec)
    optMapEntry :: forall a -> KnownEdnsOption a => (Int, OptionCodec)
optMapEntry a =
        ( forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (OptNum -> Word16) -> OptNum -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptNum -> Word16
forall a b. Coercible a b => a -> b
coerce (OptNum -> Int) -> OptNum -> Int
forall a b. (a -> b) -> a -> b
$ optNum a
        , Proxy a -> OptionExtensionVal a -> OptionCodec
forall a.
KnownEdnsOption a =>
Proxy a -> OptionExtensionVal a -> OptionCodec
OptionCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (optionExtensionVal a)
        )