-- |
-- Module      : Net.DNSBase.Resolver.Internal.Types
-- Description : Internal types for resolver configuration and handles
-- Copyright   : (c) IIJ Innovation Institute Inc., 2009
--               (c) Viktor Dukhovni, 2020-2026
-- License     : BSD-3-Clause
-- Maintainer  : ietf-dane@dukhovni.org
-- Stability   : unstable
{-# LANGUAGE RecordWildCards #-}

module Net.DNSBase.Resolver.Internal.Types
     (
     -- * Static resolver configuration
       ResolverConf(..)
     , NameserverConf(..)
     , NameserverSpec(..)
     , Nameserver(..)
     -- ** Derived resolver objects
     , ResolvSeed(..)
     , Resolver(..)
     , withResolver
     -- ** Resolver control structures
     , RDataMap
     , OptionMap
     , EdnsControls
     , QueryControls(
         QctlFlags
       , EdnsEnabled
       , EdnsDisabled
       , EdnsVersion
       , EdnsUdpSize
       , EdnsOptionCtl
       )
     -- * Resolver Monad
     , DNSIO
     , runDNSIO
     , liftDNS
     , makeQueryFlags
     ) where

import qualified Crypto.Random as C
import qualified Data.IORef as I
import Data.List (intercalate)
import Network.Socket (AddrInfo(..), PortNumber)

import Net.DNSBase.Decode.Internal.Option
import Net.DNSBase.EDNS.Internal.Option
import Net.DNSBase.Internal.EDNS
import Net.DNSBase.Internal.Error
import Net.DNSBase.Internal.Flags
import Net.DNSBase.Internal.RData
import Net.DNSBase.Internal.Util

-- | An opt-in monad for chaining multiple DNS operations with
-- short-circuit error handling.  The primary public API uses plain
-- @'IO' ('Either' 'DNSError' a)@; 'DNSIO' is a thin wrapper around
-- @'ExceptT' 'DNSError' 'IO'@ for users who prefer transformer-style
-- composition.  Convert between the two forms with 'runDNSIO' and
-- 'liftDNS'.
type DNSIO = ExceptT DNSError IO

-- | Run a 'DNSIO' computation and return its @'Either' 'DNSError' a@
-- result in plain 'IO'.
runDNSIO :: DNSIO a -> IO (Either DNSError a)
runDNSIO :: forall a. DNSIO a -> IO (Either DNSError a)
runDNSIO = ExceptT DNSError IO a -> IO (Either DNSError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

-- | Lift a plain @'IO' ('Either' 'DNSError' a)@ action into 'DNSIO',
-- for combining with other 'DNSIO' steps.
liftDNS :: IO (Either DNSError a) -> DNSIO a
liftDNS :: forall a. IO (Either DNSError a) -> DNSIO a
liftDNS = IO (Either DNSError a) -> ExceptT DNSError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT

-- | User-supplied resolver configuration.  Carries the caller's
-- choices: where nameservers come from, the per-attempt timeout
-- and retry budget, default 'QueryControls', and any
-- user-registered RR-type / EDNS option codecs.  Built-in defaults
-- are not stored here — they are merged into the effective
-- configuration only when 'Net.DNSBase.Resolver.makeResolvSeed' produces a 'ResolvSeed'.
data ResolverConf = ResolverConf
    { ResolverConf -> NameserverConf
rcSource    :: NameserverConf -- ^ Nameserver source: a resolver-conf file path or an explicit list.
    , ResolverConf -> Int
rcTimeout   :: Int            -- ^ Per-attempt timeout in microseconds.
    , ResolverConf -> Int
rcRetries   :: Int            -- ^ Maximum number of attempts, including the first.
    , ResolverConf -> QueryControls
rcQryCtls   :: QueryControls  -- ^ Default query-flag and EDNS controls.
    , ResolverConf -> RDataMap
rcRDataMap  :: RDataMap       -- ^ User-registered RR-type codecs, indexed by 'Net.DNSBase.RRTYPE.RRTYPE' code.
    , ResolverConf -> OptionMap
rcOptionMap :: OptionMap      -- ^ User-registered EDNS option codecs, indexed by 'Net.DNSBase.EDNS.OptNum.OptNum'.
    }

-- | Configuration file name, or explicit list of addresses/hostnames.
data NameserverConf = SourceFile FilePath
                    | HostList (NonEmpty NameserverSpec)

-- | Nameserver address string or hostname, with optional port.
--
data NameserverSpec = NameserverSpec
    { NameserverSpec -> String
nameserverName :: String
    , NameserverSpec -> Maybe PortNumber
nameserverPort :: Maybe PortNumber
    }

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

data Nameserver = Nameserver
    { Nameserver -> Maybe String
nsName :: Maybe String    -- ^ Hostname when specified
    , Nameserver -> AddrInfo
nsAddr :: AddrInfo        -- ^ Corresponding address
    }

instance Show Nameserver where
    showsPrec :: Int -> Nameserver -> ShowS
showsPrec Int
_ (Nameserver {Maybe String
AddrInfo
nsName :: Nameserver -> Maybe String
nsAddr :: Nameserver -> AddrInfo
nsName :: Maybe String
nsAddr :: AddrInfo
..}) =
        ShowS -> (String -> ShowS) -> Maybe String -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id String -> ShowS
showString Maybe String
nsName
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'['
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SockAddr -> ShowS
forall a. Show a => a -> ShowS
shows (AddrInfo -> SockAddr
addrAddress AddrInfo
nsAddr)
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']'

-- | Resolved, immutable resolver state built by 'Net.DNSBase.Resolver.makeResolvSeed'
-- from a 'ResolverConf'.  Combines the user's choices with the
-- library's built-in defaults: resolved nameserver addresses,
-- and the effective RR-type and EDNS-option codec maps with
-- user-registered code points overriding the library defaults
-- (except at a small set of protected code points, where
-- attempted user overrides are silently ignored).
--
-- A 'ResolvSeed' is safe to share across threads; each query-issuing
-- thread should call 'withResolver' on the same seed to obtain its
-- own per-thread 'Resolver' handle.
data ResolvSeed = ResolvSeed
    { ResolvSeed -> ResolverConf
seedConfig    :: ResolverConf       -- ^ Caller's original 'ResolverConf'.
    , ResolvSeed -> RDataMap
seedRDataMap  :: RDataMap           -- ^ Effective RR-type codec map.
    , ResolvSeed -> OptionMap
seedOptionMap :: OptionMap          -- ^ Effective EDNS option codec map.
    , ResolvSeed -> NonEmpty Nameserver
seedServers   :: NonEmpty Nameserver -- ^ Resolved nameserver endpoints.
    }

-- | Internal DNS Resolver handle, obtained via 'withResolver'.
-- Must not be used concurrently in multiple threads.
--
data Resolver = Resolver
    { Resolver -> ResolvSeed
resolvSeed :: ResolvSeed -- ^ Used to construct the resolver
    , Resolver -> IO Word64
resolvRng  :: IO Word64  -- ^ Resolver's RNG
    }

-- | Provide a 'Resolver' to the supplied action.  Concurrent use of a
-- single 'Resolver' is /not/ supported: the handle carries internal
-- mutable state and the library makes no soundness guarantees if it
-- is shared across threads.  Programs that issue queries from
-- multiple threads must call 'withResolver' once per worker thread
-- (typically inside @forkIO@) to obtain a separate handle.  The
-- 'ResolvSeed' itself is immutable and is the right object to share
-- across threads.
--
-- The action runs in plain 'IO'; DNS-protocol errors from individual
-- lookups appear in the @'Either' 'DNSError' a@ return shape of each
-- lookup function inside the action.  This function does not itself
-- produce or propagate 'DNSError's.
withResolver :: ResolvSeed -> (Resolver -> IO a) -> IO a
withResolver :: forall a. ResolvSeed -> (Resolver -> IO a) -> IO a
withResolver ResolvSeed
resolvSeed Resolver -> IO a
f = do
    resolvRng <- IORef ChaChaDRG -> IO Word64
getRandom (IORef ChaChaDRG -> IO Word64)
-> IO (IORef ChaChaDRG) -> IO (IO Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO ChaChaDRG
forall (randomly :: * -> *).
MonadRandom randomly =>
randomly ChaChaDRG
C.drgNew IO ChaChaDRG
-> (ChaChaDRG -> IO (IORef ChaChaDRG)) -> IO (IORef ChaChaDRG)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ChaChaDRG -> IO (IORef ChaChaDRG)
forall a. a -> IO (IORef a)
I.newIORef)
    f Resolver{..}
  where
    getRandom :: I.IORef C.ChaChaDRG -> IO Word64
    getRandom :: IORef ChaChaDRG -> IO Word64
getRandom IORef ChaChaDRG
ref = do
        gen <- IORef ChaChaDRG -> IO ChaChaDRG
forall a. IORef a -> IO a
I.readIORef IORef ChaChaDRG
ref
        let (bs, gen') = C.randomBytesGenerate 8 gen
            !w = ByteString -> Word64
word64be ByteString
bs
        w <$ I.writeIORef ref gen'

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

-- * Query control monoids

-- | Query controls consisting of an endomorphism over 'FlagOps' to modify
-- DNS flag bits, and an 'EdnsControls' structure to configure EDNS
-- behavior.
--
-- Constitutes a 'Monoid' with left-biased mappend operation
data QueryControls = QueryControls (FlagOps -> FlagOps) EdnsControls

instance Show QueryControls where
    showsPrec :: Int -> QueryControls -> ShowS
showsPrec Int
p (QueryControls FlagOps -> FlagOps
fctl EdnsControls
ectl) = Int -> ShowS -> ShowS
showsP Int
p (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"QueryControls "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagOps -> ShowS
forall a. Show a => a -> ShowS
shows' (FlagOps -> FlagOps
fctl FlagOps
emptyFlagOps) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EdnsControls -> ShowS
forall a. Show a => a -> ShowS
shows' EdnsControls
ectl

instance Semigroup QueryControls where
    (QueryControls FlagOps -> FlagOps
fl1 EdnsControls
edns1) <> :: QueryControls -> QueryControls -> QueryControls
<> (QueryControls FlagOps -> FlagOps
fl2 EdnsControls
edns2) =
        (FlagOps -> FlagOps) -> EdnsControls -> QueryControls
QueryControls (FlagOps -> FlagOps
fl1 (FlagOps -> FlagOps) -> (FlagOps -> FlagOps) -> FlagOps -> FlagOps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagOps -> FlagOps
fl2) (EdnsControls
edns1 EdnsControls -> EdnsControls -> EdnsControls
forall a. Semigroup a => a -> a -> a
<> EdnsControls
edns2)

instance Monoid QueryControls where
    mempty :: QueryControls
mempty = (FlagOps -> FlagOps) -> EdnsControls -> QueryControls
QueryControls FlagOps -> FlagOps
forall a. a -> a
id EdnsControls
forall a. Monoid a => a
mempty

-- | Apply the requested DNS flag operation, setting or clearing the requested
-- flag bits, or restoring defaults.
pattern QctlFlags :: (FlagOps -> FlagOps) -- ^ Desired 'FlagOps' modifier
                  -> QueryControls
pattern $mQctlFlags :: forall {r}.
QueryControls -> ((FlagOps -> FlagOps) -> r) -> ((# #) -> r) -> r
$bQctlFlags :: (FlagOps -> FlagOps) -> QueryControls
QctlFlags fl <- QueryControls fl _ where
    QctlFlags FlagOps -> FlagOps
fl = (FlagOps -> FlagOps) -> EdnsControls -> QueryControls
QueryControls FlagOps -> FlagOps
fl EdnsControls
forall a. Monoid a => a
mempty
{-# COMPLETE QctlFlags #-}

-- | Return the results of applying the flag query controls to the default
-- query flags, setting or clearing the requested flag bits.
makeQueryFlags :: QueryControls -> DNSFlags
makeQueryFlags :: QueryControls -> DNSFlags
makeQueryFlags (QctlFlags FlagOps -> FlagOps
op) = FlagOps -> DNSFlags -> DNSFlags
applyFlagOps (FlagOps -> FlagOps
op FlagOps
emptyFlagOps) DNSFlags
defaultQueryFlags

-- | EDNS query controls.  When EDNS is disabled via @ednsEnabled FlagClear@,
-- all the other EDNS-related overrides have no effect. Semigroup append is
-- left-biased
data EdnsControls = EdnsControls
    (Maybe Bool)             -- ^ Enabled
    (Maybe Word8)            -- ^ Version
    (Maybe Word16)           -- ^ UDP Size
    (OptionCtl -> OptionCtl) -- ^ EDNS option list tweaks

instance Semigroup EdnsControls where
    (EdnsControls Maybe Bool
en1 Maybe Word8
vn1 Maybe Word16
sz1 OptionCtl -> OptionCtl
od1) <> :: EdnsControls -> EdnsControls -> EdnsControls
<> (EdnsControls Maybe Bool
en2 Maybe Word8
vn2 Maybe Word16
sz2 OptionCtl -> OptionCtl
od2) =
        Maybe Bool
-> Maybe Word8
-> Maybe Word16
-> (OptionCtl -> OptionCtl)
-> EdnsControls
EdnsControls (Maybe Bool
en1 Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
en2) (Maybe Word8
vn1 Maybe Word8 -> Maybe Word8 -> Maybe Word8
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word8
vn2) (Maybe Word16
sz1 Maybe Word16 -> Maybe Word16 -> Maybe Word16
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word16
sz2) (OptionCtl -> OptionCtl
od1 (OptionCtl -> OptionCtl)
-> (OptionCtl -> OptionCtl) -> OptionCtl -> OptionCtl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionCtl -> OptionCtl
od2)

instance Monoid EdnsControls where
    mempty :: EdnsControls
mempty = Maybe Bool
-> Maybe Word8
-> Maybe Word16
-> (OptionCtl -> OptionCtl)
-> EdnsControls
EdnsControls Maybe Bool
forall a. Maybe a
Nothing Maybe Word8
forall a. Maybe a
Nothing Maybe Word16
forall a. Maybe a
Nothing OptionCtl -> OptionCtl
forall a. a -> a
id

instance Show EdnsControls where
    show :: EdnsControls -> String
show (EdnsControls Maybe Bool
en Maybe Word8
vn Maybe Word16
sz OptionCtl -> OptionCtl
od) =
        [String] -> String
_showOpts
            [ String -> Maybe Bool -> String
forall a. Show a => String -> Maybe a -> String
_showWord String
"edns.enabled" Maybe Bool
en
            , String -> Maybe Word8 -> String
forall a. Show a => String -> Maybe a -> String
_showWord String
"edns.version" Maybe Word8
vn
            , String -> Maybe Word16 -> String
forall a. Show a => String -> Maybe a -> String
_showWord String
"edns.udpsize" Maybe Word16
sz
            , String -> ShowS
_showOdOp String
"edns.options" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ OptionCtl -> String
forall a. Show a => a -> String
show
                                       (OptionCtl -> String) -> OptionCtl -> String
forall a b. (a -> b) -> a -> b
$ OptionCtl -> OptionCtl
od OptionCtl
emptyOptionCtl ]
      where
        _showOpts :: [String] -> String
        _showOpts :: [String] -> String
_showOpts [String]
os = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
os

        _showWord :: Show a => String -> Maybe a -> String
        _showWord :: forall a. Show a => String -> Maybe a -> String
_showWord String
nm Maybe a
w = String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\a
s -> String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
s) Maybe a
w

        _showOdOp :: String -> String -> String
        _showOdOp :: String -> ShowS
_showOdOp String
nm String
os = case String
os of
            String
"" -> String
""
            String
_  -> String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
os

-- | Enable EDNS for this query, overriding the resolver default
-- if it had EDNS disabled.  The OPT pseudo-RR is included in the
-- outgoing query.
pattern EdnsEnabled :: QueryControls
pattern $mEdnsEnabled :: forall {r}. QueryControls -> ((# #) -> r) -> ((# #) -> r) -> r
$bEdnsEnabled :: QueryControls
EdnsEnabled <-
    QueryControls _ (EdnsControls (Just True) _ _ _) where
    EdnsEnabled = (FlagOps -> FlagOps) -> EdnsControls -> QueryControls
QueryControls FlagOps -> FlagOps
forall a. a -> a
id (Maybe Bool
-> Maybe Word8
-> Maybe Word16
-> (OptionCtl -> OptionCtl)
-> EdnsControls
EdnsControls (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Maybe Word8
forall a. Maybe a
Nothing Maybe Word16
forall a. Maybe a
Nothing OptionCtl -> OptionCtl
forall a. a -> a
id)

-- | Disable EDNS for this query.  When EDNS is disabled, the OPT
-- pseudo-RR is omitted from the outgoing query and the other
-- EDNS-related tweaks ('EdnsVersion', 'EdnsUdpSize',
-- 'EdnsOptionCtl') have no effect on the wire.
pattern EdnsDisabled :: QueryControls
pattern $mEdnsDisabled :: forall {r}. QueryControls -> ((# #) -> r) -> ((# #) -> r) -> r
$bEdnsDisabled :: QueryControls
EdnsDisabled <-
    QueryControls _ (EdnsControls (Just False) _ _ _) where
    EdnsDisabled = (FlagOps -> FlagOps) -> EdnsControls -> QueryControls
QueryControls FlagOps -> FlagOps
forall a. a -> a
id (Maybe Bool
-> Maybe Word8
-> Maybe Word16
-> (OptionCtl -> OptionCtl)
-> EdnsControls
EdnsControls (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) Maybe Word8
forall a. Maybe a
Nothing Maybe Word16
forall a. Maybe a
Nothing OptionCtl -> OptionCtl
forall a. a -> a
id)

-- | Override the EDNS version advertised in the OPT pseudo-RR
-- for this query.  Only version @0@ is specified, and versions
-- other than @0@ are unlikely to be interoperable at present.
pattern EdnsVersion :: Word8 -- ^ Desired version
                    -> QueryControls
pattern $mEdnsVersion :: forall {r}. QueryControls -> (Word8 -> r) -> ((# #) -> r) -> r
$bEdnsVersion :: Word8 -> QueryControls
EdnsVersion vn <-
    QueryControls _ (EdnsControls _ (Just vn) _ _) where
    EdnsVersion Word8
vn = (FlagOps -> FlagOps) -> EdnsControls -> QueryControls
QueryControls FlagOps -> FlagOps
forall a. a -> a
id (Maybe Bool
-> Maybe Word8
-> Maybe Word16
-> (OptionCtl -> OptionCtl)
-> EdnsControls
EdnsControls Maybe Bool
forall a. Maybe a
Nothing (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
vn) Maybe Word16
forall a. Maybe a
Nothing OptionCtl -> OptionCtl
forall a. a -> a
id)

-- | Override the maximum UDP payload size the client advertises
-- to the server for this query.  The value is clamped to the
-- 'minUdpSize' / 'maxUdpSize' range.
pattern EdnsUdpSize :: Word16 -- ^ Desired size
                    -> QueryControls
pattern $mEdnsUdpSize :: forall {r}. QueryControls -> (Word16 -> r) -> ((# #) -> r) -> r
$bEdnsUdpSize :: Word16 -> QueryControls
EdnsUdpSize sz <-
    QueryControls _ (EdnsControls _ _ (Just sz) _) where
    EdnsUdpSize Word16
sz = (FlagOps -> FlagOps) -> EdnsControls -> QueryControls
QueryControls FlagOps -> FlagOps
forall a. a -> a
id (Maybe Bool
-> Maybe Word8
-> Maybe Word16
-> (OptionCtl -> OptionCtl)
-> EdnsControls
EdnsControls Maybe Bool
forall a. Maybe a
Nothing Maybe Word8
forall a. Maybe a
Nothing (Word16 -> Maybe Word16
forall a. a -> Maybe a
Just Word16
capped) OptionCtl -> OptionCtl
forall a. a -> a
id)
      where
        !capped :: Word16
capped = Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
max Word16
minUdpSize (Word16 -> Word16) -> (Word16 -> Word16) -> Word16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
min Word16
maxUdpSize (Word16 -> Word16) -> Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ Word16
sz

-- | Carry a per-call modification of the OPT pseudo-RR's EDNS
-- option list as an endomorphism @'OptionCtl' -> 'OptionCtl'@.
-- The endomorphism is applied to the resolver's ambient option
-- list at query-build time, so callers express deltas — clear
-- everything, add an option, replace an option — rather than full
-- replacements.
--
-- 'optCtlAdd' and 'optCtlSet' are the standard ways to build the
-- endomorphism.  For example, to opt out of geolocation-tailored
-- answers for a single query by signalling \"do not use my
-- subnet\" via ECS with a zero-length source prefix
-- ([RFC 7871 section 7.1.2](https://datatracker.ietf.org/doc/html/rfc7871#section-7.1.2)):
--
-- > let noEcs = EdnsOptionCtl
-- >           $ optCtlAdd [ EdnsOption
-- >                       $ O_ECS 0 0 (IPv4 (toIPv4 [0,0,0,0])) ]
-- >  in lookupAnswers rslv noEcs IN A $$(dnLit8 "example.org")
--
-- 'optCtlAdd' replaces the resolver's existing ECS option (if
-- any) with this one because they share an @OPTCODE@; other
-- options the resolver had configured pass through untouched.
-- 'optCtlSet' would instead clear the entire option list and use
-- only the supplied options.
pattern EdnsOptionCtl :: (OptionCtl -> OptionCtl)
                         -- ^ Selected modifier: optCtlAdd, ...
                      -> QueryControls
pattern $mEdnsOptionCtl :: forall {r}.
QueryControls
-> ((OptionCtl -> OptionCtl) -> r) -> ((# #) -> r) -> r
$bEdnsOptionCtl :: (OptionCtl -> OptionCtl) -> QueryControls
EdnsOptionCtl omod <-
    QueryControls _ (EdnsControls _ _ _ omod) where
    EdnsOptionCtl OptionCtl -> OptionCtl
omod = (FlagOps -> FlagOps) -> EdnsControls -> QueryControls
QueryControls FlagOps -> FlagOps
forall a. a -> a
id (Maybe Bool
-> Maybe Word8
-> Maybe Word16
-> (OptionCtl -> OptionCtl)
-> EdnsControls
EdnsControls Maybe Bool
forall a. Maybe a
Nothing Maybe Word8
forall a. Maybe a
Nothing Maybe Word16
forall a. Maybe a
Nothing OptionCtl -> OptionCtl
omod)
{-# COMPLETE EdnsOptionCtl #-}