-- |
-- Module      : Net.DNSBase.Internal.RData
-- Description : TBD
-- Copyright   : (c) Viktor Dukhovni, 2026
-- License     : BSD-3-Clause
-- Maintainer  : ietf-dane@dukhovni.org
-- Stability   : unstable
{-# LANGUAGE RecordWildCards #-}

{-# LANGUAGE DefaultSignatures #-}
module Net.DNSBase.Internal.RData
    ( -- * RData class
      RData(..)
    , fromRData
    , monoRData
    , rdataType
    , rdataEncode
    , rdataEncodeCanonical
      -- ** Opaque RData
    , OpaqueRData(..)
    , opaqueRData
    , toOpaqueRData
      -- ** Extensibility
    , KnownRData(..)
    , RDataCodec(..)
    , RDataMap
    ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Short as SB
import Data.IntMap (IntMap)

import Net.DNSBase.Decode.Internal.State
import Net.DNSBase.Encode.Internal.State
import Net.DNSBase.Internal.Bytes
import Net.DNSBase.Internal.Nat16
import Net.DNSBase.Internal.Present
import Net.DNSBase.Internal.RRTYPE
import Net.DNSBase.Internal.Util

-- | Abstract DNS Resource Record (type-specific) data.
--
-- The decoding, encoding and presentation functions are responsible for just
-- the value, presentation of the associated RR type defaults to the built-in
-- names, for novel types override 'rdTypePres'.
--
-- The 'Show' instance is typically derived, and will output the type
-- constructor (its output strives to produce syntactically valid Haskell
-- values), in contrast with 'Presentable' which produces RFC-standard
-- presentation forms.
class ( Typeable a, Eq a, Ord a, Show a, Presentable a
      ) => KnownRData a where
    -- | The codec-consumed extension value for type @a@.  Defaults
    -- to @()@.  Types with non-trivial extension data (SVCB and
    -- HTTPS, which carry the SvcParam decoder map) supply their
    -- own associated-type definition.
    type RDataExtensionVal a :: Type
    type RDataExtensionVal a = ()

    -- | The library's built-in starting 'RDataExtensionVal' for type
    -- @a@.  Used as the baseline when the library installs its
    -- built-in registration for @a@, and as the starting point
    -- when the user extends the codec for @a@.  For
    -- @'RDataExtensionVal' a ~ ()@ types the class default applies.
    rdataExtensionVal :: forall b -> b ~ a => RDataExtensionVal a
    default rdataExtensionVal :: (RDataExtensionVal a ~ ())
                              => forall b -> b ~ a => RDataExtensionVal a
    rdataExtensionVal _ = ()

    rdType     :: forall b -> b ~ a => RRTYPE
    rdTypePres :: forall b -> b ~ a => Builder -> Builder
    rdDecode   :: forall b -> b ~ a => RDataExtensionVal a -> Int -> SGet RData
    -- Default encoding
    rdEncode   :: a -> SPut s RData
    -- Canonical encoding for DNSSEC validation.
    cnEncode   :: a -> SPut s RData
    cnEncode    = a -> SPut s RData
forall s. a -> SPut s RData
forall a s. KnownRData a => a -> SPut s RData
rdEncode

    -- | Override for user-friendly types for non-built-in types added at
    -- runtime (as part of resolver configuration).  Otherwise, defaults to
    -- @TYPE@/number/.
    rdTypePres _ = RRTYPE -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present (RRTYPE -> Builder -> Builder) -> RRTYPE -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ rdType a
    {-# INLINE rdTypePres #-}

-- | Wrapper around any concrete 'KnownRData' type.
--
-- Its presentation form includes both the type and the value, space-separated.
-- The underlying concrete types present just their values.
data RData = forall a. KnownRData a => RData a

-- | Recover a typed RR payload from the existential 'RData' wrapper.
-- Returns @'Just' x@ when the dynamic payload's type matches the
-- caller's expected type @a@, and 'Nothing' otherwise.
--
-- The target type is selected by the result-side pattern; once
-- there's a concrete constructor on the @Just@ side, the
-- @'KnownRData' a@ constraint is resolved without an explicit type
-- ascription.  A typical use is a view-pattern dispatch that
-- handles two or more RR types at once:
--
-- > evalIP :: (IP -> a) -> RData -> Maybe a
-- > evalIP f (fromRData -> Just (T_A    ip)) = Just $! f (IPv4 ip)
-- > evalIP f (fromRData -> Just (T_AAAA ip)) = Just $! f (IPv6 ip)
-- > evalIP _ _                               = Nothing
--
-- 'fromRData' is the right tool when the value in hand is already
-- an 'RData'.  If you instead have an 'Net.DNSBase.RR.RR' (or a list of them, as
-- returned by 'Net.DNSBase.Lookup.lookupAnswers'), 'Net.DNSBase.RR.rrDataCast' is the convenience
-- composition @'fromRData' . 'Net.DNSBase.RR.rrData'@.  And 'monoRData' performs
-- the filter-and-cast over a 'Foldable' container in one step.
fromRData  :: forall a. KnownRData a => RData -> Maybe a
fromRData :: forall a. KnownRData a => RData -> Maybe a
fromRData (RData a
a) = a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a
{-# INLINE fromRData #-}

instance Show RData where
    showsPrec :: Int -> RData -> ShowS
showsPrec Int
p (RData a
a) = Int -> ShowS -> ShowS
showsP Int
p (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"RData " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows' a
a

-- | Presents the type and value, space-separated.
instance Presentable RData where
    present :: RData -> Builder -> Builder
present (RData (a
a :: t)) = rdTypePres t (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp a
a

-- | Known RData Proxy + Codec parameter pair
data RDataCodec where
    RDataCodec :: KnownRData a
              => Proxy a
              -> RDataExtensionVal a
              -> RDataCodec

-- | Map associating a type-specific length-aware 'RData' decoder
-- to each 'Net.DNSBase.RRTYPE.RRTYPE'
type RDataMap = IntMap RDataCodec

-- | Filter a 'Foldable' of 'RData' down to the elements whose
-- payload type matches the caller's target @a@, returning a
-- monomorphic list of those typed values.  Elements with a
-- different payload type are dropped.
--
-- For example, the @T_mx@ payloads from a mixed 'RData' list:
--
-- > mxs :: [RData] -> [T_mx]
-- > mxs = monoRData
--
-- Equivalent to @'Data.Maybe.mapMaybe' 'fromRData' . 'Data.Foldable.toList'@,
-- but in one fused pass.  See 'fromRData' for the single-element
-- cast, and 'Net.DNSBase.RR.rrDataCast' for the 'Net.DNSBase.RR.RR'-input analogue.
monoRData :: forall a t. (KnownRData a, Foldable t) => t RData -> [a]
monoRData :: forall a (t :: * -> *).
(KnownRData a, Foldable t) =>
t RData -> [a]
monoRData = (RData -> [a] -> [a]) -> [a] -> t RData -> [a]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([a] -> [a]) -> (a -> [a] -> [a]) -> Maybe a -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id (:) (Maybe a -> [a] -> [a])
-> (RData -> Maybe a) -> RData -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RData -> Maybe a
forall a. KnownRData a => RData -> Maybe a
fromRData) []
{-# INLINE monoRData #-}

{-# INLINE rdataType #-}
rdataType :: RData -> RRTYPE
rdataType :: RData -> RRTYPE
rdataType (RData (a
_ :: t)) = rdType t

instance Eq RData where
    (RData (a
_a :: a)) == :: RData -> RData -> Bool
== (RData (a
_b :: b)) =
        case teq a b of
            Just a :~: a
Refl -> a
_a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a
_b
            Maybe (a :~: a)
_         -> Bool
False

-- | Compare RData first by RRtype number, then by content.
-- When two RRtype numbers match, but the data types nevertheless differ, order
-- opaque type after non-opaque.  In the unlikely case of two non-opaque types
-- with the same RRtype, compare their opaque encodings (this could throw an
-- error if one of the objects is not encodable, perhaps because encoding would
-- be too long).
instance Ord RData where
    ra :: RData
ra@(RData (a
_a :: a)) compare :: RData -> RData -> Ordering
`compare` rb :: RData
rb@(RData (a
_b :: b)) =
        RRTYPE -> RRTYPE -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (rdType a) (rdType b)
        Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> if | Just a :~: a
Refl <- teq a b -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
_a a
a
_b
              | RRTYPE -> RData -> Bool
isOpaque (rdType a) RData
ra -> Ordering
GT
              | RRTYPE -> RData -> Bool
isOpaque (rdType b) RData
rb -> Ordering
LT
              | Bool
otherwise -> Either (EncodeErr (Maybe RData)) RData
-> Either (EncodeErr (Maybe RData)) RData -> Ordering
forall {a} {a} {a}.
(Ord a, Show a, Show a) =>
Either a a -> Either a a -> Ordering
ocmp (RData -> Either (EncodeErr (Maybe RData)) RData
toOpaqueRData RData
ra) (RData -> Either (EncodeErr (Maybe RData)) RData
toOpaqueRData RData
rb)
      where
        ocmp :: Either a a -> Either a a -> Ordering
ocmp (Right a
oa) (Right a
ob) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
oa a
ob
        ocmp (Left a
e)   Either a a
_          = String -> Ordering
forall a. HasCallStack => String -> a
error (String -> Ordering) -> String -> Ordering
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
e
        ocmp Either a a
_          (Left a
e)   = String -> Ordering
forall a. HasCallStack => String -> a
error (String -> Ordering) -> String -> Ordering
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
e

-- | Perform a default encoding of the contained 'KnownRData'.
rdataEncode :: RData -> SPut s RData
rdataEncode :: forall s. RData -> SPut s RData
rdataEncode rd :: RData
rd@(RData a
a) = RData -> SPutM s RData () -> SPutM s RData ()
forall r s a. ErrorContext r => r -> SPutM s r a -> SPutM s r a
setContext RData
rd (SPutM s RData () -> SPutM s RData ())
-> SPutM s RData () -> SPutM s RData ()
forall a b. (a -> b) -> a -> b
$ a -> SPutM s RData ()
forall s. a -> SPut s RData
forall a s. KnownRData a => a -> SPut s RData
rdEncode a
a

-- | Perform a canonical encoding of the contained 'KnownRData'.
rdataEncodeCanonical :: RData -> SPut s RData
rdataEncodeCanonical :: forall s. RData -> SPut s RData
rdataEncodeCanonical rd :: RData
rd@(RData a
a) = RData -> SPutM s RData () -> SPutM s RData ()
forall r s a. ErrorContext r => r -> SPutM s r a -> SPutM s r a
setContext RData
rd (SPutM s RData () -> SPutM s RData ())
-> SPutM s RData () -> SPutM s RData ()
forall a b. (a -> b) -> a -> b
$ a -> SPutM s RData ()
forall s. a -> SPut s RData
forall a s. KnownRData a => a -> SPut s RData
cnEncode a
a

-- | Opaque 'RData', for RRTYPEs not known at runtime
--
data OpaqueRData n = Nat16 n => OpaqueRData ShortByteString
deriving instance Eq (OpaqueRData n)
deriving instance Ord (OpaqueRData n)
instance Show (OpaqueRData n) where
    showsPrec :: Int -> OpaqueRData n -> ShowS
showsPrec Int
p (OpaqueRData ShortByteString
bs) = Int -> ShowS -> ShowS
showsP Int
p (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"OpaqueRData @"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ShowS
forall a. Show a => a -> ShowS
shows (natToWord16 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
. forall a. Show a => a -> ShowS
shows @Bytes16 (ShortByteString -> Bytes16
forall a b. Coercible a b => a -> b
coerce ShortByteString
bs)

instance Presentable (OpaqueRData n) where
    present :: OpaqueRData n -> Builder -> Builder
present (OpaqueRData ShortByteString
val) =
        String -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present String
"\\#"
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp (ShortByteString -> Int
SB.length ShortByteString
val)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Builder -> Builder
present16 ShortByteString
val
      where
        present16 :: ShortByteString -> Builder -> Builder
present16 = forall a. Presentable a => a -> Builder -> Builder
presentSp @Bytes16 (Bytes16 -> Builder -> Builder)
-> (ShortByteString -> Bytes16)
-> ShortByteString
-> Builder
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Bytes16
forall a b. Coercible a b => a -> b
coerce

instance Nat16 n => KnownRData (OpaqueRData n) where
    rdType :: forall b -> (b ~ OpaqueRData n) => RRTYPE
rdType _ = Word16 -> RRTYPE
RRTYPE (Word16 -> RRTYPE) -> Word16 -> RRTYPE
forall a b. (a -> b) -> a -> b
$ natToWord16 n
    rdTypePres :: forall b -> (b ~ OpaqueRData n) => Builder -> Builder
rdTypePres _ = String -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present String
"TYPE"
                 (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. OpaqueRData n -> SPut s RData
rdEncode (OpaqueRData ShortByteString
bs) = ShortByteString -> SPut s RData
forall r s. ErrorContext r => ShortByteString -> SPut s r
putShortByteString ShortByteString
bs
    rdDecode :: forall b ->
(b ~ OpaqueRData n) =>
RDataExtensionVal (OpaqueRData n) -> Int -> SGet RData
rdDecode _ RDataExtensionVal (OpaqueRData n)
_ = OpaqueRData n -> RData
forall a. KnownRData a => a -> RData
RData (OpaqueRData n -> RData)
-> (ShortByteString -> OpaqueRData n) -> ShortByteString -> RData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). Nat16 n => ShortByteString -> OpaqueRData n
OpaqueRData @n (ShortByteString -> RData)
-> (Int -> SGet ShortByteString) -> Int -> SGet RData
forall (m :: * -> *) b c a.
Functor m =>
(b -> c) -> (a -> m b) -> a -> m c
<.> Int -> SGet ShortByteString
getShortNByteString

-- | Create opaque RData from its type number and Bytes16 value
opaqueRData :: Word16 -> ShortByteString -> RData
opaqueRData :: Word16 -> ShortByteString -> RData
opaqueRData Word16
w ShortByteString
bs = Word16 -> (forall (n :: Nat) -> Nat16 n => RData) -> RData
forall r. Word16 -> (forall (n :: Nat) -> Nat16 n => r) -> r
withNat16 Word16
w forall (n :: Nat) -> Nat16 n => RData
go
  where
    go :: forall (n :: Nat) -> Nat16 n => RData
    go :: forall (n :: Nat) -> Nat16 n => RData
go n = OpaqueRData n -> RData
forall a. KnownRData a => a -> RData
RData (OpaqueRData n -> RData) -> OpaqueRData n -> RData
forall a b. (a -> b) -> a -> b
$ (ShortByteString -> OpaqueRData n
forall (n :: Nat). Nat16 n => ShortByteString -> OpaqueRData n
OpaqueRData ShortByteString
bs :: OpaqueRData n)

-- | Convert 'RData' to its /opaque/ equivalent of the same RRtype.
-- 'OpaqueRData' values will be returned as-is.  Otherwise, this will attempt
-- to encode the record without name compression, the encoding may fail, in
-- which case the return value will be 'Nothing'.
--
toOpaqueRData :: RData -> Either (EncodeErr (Maybe RData)) RData
toOpaqueRData :: RData -> Either (EncodeErr (Maybe RData)) RData
toOpaqueRData rd :: RData
rd@(RData -> RRTYPE
rdataType -> RRTYPE
rt) = Word16
-> (forall (n :: Nat) ->
    Nat16 n => Either (EncodeErr (Maybe RData)) RData)
-> Either (EncodeErr (Maybe RData)) RData
forall r. Word16 -> (forall (n :: Nat) -> Nat16 n => r) -> r
withNat16 (RRTYPE -> Word16
forall a b. Coercible a b => a -> b
coerce RRTYPE
rt) forall (n :: Nat) ->
Nat16 n => Either (EncodeErr (Maybe RData)) RData
go
  where
    go :: forall (n :: Nat) -> Nat16 n => Either (EncodeErr (Maybe RData)) RData
    go :: forall (n :: Nat) ->
Nat16 n => Either (EncodeErr (Maybe RData)) RData
go n | RRTYPE -> RData -> Bool
isOpaque RRTYPE
rt RData
rd = RData -> Either (EncodeErr (Maybe RData)) RData
forall a b. b -> Either a b
Right RData
rd
         | Bool
otherwise
           = OpaqueRData n -> RData
forall a. KnownRData a => a -> RData
RData (OpaqueRData n -> RData)
-> (ByteString -> OpaqueRData n) -> ByteString -> RData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> OpaqueRData n
mkopaque (ByteString -> RData)
-> Either (EncodeErr (Maybe RData)) ByteString
-> Either (EncodeErr (Maybe RData)) RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. SPut s RData)
-> Either (EncodeErr (Maybe RData)) ByteString
forall r.
ErrorContext r =>
(forall s. SPut s r) -> Either (EncodeErr (Maybe r)) ByteString
encodeVerbatim do RData -> SPut s RData
forall s. RData -> SPut s RData
rdataEncode RData
rd
             where
               mkopaque :: B.ByteString -> OpaqueRData n
               mkopaque :: ByteString -> OpaqueRData n
mkopaque ByteString
bs = ShortByteString -> OpaqueRData n
forall (n :: Nat). Nat16 n => ShortByteString -> OpaqueRData n
OpaqueRData (ShortByteString -> OpaqueRData n)
-> ShortByteString -> OpaqueRData n
forall a b. (a -> b) -> a -> b
$ ByteString -> ShortByteString
SB.toShort ByteString
bs

-- | Check whether the given 'RData' is opaque of given RRtype.
--
isOpaque :: RRTYPE -> RData -> Bool
isOpaque :: RRTYPE -> RData -> Bool
isOpaque RRTYPE
rt RData
rd = Word16 -> (forall (n :: Nat) -> Nat16 n => Bool) -> Bool
forall r. Word16 -> (forall (n :: Nat) -> Nat16 n => r) -> r
withNat16 (RRTYPE -> Word16
forall a b. Coercible a b => a -> b
coerce RRTYPE
rt) forall (n :: Nat) -> Nat16 n => Bool
go
  where
    go :: forall (n :: Nat) -> Nat16 n => Bool
    go :: forall (n :: Nat) -> Nat16 n => Bool
go n = Maybe (OpaqueRData n) -> Bool
forall a. Maybe a -> Bool
isJust (RData -> Maybe (OpaqueRData n)
forall a. KnownRData a => RData -> Maybe a
fromRData RData
rd :: Maybe (OpaqueRData n))