From 6cff21a4f644a0a53106cdea239fb9b055cc07b3 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 19 Feb 2026 08:05:28 +0900 Subject: [PATCH 1/5] better naming: HeaderControls -> FlagControls --- dnsext-do53/DNS/Do53/Client.hs | 2 +- dnsext-do53/DNS/Do53/Query.hs | 32 ++++++++++++++++---------------- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/dnsext-do53/DNS/Do53/Client.hs b/dnsext-do53/DNS/Do53/Client.hs index df5a6a108..89c9cc4fb 100644 --- a/dnsext-do53/DNS/Do53/Client.hs +++ b/dnsext-do53/DNS/Do53/Client.hs @@ -61,7 +61,7 @@ module DNS.Do53.Client ( -- ** Query control QueryControls (..), - HeaderControls (..), + FlagControls (..), EdnsControls (..), FlagOp (..), rdFlag, diff --git a/dnsext-do53/DNS/Do53/Query.hs b/dnsext-do53/DNS/Do53/Query.hs index 42d31bb96..15dde20d1 100644 --- a/dnsext-do53/DNS/Do53/Query.hs +++ b/dnsext-do53/DNS/Do53/Query.hs @@ -2,7 +2,7 @@ module DNS.Do53.Query ( QueryControls (..), - HeaderControls (..), + FlagControls (..), EdnsControls (..), FlagOp (..), rdFlag, @@ -66,7 +66,7 @@ import qualified Data.Semigroup as Sem -- :} -- edns.version:1,edns.options:[NSID,ClientSubnet] data QueryControls = QueryControls - { qctlHeader :: HeaderControls + { qctlFlag :: FlagControls , qctlEdns :: EdnsControls } deriving (Eq) @@ -93,21 +93,21 @@ instance Show QueryControls where -- >>> rdFlag FlagClear -- rd:0 rdFlag :: FlagOp -> QueryControls -rdFlag rd = mempty{qctlHeader = mempty{rdBit = rd}} +rdFlag rd = mempty{qctlFlag = mempty{rdBit = rd}} -- | Generator of 'QueryControls' that adjusts the AD (Authentic Data) bit. -- -- >>> adFlag FlagSet -- ad:1 adFlag :: FlagOp -> QueryControls -adFlag ad = mempty{qctlHeader = mempty{adBit = ad}} +adFlag ad = mempty{qctlFlag = mempty{adBit = ad}} -- | Generator of 'QueryControls' that adjusts the CD (Checking Disabled) bit. -- -- >>> cdFlag FlagSet -- cd:1 cdFlag :: FlagOp -> QueryControls -cdFlag cd = mempty{qctlHeader = mempty{cdBit = cd}} +cdFlag cd = mempty{qctlFlag = mempty{cdBit = cd}} -- | Generator of 'QueryControls' that enables or disables EDNS support. -- When EDNS is disabled, the rest of the 'EDNS' controls are ignored. @@ -154,27 +154,27 @@ ednsSetOptions od = mempty{qctlEdns = mempty{extOd = od}} -- | Control over query-related DNS header flags. As with function composition, -- the left-most value has the last say. -data HeaderControls = HeaderControls +data FlagControls = FlagControls { rdBit :: FlagOp , adBit :: FlagOp , cdBit :: FlagOp } deriving (Eq) -instance Sem.Semigroup HeaderControls where - (HeaderControls rd1 ad1 cd1) <> (HeaderControls rd2 ad2 cd2) = - HeaderControls (rd1 <> rd2) (ad1 <> ad2) (cd1 <> cd2) +instance Sem.Semigroup FlagControls where + (FlagControls rd1 ad1 cd1) <> (FlagControls rd2 ad2 cd2) = + FlagControls (rd1 <> rd2) (ad1 <> ad2) (cd1 <> cd2) -instance Monoid HeaderControls where - mempty = HeaderControls FlagKeep FlagKeep FlagKeep +instance Monoid FlagControls where + mempty = FlagControls FlagKeep FlagKeep FlagKeep #if !(MIN_VERSION_base(4,11,0)) -- this is redundant starting with base-4.11 / GHC 8.4 -- if you want to avoid CPP, you can define `mappend = (<>)` unconditionally mappend = (Sem.<>) #endif -instance Show HeaderControls where - show (HeaderControls rd ad cd) = +instance Show FlagControls where + show (FlagControls rd ad cd) = _showOpts [ _showFlag "rd" rd , _showFlag "ad" ad @@ -378,7 +378,7 @@ queryControls -> a queryControls h ctls = h (queryDNSFlags hctls) (queryEdns ehctls) where - hctls = qctlHeader ctls + hctls = qctlFlag ctls ehctls = qctlEdns ctls -- \| Apply the given 'FlagOp' to a default boolean value to produce the final @@ -416,8 +416,8 @@ queryControls h ctls = h (queryDNSFlags hctls) (queryEdns ehctls) -- resolvers based on the resulting configuration, with the exception of -- 'DNS.Do53.lookupRawCtl' which takes an additional -- 'QueryControls' argument to augment the default overrides. - queryDNSFlags :: HeaderControls -> DNSFlags -> DNSFlags - queryDNSFlags (HeaderControls rd ad cd) d = + queryDNSFlags :: FlagControls -> DNSFlags -> DNSFlags + queryDNSFlags (FlagControls rd ad cd) d = d { recDesired = applyFlag rd $ recDesired d , authenData = applyFlag ad $ authenData d From 578e7287eec42d535200e4b5d102214adbcd69c8 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 19 Feb 2026 08:13:34 +0900 Subject: [PATCH 2/5] implementing aaFlag --- dnsext-do53/DNS/Do53/Query.hs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/dnsext-do53/DNS/Do53/Query.hs b/dnsext-do53/DNS/Do53/Query.hs index 15dde20d1..5a03343dc 100644 --- a/dnsext-do53/DNS/Do53/Query.hs +++ b/dnsext-do53/DNS/Do53/Query.hs @@ -9,6 +9,7 @@ module DNS.Do53.Query ( adFlag, cdFlag, doFlag, + aaFlag, ednsEnabled, ednsSetVersion, ednsSetUdpSize, @@ -102,6 +103,9 @@ rdFlag rd = mempty{qctlFlag = mempty{rdBit = rd}} adFlag :: FlagOp -> QueryControls adFlag ad = mempty{qctlFlag = mempty{adBit = ad}} +aaFlag :: FlagOp -> QueryControls +aaFlag aa = mempty{qctlFlag = mempty{aaBit = aa}} + -- | Generator of 'QueryControls' that adjusts the CD (Checking Disabled) bit. -- -- >>> cdFlag FlagSet @@ -158,15 +162,16 @@ data FlagControls = FlagControls { rdBit :: FlagOp , adBit :: FlagOp , cdBit :: FlagOp + , aaBit :: FlagOp } deriving (Eq) instance Sem.Semigroup FlagControls where - (FlagControls rd1 ad1 cd1) <> (FlagControls rd2 ad2 cd2) = - FlagControls (rd1 <> rd2) (ad1 <> ad2) (cd1 <> cd2) + (FlagControls rd1 ad1 cd1 aa1) <> (FlagControls rd2 ad2 cd2 aa2) = + FlagControls (rd1 <> rd2) (ad1 <> ad2) (cd1 <> cd2) (aa1 <> aa2) instance Monoid FlagControls where - mempty = FlagControls FlagKeep FlagKeep FlagKeep + mempty = FlagControls FlagKeep FlagKeep FlagKeep FlagKeep #if !(MIN_VERSION_base(4,11,0)) -- this is redundant starting with base-4.11 / GHC 8.4 -- if you want to avoid CPP, you can define `mappend = (<>)` unconditionally @@ -174,11 +179,12 @@ instance Monoid FlagControls where #endif instance Show FlagControls where - show (FlagControls rd ad cd) = + show (FlagControls rd ad cd aa) = _showOpts [ _showFlag "rd" rd , _showFlag "ad" ad , _showFlag "cd" cd + , _showFlag "aa" aa ] ---------------------------------------------------------------- @@ -417,9 +423,10 @@ queryControls h ctls = h (queryDNSFlags hctls) (queryEdns ehctls) -- 'DNS.Do53.lookupRawCtl' which takes an additional -- 'QueryControls' argument to augment the default overrides. queryDNSFlags :: FlagControls -> DNSFlags -> DNSFlags - queryDNSFlags (FlagControls rd ad cd) d = + queryDNSFlags (FlagControls rd ad cd aa) d = d { recDesired = applyFlag rd $ recDesired d , authenData = applyFlag ad $ authenData d , chkDisable = applyFlag cd $ chkDisable d + , authAnswer = applyFlag aa $ authAnswer d } From fd2257758aada6805e7e3e02c86f550cef9aab77 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 19 Feb 2026 08:32:27 +0900 Subject: [PATCH 3/5] implementing CodeControls --- dnsext-do53/DNS/Do53/Internal.hs | 1 + dnsext-do53/DNS/Do53/Query.hs | 58 ++++++++++++++++++++++++++++---- 2 files changed, 52 insertions(+), 7 deletions(-) diff --git a/dnsext-do53/DNS/Do53/Internal.hs b/dnsext-do53/DNS/Do53/Internal.hs index 8a042629d..2b56e21c1 100644 --- a/dnsext-do53/DNS/Do53/Internal.hs +++ b/dnsext-do53/DNS/Do53/Internal.hs @@ -44,6 +44,7 @@ module DNS.Do53.Internal ( encodeQuery, modifyQuery, queryControls, + CodeControls (..), -- * Generating identifier singleGenId, diff --git a/dnsext-do53/DNS/Do53/Query.hs b/dnsext-do53/DNS/Do53/Query.hs index 5a03343dc..066e9eb10 100644 --- a/dnsext-do53/DNS/Do53/Query.hs +++ b/dnsext-do53/DNS/Do53/Query.hs @@ -4,6 +4,7 @@ module DNS.Do53.Query ( QueryControls (..), FlagControls (..), EdnsControls (..), + CodeControls (..), FlagOp (..), rdFlag, adFlag, @@ -69,15 +70,16 @@ import qualified Data.Semigroup as Sem data QueryControls = QueryControls { qctlFlag :: FlagControls , qctlEdns :: EdnsControls + , qctlCode :: CodeControls } deriving (Eq) instance Sem.Semigroup QueryControls where - (QueryControls fl1 ex1) <> (QueryControls fl2 ex2) = - QueryControls (fl1 <> fl2) (ex1 <> ex2) + (QueryControls fl1 ex1 cc1) <> (QueryControls fl2 ex2 cc2) = + QueryControls (fl1 <> fl2) (ex1 <> ex2) (cc1 <> cc2) instance Monoid QueryControls where - mempty = QueryControls mempty mempty + mempty = QueryControls mempty mempty mempty #if !(MIN_VERSION_base(4,11,0)) -- this is redundant starting with base-4.11 / GHC 8.4 -- if you want to avoid CPP, you can define `mappend = (<>)` unconditionally @@ -85,7 +87,7 @@ instance Monoid QueryControls where #endif instance Show QueryControls where - show (QueryControls fl ex) = _showOpts [show fl, show ex] + show (QueryControls fl ex cc) = _showOpts [show fl, show ex, show cc] ---------------------------------------------------------------- @@ -296,6 +298,34 @@ instance Show EdnsControls where ---------------------------------------------------------------- +data CodeControls = CodeControls + { ccOpcode :: Maybe OPCODE + } + deriving (Eq) + +instance Sem.Semigroup CodeControls where + (CodeControls op1) <> (CodeControls op2) = + CodeControls (op1 <|> op2) + +instance Monoid CodeControls where + mempty = CodeControls Nothing +#if !(MIN_VERSION_base(4,11,0)) + -- this is redundant starting with base-4.11 / GHC 8.4 + -- if you want to avoid CPP, you can define `mappend = (<>)` unconditionally + mappend = (Sem.<>) +#endif + +instance Show CodeControls where + show (CodeControls op) = + _showOpts + [ _show "edns.version" op + ] + where + _show :: Show a => String -> Maybe a -> String + _show nm w = maybe _skipDefault (\s -> nm ++ ":" ++ show s) w + +---------------------------------------------------------------- + -- | Boolean flag operations. These form a 'Monoid'. When combined via -- `mappend`, as with function composition, the left-most value has -- the last say. @@ -376,16 +406,26 @@ modifyQuery -- ^ Flag and EDNS overrides -> DNSMessage -> DNSMessage -modifyQuery ctls query = queryControls (\mf eh -> query{flags = mf (flags query), ednsHeader = eh}) ctls +modifyQuery ctls query = + queryControls + ( \mf eh op -> + query + { flags = mf (flags query) + , ednsHeader = eh + , opcode = op + } + ) + ctls queryControls - :: ((DNSFlags -> DNSFlags) -> EDNSheader -> a) + :: ((DNSFlags -> DNSFlags) -> EDNSheader -> OPCODE -> a) -> QueryControls -> a -queryControls h ctls = h (queryDNSFlags hctls) (queryEdns ehctls) +queryControls h ctls = h (queryDNSFlags hctls) (queryEdns ehctls) (queryOpcode opctls) where hctls = qctlFlag ctls ehctls = qctlEdns ctls + opctls = qctlCode ctls -- \| Apply the given 'FlagOp' to a default boolean value to produce the final -- setting. @@ -430,3 +470,7 @@ queryControls h ctls = h (queryDNSFlags hctls) (queryEdns ehctls) , chkDisable = applyFlag cd $ chkDisable d , authAnswer = applyFlag aa $ authAnswer d } + + queryOpcode :: CodeControls -> OPCODE + queryOpcode (CodeControls (Just op)) = op + queryOpcode _ = OP_STD From 63924555221b951703e8f0dca9fc0e7da1f2ed39 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 19 Feb 2026 09:10:19 +0900 Subject: [PATCH 4/5] implementing opCode --- dnsext-do53/DNS/Do53/Internal.hs | 2 ++ dnsext-do53/DNS/Do53/Query.hs | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/dnsext-do53/DNS/Do53/Internal.hs b/dnsext-do53/DNS/Do53/Internal.hs index 2b56e21c1..2fc5af393 100644 --- a/dnsext-do53/DNS/Do53/Internal.hs +++ b/dnsext-do53/DNS/Do53/Internal.hs @@ -45,6 +45,8 @@ module DNS.Do53.Internal ( modifyQuery, queryControls, CodeControls (..), + opCode, + aaFlag, -- * Generating identifier singleGenId, diff --git a/dnsext-do53/DNS/Do53/Query.hs b/dnsext-do53/DNS/Do53/Query.hs index 066e9eb10..1dc040290 100644 --- a/dnsext-do53/DNS/Do53/Query.hs +++ b/dnsext-do53/DNS/Do53/Query.hs @@ -15,6 +15,7 @@ module DNS.Do53.Query ( ednsSetVersion, ednsSetUdpSize, ednsSetOptions, + opCode, queryControls, modifyQuery, encodeQuery, @@ -324,6 +325,9 @@ instance Show CodeControls where _show :: Show a => String -> Maybe a -> String _show nm w = maybe _skipDefault (\s -> nm ++ ":" ++ show s) w +opCode :: OPCODE -> QueryControls +opCode op = mempty{qctlCode = mempty{ccOpcode = Just op}} + ---------------------------------------------------------------- -- | Boolean flag operations. These form a 'Monoid'. When combined via From 047ce4bd6960a88bf3fd48b0500d535872279534 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 19 Feb 2026 09:10:42 +0900 Subject: [PATCH 5/5] iterative: using new queryControls --- dnsext-iterative/DNS/Iterative/Query/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dnsext-iterative/DNS/Iterative/Query/Types.hs b/dnsext-iterative/DNS/Iterative/Query/Types.hs index 6681e188a..f3ed29c76 100644 --- a/dnsext-iterative/DNS/Iterative/Query/Types.hs +++ b/dnsext-iterative/DNS/Iterative/Query/Types.hs @@ -40,7 +40,7 @@ queryParamIN :: Domain -> TYPE -> QueryControls -> QueryParam queryParamIN dom typ = queryParam (Question dom typ IN) queryControls' :: (DNSFlags -> EDNSheader -> a) -> QueryControls -> a -queryControls' h = queryControls (\mf eh -> h (mf defaultQueryDNSFlags) eh) +queryControls' h = queryControls (\mf eh _ -> h (mf defaultQueryDNSFlags) eh) ----------