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

module Net.DNSBase.RData.CAA
    ( -- * Certification Authority Authorisation
      T_caa(..)
    , validCaaTag
    ) where

import qualified Data.ByteString.Short as SB

import Net.DNSBase.Internal.Util

import Net.DNSBase.Decode.State
import Net.DNSBase.Encode.Metric
import Net.DNSBase.Encode.State
import Net.DNSBase.Present
import Net.DNSBase.RData
import Net.DNSBase.RRTYPE
import Net.DNSBase.Text

-- | The @CAA@ resource record
-- ([RFC 8659 section 4.1](https://www.rfc-editor.org/rfc/rfc8659.html#section-4.1))
-- — three fields: an 8-bit flag byte, an ASCII-alphanumeric property
-- /tag/ (1..255 bytes), and the property's value (free-form bytes).
--
-- Tags are compared case-sensitively when comparing 'T_caa'
-- 'RData' objects.  CAs are required by RFC 8659 to handle tags
-- case-insensitively; that's a check for application-layer code,
-- not for the wire-format codec.  Use 'validCaaTag' to verify a
-- tag's syntactic constraints before encoding.
--
-- The 'Ord' instance compares the flag byte, then tag length,
-- then tag bytes, then value bytes — wire-encoding order, so it
-- agrees with the canonical RR-content ordering of
-- [RFC 4034 section 6.2](https://datatracker.ietf.org/doc/html/rfc4034#section-6.2).
data T_caa = T_CAA
    { T_caa -> Word8
caaFlags :: Word8
    , T_caa -> ShortByteString
caaTag   :: ShortByteString
    , T_caa -> ShortByteString
caaValue :: ShortByteString }
    deriving (T_caa -> T_caa -> Bool
(T_caa -> T_caa -> Bool) -> (T_caa -> T_caa -> Bool) -> Eq T_caa
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: T_caa -> T_caa -> Bool
== :: T_caa -> T_caa -> Bool
$c/= :: T_caa -> T_caa -> Bool
/= :: T_caa -> T_caa -> Bool
Eq, Int -> T_caa -> ShowS
[T_caa] -> ShowS
T_caa -> String
(Int -> T_caa -> ShowS)
-> (T_caa -> String) -> ([T_caa] -> ShowS) -> Show T_caa
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> T_caa -> ShowS
showsPrec :: Int -> T_caa -> ShowS
$cshow :: T_caa -> String
show :: T_caa -> String
$cshowList :: [T_caa] -> ShowS
showList :: [T_caa] -> ShowS
Show)

instance Ord T_caa where
    T_caa
a compare :: T_caa -> T_caa -> Ordering
`compare` T_caa
b = T_caa -> Word8
caaFlags  T_caa
a Word8 -> Word8 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` T_caa -> Word8
caaFlags  T_caa
b
                 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> T_caa -> Int
tagLength T_caa
a Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` T_caa -> Int
tagLength T_caa
b
                 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> T_caa -> ShortByteString
caaTag    T_caa
a ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` T_caa -> ShortByteString
caaTag    T_caa
b
                 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> T_caa -> ShortByteString
caaValue  T_caa
a ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` T_caa -> ShortByteString
caaValue  T_caa
b
      where
        tagLength :: T_caa -> Int
tagLength = ShortByteString -> Int
SB.length (ShortByteString -> Int)
-> (T_caa -> ShortByteString) -> T_caa -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_caa -> ShortByteString
caaTag

instance Presentable T_caa where
    present :: T_caa -> Builder -> Builder
present T_CAA{Word8
ShortByteString
caaFlags :: T_caa -> Word8
caaTag :: T_caa -> ShortByteString
caaValue :: T_caa -> ShortByteString
caaFlags :: Word8
caaTag :: ShortByteString
caaValue :: ShortByteString
..}
        = Word8 -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Word8
caaFlags
          (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp ShortByteString
caaTag
          (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Presentable a => a -> Builder -> Builder
presentSp @DnsText (ShortByteString -> DnsText
forall a b. Coercible a b => a -> b
coerce ShortByteString
caaValue)

instance KnownRData T_caa where
    rdType :: forall b -> (b ~ T_caa) => RRTYPE
rdType _ = RRTYPE
CAA
    rdEncode :: forall s. T_caa -> SPut s RData
rdEncode T_CAA{Word8
ShortByteString
caaFlags :: T_caa -> Word8
caaTag :: T_caa -> ShortByteString
caaValue :: T_caa -> ShortByteString
caaFlags :: Word8
caaTag :: ShortByteString
caaValue :: ShortByteString
..}
        | ShortByteString -> Bool
validCaaTag ShortByteString
caaTag = 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
$
                                   Word8 -> SizedBuilder
mbWord8 Word8
caaFlags
                                SizedBuilder -> SizedBuilder -> SizedBuilder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> SizedBuilder
mbShortByteStringLen8 ShortByteString
caaTag
                                SizedBuilder -> SizedBuilder -> SizedBuilder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> SizedBuilder
mbShortByteString ShortByteString
caaValue
        | Bool
otherwise         = (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s RData
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith a -> EncodeErr a
forall r. (Typeable r, Show r, Eq r) => r -> EncodeErr r
forall a. ErrorContext a => a -> EncodeErr a
CantEncode
    rdDecode :: forall b ->
(b ~ T_caa) => RDataExtensionVal T_caa -> Int -> SGet RData
rdDecode _ RDataExtensionVal T_caa
_ = SGet RData -> Int -> SGet RData
forall a b. a -> b -> a
const do
        caaFlags <- SGet Word8
get8
        caaTag   <- getShortByteStringLen8
        when (not $ validCaaTag caaTag) $ failSGet "CAA tag not alphanumeric"
        caaValue <- getShortByteString
        pure $ RData T_CAA{..}

-- | Verify a CAA tag's syntactic constraints: non-empty and made
-- entirely of ASCII alphanumeric bytes (RFC 8659 section 4.2).  Required
-- before encoding; the decoder applies the same check and rejects
-- a wire-form 'T_caa' whose tag fails it.
validCaaTag :: ShortByteString -> Bool
validCaaTag :: ShortByteString -> Bool
validCaaTag = Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (ShortByteString -> Bool) -> ShortByteString -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Bool
not (Bool -> Bool)
-> (ShortByteString -> Bool) -> ShortByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Bool
SB.null (ShortByteString -> Bool -> Bool)
-> (ShortByteString -> Bool) -> ShortByteString -> Bool
forall a b.
(ShortByteString -> a -> b)
-> (ShortByteString -> a) -> ShortByteString -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word8 -> Bool) -> ShortByteString -> Bool
SB.all Word8 -> Bool
forall {a}. (Ord a, Num a, Bits a) => a -> Bool
isalnum
  where
    isalnum :: a -> Bool
isalnum a
w = a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
0x30 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 Bool -> Bool -> Bool
|| (a
w a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xdf) a -> a -> a
forall a. Num a => a -> a -> a
- a
0x41 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
26