{-|
Module      : Net.DNSBase.RData.SVCB
Description : Service Binding (SVCB) and HTTPS resource records
Copyright   : (c) Viktor Dukhovni, 2026
License     : BSD-3-Clause
Maintainer  : ietf-dane@dukhovni.org
Stability   : unstable

The Service Binding RR ('T_svcb') and its HTTPS-specific
variant ('T_https'), defined by RFC 9460.  Both share a wire
format with three fields — priority, target name, and a list
of typed (key, value) service parameters — represented
internally by the 'X_svcb' data type, indexed by a type-level
natural that determines the specific RR type.

The service-parameter machinery is split across submodules:

* "Net.DNSBase.RData.SVCB.SVCParamKey" — the 16-bit key codes,
  with pattern synonyms for the registered keys.
* "Net.DNSBase.RData.SVCB.SVCParamValue" — the
  'KnownSVCParamValue' typeclass, the existential
  'SVCB.SVCParamValue' wrapper, and the 'OpaqueSPV' fallback for
  unrecognised keys.
* "Net.DNSBase.RData.SVCB.SPV" — the concrete value types
  ('Net.DNSBase.RData.SVCB.SPV_alpn',
  'Net.DNSBase.RData.SVCB.SPV_port', ...).
* "Net.DNSBase.RData.SVCB.SPVSet" — the (key-indexed)
  collection holding the parameters of a single SVCB/HTTPS
  record.

New service-parameter value types can be installed at runtime via
'Net.DNSBase.Resolver.extendRRwithType' on the @SVCB@ or @HTTPS@
RR type — see "Net.DNSBase.Extensible" for a worked example.  The
@mandatory@ key (codepoint 0) is reserved and cannot be replaced
by user code.
-}
{-# LANGUAGE
    MagicHash
  , RecordWildCards
  , UndecidableInstances
  #-}
{-# OPTIONS_GHC -Wno-duplicate-exports #-}

module Net.DNSBase.RData.SVCB
    ( -- * SVCB and HTTPS
      X_svcb(.., T_SVCB, T_HTTPS
            , httpsPriority, httpsTarget, httpsParamValues
            , svcPriority, svcTarget, svcParamValues)
    , type XsvcbConName
      -- *** @T_HTTPS@ pattern record synonym fields
    , T_https
    , httpsPriority, httpsTarget, httpsParamValues
      -- *** @T_SVCB@ pattern record synonym fields
    , T_svcb
    , svcPriority, svcTarget, svcParamValues
      -- ** Service parameter values
    , KnownSVCParamValue(..)
    , SPVSet(..)
    , spvLookup
    , module Net.DNSBase.RData.SVCB.SPV
    , module Net.DNSBase.RData.SVCB.SVCParamValue
    , module Net.DNSBase.RData.SVCB.SVCParamKey
    ) where

import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import GHC.Exts (proxy#)
import GHC.IsList(IsList(..))
import GHC.TypeLits as TL (TypeError, ErrorMessage(..))
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal')

import Net.DNSBase.Internal.Util

import Net.DNSBase.Decode.Domain
import Net.DNSBase.Decode.State
import Net.DNSBase.Domain
import Net.DNSBase.Encode.Metric
import Net.DNSBase.Encode.State
import Net.DNSBase.Nat16
import Net.DNSBase.Present
import Net.DNSBase.RData
import Net.DNSBase.RData.SVCB.SPV
import Net.DNSBase.RData.SVCB.SVCParamKey
import Net.DNSBase.RData.SVCB.SVCParamValue
import Net.DNSBase.RData.SVCB.SPVSet (SPVSet(..), spvSetFromMonoList, spvLookup)
import Net.DNSBase.RRTYPE

type XsvcbConName :: Nat -> Symbol
type family XsvcbConName n where
    XsvcbConName N_svcb  = "T_SVCB"
    XsvcbConName N_https = "T_HTTPS"
    XsvcbConName n       = TypeError
                           ( ShowType n
                             :<>: TL.Text " is not a SVCB-based RRTYPE" )

-- | Each parameter decoder is responsible for deserialising just the value
-- part of the service parameter key-value pair, the key is already decoded and
-- used to locate the right map entry.  The input 'Int' parameter is the
-- length of the serialised data to decode.
--
type SPVDecoderMap = IntMap (Int -> SGet SVCParamValue)

-- | X_svcb specialised to @HTTPS@ records.
--
-- Note that @T_https@ is just a type alias!  The 'T_HTTPS' record pattern
-- synonym and its fields are bundled with the underlying 'X_svcb'
-- data type.  In many cases it is sufficient to import just
-- @X_svcb(..)@, but if you also need the type alias, it needs to be
-- imported separately:
--
-- > import Net.DNSBase (X_svcb(..), T_https)
--
type T_https = X_svcb N_https

-- | X_svcb specialised to @SVCB@ records.
--
-- Note that @T_svcb@ is just a type alias!  The 'T_SCVB' record pattern
-- synonym and its fields are bundled with the underlying 'X_svcb'
-- data type.  In many cases it is sufficient to import just
-- @X_svcb(..)@, but if you also need the type alias, it needs to be
-- imported separately:
--
-- > import Net.DNSBase (X_svcb(..), T_svcb)
--
type T_svcb  = X_svcb N_svcb

-- | Record pattern synonym viewing the shared 'X_svcb' record as
-- an HTTPS service-binding record (RFC 9460).  Fields:
-- 'httpsPriority', 'httpsTarget', 'httpsParamValues'.
pattern T_HTTPS :: Word16 -- ^ SvcPriority
                -> Domain -- ^ TargetName
                -> SPVSet -- ^ SvcParams
                -> T_https
pattern $bT_HTTPS :: Word16 -> Domain -> SPVSet -> T_https
$mT_HTTPS :: forall {r}.
T_https -> (Word16 -> Domain -> SPVSet -> r) -> ((# #) -> r) -> r
T_HTTPS { T_https -> Word16
httpsPriority, T_https -> Domain
httpsTarget, T_https -> SPVSet
httpsParamValues }
      = (X_SVCB httpsPriority httpsTarget httpsParamValues :: T_https)
{-# COMPLETE T_HTTPS #-}

-- | Record pattern synonym viewing the shared 'X_svcb' record as a
-- generic SVCB service-binding record (RFC 9460).  Fields:
-- 'svcPriority', 'svcTarget', 'svcParamValues'.  See 'X_svcb' for
-- why 'T_svcb' and 'T_https' are not coercible.
pattern T_SVCB :: Word16 -- ^ SvcPriority
               -> Domain -- ^ TargetName
               -> SPVSet -- ^ SvcParams
               -> T_svcb
pattern $bT_SVCB :: Word16 -> Domain -> SPVSet -> T_svcb
$mT_SVCB :: forall {r}.
T_svcb -> (Word16 -> Domain -> SPVSet -> r) -> ((# #) -> r) -> r
T_SVCB { T_svcb -> Word16
svcPriority, T_svcb -> Domain
svcTarget, T_svcb -> SPVSet
svcParamValues }
      = (X_SVCB svcPriority svcTarget svcParamValues :: T_svcb)
{-# COMPLETE T_SVCB #-}

-- | Shared wire-format representation for the @SVCB@ service
-- binding record
-- ([RFC 9460 section 2](https://datatracker.ietf.org/doc/html/rfc9460#section-2))
-- and its HTTPS-specific variant
-- ([RFC 9460 section 9](https://datatracker.ietf.org/doc/html/rfc9460#section-9)).
--
-- >                                 1  1  1  1  1  1
-- >   0  1  2  3  4  5  6  7  8  9  0  1  2  3  4  5
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                  SvcPriority                  |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > /                  TargetName                   /
-- > /                                               /
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > /                   SvcParams                   /
-- > /                                               /
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
--
-- The type parameter @n@ (either 'N_https' or 'N_svcb')
-- determines the RR type.  Each has its own type synonym
-- ('T_https', 'T_svcb') and matching record pattern synonym
-- ('T_HTTPS', 'T_SVCB') with the corresponding field-name prefix
-- (@https@, @svcb@).  The wire format is shared, but the type
-- role of @n@ is @nominal@: a 'T_svcb' value cannot be used where
-- a 'T_https' is expected.  This is deliberate — the two RR types
-- serve different transports, and future SvcParamKeys may apply
-- to only one of them.
--
-- Note that @T_https@ and @T_svcb@ are just type aliases!  The 'T_HTTPS'
-- and 'T_SVCB' record pattern synonyms and their fields are
-- bundled with the underlying 'X_svcb' data type.  In many cases it
-- is sufficient to import just @X_svcb(..)@, but if you also need
-- the type aliases, they need to be imported separately:
--
-- > import Net.DNSBase (X_svcb(..), T_https, T_svcb)
--
-- The target field is not subject to wire-form name compression
-- ([RFC 3597 section 4](https://datatracker.ietf.org/doc/html/rfc3597#section-4))
-- and is /not/ in the
-- [RFC 4034 section 6.2](https://datatracker.ietf.org/doc/html/rfc4034#section-6.2)
-- list of types that lower-case their RDATA names — it is
-- compared case-sensitively in canonical form.  The 'Ord'
-- instance compares structurally on the parsed fields rather
-- than on the wire form, so it is /not/ canonical: callers that
-- need RFC 4034 canonical ordering must serialise to wire form
-- first.
--
-- The /SvcParams/ field is a list of @(key, length, value)@
-- triples — possibly empty — making up the rest of the RData:
--
-- >                                 1  1  1  1  1  1
-- >   0  1  2  3  4  5  6  7  8  9  0  1  2  3  4  5
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                  SvcParamKey                  |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                  SvcParamLen                  |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > /                  SvcParamValue                /
-- > /                                               /
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
--
-- On the wire the list must be in strictly ascending key order;
-- the presentation form may list keys in any order.  Each value
-- has the type associated with its key in the decoder state
-- configured for the RR type — keys absent from the state decode
-- as 'OpaqueSPV', preserving the raw bytes.
--
-- The record pattern synonyms 'T_SVCB' and 'T_HTTPS' build the
-- corresponding 'T_svcb' or 'T_https' value directly, with their
-- own field-name prefixes (@svc@ and @https@):
--
-- > let s = T_SVCB  { svcPriority      = 0
-- >                 , svcTarget        = RootDomain
-- >                 , svcParamValues   = [] }
-- >     h = T_HTTPS { httpsPriority    = 0
-- >                 , httpsTarget      = RootDomain
-- >                 , httpsParamValues = [] }
-- >  in RData s : RData h : []
--
-- Functions that work on either RR type can use the
-- underscore-prefixed selectors on the shared 'X_svcb' record:
--
-- > aliasDomain :: forall n. X_svcb n -> Maybe Domain
-- > aliasDomain r | x_svcPriority r == 0 = Just $ x_svcTarget r
-- >               | otherwise           = Nothing
type X_svcb :: Nat -> Type
type role X_svcb nominal
data X_svcb n = X_SVCB
    { forall (n :: Nat). X_svcb n -> Word16
x_svcPriority    :: Word16 -- ^ SvcPriority
    , forall (n :: Nat). X_svcb n -> Domain
x_svcTarget      :: Domain -- ^ TargetName
    , forall (n :: Nat). X_svcb n -> SPVSet
x_svcParamValues :: SPVSet -- ^ SvcParams
    }

deriving instance Eq (X_svcb n)

instance (KnownSymbol (XsvcbConName n)) => Show (X_svcb n) where
    showsPrec :: Int -> X_svcb n -> ShowS
showsPrec Int
p X_SVCB{Word16
Domain
SPVSet
x_svcPriority :: forall (n :: Nat). X_svcb n -> Word16
x_svcTarget :: forall (n :: Nat). X_svcb n -> Domain
x_svcParamValues :: forall (n :: Nat). X_svcb n -> SPVSet
x_svcPriority :: Word16
x_svcTarget :: Domain
x_svcParamValues :: SPVSet
..} = Int -> ShowS -> ShowS
showsP Int
p (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString (Proxy# (XsvcbConName n) -> String
forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' (forall {k} (a :: k). Proxy# a
forall (a :: Symbol). Proxy# a
proxy# @(XsvcbConName n))) 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
. Word16 -> ShowS
forall a. Show a => a -> ShowS
shows' Word16
x_svcPriority    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
. Domain -> ShowS
forall a. Show a => a -> ShowS
shows' Domain
x_svcTarget      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
. SPVSet -> ShowS
forall a. Show a => a -> ShowS
shows' SPVSet
x_svcParamValues

instance Ord (X_svcb n) where
    X_svcb n
a compare :: X_svcb n -> X_svcb n -> Ordering
`compare` X_svcb n
b = (X_svcb n -> Word16
forall (n :: Nat). X_svcb n -> Word16
x_svcPriority X_svcb n
a) Word16 -> Word16 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (X_svcb n -> Word16
forall (n :: Nat). X_svcb n -> Word16
x_svcPriority X_svcb n
b)
                 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (X_svcb n -> Domain
forall (n :: Nat). X_svcb n -> Domain
x_svcTarget   X_svcb n
a) Domain -> Domain -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (X_svcb n -> Domain
forall (n :: Nat). X_svcb n -> Domain
x_svcTarget   X_svcb n
b)
                 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (X_svcb n -> [SVCParamValue]
forall {n :: Nat}. X_svcb n -> [SVCParamValue]
spvs         X_svcb n
a) [SVCParamValue] -> [SVCParamValue] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (X_svcb n -> [SVCParamValue]
forall {n :: Nat}. X_svcb n -> [SVCParamValue]
spvs         X_svcb n
b)
      where
        spvs :: X_svcb n -> [SVCParamValue]
spvs = SPVSet -> [Item SPVSet]
SPVSet -> [SVCParamValue]
forall l. IsList l => l -> [Item l]
toList (SPVSet -> [SVCParamValue])
-> (X_svcb n -> SPVSet) -> X_svcb n -> [SVCParamValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X_svcb n -> SPVSet
forall (n :: Nat). X_svcb n -> SPVSet
x_svcParamValues

instance Presentable (X_svcb n) where
    present :: X_svcb n -> Builder -> Builder
present (X_SVCB Word16
p Domain
d SPVSet
vs)  =
        Word16 -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Word16
p (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp Domain
d (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> [SVCParamValue] -> Builder)
-> [SVCParamValue] -> Builder -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((SVCParamValue -> Builder -> Builder)
-> Builder -> [SVCParamValue] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SVCParamValue -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp) (SPVSet -> [Item SPVSet]
forall l. IsList l => l -> [Item l]
toList SPVSet
vs)

instance (Nat16 n, KnownSymbol (XsvcbConName n)) => KnownRData (X_svcb n) where
    type RDataExtensionVal (X_svcb n) = SPVDecoderMap
    rdataExtensionVal :: forall b -> (b ~ X_svcb n) => RDataExtensionVal (X_svcb n)
rdataExtensionVal _ = SPVDecoderMap
RDataExtensionVal (X_svcb n)
baseSVCParams

    rdType :: forall b -> (b ~ X_svcb n) => RRTYPE
rdType _ = Word16 -> RRTYPE
RRTYPE (Word16 -> RRTYPE) -> Word16 -> RRTYPE
forall a b. (a -> b) -> a -> b
$ natToWord16 n
    rdEncode :: forall s. X_svcb n -> SPut s RData
rdEncode (X_SVCB Word16
p Domain
d SPVSet
vs) = do
        SizedBuilder -> SPut s RData
forall r s. ErrorContext r => SizedBuilder -> SPut s r
putSizedBuilder (SizedBuilder -> SPut s RData) -> SizedBuilder -> SPut s RData
forall a b. (a -> b) -> a -> b
$ Word16 -> SizedBuilder
mbWord16 Word16
p SizedBuilder -> SizedBuilder -> SizedBuilder
forall a. Semigroup a => a -> a -> a
<> Domain -> SizedBuilder
mbWireForm Domain
d
        (SVCParamValue -> SPut s RData) -> [SVCParamValue] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SVCParamValue -> SPut s RData
forall {r} {s}.
(Typeable r, Show r, Eq r) =>
SVCParamValue -> SPutM s r ()
enc ([SVCParamValue] -> SPut s RData)
-> [SVCParamValue] -> SPut s RData
forall a b. (a -> b) -> a -> b
$ SPVSet -> [Item SPVSet]
forall l. IsList l => l -> [Item l]
toList SPVSet
vs
      where
        enc :: SVCParamValue -> SPutM s r ()
enc (SVCParamValue (a
x :: t)) = do
            Word16 -> SPutM s r ()
forall r s. ErrorContext r => Word16 -> SPut s r
put16 (Word16 -> SPutM s r ()) -> Word16 -> SPutM s r ()
forall a b. (a -> b) -> a -> b
$ SVCParamKey -> Word16
forall a b. Coercible a b => a -> b
coerce (SVCParamKey -> Word16) -> SVCParamKey -> Word16
forall a b. (a -> b) -> a -> b
$ spvKey t
            SPutM s r () -> SPutM s r ()
forall r s a. ErrorContext r => SPutM s r a -> SPutM s r a
passLen (SPutM s r () -> SPutM s r ()) -> SPutM s r () -> SPutM s r ()
forall a b. (a -> b) -> a -> b
$ a -> SPutM s r ()
forall a r s.
(KnownSVCParamValue a, ErrorContext r) =>
a -> SPut s r
forall r s. ErrorContext r => a -> SPut s r
encodeSPV a
x
    -- The resolver serice parameter extension slots for @T_svcb@
    -- and @T_https@ are configured with the table of known parameters
    -- and can be extended at runtime as part of resolver configuration.
    rdDecode :: forall b ->
(b ~ X_svcb n) => RDataExtensionVal (X_svcb n) -> Int -> SGet RData
rdDecode _ RDataExtensionVal (X_svcb n)
sdm Int
len = do
        pos0            <- SGet Int
getPosition
        x_svcPriority    <- get16
        x_svcTarget      <- getDomainNC
        pos1            <- getPosition
        vals            <- decodeSVCFieldValues (len - (pos1 - pos0))
        let x_svcParamValues = [SVCParamValue] -> SPVSet
spvSetFromMonoList ([SVCParamValue] -> SPVSet) -> [SVCParamValue] -> SPVSet
forall a b. (a -> b) -> a -> b
$ [SVCParamValue] -> [SVCParamValue]
forall a. [a] -> [a]
reverse [SVCParamValue]
vals
        pure $ RData $ (X_SVCB{..} :: X_svcb n)
      where
        decodeSVCFieldValues :: Int -> SGet [SVCParamValue]
        decodeSVCFieldValues :: Int -> SGet [SVCParamValue]
decodeSVCFieldValues = Int -> SGet [SVCParamValue] -> SGet [SVCParamValue]
forall a. Int -> SGet a -> SGet a
fitSGet (Int -> SGet [SVCParamValue] -> SGet [SVCParamValue])
-> (Int -> Int)
-> Int
-> SGet [SVCParamValue]
-> SGet [SVCParamValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int
forall a. a -> a
id (Int -> SGet [SVCParamValue] -> SGet [SVCParamValue])
-> (Int -> SGet [SVCParamValue]) -> Int -> SGet [SVCParamValue]
forall a b. (Int -> a -> b) -> (Int -> a) -> Int -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [SVCParamValue] -> Word16 -> Int -> SGet [SVCParamValue]
loop [] Word16
0
          where
            loop :: [SVCParamValue] -> Word16 -> Int -> SGet [SVCParamValue]
            loop :: [SVCParamValue] -> Word16 -> Int -> SGet [SVCParamValue]
loop [SVCParamValue]
acc !Word16
kmin !Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
                pos0 <- SGet Int
getPosition
                key  <- get16
                vlen <- getInt16
                when (key == 0xffff) reserved
                when (kmin > key) $ nonmono (kmin-1) key
                spv <- case IM.lookup (fromIntegral key) sdm of
                    Just Int -> SGet SVCParamValue
dc -> Int -> SGet SVCParamValue -> SGet SVCParamValue
forall a. Int -> SGet a -> SGet a
fitSGet Int
vlen (SGet SVCParamValue -> SGet SVCParamValue)
-> SGet SVCParamValue -> SGet SVCParamValue
forall a b. (a -> b) -> a -> b
$ Int -> SGet SVCParamValue
dc Int
vlen
                    Maybe (Int -> SGet SVCParamValue)
Nothing -> Word16 -> ShortByteString -> SVCParamValue
opaqueSPV Word16
key (ShortByteString -> SVCParamValue)
-> SGet ShortByteString -> SGet SVCParamValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> SGet ShortByteString
getShortNByteString Int
vlen
                used <- (subtract pos0) <$> getPosition
                loop (spv : acc) (key + 1) (n - used)
            loop [SVCParamValue]
acc Word16
_ Int
0 = [SVCParamValue] -> SGet [SVCParamValue]
forall a. a -> SGet a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SVCParamValue]
acc
            loop [SVCParamValue]
_ Word16
_ Int
_ = String -> SGet [SVCParamValue]
forall a. String -> SGet a
failSGet String
"internal error"

            -- 65535 is a reserved "Invalid key"
            reserved :: SGet a
reserved = String -> SGet a
forall a. String -> SGet a
failSGet String
"Reserved invalid key: 65535"
            -- Keys MUST be in strictly increasing order
            nonmono :: a -> a -> SGet a
nonmono a
k1 a
k2 =
                String -> SGet a
forall a. String -> SGet a
failSGet (String -> SGet a) -> String -> SGet a
forall a b. (a -> b) -> a -> b
$ String
"Non-increasing keys: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k1 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
k2

instance (Nat16 n, KnownSymbol (XsvcbConName n))
      => TypeExtensible (X_svcb n) SPVDecoderMap where
    type TypeExtensionArg (X_svcb n) b = KnownSVCParamValue b

    -- Insert the typed decoder at b's SvcParam key, except for the
    -- reserved @mandatory@ slot (codepoint 0), which the library
    -- owns and silently drops user attempts to replace.
    extendByType :: forall t b ->
(t ~ X_svcb n, TypeExtensionArg t b) =>
SPVDecoderMap -> SPVDecoderMap
extendByType _ b SPVDecoderMap
m
        | Int
key Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
mandatoryKey = SPVDecoderMap
m
        | Bool
otherwise = Int
-> (Int -> SGet SVCParamValue) -> SPVDecoderMap -> SPVDecoderMap
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
key (decodeSPV b) SPVDecoderMap
m
      where
        key :: Int
key = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (SVCParamKey -> Word16) -> SVCParamKey -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SVCParamKey -> Word16
forall a b. Coercible a b => a -> b
coerce (SVCParamKey -> Int) -> SVCParamKey -> Int
forall a b. (a -> b) -> a -> b
$ spvKey b

-- | Initial decoder state used as the
-- 'Net.DNSBase.RData.rdataExtensionVal' for both 'T_svcb' and
-- 'T_https'.  Not exported: user code interacts with it through
-- 'Net.DNSBase.Resolver.extendRRwithType', which calls
-- 'extendByType' to insert additional 'KnownSVCParamValue'
-- decoders.
baseSVCParams :: SPVDecoderMap
baseSVCParams :: SPVDecoderMap
baseSVCParams = [(Int, Int -> SGet SVCParamValue)] -> SPVDecoderMap
forall a. [(Int, a)] -> IntMap a
IM.fromList
    [ spvMapEntry SPV_mandatory
    , spvMapEntry SPV_alpn
    , spvMapEntry SPV_ndalpn
    , spvMapEntry SPV_port
    , spvMapEntry SPV_ipv4hint
    , spvMapEntry SPV_ech
    , spvMapEntry SPV_ipv6hint
    , spvMapEntry SPV_dohpath
    , spvMapEntry SPV_tlsgroups
    , spvMapEntry SPV_docpath
    , spvMapEntry SPV_pvd
    ]
  where
    spvMapEntry :: forall a -> KnownSVCParamValue a
                => (Int, Int -> SGet SVCParamValue)
    spvMapEntry :: forall a ->
KnownSVCParamValue a => (Int, Int -> SGet SVCParamValue)
spvMapEntry a =
        ( forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (SVCParamKey -> Word16) -> SVCParamKey -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SVCParamKey -> Word16
forall a b. Coercible a b => a -> b
coerce (SVCParamKey -> Int) -> SVCParamKey -> Int
forall a b. (a -> b) -> a -> b
$ spvKey a
        , decodeSPV a)

-- Numeric SvcParamKey for the @mandatory@ key; protected from
-- user override inside 'extendByType'.
mandatoryKey :: Int
mandatoryKey :: Int
mandatoryKey = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Int) -> (SVCParamKey -> Word16) -> SVCParamKey -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SVCParamKey -> Word16
forall a b. Coercible a b => a -> b
coerce (SVCParamKey -> Int) -> SVCParamKey -> Int
forall a b. (a -> b) -> a -> b
$ spvKey SPV_mandatory