QUICAddr.hs

{-# 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 (Eq, Show, Ord, Read, Bounded, Enum, Real, Integral, Num, 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
  { quicBindHost :: !HostName,
    quicBindPort :: !ServiceName,
    quicEndpointId :: !EndPointId
  }
  deriving (Eq, Ord, Show)

-- | Encode a 'QUICAddr' to 'EndPointAddress'
encodeQUICAddr :: QUICAddr -> EndPointAddress
encodeQUICAddr (QUICAddr host port ix) =
  EndPointAddress
    (BS8.pack $ host <> ":" <> port <> ":" <> show ix)

-- | Decode end point address
decodeQUICAddr ::
  EndPointAddress ->
  Either String QUICAddr
decodeQUICAddr (EndPointAddress bs) =
  case splitMaxFromEnd (== ':') 2 $ BSC.unpack bs of
    [host, port, endPointIdStr] ->
      case reads endPointIdStr of
        [(endPointId, "")] -> Right $ QUICAddr host port endPointId
        _ -> Left $ "Undecodeable 'EndPointAddress': " <> show bs
    _ ->
      Left $ "Undecodeable 'EndPointAddress': " <> show 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 p = \n -> go [[]] n . reverse
  where
    -- go :: [[a]] -> Int -> [a] -> [[a]]
    go accs _ [] = accs
    go ([] : accs) 0 xs = reverse xs : accs
    go (acc : accs) n (x : xs) =
      if p x
        then go ([] : acc : accs) (n - 1) xs
        else go ((x : acc) : accs) n xs
    go _ _ _ = error "Bug in splitMaxFromEnd"