-- |
-- Module      : Net.DNSBase.EDNS.Option.EDE
-- Description : Extended DNS Errors (RFC 8914)
-- Copyright   : (c) Viktor Dukhovni, 2026
-- License     : BSD-3-Clause
-- Maintainer  : ietf-dane@dukhovni.org
-- Stability   : unstable
{-# LANGUAGE OverloadedStrings #-}

module Net.DNSBase.EDNS.Option.EDE
    ( O_ede(..)
    ) where

import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Short as SB
import qualified Data.IntMap.Strict as IM

import Net.DNSBase.Decode.Internal.State
import Net.DNSBase.EDNS.Internal.Option
import Net.DNSBase.EDNS.Internal.OptNum
import Net.DNSBase.Encode.Internal.State
import Net.DNSBase.Extensible
import Net.DNSBase.Internal.Present
import Net.DNSBase.Internal.Text
import Net.DNSBase.Internal.Util

-- | [Extended DNS Error](https://www.rfc-editor.org/rfc/rfc8914.html#section-2)
--
-- > +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
-- > |          INFO-CODE            |
-- > +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
-- > / EXTRA-TEXT ...                /
-- > +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
--
-- The decoded value carries the wire-format info-code and extra
-- text alongside an /optional/ friendly name ('edeName') looked
-- up from the resolver's EDE name table.  An empty 'edeName'
-- denotes "no entry in the table": the 'Presentable' instance
-- falls back to a bare numeric code in that case.
--
-- The 'Net.DNSBase.EDNS.Option.OptionExtensionVal' for 'O_ede' is the name registry —
-- an 'IM.IntMap' from info-code to user-facing name.
-- Applications can register new names or override standard
-- ones via 'Net.DNSBase.Resolver.extendEdnsOptionWithValue' on
-- 'O_ede', passing the @(code, name)@ pair to add.
data O_ede = O_EDE
    { O_ede -> Word16
edeInfoCode :: !Word16
        -- ^ EDE info-code (RFC 8914, section 4).
    , O_ede -> ShortByteString
edeName     :: !ShortByteString
        -- ^ Friendly name looked up at decode time, or 'mempty'
        --   when the table has no matching entry.
    , O_ede -> ShortByteString
edeText     :: !ShortByteString
        -- ^ Extra-text payload (UTF-8).  May be empty.
    } deriving (O_ede -> O_ede -> Bool
(O_ede -> O_ede -> Bool) -> (O_ede -> O_ede -> Bool) -> Eq O_ede
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: O_ede -> O_ede -> Bool
== :: O_ede -> O_ede -> Bool
$c/= :: O_ede -> O_ede -> Bool
/= :: O_ede -> O_ede -> Bool
Eq, Int -> O_ede -> ShowS
[O_ede] -> ShowS
O_ede -> String
(Int -> O_ede -> ShowS)
-> (O_ede -> String) -> ([O_ede] -> ShowS) -> Show O_ede
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> O_ede -> ShowS
showsPrec :: Int -> O_ede -> ShowS
$cshow :: O_ede -> String
show :: O_ede -> String
$cshowList :: [O_ede] -> ShowS
showList :: [O_ede] -> ShowS
Show)

-- | Presentation form modelled after BIND @dig@:
--
-- > 9 (DNSKEY Missing): "no SEP matching the DS found for dnssec-failed.org."
--
-- The numeric code is always shown.  The friendly name (parenthesised,
-- raw — registry tags don't need quoting) and trailing colon+text
-- (DNS text quoting applied — the EXTRA-TEXT is free-form payload)
-- appear when present; an unregistered code with no extra text
-- renders as just the bare number.
instance Presentable O_ede where
    present :: O_ede -> Builder -> Builder
present (O_EDE Word16
code ShortByteString
name ShortByteString
text) =
        Word16 -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Word16
code (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
namePart (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
textPart
      where
        namePart :: Builder -> Builder
namePart
            | ShortByteString -> Bool
SB.null ShortByteString
name = Builder -> Builder
forall a. a -> a
id
            | Bool
otherwise    = forall a. Presentable a => a -> Builder -> Builder
present @String String
" ("
                           (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShortByteString -> Builder
B.shortByteString ShortByteString
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>)
                           (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Presentable a => a -> Builder -> Builder
present @String String
")"
        textPart :: Builder -> Builder
textPart
            | ShortByteString -> Bool
SB.null ShortByteString
text = Builder -> Builder
forall a. a -> a
id
            | Bool
otherwise    = forall a. Presentable a => a -> Builder -> Builder
present @String String
": "
                           (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DnsText -> Builder -> Builder)
-> ShortByteString -> Builder -> Builder
forall a b. Coercible a b => a -> b
coerce (forall a. Presentable a => a -> Builder -> Builder
present @DnsText) ShortByteString
text

instance KnownEdnsOption O_ede where
    type OptionExtensionVal O_ede = IM.IntMap ShortByteString
    optionExtensionVal :: forall b -> (b ~ O_ede) => OptionExtensionVal O_ede
optionExtensionVal _ = IntMap ShortByteString
OptionExtensionVal O_ede
baseEdeNames

    optNum :: forall b -> (b ~ O_ede) => OptNum
optNum _ = OptNum
EDE
    {-# INLINE optNum #-}
    optEncode :: forall s r. (Typeable r, Eq r, Show r) => O_ede -> SPut s r
optEncode (O_EDE Word16
c ShortByteString
_ ShortByteString
t) = do
        Word16 -> SPut s r
forall r s. ErrorContext r => Word16 -> SPut s r
put16 Word16
c
        ShortByteString -> SPut s r
forall r s. ErrorContext r => ShortByteString -> SPut s r
putShortByteString ShortByteString
t
    optDecode :: forall b ->
(b ~ O_ede) => OptionExtensionVal b -> Int -> SGet EdnsOption
optDecode _ OptionExtensionVal b
namesMap Int
len = do
        code <- SGet Word16
get16
        text <- getShortNByteString (len - 2)
        pure $! EdnsOption $! O_EDE code
            (IM.findWithDefault mempty (fromIntegral code) namesMap)
            text

instance ValueExtensible O_ede (IM.IntMap ShortByteString) where
    -- A caller registers a @(code, name)@ pair; later
    -- registrations win over earlier entries at the same code.
    type ValueExtensionArg O_ede b = (b ~ (Word16, ShortByteString))
    extendByValue :: forall t ->
forall b.
(t ~ O_ede, ValueExtensionArg t b) =>
b -> IntMap ShortByteString -> IntMap ShortByteString
extendByValue _ (Word16
code, ShortByteString
name) IntMap ShortByteString
m = Int
-> ShortByteString
-> IntMap ShortByteString
-> IntMap ShortByteString
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
code) ShortByteString
name IntMap ShortByteString
m

-- | Built-in friendly names for the EDE info-codes registered by
-- [IANA](https://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml#extended-dns-error-codes)
-- through RFC 8914 section 4 and subsequent assignments.
-- Applications can extend or override this map via
-- 'Net.DNSBase.Resolver.extendEdnsOptionWithValue' on 'O_ede'.
baseEdeNames :: IM.IntMap ShortByteString
baseEdeNames :: IntMap ShortByteString
baseEdeNames = [(Int, ShortByteString)] -> IntMap ShortByteString
forall a. [(Int, a)] -> IntMap a
IM.fromList
    [ ( Int
0, ShortByteString
"Other Error")
    , ( Int
1, ShortByteString
"Unsupported DNSKEY Algorithm")
    , ( Int
2, ShortByteString
"Unsupported DS Digest Type")
    , ( Int
3, ShortByteString
"Stale Answer")
    , ( Int
4, ShortByteString
"Forged Answer")
    , ( Int
5, ShortByteString
"DNSSEC Indeterminate")
    , ( Int
6, ShortByteString
"DNSSEC Bogus")
    , ( Int
7, ShortByteString
"Signature Expired")
    , ( Int
8, ShortByteString
"Signature Not Yet Valid")
    , ( Int
9, ShortByteString
"DNSKEY Missing")
    , (Int
10, ShortByteString
"RRSIGs Missing")
    , (Int
11, ShortByteString
"No Zone Key Bit Set")
    , (Int
12, ShortByteString
"NSEC Missing")
    , (Int
13, ShortByteString
"Cached Error")
    , (Int
14, ShortByteString
"Not Ready")
    , (Int
15, ShortByteString
"Blocked")
    , (Int
16, ShortByteString
"Censored")
    , (Int
17, ShortByteString
"Filtered")
    , (Int
18, ShortByteString
"Prohibited")
    , (Int
19, ShortByteString
"Stale NXDOMAIN Answer")
    , (Int
20, ShortByteString
"Not Authoritative")
    , (Int
21, ShortByteString
"Not Supported")
    , (Int
22, ShortByteString
"No Reachable Authority")
    , (Int
23, ShortByteString
"Network Error")
    , (Int
24, ShortByteString
"Invalid Data")
    , (Int
25, ShortByteString
"Signature Expired before Valid")
    , (Int
26, ShortByteString
"Too Early")
    , (Int
27, ShortByteString
"Unsupported NSEC3 Iterations Value")
    , (Int
28, ShortByteString
"Unable to conform to policy")
    , (Int
29, ShortByteString
"Synthesized")
    , (Int
30, ShortByteString
"Invalid Query Type")
    , (Int
31, ShortByteString
"Rate Limited")
    , (Int
32, ShortByteString
"Over Quota")
    ]