{-|
Module      : Net.DNSBase.RRSet
Description : Owner/class/type RR sets with associated DNSSEC signatures
Copyright   : (c) Viktor Dukhovni, 2026
License     : BSD-3-Clause
Maintainer  : ietf-dane@dukhovni.org
Stability   : unstable

An 'RRSet' groups a flat list of 'RR' values into the standard
DNS unit: records sharing the same (owner, class, type),
together with any 'RRSIG' records covering them.  The
'rrSetsFromList' function partitions a flat list — typically
the answer or authority section of a 'Net.DNSBase.Message.DNSMessage' — into the
corresponding RRSets, attaching each RRSIG to the set it
covers based on the type-covered field.
-}
{-# LANGUAGE RecordWildCards #-}
module Net.DNSBase.RRSet
    ( RRSet(..)
    , rrSetsFromList
    )
    where
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE

import Net.DNSBase.Internal.Domain
import Net.DNSBase.Internal.RR
import Net.DNSBase.Internal.RRTYPE
import Net.DNSBase.Internal.RRCLASS
import Net.DNSBase.Internal.Util
import Net.DNSBase.RData.Dnssec

data RRSet = RRSet
    { RRSet -> Domain
rrSetOwner :: Domain
    , RRSet -> RRCLASS
rrSetClass :: RRCLASS
    , RRSet -> RRTYPE
rrSetType  :: RRTYPE
    , RRSet -> [RR]
rrSetRecs  :: [RR]
    , RRSet -> [RR]
rrSetSigs  :: [RR]
    }

rrSetsFromList :: [RR] -> [RRSet]
rrSetsFromList :: [RR] -> [RRSet]
rrSetsFromList [RR]
rrs = [RR]
rrs
    [RR] -> ([RR] -> [(RR, RRTYPE, Domain)]) -> [(RR, RRTYPE, Domain)]
forall a b. a -> (a -> b) -> b
& (RR -> (RR, RRTYPE, Domain)) -> [RR] -> [(RR, RRTYPE, Domain)]
forall a b. (a -> b) -> [a] -> [b]
map RR -> (RR, RRTYPE, Domain)
decorate
    [(RR, RRTYPE, Domain)]
-> ([(RR, RRTYPE, Domain)] -> [(RR, RRTYPE, Domain)])
-> [(RR, RRTYPE, Domain)]
forall a b. a -> (a -> b) -> b
& ((RR, RRTYPE, Domain) -> (RR, RRTYPE, Domain) -> Ordering)
-> [(RR, RRTYPE, Domain)] -> [(RR, RRTYPE, Domain)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (((RR, RRTYPE, Domain) -> (RRTYPE, RRCLASS, Domain))
-> (RR, RRTYPE, Domain) -> (RR, RRTYPE, Domain) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (RR, RRTYPE, Domain) -> (RRTYPE, RRCLASS, Domain)
drrKey)
    [(RR, RRTYPE, Domain)]
-> ([(RR, RRTYPE, Domain)] -> [NonEmpty (RR, RRTYPE, Domain)])
-> [NonEmpty (RR, RRTYPE, Domain)]
forall a b. a -> (a -> b) -> b
& ((RR, RRTYPE, Domain) -> (RRTYPE, RRCLASS, Domain))
-> [(RR, RRTYPE, Domain)] -> [NonEmpty (RR, RRTYPE, Domain)]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
NE.groupWith (RR, RRTYPE, Domain) -> (RRTYPE, RRCLASS, Domain)
drrKey
    [NonEmpty (RR, RRTYPE, Domain)]
-> ([NonEmpty (RR, RRTYPE, Domain)] -> [RRSet]) -> [RRSet]
forall a b. a -> (a -> b) -> b
& [NonEmpty (RR, RRTYPE, Domain)] -> [RRSet]
makeSets
  where
    decorate :: RR -> (RR, RRTYPE, Domain)
    decorate :: RR -> (RR, RRTYPE, Domain)
decorate RR
rr =
        let !styp :: RRTYPE
styp = RRTYPE -> (T_rrsig -> RRTYPE) -> Maybe T_rrsig -> RRTYPE
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RR -> RRTYPE
rrType RR
rr) T_rrsig -> RRTYPE
rrsigType (RR -> Maybe T_rrsig
forall a. KnownRData a => RR -> Maybe a
rrDataCast RR
rr)
            !host :: Domain
host = Domain -> Domain
canonicalise (RR -> Domain
rrOwner RR
rr)
         in (RR
rr, RRTYPE
styp, Domain
host)

    drrKey :: (RR, RRTYPE, Domain) -> (RRTYPE, RRCLASS, Domain)
    drrKey :: (RR, RRTYPE, Domain) -> (RRTYPE, RRCLASS, Domain)
drrKey (RR
rr, RRTYPE
typ, Domain
host) = (RRTYPE
typ, RR -> RRCLASS
rrClass RR
rr, Domain
host)

    makeSets :: [NonEmpty (RR, RRTYPE, Domain)] -> [RRSet]
    makeSets :: [NonEmpty (RR, RRTYPE, Domain)] -> [RRSet]
makeSets [] = []
    makeSets (((rr :: RR
rr@(RR -> RRCLASS
rrClass -> RRCLASS
rrSetClass), RRTYPE
rrSetType, Domain
rrSetOwner) :| [(RR, RRTYPE, Domain)]
rest) : [NonEmpty (RR, RRTYPE, Domain)]
grps)
        | !Domain
owner <- RR -> Domain
rrOwner RR
rr
        , ([RR]
rrSetRecs, [RR]
rrSetSigs) <- (RR -> Bool) -> [RR] -> ([RR], [RR])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition ((RRTYPE -> RRTYPE -> Bool
forall a. Eq a => a -> a -> Bool
== RRTYPE
rrSetType) (RRTYPE -> Bool) -> (RR -> RRTYPE) -> RR -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RR -> RRTYPE
rrType)
            ([RR] -> ([RR], [RR])) -> [RR] -> ([RR], [RR])
forall a b. (a -> b) -> a -> b
$ RR
rr RR -> [RR] -> [RR]
forall a. a -> [a] -> [a]
: Domain -> [(RR, RRTYPE, Domain)] -> [RR]
forall {t :: * -> *} {b} {c}.
Foldable t =>
Domain -> t (RR, b, c) -> [RR]
rrsOfWithOwner Domain
owner [(RR, RRTYPE, Domain)]
rest
        , Bool -> Bool
not ([RR] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RR]
rrSetRecs) = RRSet {[RR]
RRTYPE
RRCLASS
Domain
rrSetOwner :: Domain
rrSetClass :: RRCLASS
rrSetType :: RRTYPE
rrSetRecs :: [RR]
rrSetSigs :: [RR]
rrSetClass :: RRCLASS
rrSetType :: RRTYPE
rrSetOwner :: Domain
rrSetRecs :: [RR]
rrSetSigs :: [RR]
..} RRSet -> [RRSet] -> [RRSet]
forall a. a -> [a] -> [a]
: [NonEmpty (RR, RRTYPE, Domain)] -> [RRSet]
makeSets [NonEmpty (RR, RRTYPE, Domain)]
grps
        | Bool
otherwise = [NonEmpty (RR, RRTYPE, Domain)] -> [RRSet]
makeSets [NonEmpty (RR, RRTYPE, Domain)]
grps

    rrsOfWithOwner :: Domain -> t (RR, b, c) -> [RR]
rrsOfWithOwner Domain
owner = ((RR, b, c) -> [RR] -> [RR]) -> [RR] -> t (RR, b, c) -> [RR]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (RR, b, c) -> [RR] -> [RR]
go []
      where
        go :: (RR, b, c) -> [RR] -> [RR]
go ((RR, b, c) -> RR
setOwner -> !RR
h) ![RR]
t = RR
h RR -> [RR] -> [RR]
forall a. a -> [a] -> [a]
: [RR]
t
        setOwner :: (RR, b, c) -> RR
setOwner (RR
r, b
_, c
_) = RR
r {rrOwner = owner}