{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Network.Transport.QUIC.Internal.QUICAddr (
    EndPointId (..),
    QUICAddr (..),
    encodeQUICAddr,
    decodeQUICAddr,
) where

import Data.Binary (Binary)
import Data.ByteString.Char8 qualified as BS8
import Data.ByteString.Char8 qualified as BSC (unpack)
import Data.Word (Word32)
import Network.Socket (HostName, ServiceName)
import Network.Transport (EndPointAddress (EndPointAddress))

{- | Represents the unique ID of an endpoint within a transport.

This is used by endpoints to identify remote endpoints, even though
the remote endpoints are all backed by the same QUIC address.
-}
newtype EndPointId = EndPointId Word32
    deriving newtype (EndPointId -> EndPointId -> Bool
(EndPointId -> EndPointId -> Bool)
-> (EndPointId -> EndPointId -> Bool) -> Eq EndPointId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EndPointId -> EndPointId -> Bool
== :: EndPointId -> EndPointId -> Bool
$c/= :: EndPointId -> EndPointId -> Bool
/= :: EndPointId -> EndPointId -> Bool
Eq, Int -> EndPointId -> ShowS
[EndPointId] -> ShowS
EndPointId -> String
(Int -> EndPointId -> ShowS)
-> (EndPointId -> String)
-> ([EndPointId] -> ShowS)
-> Show EndPointId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EndPointId -> ShowS
showsPrec :: Int -> EndPointId -> ShowS
$cshow :: EndPointId -> String
show :: EndPointId -> String
$cshowList :: [EndPointId] -> ShowS
showList :: [EndPointId] -> ShowS
Show, Eq EndPointId
Eq EndPointId =>
(EndPointId -> EndPointId -> Ordering)
-> (EndPointId -> EndPointId -> Bool)
-> (EndPointId -> EndPointId -> Bool)
-> (EndPointId -> EndPointId -> Bool)
-> (EndPointId -> EndPointId -> Bool)
-> (EndPointId -> EndPointId -> EndPointId)
-> (EndPointId -> EndPointId -> EndPointId)
-> Ord EndPointId
EndPointId -> EndPointId -> Bool
EndPointId -> EndPointId -> Ordering
EndPointId -> EndPointId -> EndPointId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EndPointId -> EndPointId -> Ordering
compare :: EndPointId -> EndPointId -> Ordering
$c< :: EndPointId -> EndPointId -> Bool
< :: EndPointId -> EndPointId -> Bool
$c<= :: EndPointId -> EndPointId -> Bool
<= :: EndPointId -> EndPointId -> Bool
$c> :: EndPointId -> EndPointId -> Bool
> :: EndPointId -> EndPointId -> Bool
$c>= :: EndPointId -> EndPointId -> Bool
>= :: EndPointId -> EndPointId -> Bool
$cmax :: EndPointId -> EndPointId -> EndPointId
max :: EndPointId -> EndPointId -> EndPointId
$cmin :: EndPointId -> EndPointId -> EndPointId
min :: EndPointId -> EndPointId -> EndPointId
Ord, ReadPrec [EndPointId]
ReadPrec EndPointId
Int -> ReadS EndPointId
ReadS [EndPointId]
(Int -> ReadS EndPointId)
-> ReadS [EndPointId]
-> ReadPrec EndPointId
-> ReadPrec [EndPointId]
-> Read EndPointId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EndPointId
readsPrec :: Int -> ReadS EndPointId
$creadList :: ReadS [EndPointId]
readList :: ReadS [EndPointId]
$creadPrec :: ReadPrec EndPointId
readPrec :: ReadPrec EndPointId
$creadListPrec :: ReadPrec [EndPointId]
readListPrec :: ReadPrec [EndPointId]
Read, EndPointId
EndPointId -> EndPointId -> Bounded EndPointId
forall a. a -> a -> Bounded a
$cminBound :: EndPointId
minBound :: EndPointId
$cmaxBound :: EndPointId
maxBound :: EndPointId
Bounded, Int -> EndPointId
EndPointId -> Int
EndPointId -> [EndPointId]
EndPointId -> EndPointId
EndPointId -> EndPointId -> [EndPointId]
EndPointId -> EndPointId -> EndPointId -> [EndPointId]
(EndPointId -> EndPointId)
-> (EndPointId -> EndPointId)
-> (Int -> EndPointId)
-> (EndPointId -> Int)
-> (EndPointId -> [EndPointId])
-> (EndPointId -> EndPointId -> [EndPointId])
-> (EndPointId -> EndPointId -> [EndPointId])
-> (EndPointId -> EndPointId -> EndPointId -> [EndPointId])
-> Enum EndPointId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EndPointId -> EndPointId
succ :: EndPointId -> EndPointId
$cpred :: EndPointId -> EndPointId
pred :: EndPointId -> EndPointId
$ctoEnum :: Int -> EndPointId
toEnum :: Int -> EndPointId
$cfromEnum :: EndPointId -> Int
fromEnum :: EndPointId -> Int
$cenumFrom :: EndPointId -> [EndPointId]
enumFrom :: EndPointId -> [EndPointId]
$cenumFromThen :: EndPointId -> EndPointId -> [EndPointId]
enumFromThen :: EndPointId -> EndPointId -> [EndPointId]
$cenumFromTo :: EndPointId -> EndPointId -> [EndPointId]
enumFromTo :: EndPointId -> EndPointId -> [EndPointId]
$cenumFromThenTo :: EndPointId -> EndPointId -> EndPointId -> [EndPointId]
enumFromThenTo :: EndPointId -> EndPointId -> EndPointId -> [EndPointId]
Enum, Num EndPointId
Ord EndPointId
(Num EndPointId, Ord EndPointId) =>
(EndPointId -> Rational) -> Real EndPointId
EndPointId -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: EndPointId -> Rational
toRational :: EndPointId -> Rational
Real, Enum EndPointId
Real EndPointId
(Real EndPointId, Enum EndPointId) =>
(EndPointId -> EndPointId -> EndPointId)
-> (EndPointId -> EndPointId -> EndPointId)
-> (EndPointId -> EndPointId -> EndPointId)
-> (EndPointId -> EndPointId -> EndPointId)
-> (EndPointId -> EndPointId -> (EndPointId, EndPointId))
-> (EndPointId -> EndPointId -> (EndPointId, EndPointId))
-> (EndPointId -> Integer)
-> Integral EndPointId
EndPointId -> Integer
EndPointId -> EndPointId -> (EndPointId, EndPointId)
EndPointId -> EndPointId -> EndPointId
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: EndPointId -> EndPointId -> EndPointId
quot :: EndPointId -> EndPointId -> EndPointId
$crem :: EndPointId -> EndPointId -> EndPointId
rem :: EndPointId -> EndPointId -> EndPointId
$cdiv :: EndPointId -> EndPointId -> EndPointId
div :: EndPointId -> EndPointId -> EndPointId
$cmod :: EndPointId -> EndPointId -> EndPointId
mod :: EndPointId -> EndPointId -> EndPointId
$cquotRem :: EndPointId -> EndPointId -> (EndPointId, EndPointId)
quotRem :: EndPointId -> EndPointId -> (EndPointId, EndPointId)
$cdivMod :: EndPointId -> EndPointId -> (EndPointId, EndPointId)
divMod :: EndPointId -> EndPointId -> (EndPointId, EndPointId)
$ctoInteger :: EndPointId -> Integer
toInteger :: EndPointId -> Integer
Integral, Integer -> EndPointId
EndPointId -> EndPointId
EndPointId -> EndPointId -> EndPointId
(EndPointId -> EndPointId -> EndPointId)
-> (EndPointId -> EndPointId -> EndPointId)
-> (EndPointId -> EndPointId -> EndPointId)
-> (EndPointId -> EndPointId)
-> (EndPointId -> EndPointId)
-> (EndPointId -> EndPointId)
-> (Integer -> EndPointId)
-> Num EndPointId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: EndPointId -> EndPointId -> EndPointId
+ :: EndPointId -> EndPointId -> EndPointId
$c- :: EndPointId -> EndPointId -> EndPointId
- :: EndPointId -> EndPointId -> EndPointId
$c* :: EndPointId -> EndPointId -> EndPointId
* :: EndPointId -> EndPointId -> EndPointId
$cnegate :: EndPointId -> EndPointId
negate :: EndPointId -> EndPointId
$cabs :: EndPointId -> EndPointId
abs :: EndPointId -> EndPointId
$csignum :: EndPointId -> EndPointId
signum :: EndPointId -> EndPointId
$cfromInteger :: Integer -> EndPointId
fromInteger :: Integer -> EndPointId
Num, Get EndPointId
[EndPointId] -> Put
EndPointId -> Put
(EndPointId -> Put)
-> Get EndPointId -> ([EndPointId] -> Put) -> Binary EndPointId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: EndPointId -> Put
put :: EndPointId -> Put
$cget :: Get EndPointId
get :: Get EndPointId
$cputList :: [EndPointId] -> Put
putList :: [EndPointId] -> Put
Binary)

-- A QUICAddr represents the unique address an `endpoint` has, which involves
-- pointing to the transport (HostName, ServiceName) and then specific
-- endpoint spawned by that transport (EndpointId)
data QUICAddr = QUICAddr
    { QUICAddr -> String
quicBindHost :: !HostName
    , QUICAddr -> String
quicBindPort :: !ServiceName
    , QUICAddr -> EndPointId
quicEndpointId :: !EndPointId
    }
    deriving (QUICAddr -> QUICAddr -> Bool
(QUICAddr -> QUICAddr -> Bool)
-> (QUICAddr -> QUICAddr -> Bool) -> Eq QUICAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QUICAddr -> QUICAddr -> Bool
== :: QUICAddr -> QUICAddr -> Bool
$c/= :: QUICAddr -> QUICAddr -> Bool
/= :: QUICAddr -> QUICAddr -> Bool
Eq, Eq QUICAddr
Eq QUICAddr =>
(QUICAddr -> QUICAddr -> Ordering)
-> (QUICAddr -> QUICAddr -> Bool)
-> (QUICAddr -> QUICAddr -> Bool)
-> (QUICAddr -> QUICAddr -> Bool)
-> (QUICAddr -> QUICAddr -> Bool)
-> (QUICAddr -> QUICAddr -> QUICAddr)
-> (QUICAddr -> QUICAddr -> QUICAddr)
-> Ord QUICAddr
QUICAddr -> QUICAddr -> Bool
QUICAddr -> QUICAddr -> Ordering
QUICAddr -> QUICAddr -> QUICAddr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: QUICAddr -> QUICAddr -> Ordering
compare :: QUICAddr -> QUICAddr -> Ordering
$c< :: QUICAddr -> QUICAddr -> Bool
< :: QUICAddr -> QUICAddr -> Bool
$c<= :: QUICAddr -> QUICAddr -> Bool
<= :: QUICAddr -> QUICAddr -> Bool
$c> :: QUICAddr -> QUICAddr -> Bool
> :: QUICAddr -> QUICAddr -> Bool
$c>= :: QUICAddr -> QUICAddr -> Bool
>= :: QUICAddr -> QUICAddr -> Bool
$cmax :: QUICAddr -> QUICAddr -> QUICAddr
max :: QUICAddr -> QUICAddr -> QUICAddr
$cmin :: QUICAddr -> QUICAddr -> QUICAddr
min :: QUICAddr -> QUICAddr -> QUICAddr
Ord, Int -> QUICAddr -> ShowS
[QUICAddr] -> ShowS
QUICAddr -> String
(Int -> QUICAddr -> ShowS)
-> (QUICAddr -> String) -> ([QUICAddr] -> ShowS) -> Show QUICAddr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QUICAddr -> ShowS
showsPrec :: Int -> QUICAddr -> ShowS
$cshow :: QUICAddr -> String
show :: QUICAddr -> String
$cshowList :: [QUICAddr] -> ShowS
showList :: [QUICAddr] -> ShowS
Show)

-- | Encode a 'QUICAddr' to 'EndPointAddress'
encodeQUICAddr :: QUICAddr -> EndPointAddress
encodeQUICAddr :: QUICAddr -> EndPointAddress
encodeQUICAddr (QUICAddr String
host String
port EndPointId
ix) =
    ByteString -> EndPointAddress
EndPointAddress
        (String -> ByteString
BS8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
host String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
port String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> EndPointId -> String
forall a. Show a => a -> String
show EndPointId
ix)

-- | Decode end point address
decodeQUICAddr ::
    EndPointAddress ->
    Either String QUICAddr
decodeQUICAddr :: EndPointAddress -> Either String QUICAddr
decodeQUICAddr (EndPointAddress ByteString
bs) =
    case (Char -> Bool) -> Int -> String -> [String]
forall a. (a -> Bool) -> Int -> [a] -> [[a]]
splitMaxFromEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Int
2 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
bs of
        [String
host, String
port, String
endPointIdStr] ->
            case ReadS EndPointId
forall a. Read a => ReadS a
reads String
endPointIdStr of
                [(EndPointId
endPointId, String
"")] -> QUICAddr -> Either String QUICAddr
forall a b. b -> Either a b
Right (QUICAddr -> Either String QUICAddr)
-> QUICAddr -> Either String QUICAddr
forall a b. (a -> b) -> a -> b
$ String -> String -> EndPointId -> QUICAddr
QUICAddr String
host String
port EndPointId
endPointId
                [(EndPointId, String)]
_ -> String -> Either String QUICAddr
forall a b. a -> Either a b
Left (String -> Either String QUICAddr)
-> String -> Either String QUICAddr
forall a b. (a -> b) -> a -> b
$ String
"Undecodeable 'EndPointAddress': " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
bs
        [String]
_ ->
            String -> Either String QUICAddr
forall a b. a -> Either a b
Left (String -> Either String QUICAddr)
-> String -> Either String QUICAddr
forall a b. (a -> b) -> a -> b
$ String
"Undecodeable 'EndPointAddress': " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
bs

{- | @spltiMaxFromEnd p n xs@ splits list @xs@ at elements matching @p@,
returning at most @p@ segments -- counting from the /end/

> splitMaxFromEnd (== ':') 2 "ab:cd:ef:gh" == ["ab:cd", "ef", "gh"]
-}
splitMaxFromEnd :: (a -> Bool) -> Int -> [a] -> [[a]]
splitMaxFromEnd :: forall a. (a -> Bool) -> Int -> [a] -> [[a]]
splitMaxFromEnd a -> Bool
p = \Int
n -> [[a]] -> Int -> [a] -> [[a]]
forall {t}. (Eq t, Num t) => [[a]] -> t -> [a] -> [[a]]
go [[]] Int
n ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse
  where
    -- go :: [[a]] -> Int -> [a] -> [[a]]
    go :: [[a]] -> t -> [a] -> [[a]]
go [[a]]
accs t
_ [] = [[a]]
accs
    go ([] : [[a]]
accs) t
0 [a]
xs = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
accs
    go ([a]
acc : [[a]]
accs) t
n (a
x : [a]
xs) =
        if a -> Bool
p a
x
            then [[a]] -> t -> [a] -> [[a]]
go ([] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a]
acc [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
accs) (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [a]
xs
            else [[a]] -> t -> [a] -> [[a]]
go ((a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
accs) t
n [a]
xs
    go [[a]]
_ t
_ [a]
_ = String -> [[a]]
forall a. HasCallStack => String -> a
error String
"Bug in splitMaxFromEnd"