-- |
-- Module      : Net.DNSBase.Decode.Internal.Option
-- Description : TBD
-- Copyright   : (c) Viktor Dukhovni, 2026
-- License     : BSD-3-Clause
-- Maintainer  : ietf-dane@dukhovni.org
-- Stability   : unstable
module Net.DNSBase.Decode.Internal.Option
    ( OptionMap
    , T_opt(..)
    , emptyOptionMap
    , getOPTWith
    ) where

import qualified Data.IntMap.Strict as IM

import Net.DNSBase.Decode.Internal.State
import Net.DNSBase.EDNS.Internal.Option
import Net.DNSBase.EDNS.Internal.Option.Opaque
import Net.DNSBase.Internal.Present
import Net.DNSBase.Internal.RData
import Net.DNSBase.Internal.RRTYPE
import Net.DNSBase.Internal.Util

-- | [OPT RDATA](https://tools.ietf.org/html/rfc6891#section-6.1.2).
-- More precisely, just the EDNS option list of @OPT@ pseudo-RR.
-- The fixed fields are part of the 'Net.DNSBase.Message.DNSMessage' metadata.
--
-- Used only internally while decoding messages, not user-visible.
--
-- The variable part of an OPT RR may contain zero or more options in
-- the RDATA.  Each option MUST be treated as a bit field.  Each option
-- is encoded as:
--
-- > +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
-- > |                          OPTION-CODE                          |
-- > +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
-- > |                         OPTION-LENGTH                         |
-- > +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
-- > |                                                               |
-- > /                          OPTION-DATA                          /
-- > /                                                               /
-- > +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
--
-- Neither name compression nor canonical ordering are applicable here.
-- This datatype has no 'Ord' instance.
--
newtype T_opt = T_OPT [EdnsOption]
instance Eq  T_opt         where == :: T_opt -> T_opt -> Bool
(==) = T_opt -> T_opt -> Bool
forall a. a
unreachable
instance Ord T_opt         where compare :: T_opt -> T_opt -> Ordering
compare = T_opt -> T_opt -> Ordering
forall a. a
unreachable
instance Presentable T_opt where present :: T_opt -> Builder -> Builder
present = T_opt -> Builder -> Builder
forall a. a
unreachable
instance Show T_opt        where showsPrec :: Int -> T_opt -> ShowS
showsPrec = Int -> T_opt -> ShowS
forall a. a
unreachable
instance KnownRData T_opt  where
    rdType :: forall b -> (b ~ T_opt) => RRTYPE
rdType _ = RRTYPE
OPT
    rdEncode :: forall s. T_opt -> SPut s RData
rdEncode = T_opt -> SPut s RData
forall a. a
unreachable
    rdDecode :: forall b ->
(b ~ T_opt) => RDataExtensionVal T_opt -> Int -> SGet RData
rdDecode _ = () -> Int -> SGet RData
RDataExtensionVal T_opt -> Int -> SGet RData
forall a. a
unreachable

unreachable :: a
unreachable :: forall a. a
unreachable = String -> a
forall a. String -> a
errorWithoutStackTrace String
"Unreachable method of internal data type"

-- | Table of known EDNS option type codecs, paralleling
-- 'RDataMap' on the RR-type side.
type OptionMap = IM.IntMap OptionCodec

-- | Empty EDNS option codec map
emptyOptionMap :: OptionMap
emptyOptionMap :: OptionMap
emptyOptionMap = OptionMap
forall a. IntMap a
IM.empty

-- | Decoder for the @OPT@ pseudo-RR using a custom set of EDNS option
-- codecs.
--
getOPTWith :: OptionMap -- ^ OPTCODE->codec map
           -> Int       -- ^ OPT RData length
           -> SGet RData
getOPTWith :: OptionMap -> Int -> SGet RData
getOPTWith OptionMap
optmap = T_opt -> RData
forall a. KnownRData a => a -> RData
RData (T_opt -> RData)
-> ([EdnsOption] -> T_opt) -> [EdnsOption] -> RData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EdnsOption] -> T_opt
T_OPT ([EdnsOption] -> RData)
-> (Int -> SGet [EdnsOption]) -> Int -> SGet RData
forall (m :: * -> *) b c a.
Functor m =>
(b -> c) -> (a -> m b) -> a -> m c
<.> Int -> SGet [EdnsOption]
getOptions
  where
    getOptions :: Int -> SGet [EdnsOption]
    getOptions :: Int -> SGet [EdnsOption]
getOptions Int
0 = [EdnsOption] -> SGet [EdnsOption]
forall a. a -> SGet a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    getOptions Int
rdlen = do
        code <- SGet Word16
get16
        len  <- getInt16
        opt  <- case IM.lookup (fromIntegral code) optmap of
            Maybe OptionCodec
Nothing -> Word16 -> ShortByteString -> EdnsOption
opaqueEdnsOption Word16
code (ShortByteString -> EdnsOption)
-> (ShortByteString -> ShortByteString)
-> ShortByteString
-> EdnsOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ShortByteString
forall a b. Coercible a b => a -> b
coerce (ShortByteString -> EdnsOption)
-> SGet ShortByteString -> SGet EdnsOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> SGet ShortByteString
getShortNByteString Int
len
            Just (OptionCodec (Proxy a
_ :: Proxy a) OptionExtensionVal a
opts) ->
                Int -> SGet EdnsOption -> SGet EdnsOption
forall a. Int -> SGet a -> SGet a
fitSGet Int
len (SGet EdnsOption -> SGet EdnsOption)
-> SGet EdnsOption -> SGet EdnsOption
forall a b. (a -> b) -> a -> b
$ (a ~ a) => OptionExtensionVal a -> Int -> SGet EdnsOption
OptionExtensionVal a -> Int -> SGet EdnsOption
forall b ->
(b ~ a) => OptionExtensionVal b -> Int -> SGet EdnsOption
forall a.
KnownEdnsOption a =>
forall b ->
(b ~ a) => OptionExtensionVal b -> Int -> SGet EdnsOption
optDecode a OptionExtensionVal a
opts Int
len
        (opt :) <$> getOptions (rdlen - (len + 4))