{-|
Module      : Net.DNSBase.RData.SVCB.SPVSet
Description : Indexed collection of SVCB service-parameter values
Copyright   : (c) Viktor Dukhovni, 2026
License     : BSD-3-Clause
Maintainer  : ietf-dane@dukhovni.org
Stability   : unstable

The collection of service parameters carried in a single
@SVCB@ or @HTTPS@ record, keyed by 'Net.DNSBase.RData.SVCB.SVCParamKey' (one value
per key code, per RFC 9460).  Construction is via the 'IsList'
instance — @fromList [SVCParamValue p1, ...]@; enumeration via
'toList' returns the parameters in ascending key order, which
is also the canonical on-the-wire order.

Each key code is associated with a specific 'KnownSVCParamValue'
type; the values are held inside the existential 'SVCParamValue'
wrapper so a single set can mix heterogeneous parameter types.
'spvLookup' takes the parameter /type/ as a type application
and returns the typed value when the matching key is present:

> ghci> import qualified GHC.IsList as IL (fromList)
> ghci> spvset = IL.fromList @SPVSet [SVCParamValue (SPV_PORT 80), SVCParamValue SPV_NDALPN]
> ghci> spvset
> fromList @SPVSet [SVCParamValue SPV_NDALPN,SVCParamValue 80]
> ghci> spvLookup @SPV_ndalpn spvset
> Just SPV_NDALPN

The type application can be elided when a pattern match
constrains the result type:

> ghci> case spvLookup spvset of { Just (SPV_PORT p) -> p; _ -> 0 }
> 80
-}

module Net.DNSBase.RData.SVCB.SPVSet
    ( SPVSet(SPVMap)
    , spvLookup
    , spvSetFromMonoList
    ) where

import qualified Data.IntMap.Strict as IM
import GHC.IsList(IsList(..))

import Net.DNSBase.Internal.Util

import Net.DNSBase.Present
import Net.DNSBase.RData.SVCB.SVCParamValue

-- | The set of service parameters in an @SVCB@ or @HTTPS@ record,
-- with at most one value per 'Net.DNSBase.RData.SVCB.SVCParamKey'.  The 'Monoid'
-- instance provides the empty set; the 'Semigroup' instance is
-- left-biased on key collisions.
newtype SPVSet = SPVSet (IM.IntMap SVCParamValue)
    deriving (SPVSet -> SPVSet -> Bool
(SPVSet -> SPVSet -> Bool)
-> (SPVSet -> SPVSet -> Bool) -> Eq SPVSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SPVSet -> SPVSet -> Bool
== :: SPVSet -> SPVSet -> Bool
$c/= :: SPVSet -> SPVSet -> Bool
/= :: SPVSet -> SPVSet -> Bool
Eq, NonEmpty SPVSet -> SPVSet
SPVSet -> SPVSet -> SPVSet
(SPVSet -> SPVSet -> SPVSet)
-> (NonEmpty SPVSet -> SPVSet)
-> (forall b. Integral b => b -> SPVSet -> SPVSet)
-> Semigroup SPVSet
forall b. Integral b => b -> SPVSet -> SPVSet
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SPVSet -> SPVSet -> SPVSet
<> :: SPVSet -> SPVSet -> SPVSet
$csconcat :: NonEmpty SPVSet -> SPVSet
sconcat :: NonEmpty SPVSet -> SPVSet
$cstimes :: forall b. Integral b => b -> SPVSet -> SPVSet
stimes :: forall b. Integral b => b -> SPVSet -> SPVSet
Semigroup, Semigroup SPVSet
SPVSet
Semigroup SPVSet =>
SPVSet
-> (SPVSet -> SPVSet -> SPVSet)
-> ([SPVSet] -> SPVSet)
-> Monoid SPVSet
[SPVSet] -> SPVSet
SPVSet -> SPVSet -> SPVSet
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SPVSet
mempty :: SPVSet
$cmappend :: SPVSet -> SPVSet -> SPVSet
mappend :: SPVSet -> SPVSet -> SPVSet
$cmconcat :: [SPVSet] -> SPVSet
mconcat :: [SPVSet] -> SPVSet
Monoid)

instance Show SPVSet where
    showsPrec :: Key -> SPVSet -> ShowS
showsPrec Key
p (SPVSet -> [Item SPVSet]
forall l. IsList l => l -> [Item l]
toList -> [Item SPVSet]
pvs) = Key -> ShowS -> ShowS
showsP Key
p (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"fromList @SPVSet " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SVCParamValue] -> ShowS
forall a. Show a => a -> ShowS
shows' [Item SPVSet]
[SVCParamValue]
pvs

instance Presentable SPVSet where
    present :: SPVSet -> Builder -> Builder
present SPVSet
vs Builder
k = case SPVSet -> [Item SPVSet]
forall l. IsList l => l -> [Item l]
toList SPVSet
vs of
        Item SPVSet
