-- |
-- Module      : Net.DNSBase.Encode.Internal.Metric
-- Description : TBD
-- Copyright   : (c) Viktor Dukhovni, 2026
-- License     : BSD-3-Clause
-- Maintainer  : ietf-dane@dukhovni.org
-- Stability   : unstable
module Net.DNSBase.Encode.Internal.Metric
    ( SizedBuilder
    -- exported pattern
    , pattern SizedBuilder
    -- exported converters
    , mbErr
    , mbWord8
    , mbWord16
    , mbWord32
    , mbWord64
    , mbByteString
    , mbByteStringLen8
    , mbByteStringLen16
    , mbShortByteString
    , mbShortByteStringLen8
    , mbShortByteStringLen16
    , mbIPv4
    , mbIPv6
    ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Short as SB

import Net.DNSBase.Internal.Util

-- Auto-instantiated monoid that is coercible to and from SizedBuilder
-- and naturally specifies the proper semantics of each tuple element
type MonoMetricBuilder = (Sum Int, All, Builder)

-- | Monoidal wrapper over Builder monoid that internally records
-- the total length of the Builder output and maintains a flag
-- for post-hoc error checking
newtype SizedBuilder = SizedBuilder_ (Int, Bool, Builder)

instance Monoid SizedBuilder where
    mempty :: SizedBuilder
mempty = MonoMetricBuilder -> SizedBuilder
forall a b. Coercible a b => a -> b
coerce (MonoMetricBuilder
forall a. Monoid a => a
mempty :: MonoMetricBuilder)

-- | The semigroup operation is strict in all the elements of the tuple.
instance Semigroup SizedBuilder where
    {-# INLINE (<>) #-}
    SizedBuilder
x<> :: SizedBuilder -> SizedBuilder -> SizedBuilder
<>SizedBuilder
y = MonoMetricBuilder -> SizedBuilder
_force (MonoMetricBuilder -> SizedBuilder)
-> MonoMetricBuilder -> SizedBuilder
forall a b. (a -> b) -> a -> b
$ SizedBuilder -> MonoMetricBuilder
_mono SizedBuilder
x MonoMetricBuilder -> MonoMetricBuilder -> MonoMetricBuilder
forall a. Semigroup a => a -> a -> a
<> SizedBuilder -> MonoMetricBuilder
_mono SizedBuilder
y

{-# INLINE _mono #-}
_mono :: SizedBuilder -> MonoMetricBuilder
_mono :: SizedBuilder -> MonoMetricBuilder
_mono = SizedBuilder -> MonoMetricBuilder
forall a b. Coercible a b => a -> b
coerce

{-# INLINE _force #-}
_force :: MonoMetricBuilder -> SizedBuilder
_force :: MonoMetricBuilder -> SizedBuilder
_force MonoMetricBuilder
m = case MonoMetricBuilder -> SizedBuilder
forall a b. Coercible a b => a -> b
coerce MonoMetricBuilder
m of
    a :: SizedBuilder
a@(StrictMB Int
_ Bool
_ Builder
_) -> SizedBuilder
a

------------------ Pattern synonyms

pattern StrictMB :: Int -> Bool -> Builder -> SizedBuilder
pattern $mStrictMB :: forall {r}.
SizedBuilder -> (Int -> Bool -> Builder -> r) -> ((# #) -> r) -> r
$bStrictMB :: Int -> Bool -> Builder -> SizedBuilder
StrictMB n t b <- SizedBuilder_ (!n, !t, !b) where
  StrictMB !Int
n !Bool
t !Builder
b = (Int, Bool, Builder) -> SizedBuilder
SizedBuilder_ (Int
n, Bool
t, Builder
b)
{-# COMPLETE StrictMB #-}

-- Set sticky tag that the builder state is broken
pattern Invalid :: SizedBuilder
pattern $mInvalid :: forall {r}. SizedBuilder -> ((# #) -> r) -> ((# #) -> r) -> r
$bInvalid :: SizedBuilder
Invalid <- SizedBuilder_ ( _, False, _) where
  Invalid = (Int, Bool, Builder) -> SizedBuilder
SizedBuilder_ (Int
0, Bool
False, Builder
forall a. Monoid a => a
mempty)

pattern Valid :: Int -> Builder -> SizedBuilder
pattern $mValid :: forall {r}.
SizedBuilder -> (Int -> Builder -> r) -> ((# #) -> r) -> r
$bValid :: Int -> Builder -> SizedBuilder
Valid n b <- SizedBuilder_ (!n, True, b) where
  Valid !Int
n Builder
b = (Int, Bool, Builder) -> SizedBuilder
SizedBuilder_ (Int
n, Bool
True, Builder
b)
{-# COMPLETE Valid, Invalid #-}

-- | Extract length and builder when valid.
pattern SizedBuilder :: Int -> Builder -> SizedBuilder
pattern $mSizedBuilder :: forall {r}.
SizedBuilder -> (Int -> Builder -> r) -> ((# #) -> r) -> r
SizedBuilder n b <- SizedBuilder_ (!n, True, b)
{-# COMPLETE SizedBuilder, Invalid #-}

-- | SizedBuilder representing an unspecified error, probably
-- one of the inputs was too long.
mbErr :: SizedBuilder
mbErr :: SizedBuilder
mbErr = SizedBuilder
Invalid

-- internal constructors for fixed and variable -length values
_constlen ::       Int  -> (a -> Builder) -> a -> SizedBuilder
_varlen   :: (a -> Int) -> (a -> Builder) -> a -> SizedBuilder
_constlen :: forall a. Int -> (a -> Builder) -> a -> SizedBuilder
_constlen !Int
i !a -> Builder
f = \a
x -> Int -> Builder -> SizedBuilder
Valid Int
i (a -> Builder
f a
x)
_varlen :: forall a. (a -> Int) -> (a -> Builder) -> a -> SizedBuilder
_varlen   !a -> Int
l !a -> Builder
f = \a
x -> Int -> Builder -> SizedBuilder
Valid (a -> Int
l a
x) (a -> Builder
f a
x)
{-# INLINE _constlen #-}
{-# INLINE _varlen #-}

-- | Encode an unsigned 8-bit number.
mbWord8 :: Word8 -> SizedBuilder
mbWord8 :: Word8 -> SizedBuilder
mbWord8 = Int -> (Word8 -> Builder) -> Word8 -> SizedBuilder
forall a. Int -> (a -> Builder) -> a -> SizedBuilder
_constlen Int
1 Word8 -> Builder
B.word8
{-# INLINE mbWord8 #-}

-- | Encode an unsigned 16-bit number in network byte order.
mbWord16 :: Word16 -> SizedBuilder
mbWord16 :: Word16 -> SizedBuilder
mbWord16 = Int -> (Word16 -> Builder) -> Word16 -> SizedBuilder
forall a. Int -> (a -> Builder) -> a -> SizedBuilder
_constlen Int
2 Word16 -> Builder
B.word16BE
{-# INLINE mbWord16 #-}

-- | Encode an unsigned 32-bit number in network byte order.
mbWord32 :: Word32 -> SizedBuilder
mbWord32 :: Word32 -> SizedBuilder
mbWord32 = Int -> (Word32 -> Builder) -> Word32 -> SizedBuilder
forall a. Int -> (a -> Builder) -> a -> SizedBuilder
_constlen Int
4 Word32 -> Builder
B.word32BE
{-# INLINE mbWord32 #-}

-- | Encode an unsigned 64-bit number in network byte order.
mbWord64 :: Word64 -> SizedBuilder
mbWord64 :: Word64 -> SizedBuilder
mbWord64 = Int -> (Word64 -> Builder) -> Word64 -> SizedBuilder
forall a. Int -> (a -> Builder) -> a -> SizedBuilder
_constlen Int
8 Word64 -> Builder
B.word64BE
{-# INLINE mbWord64 #-}

{-# INLINE mbInt8 #-}
{-# INLINE mbInt16 #-}
mbInt8, mbInt16 :: Int -> SizedBuilder
mbInt8 :: Int -> SizedBuilder
mbInt8  = Int -> (Int -> Builder) -> Int -> SizedBuilder
forall a. Int -> (a -> Builder) -> a -> SizedBuilder
_constlen Int
1 (Int8 -> Builder
B.int8    (Int8 -> Builder) -> (Int -> Int8) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
mbInt16 :: Int -> SizedBuilder
mbInt16 = Int -> (Int -> Builder) -> Int -> SizedBuilder
forall a. Int -> (a -> Builder) -> a -> SizedBuilder
_constlen Int
2 (Int16 -> Builder
B.int16BE (Int16 -> Builder) -> (Int -> Int16) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

-- | Encode a "ByteString" of up to approximately 65535 bytes.  In practice the
-- limit is smaller since the entire DNS packet has a 16-bit length limit.
mbByteString :: ByteString -> SizedBuilder
mbByteString :: ByteString -> SizedBuilder
mbByteString ByteString
b
    | !Int
len <- ByteString -> Int
B.length ByteString
b
    , Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = Int -> Builder -> SizedBuilder
Valid Int
len (ByteString -> Builder
B.byteString ByteString
b)
    | Bool
otherwise     = SizedBuilder
mbErr

-- | Encode a length-tagged "ByteString" of up to 255 bytes.
mbByteStringLen8 :: ByteString -> SizedBuilder
mbByteStringLen8 :: ByteString -> SizedBuilder
mbByteStringLen8 ByteString
b
    | !Int
len <- ByteString -> Int
B.length ByteString
b
    , Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xff = Int -> SizedBuilder
mbInt8 Int
len SizedBuilder -> SizedBuilder -> SizedBuilder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> SizedBuilder
Valid Int
len (ByteString -> Builder
B.byteString ByteString
b)
    | Bool
otherwise   = SizedBuilder
mbErr

-- | Encode a length-tagged ByteString of up to approximately 65535 bytes.  In
-- practice the limit is smaller since the entire DNS packet has a 16-bit
-- length limit.
mbByteStringLen16 :: ByteString -> SizedBuilder
mbByteStringLen16 :: ByteString -> SizedBuilder
mbByteStringLen16 ByteString
b
    | !Int
len <- ByteString -> Int
B.length ByteString
b
    , Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = Int -> SizedBuilder
mbInt16 Int
len SizedBuilder -> SizedBuilder -> SizedBuilder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> SizedBuilder
Valid Int
len (ByteString -> Builder
B.byteString ByteString
b)
    | Bool
otherwise     = SizedBuilder
mbErr

-- | Encode a "ShortByteString" of up to approximately 65535 bytes.  In
-- practice the limit is smaller since the entire DNS packet has a 16-bit
-- length limit.
mbShortByteString :: ShortByteString -> SizedBuilder
mbShortByteString :: ShortByteString -> SizedBuilder
mbShortByteString ShortByteString
b
    | !Int
len <- ShortByteString -> Int
SB.length ShortByteString
b
    , Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = Int -> Builder -> SizedBuilder
Valid Int
len (ShortByteString -> Builder
B.shortByteString ShortByteString
b)
    | Bool
otherwise     = SizedBuilder
mbErr

-- | Encode a "ShortByteString" of up to 255 bytes, preceded by its length.
mbShortByteStringLen8 :: ShortByteString -> SizedBuilder
mbShortByteStringLen8 :: ShortByteString -> SizedBuilder
mbShortByteStringLen8 ShortByteString
b
    | Int
len <- ShortByteString -> Int
SB.length ShortByteString
b
    , Word8
l8 <- Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
    , Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xff = Int -> Builder -> SizedBuilder
Valid (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word8 -> Builder
B.word8 Word8
l8 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
B.shortByteString ShortByteString
b)
    | Bool
otherwise   = SizedBuilder
mbErr

-- | Encode a length-tagged ByteString of up to approximately 65535 bytes.  In
-- practice the limit is smaller since the entire DNS packet has a 16-bit
-- length limit.
mbShortByteStringLen16 :: ShortByteString -> SizedBuilder
mbShortByteStringLen16 :: ShortByteString -> SizedBuilder
mbShortByteStringLen16 ShortByteString
b
    | Int
len <- ShortByteString -> Int
SB.length ShortByteString
b
    , Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = Int -> SizedBuilder
mbInt16 Int
len SizedBuilder -> SizedBuilder -> SizedBuilder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> SizedBuilder
Valid Int
len (ShortByteString -> Builder
B.shortByteString ShortByteString
b)
    | Bool
otherwise     = SizedBuilder
mbErr

-- | Encode an IPv4 address
mbIPv4 :: IPv4 -> SizedBuilder
mbIPv4 :: IPv4 -> SizedBuilder
mbIPv4 = Int -> (IPv4 -> Builder) -> IPv4 -> SizedBuilder
forall a. Int -> (a -> Builder) -> a -> SizedBuilder
_constlen Int
4 (Word32 -> Builder
B.word32BE (Word32 -> Builder) -> (IPv4 -> Word32) -> IPv4 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Word32
fromIPv4w)

-- | Encode an IPv4 address
mbIPv6 :: IPv6 -> SizedBuilder
mbIPv6 :: IPv6 -> SizedBuilder
mbIPv6 = Int -> (IPv6 -> Builder) -> IPv6 -> SizedBuilder
forall a. Int -> (a -> Builder) -> a -> SizedBuilder
_constlen Int
16 \ (IPv6 -> (Word32, Word32, Word32, Word32)
fromIPv6w -> (Word32
w1, Word32
w2, Word32
w3, Word32
w4)) ->
    Word32 -> Builder
B.word32BE Word32
w1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
B.word32BE Word32
w2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
B.word32BE Word32
w3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
B.word32BE Word32
w4