-- | Circuit Relay v2 client: make reservations and connect through relays.
--
-- Client-side operations:
--   - makeReservation: send RESERVE to relay, receive reservation info
--   - connectViaRelay: send CONNECT to relay, receive relayed stream
--   - handleStop: target receives relay'd connection notification
module Network.LibP2P.NAT.Relay.Client
  ( -- * Client operations
    makeReservation
  , connectViaRelay
    -- * Target handler
  , handleStop
  ) where

import Network.LibP2P.NAT.Relay.Message
import Network.LibP2P.MultistreamSelect.Negotiation (StreamIO (..))
import Network.LibP2P.Crypto.PeerId (PeerId (..))

-- | Send a RESERVE request to a relay and receive the reservation response.
makeReservation :: StreamIO -> IO (Either String HopMessage)
makeReservation :: StreamIO -> IO (Either String HopMessage)
makeReservation StreamIO
stream = do
  let reserveMsg :: HopMessage
reserveMsg = HopMessage
        { hopType :: Maybe HopMessageType
hopType = HopMessageType -> Maybe HopMessageType
forall a. a -> Maybe a
Just HopMessageType
HopReserve
        , hopPeer :: Maybe RelayPeer
hopPeer = Maybe RelayPeer
forall a. Maybe a
Nothing
        , hopReservation :: Maybe Reservation
hopReservation = Maybe Reservation
forall a. Maybe a
Nothing
        , hopLimit :: Maybe RelayLimit
hopLimit = Maybe RelayLimit
forall a. Maybe a
Nothing
        , hopStatus :: Maybe RelayStatus
hopStatus = Maybe RelayStatus
forall a. Maybe a
Nothing
        }
  StreamIO -> HopMessage -> IO ()
writeHopMessage StreamIO
stream HopMessage
reserveMsg
  StreamIO -> Int -> IO (Either String HopMessage)
readHopMessage StreamIO
stream Int
maxRelayMessageSize

-- | Send a CONNECT request to a relay to reach a target peer.
connectViaRelay :: StreamIO -> PeerId -> IO (Either String HopMessage)
connectViaRelay :: StreamIO -> PeerId -> IO (Either String HopMessage)
connectViaRelay StreamIO
stream (PeerId ByteString
targetIdBytes) = do
  let connectReq :: HopMessage
connectReq = HopMessage
        { hopType :: Maybe HopMessageType
hopType = HopMessageType -> Maybe HopMessageType
forall a. a -> Maybe a
Just HopMessageType
HopConnect
        , hopPeer :: Maybe RelayPeer
hopPeer = RelayPeer -> Maybe RelayPeer
forall a. a -> Maybe a
Just RelayPeer
            { rpId :: ByteString
rpId = ByteString
targetIdBytes
            , rpAddrs :: [ByteString]
rpAddrs = []
            }
        , hopReservation :: Maybe Reservation
hopReservation = Maybe Reservation
forall a. Maybe a
Nothing
        , hopLimit :: Maybe RelayLimit
hopLimit = Maybe RelayLimit
forall a. Maybe a
Nothing
        , hopStatus :: Maybe RelayStatus
hopStatus = Maybe RelayStatus
forall a. Maybe a
Nothing
        }
  StreamIO -> HopMessage -> IO ()
writeHopMessage StreamIO
stream HopMessage
connectReq
  StreamIO -> Int -> IO (Either String HopMessage)
readHopMessage StreamIO
stream Int
maxRelayMessageSize

-- | Handle an incoming stop connection from a relay (target side).
-- Reads the CONNECT message, responds with OK, and returns the source peer ID and limit.
handleStop :: StreamIO -> IO (Either String (PeerId, Maybe RelayLimit))
handleStop :: StreamIO -> IO (Either String (PeerId, Maybe RelayLimit))
handleStop StreamIO
stream = do
  result <- StreamIO -> Int -> IO (Either String StopMessage)
readStopMessage StreamIO
stream Int
maxRelayMessageSize
  case result of
    Left String
err -> Either String (PeerId, Maybe RelayLimit)
-> IO (Either String (PeerId, Maybe RelayLimit))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (PeerId, Maybe RelayLimit)
forall a b. a -> Either a b
Left String
err)
    Right StopMessage
msg -> case StopMessage -> Maybe StopMessageType
stopType StopMessage
msg of
      Just StopMessageType
StopConnect -> do
        case StopMessage -> Maybe RelayPeer
stopPeer StopMessage
msg of
          Maybe RelayPeer
Nothing -> do
            StreamIO -> RelayStatus -> IO ()
sendStopStatus StreamIO
stream RelayStatus
MalformedMessage
            Either String (PeerId, Maybe RelayLimit)
-> IO (Either String (PeerId, Maybe RelayLimit))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (PeerId, Maybe RelayLimit)
forall a b. a -> Either a b
Left String
"stop CONNECT missing peer info")
          Just RelayPeer
peer -> do
            -- Respond with OK
            StreamIO -> RelayStatus -> IO ()
sendStopStatus StreamIO
stream RelayStatus
RelayOK
            let sourcePeerId :: PeerId
sourcePeerId = ByteString -> PeerId
PeerId (RelayPeer -> ByteString
rpId RelayPeer
peer)
            Either String (PeerId, Maybe RelayLimit)
-> IO (Either String (PeerId, Maybe RelayLimit))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((PeerId, Maybe RelayLimit)
-> Either String (PeerId, Maybe RelayLimit)
forall a b. b -> Either a b
Right (PeerId
sourcePeerId, StopMessage -> Maybe RelayLimit
stopLimit StopMessage
msg))
      Maybe StopMessageType
_ -> Either String (PeerId, Maybe RelayLimit)
-> IO (Either String (PeerId, Maybe RelayLimit))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (PeerId, Maybe RelayLimit)
forall a b. a -> Either a b
Left String
"unexpected stop message type")

-- | Send a StopMessage STATUS response.
sendStopStatus :: StreamIO -> RelayStatus -> IO ()
sendStopStatus :: StreamIO -> RelayStatus -> IO ()
sendStopStatus StreamIO
stream RelayStatus
status = StreamIO -> StopMessage -> IO ()
writeStopMessage StreamIO
stream StopMessage
  { stopType :: Maybe StopMessageType
stopType = StopMessageType -> Maybe StopMessageType
forall a. a -> Maybe a
Just StopMessageType
StopStatus
  , stopPeer :: Maybe RelayPeer
stopPeer = Maybe RelayPeer
forall a. Maybe a
Nothing
  , stopLimit :: Maybe RelayLimit
stopLimit = Maybe RelayLimit
forall a. Maybe a
Nothing
  , stopStatus :: Maybe RelayStatus
stopStatus = RelayStatus -> Maybe RelayStatus
forall a. a -> Maybe a
Just RelayStatus
status
  }