v:[Item SPVSet]
rest -> SVCParamValue -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Item SPVSet
SVCParamValue
v (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ (SVCParamValue -> Builder -> Builder)
-> Builder -> [SVCParamValue] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SVCParamValue -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp Builder
k [Item SPVSet]
[SVCParamValue]
rest
        []     -> Builder
k

-- | One-sided pattern that exposes the underlying 'IM.IntMap' for
-- traversal or low-level inspection.  The values are kept in the
-- existential 'SVCParamValue' wrapper, so any concrete parameter
-- may be either typed (a 'KnownSVCParamValue' instance) or
-- 'Net.DNSBase.RData.SVCB.OpaqueSPV'.  For typed lookups by parameter type use
-- 'spvLookup' instead.
pattern SPVMap :: IM.IntMap SVCParamValue -- ^ Values as an 'IM.IntMap'
               -> SPVSet
pattern $mSPVMap :: forall {r}.
SPVSet -> (IntMap SVCParamValue -> r) -> ((# #) -> r) -> r
SPVMap m <- SPVSet m

-- | Look up the parameter at the key associated with type @a@,
-- returning a 'Just' only when the stored value really is of type
-- @a@.  A value of the same key code but held as 'Net.DNSBase.RData.SVCB.OpaqueSPV'
-- (because the typed instance was not registered when the record
-- was decoded) does /not/ match — opaque values must be
-- retrieved through 'SPVMap'.
spvLookup :: forall a. KnownSVCParamValue a
          => SPVSet -> Maybe a
spvLookup :: forall a. KnownSVCParamValue a => SPVSet -> Maybe a
spvLookup = (Maybe SVCParamValue -> (SVCParamValue -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. KnownSVCParamValue a => SVCParamValue -> Maybe a
fromSPV @a) (Maybe SVCParamValue -> Maybe a)
-> (SPVSet -> Maybe SVCParamValue) -> SPVSet -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> IntMap SVCParamValue -> Maybe SVCParamValue
forall a. Key -> IntMap a -> Maybe a
IM.lookup Key
key (IntMap SVCParamValue -> Maybe SVCParamValue)
-> (SPVSet -> IntMap SVCParamValue)
-> SPVSet
-> Maybe SVCParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SPVSet -> IntMap SVCParamValue
forall a b. Coercible a b => a -> b
coerce
  where
    key :: Key
key = SVCParamKey -> Key
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SVCParamKey -> Key) -> SVCParamKey -> Key
forall a b. (a -> b) -> a -> b
$ spvKey a

-- | Construction is via 'fromList', and enumeration is via 'toList'.
instance IsList SPVSet where
    type Item SPVSet = SVCParamValue

    -- | Construct a parameter Map from an unordered list.
    fromList :: [Item SPVSet] -> SPVSet
fromList [Item SPVSet]
vs =
        IntMap SVCParamValue -> SPVSet
forall a b. Coercible a b => a -> b
coerce (IntMap SVCParamValue -> SPVSet) -> IntMap SVCParamValue -> SPVSet
forall a b. (a -> b) -> a -> b
$ [(Key, SVCParamValue)] -> IntMap SVCParamValue
forall a. [(Key, a)] -> IntMap a
IM.fromList
               [ (Key
key, SVCParamValue
v) | SVCParamValue
v <- [Item SPVSet]
[SVCParamValue]
vs , let key :: Key
key = SVCParamKey -> Key
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SVCParamKey -> Key) -> SVCParamKey -> Key
forall a b. (a -> b) -> a -> b
$ SVCParamValue -> SVCParamKey
serviceParamKey SVCParamValue
v ]

    -- | Return the map as a list in ascending parameter order.
    toList :: SPVSet -> [Item SPVSet]
toList = IntMap SVCParamValue -> [SVCParamValue]
forall a. IntMap a -> [a]
IM.elems (IntMap SVCParamValue -> [SVCParamValue])
-> (SPVSet -> IntMap SVCParamValue) -> SPVSet -> [SVCParamValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SPVSet -> IntMap SVCParamValue
forall a b. Coercible a b => a -> b
coerce

-- | Build an 'SPVSet' from a list of 'SVCParamValue's whose keys
-- are in /strict monotone-increasing/ order (so also no
-- duplicates) — the precondition imposed by the underlying
-- 'IM.fromDistinctAscList' used to build the set.  The \"Mono\"
-- is intended as a reminder of the precondition.
--
-- Used internally by the wire-form decoder, which validates
-- ascending keys during parsing; application code that cannot
-- guarantee the precondition should use 'fromList' from the
-- 'IsList' instance instead.
spvSetFromMonoList :: [SVCParamValue] -> SPVSet
spvSetFromMonoList :: [SVCParamValue] -> SPVSet
spvSetFromMonoList = ([SVCParamValue] -> IntMap SVCParamValue)
-> [SVCParamValue] -> SPVSet
forall a b. Coercible a b => a -> b
coerce (([SVCParamValue] -> IntMap SVCParamValue)
 -> [SVCParamValue] -> SPVSet)
-> ([SVCParamValue] -> IntMap SVCParamValue)
-> [SVCParamValue]
-> SPVSet
forall a b. (a -> b) -> a -> b
$ [(Key, SVCParamValue)] -> IntMap SVCParamValue
forall a. [(Key, a)] -> IntMap a
IM.fromDistinctAscList ([(Key, SVCParamValue)] -> IntMap SVCParamValue)
-> ([SVCParamValue] -> [(Key, SVCParamValue)])
-> [SVCParamValue]
-> IntMap SVCParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SVCParamValue -> (Key, SVCParamValue))
-> [SVCParamValue] -> [(Key, SVCParamValue)]
forall a b. (a -> b) -> [a] -> [b]
map SVCParamValue -> (Key, SVCParamValue)
forall {a}. Num a => SVCParamValue -> (a, SVCParamValue)
kv
  where
    kv :: SVCParamValue -> (a, SVCParamValue)
kv !SVCParamValue
v = let !k :: a
k = SVCParamKey -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SVCParamKey -> a) -> SVCParamKey -> a
forall a b. (a -> b) -> a -> b
$ SVCParamValue -> SVCParamKey
serviceParamKey SVCParamValue
v in (a
k, SVCParamValue
v)