-- | NAT traversal handler registration (specs/autonat, specs/relay, specs/relay/DCUtR).
--
-- Wires the AutoNAT, Circuit Relay v2, and DCUtR module implementations
-- into the Switch protocol registry, in the style of
-- 'LibP2P.Protocol.Identify.registerIdentifyHandlers':
--
--   /libp2p/autonat/1.0.0            — AutoNAT dial-back server
--   /libp2p/circuit/relay/0.2.0/hop  — Circuit Relay v2 relay server
--   /libp2p/circuit/relay/0.2.0/stop — Circuit Relay v2 target (inbound relayed streams)
--   /libp2p/dcutr                    — DCUtR hole-punch coordination (handler side)
module LibP2P.NAT
  ( -- * Configuration
    NATConfig (..)
  , defaultNATConfig
    -- * Registration
  , registerNATHandlers
  , registerAutoNATHandler
  , registerRelayHopHandler
  , registerRelayStopHandler
  , registerDCUtRHandler
  , registerReservationCleanup
    -- * DCUtR production integration
  , registerDCUtRUpgrade
  , upgradeRelayedConnection
  , holePunchTargets
  , dcutrOwnAddrs
  , DCUtRUpgradeConfig (..)
  , defaultDCUtRUpgradeConfig
    -- * Circuit client
  , CircuitState
  , ReservationRefreshConfig (..)
  , defaultReservationRefreshConfig
  ) where

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (async)
import Control.Concurrent.STM (atomically, modifyTVar', readTVar)
import Control.Monad (filterM, unless, void)
import Data.List (nub)
import Data.Maybe (fromMaybe)
import System.Timeout (timeout)
import qualified Data.Map.Strict as Map
import Control.Exception (SomeException, catch, try)
import LibP2P.Crypto.PeerId (PeerId, peerIdBytes)
import LibP2P.Multiaddr (Multiaddr (..), encapsulate, fromBytes, isPublicAddr, isRelayedAddr)
import LibP2P.Multiaddr.Protocol (Protocol (..))
import LibP2P.MultistreamSelect.Negotiation
  ( NegotiationResult (..)
  , StreamIO (..)
  , negotiateInitiator
  )
import LibP2P.NAT.AutoNAT (AutoNATConfig (..), handleAutoNAT)
import LibP2P.NAT.AutoNAT.Message (autoNATProtocolId)
import LibP2P.NAT.DCUtR (DCUtRConfig (..), DCUtRResult (..), handleDCUtR, initiateDCUtR)
import LibP2P.NAT.DCUtR.Message (dcutrProtocolId)
import LibP2P.NAT.Relay
  ( HopContext (..)
  , RelayConfig
  , RelayState
  , defaultRelayConfig
  , handleConnect
  , handleReserve
  , newRelayState
  , rsReservations
  )
import LibP2P.NAT.Relay.Client (handleStop)
import LibP2P.NAT.Relay.Message
  ( HopMessage (..)
  , HopMessageType (..)
  , RelayStatus (..)
  , hopProtocolId
  , maxRelayMessageSize
  , readHopMessage
  , stopProtocolId
  , writeHopMessage
  )
import LibP2P.NAT.Relay.Transport
  ( CircuitAddr (..)
  , CircuitState
  , ReservationRefreshConfig (..)
  , acceptStopStream
  , circuitTransport
  , defaultReservationRefreshConfig
  , newCircuitState
  , parseCircuitAddr
  )
import LibP2P.Switch (addTransport, selectTransport, setStreamHandler)
import LibP2P.Switch.ConnPool (lookupAllConns, lookupConn)
import LibP2P.Switch.Connection (closeConnection, newStream)
import LibP2P.Switch.Dial (DialOpts (..), dialWith)
import LibP2P.Switch.Listen (switchListenAddrs)
import LibP2P.Protocol.Identify (identifyPeer)
import LibP2P.Protocol.Identify.Message (IdentifyInfo (..))
import LibP2P.Switch.Types
  ( ConnState (..)
  , Connection (..)
  , Direction (..)
  , MuxerSession (..)
  , Switch (..)
  )
import LibP2P.Switch.Upgrade (upgradeOutbound)
import LibP2P.Transport (Transport (..))

-- | Configuration for the NAT traversal handlers.
data NATConfig = NATConfig
  { NATConfig -> RelayConfig
ncRelayConfig       :: RelayConfig
    -- ^ Resource limits for the Circuit Relay v2 server side
  , NATConfig -> ReservationRefreshConfig
ncReservationRefresh :: ReservationRefreshConfig
    -- ^ Tuning for the circuit client's reservation refresh loop
  , NATConfig -> DCUtRUpgradeConfig
ncDCUtRUpgrade      :: DCUtRUpgradeConfig
    -- ^ Tuning for the DCUtR direct-connection upgrade
  }

-- | Tuning for the DCUtR upgrade that runs on an inbound relayed
-- connection.
data DCUtRUpgradeConfig = DCUtRUpgradeConfig
  { DCUtRUpgradeConfig -> Int
ducMaxAttempts :: !Int
    -- ^ Hole punch attempts, each re-running the CONNECT/SYNC exchange
    -- so RTT is re-measured. specs/relay/DCUtR: inbound peers "SHOULD
    -- retry twice (thus a total of 3 attempts)".
  , DCUtRUpgradeConfig -> Int
ducDirectDialTimeoutMicros :: !Int
    -- ^ Bound on one hole punch dial. Without it a dial whose peer never
    -- answers the handshake pins a socket and a thread forever: a
    -- simultaneous connect that fails to collide lands on the peer's
    -- ordinary listener, leaving both ends running the responder side.
    -- go-libp2p bounds the same dial with @defaultDirectDialTimeout@.
  , DCUtRUpgradeConfig -> Int
ducStreamTimeoutMicros :: !Int
    -- ^ Bound on the whole @\/libp2p\/dcutr@ coordination exchange. The
    -- relay carrying it can vanish mid-exchange. go-libp2p sets the same
    -- bound as a stream deadline (@StreamTimeout@).
  , DCUtRUpgradeConfig -> Int
ducRelayCloseGraceMicros :: !Int
    -- ^ How long the relay connection is kept after a successful
    -- upgrade. specs/relay/DCUtR: "the relay connection should be closed
    -- after a grace period". go-libp2p's holepunch package leaves this
    -- to its connection manager, which this implementation does not
    -- have, so the delay is applied here.
  }

-- | Three hole punch attempts and a 15s grace period before the relay
-- connection is dropped.
defaultDCUtRUpgradeConfig :: DCUtRUpgradeConfig
defaultDCUtRUpgradeConfig :: DCUtRUpgradeConfig
defaultDCUtRUpgradeConfig = DCUtRUpgradeConfig
  { ducMaxAttempts :: Int
ducMaxAttempts             = Int
3
  , ducDirectDialTimeoutMicros :: Int
ducDirectDialTimeoutMicros = Int
10000000  -- go-libp2p: defaultDirectDialTimeout
  , ducStreamTimeoutMicros :: Int
ducStreamTimeoutMicros     = Int
60000000  -- go-libp2p: StreamTimeout
  , ducRelayCloseGraceMicros :: Int
ducRelayCloseGraceMicros   = Int
15000000
  }

-- | Default NAT configuration: default relay limits and refresh tuning.
defaultNATConfig :: NATConfig
defaultNATConfig :: NATConfig
defaultNATConfig = NATConfig
  { ncRelayConfig :: RelayConfig
ncRelayConfig        = RelayConfig
defaultRelayConfig
  , ncReservationRefresh :: ReservationRefreshConfig
ncReservationRefresh = ReservationRefreshConfig
defaultReservationRefreshConfig
  , ncDCUtRUpgrade :: DCUtRUpgradeConfig
ncDCUtRUpgrade       = DCUtRUpgradeConfig
defaultDCUtRUpgradeConfig
  }

-- | Register the NAT protocol handlers and the circuit client transport
-- on the Switch.
--
-- Returns the relay server state (so callers can inspect
-- reservations/circuits) and the circuit client state, which ties
-- 'transportListen' on a @p2p-circuit@ address to the inbound @stop@
-- streams that arrive over the connection to that relay.
registerNATHandlers :: Switch -> NATConfig -> IO (RelayState, CircuitState)
registerNATHandlers :: Switch -> NATConfig -> IO (RelayState, CircuitState)
registerNATHandlers Switch
sw NATConfig
config = do
  relayState <- RelayConfig -> IO RelayState
newRelayState (NATConfig -> RelayConfig
ncRelayConfig NATConfig
config)
  circuitState <- newCircuitState
  addTransport sw (circuitTransport sw circuitState (ncReservationRefresh config))
  registerAutoNATHandler sw
  registerRelayHopHandler sw relayState
  registerRelayStopHandler sw circuitState
  registerDCUtRHandler sw (ncDCUtRUpgrade config)
  registerDCUtRUpgrade sw (ncDCUtRUpgrade config)
  registerReservationCleanup sw relayState
  pure (relayState, circuitState)

-- | Drop a peer's relay reservation once its last connection to us goes
-- away (specs/relay/circuit-v2): "the reservation remains valid until
-- its expiration, as long as there is an active connection from the peer
-- to the relay. If the peer disconnects, the reservation is no longer
-- valid."
--
-- The reservation is bound to the peer, not to the connection the
-- RESERVE arrived on, so a peer holding a second connection keeps it.
-- This matches go-libp2p, whose relay returns early from its disconnect
-- notifiee while @Connectedness(p) == Connected@.
--
-- 'closeConnection' removes the connection from the pool in the same STM
-- transaction that marks it closed, and only then runs the notifiers, so
-- the lookup below never observes the connection being torn down.
registerReservationCleanup :: Switch -> RelayState -> IO ()
registerReservationCleanup :: Switch -> RelayState -> IO ()
registerReservationCleanup Switch
sw RelayState
relayState =
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar [Connection -> IO ()]
-> ([Connection -> IO ()] -> [Connection -> IO ()]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' (Switch -> TVar [Connection -> IO ()]
swDisconnectNotifiers Switch
sw) (Connection -> IO ()
dropReservation (Connection -> IO ())
-> [Connection -> IO ()] -> [Connection -> IO ()]
forall a. a -> [a] -> [a]
:)
  where
    dropReservation :: Connection -> IO ()
dropReservation Connection
conn = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      let peerId :: PeerId
peerId = Connection -> PeerId
connPeerId Connection
conn
      remaining <- TVar (Map PeerId [Connection]) -> PeerId -> STM (Maybe Connection)
lookupConn (Switch -> TVar (Map PeerId [Connection])
swConnPool Switch
sw) PeerId
peerId
      case remaining of
        Just Connection
_  -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Maybe Connection
Nothing -> TVar (Map PeerId ActiveReservation)
-> (Map PeerId ActiveReservation -> Map PeerId ActiveReservation)
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' (RelayState -> TVar (Map PeerId ActiveReservation)
rsReservations RelayState
relayState) (PeerId
-> Map PeerId ActiveReservation -> Map PeerId ActiveReservation
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete PeerId
peerId)

-- | Subscribe the DCUtR direct-connection upgrade to new connections.
--
-- specs/relay/DCUtR: "The protocol starts with the completion of a relay
-- connection from @A@ to @B@. Upon observing the new connection, the
-- inbound peer (here @B@) checks the addresses advertised by @A@ via
-- identify." The trigger is therefore an *inbound* connection over a
-- circuit, the same condition go-libp2p's hole punch notifiee applies
-- (@Direction == DirInbound && isRelayAddress(RemoteMultiaddr())@).
registerDCUtRUpgrade :: Switch -> DCUtRUpgradeConfig -> IO ()
registerDCUtRUpgrade :: Switch -> DCUtRUpgradeConfig -> IO ()
registerDCUtRUpgrade Switch
sw DCUtRUpgradeConfig
config =
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar [Connection -> IO ()]
-> ([Connection -> IO ()] -> [Connection -> IO ()]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' (Switch -> TVar [Connection -> IO ()]
swNotifiers Switch
sw) (Connection -> IO ()
notifier (Connection -> IO ())
-> [Connection -> IO ()] -> [Connection -> IO ()]
forall a. a -> [a] -> [a]
:)
  where
    notifier :: Connection -> IO ()
notifier Connection
conn
      | Connection -> Direction
connDirection Connection
conn Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Inbound Bool -> Bool -> Bool
&& Multiaddr -> Bool
isRelayedAddr (Connection -> Multiaddr
connRemoteAddr Connection
conn) =
          IO DCUtRResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Switch -> DCUtRUpgradeConfig -> Connection -> IO DCUtRResult
upgradeRelayedConnection Switch
sw DCUtRUpgradeConfig
config Connection
conn)
      | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Upgrade a relayed connection to a direct one (specs/relay/DCUtR).
--
-- Tries the unilateral upgrade first, falling back to the @\/libp2p\/dcutr@
-- exchange, and on success schedules the relay connection to close after
-- the grace period. Exposed so it can be driven directly instead of
-- through the notifier.
upgradeRelayedConnection
  :: Switch -> DCUtRUpgradeConfig -> Connection -> IO DCUtRResult
upgradeRelayedConnection :: Switch -> DCUtRUpgradeConfig -> Connection -> IO DCUtRResult
upgradeRelayedConnection Switch
sw DCUtRUpgradeConfig
config Connection
relayConn = do
  outcome <- IO DCUtRResult -> IO (Either SomeException DCUtRResult)
forall e a. Exception e => IO a -> IO (Either e a)
try (Switch -> DCUtRUpgradeConfig -> Connection -> IO DCUtRResult
upgradeRelayedConnection' Switch
sw DCUtRUpgradeConfig
config Connection
relayConn)
  pure $ case outcome of
    Left (SomeException
e :: SomeException) -> [Char] -> DCUtRResult
DCUtRFailed (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)
    Right DCUtRResult
r -> DCUtRResult
r

-- | The upgrade proper. Total only through 'upgradeRelayedConnection':
-- the relay connection can die at any point, and 'newStream' surfaces a
-- dead muxer as an exception rather than a 'Left'.
upgradeRelayedConnection'
  :: Switch -> DCUtRUpgradeConfig -> Connection -> IO DCUtRResult
upgradeRelayedConnection' :: Switch -> DCUtRUpgradeConfig -> Connection -> IO DCUtRResult
upgradeRelayedConnection' Switch
sw DCUtRUpgradeConfig
config Connection
relayConn = do
  -- Learn the remote's advertised addresses. Identify also runs from its
  -- own on-connect notifier, but the two are unordered, so this waits on
  -- its own exchange rather than racing the peer store. storeIdentify
  -- merges, so the duplicate is harmless.
  _ <- Switch -> Connection -> IO (Either [Char] ())
identifyPeer Switch
sw Connection
relayConn
  publicAddrs <- holePunchTargets sw (connPeerId relayConn)
  outcome <-
    if null publicAddrs
      then pure (DCUtRFailed "no public address advertised")
      else unilateralUpgrade sw config relayConn publicAddrs
  result <- case outcome of
    DCUtRResult
DCUtRSuccess -> DCUtRResult -> IO DCUtRResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DCUtRResult
DCUtRSuccess
    DCUtRFailed [Char]
_ -> Switch -> DCUtRUpgradeConfig -> Connection -> IO DCUtRResult
initiateOverRelay Switch
sw DCUtRUpgradeConfig
config Connection
relayConn
  case result of
    DCUtRResult
DCUtRSuccess -> Switch -> DCUtRUpgradeConfig -> Connection -> IO ()
scheduleRelayClose Switch
sw DCUtRUpgradeConfig
config Connection
relayConn
    DCUtRFailed [Char]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pure result

-- | The peer's advertised addresses that are worth a unilateral direct
-- dial: decodable, not relayed, and publicly routable.
--
-- specs/relay/DCUtR: "@B@ checks the addresses advertised by @A@ via
-- identify. If that set includes public addresses, then @A@ may be
-- reachable by a direct connection". go-libp2p applies the same pair of
-- filters (@!isRelayAddress(a) && manet.IsPublicAddr(a)@).
--
-- A circuit address is never a target: dialling it would go back through
-- the relay we are trying to get off.
holePunchTargets :: Switch -> PeerId -> IO [Multiaddr]
holePunchTargets :: Switch -> PeerId -> IO [Multiaddr]
holePunchTargets Switch
sw PeerId
peerId = do
  store <- STM (Map PeerId IdentifyInfo) -> IO (Map PeerId IdentifyInfo)
forall a. STM a -> IO a
atomically (STM (Map PeerId IdentifyInfo) -> IO (Map PeerId IdentifyInfo))
-> STM (Map PeerId IdentifyInfo) -> IO (Map PeerId IdentifyInfo)
forall a b. (a -> b) -> a -> b
$ TVar (Map PeerId IdentifyInfo) -> STM (Map PeerId IdentifyInfo)
forall a. TVar a -> STM a
readTVar (Switch -> TVar (Map PeerId IdentifyInfo)
swPeerStore Switch
sw)
  let raw = [ByteString]
-> (IdentifyInfo -> [ByteString])
-> Maybe IdentifyInfo
-> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] IdentifyInfo -> [ByteString]
idListenAddrs (PeerId -> Map PeerId IdentifyInfo -> Maybe IdentifyInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerId
peerId Map PeerId IdentifyInfo
store)
  pure [ addr
       | Right addr <- map fromBytes raw
       , not (isRelayedAddr addr)
       , isPublicAddr addr
       ]

-- | Attempt a direct connection without any signalling.
--
-- specs/relay/DCUtR: "If that set includes public addresses, then @A@
-- may be reachable by a direct connection, in which case @B@ attempts a
-- unilateral connection upgrade by initiating a direct connection to
-- @A@." go-libp2p guards this the same way
-- (@!isRelayAddress(a) && manet.IsPublicAddr(a)@).
unilateralUpgrade
  :: Switch -> DCUtRUpgradeConfig -> Connection -> [Multiaddr] -> IO DCUtRResult
unilateralUpgrade :: Switch
-> DCUtRUpgradeConfig
-> Connection
-> [Multiaddr]
-> IO DCUtRResult
unilateralUpgrade Switch
sw DCUtRUpgradeConfig
config Connection
relayConn [Multiaddr]
addrs = do
  dialed <- Switch
-> DCUtRUpgradeConfig
-> Bool
-> PeerId
-> [Multiaddr]
-> IO (Either [Char] ())
holePunchDial Switch
sw DCUtRUpgradeConfig
config Bool
True (Connection -> PeerId
connPeerId Connection
relayConn) [Multiaddr]
addrs
  pure $ either DCUtRFailed (const DCUtRSuccess) dialed

-- | Run the CONNECT/CONNECT/SYNC exchange over the relayed connection.
--
-- We are peer @B@: the initiator of the exchange, and the server of the
-- resulting TCP simultaneous connect.
initiateOverRelay :: Switch -> DCUtRUpgradeConfig -> Connection -> IO DCUtRResult
initiateOverRelay :: Switch -> DCUtRUpgradeConfig -> Connection -> IO DCUtRResult
initiateOverRelay Switch
sw DCUtRUpgradeConfig
config Connection
relayConn = do
  streamOrErr <- IO (Either ResourceError StreamIO)
-> IO (Either SomeException (Either ResourceError StreamIO))
forall e a. Exception e => IO a -> IO (Either e a)
try (Switch -> Connection -> IO (Either ResourceError StreamIO)
newStream Switch
sw Connection
relayConn)
  case streamOrErr of
    Left (SomeException
e :: SomeException) ->
      DCUtRResult -> IO DCUtRResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> DCUtRResult
DCUtRFailed ([Char]
"dcutr: cannot open stream: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e))
    Right (Left ResourceError
err) -> DCUtRResult -> IO DCUtRResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> DCUtRResult
DCUtRFailed ([Char]
"dcutr: cannot open stream: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ResourceError -> [Char]
forall a. Show a => a -> [Char]
show ResourceError
err))
    Right (Right StreamIO
stream) -> do
      negotiated <- StreamIO -> [ProtocolId] -> IO NegotiationResult
negotiateInitiator StreamIO
stream [ProtocolId
dcutrProtocolId]
      case negotiated of
        NegotiationResult
NoProtocol -> do
          StreamIO -> IO ()
closeQuietly StreamIO
stream
          DCUtRResult -> IO DCUtRResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> DCUtRResult
DCUtRFailed [Char]
"remote does not support /libp2p/dcutr")
        Accepted ProtocolId
_ -> do
          ownAddrs <- Switch -> Maybe PeerId -> IO [Multiaddr]
dcutrOwnAddrs Switch
sw (Connection -> Maybe PeerId
relayObserver Connection
relayConn)
          let dcConfig = DCUtRConfig
                { dcMaxAttempts :: Int
dcMaxAttempts = DCUtRUpgradeConfig -> Int
ducMaxAttempts DCUtRUpgradeConfig
config
                , dcDialer :: Multiaddr -> IO (Either [Char] ())
dcDialer = \Multiaddr
addr ->
                    Switch
-> DCUtRUpgradeConfig
-> Bool
-> PeerId
-> [Multiaddr]
-> IO (Either [Char] ())
holePunchDial Switch
sw DCUtRUpgradeConfig
config Bool
False (Connection -> PeerId
connPeerId Connection
relayConn) [Multiaddr
addr]
                }
          result <- handleOrFail
            (bounded (ducStreamTimeoutMicros config) (initiateDCUtR dcConfig stream ownAddrs))
          closeQuietly stream
          pure result
  where
    handleOrFail :: IO DCUtRResult -> IO DCUtRResult
handleOrFail IO DCUtRResult
action = do
      outcome <- IO DCUtRResult -> IO (Either SomeException DCUtRResult)
forall e a. Exception e => IO a -> IO (Either e a)
try IO DCUtRResult
action
      pure $ case outcome of
        Left (SomeException
e :: SomeException) -> [Char] -> DCUtRResult
DCUtRFailed (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)
        Right DCUtRResult
r -> DCUtRResult
r
    bounded :: Int -> IO DCUtRResult -> IO DCUtRResult
bounded Int
limit IO DCUtRResult
action = do
      r <- Int -> IO DCUtRResult -> IO (Maybe DCUtRResult)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
limit IO DCUtRResult
action
      pure (fromMaybe (DCUtRFailed "dcutr exchange timed out") r)

-- | Dial for a hole punch: never reuse the pooled relay connection, and
-- take the security and muxer roles the spec assigns.
--
-- specs/relay/DCUtR: "For the purpose of all protocols run on top of
-- this TCP connection, @A@ is assumed to be the client and @B@ the
-- server." We are @B@, so we upgrade as the responder even though we
-- called connect(). The unilateral attempt has no counterpart dialling
-- back, so it stays the client.
holePunchDial
  :: Switch -> DCUtRUpgradeConfig -> Bool -> PeerId -> [Multiaddr]
  -> IO (Either String ())
holePunchDial :: Switch
-> DCUtRUpgradeConfig
-> Bool
-> PeerId
-> [Multiaddr]
-> IO (Either [Char] ())
holePunchDial Switch
sw DCUtRUpgradeConfig
config Bool
asClient PeerId
peerId [Multiaddr]
addrs = do
  let opts :: DialOpts
opts = DialOpts { doForceDirect :: Bool
doForceDirect = Bool
True, doUpgradeAsClient :: Bool
doUpgradeAsClient = Bool
asClient }
  dialed <- IO (Maybe (Either DialError Connection))
-> IO (Either SomeException (Maybe (Either DialError Connection)))
forall e a. Exception e => IO a -> IO (Either e a)
try (Int
-> IO (Either DialError Connection)
-> IO (Maybe (Either DialError Connection))
forall a. Int -> IO a -> IO (Maybe a)
timeout (DCUtRUpgradeConfig -> Int
ducDirectDialTimeoutMicros DCUtRUpgradeConfig
config) (Switch
-> DialOpts
-> PeerId
-> [Multiaddr]
-> IO (Either DialError Connection)
dialWith Switch
sw DialOpts
opts PeerId
peerId [Multiaddr]
addrs))
  pure $ case dialed of
    Left (SomeException
e :: SomeException) -> [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)
    Right Maybe (Either DialError Connection)
Nothing -> [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left [Char]
"hole punch dial timed out"
    Right (Just (Left DialError
err)) -> [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left (DialError -> [Char]
forall a. Show a => a -> [Char]
show DialError
err)
    Right (Just (Right Connection
_conn)) -> () -> Either [Char] ()
forall a b. b -> Either a b
Right ()

-- | Addresses we put in DCUtR CONNECT: the address reported by the relay
-- that carries this connection, followed by every non-relayed listen
-- address. Scoping the observation to that relay avoids advertising stale
-- mappings learned from unrelated peers. Private listen addresses remain
-- useful to peers on the same LAN and as deterministic test fallbacks.
dcutrOwnAddrs :: Switch -> Maybe PeerId -> IO [Multiaddr]
dcutrOwnAddrs :: Switch -> Maybe PeerId -> IO [Multiaddr]
dcutrOwnAddrs Switch
sw Maybe PeerId
observer = do
  observed <- Switch -> Maybe PeerId -> IO [Multiaddr]
observedAddrs Switch
sw Maybe PeerId
observer
  listen <- filter (not . isRelayedAddr) <$> switchListenAddrs sw
  pure (nub (observed ++ listen))

-- | How the relevant relay observed us during Identify.
observedAddrs :: Switch -> Maybe PeerId -> IO [Multiaddr]
observedAddrs :: Switch -> Maybe PeerId -> IO [Multiaddr]
observedAddrs Switch
sw Maybe PeerId
observer = do
  store <- STM (Map PeerId IdentifyInfo) -> IO (Map PeerId IdentifyInfo)
forall a. STM a -> IO a
atomically (STM (Map PeerId IdentifyInfo) -> IO (Map PeerId IdentifyInfo))
-> STM (Map PeerId IdentifyInfo) -> IO (Map PeerId IdentifyInfo)
forall a b. (a -> b) -> a -> b
$ TVar (Map PeerId IdentifyInfo) -> STM (Map PeerId IdentifyInfo)
forall a. TVar a -> STM a
readTVar (Switch -> TVar (Map PeerId IdentifyInfo)
swPeerStore Switch
sw)
  let infos = case Maybe PeerId
observer of
        Just PeerId
peerId -> [IdentifyInfo]
-> (IdentifyInfo -> [IdentifyInfo])
-> Maybe IdentifyInfo
-> [IdentifyInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] IdentifyInfo -> [IdentifyInfo]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PeerId -> Map PeerId IdentifyInfo -> Maybe IdentifyInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerId
peerId Map PeerId IdentifyInfo
store)
        Maybe PeerId
Nothing -> []
  pure
    [ addr
    | info <- infos
    , Just raw <- [idObservedAddr info]
    , Right addr <- [fromBytes raw]
    , not (isRelayedAddr addr)
    ]

-- | The relay encoded in a relayed connection's remote multiaddr.
relayObserver :: Connection -> Maybe PeerId
relayObserver :: Connection -> Maybe PeerId
relayObserver Connection
conn =
  ([Char] -> Maybe PeerId)
-> (CircuitAddr -> Maybe PeerId)
-> Either [Char] CircuitAddr
-> Maybe PeerId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe PeerId -> [Char] -> Maybe PeerId
forall a b. a -> b -> a
const Maybe PeerId
forall a. Maybe a
Nothing) (PeerId -> Maybe PeerId
forall a. a -> Maybe a
Just (PeerId -> Maybe PeerId)
-> (CircuitAddr -> PeerId) -> CircuitAddr -> Maybe PeerId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CircuitAddr -> PeerId
caRelayId) (Multiaddr -> Either [Char] CircuitAddr
parseCircuitAddr (Connection -> Multiaddr
connRemoteAddr Connection
conn))

-- | Close the relay connection after the grace period, provided a direct
-- connection to the peer is still up.
--
-- specs/relay/DCUtR: "All new streams should be opened in the direct
-- connection, while the relay connection should be closed after a grace
-- period." The re-check matters because the direct connection can die
-- inside the grace window; dropping the relay as well would leave the
-- peer unreachable, and the spec keeps the relay as the fallback.
scheduleRelayClose :: Switch -> DCUtRUpgradeConfig -> Connection -> IO ()
scheduleRelayClose :: Switch -> DCUtRUpgradeConfig -> Connection -> IO ()
scheduleRelayClose Switch
sw DCUtRUpgradeConfig
config Connection
relayConn = IO (Async ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async ()) -> IO ())
-> (IO () -> IO (Async ())) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Int -> IO ()
threadDelay (DCUtRUpgradeConfig -> Int
ducRelayCloseGraceMicros DCUtRUpgradeConfig
config)
  conns <- STM [Connection] -> IO [Connection]
forall a. STM a -> IO a
atomically (STM [Connection] -> IO [Connection])
-> STM [Connection] -> IO [Connection]
forall a b. (a -> b) -> a -> b
$ TVar (Map PeerId [Connection]) -> PeerId -> STM [Connection]
lookupAllConns (Switch -> TVar (Map PeerId [Connection])
swConnPool Switch
sw) (Connection -> PeerId
connPeerId Connection
relayConn)
  direct <- atomically $ filterM openAndDirect conns
  unless (null direct) $ closeConnection sw relayConn
  where
    openAndDirect :: Connection -> STM Bool
openAndDirect Connection
c = do
      st <- TVar ConnState -> STM ConnState
forall a. TVar a -> STM a
readTVar (Connection -> TVar ConnState
connState Connection
c)
      pure (st == ConnOpen && not (isRelayedAddr (connRemoteAddr c)))

-- | Close a stream, ignoring failures from an already-dead session.
closeQuietly :: StreamIO -> IO ()
closeQuietly :: StreamIO -> IO ()
closeQuietly StreamIO
stream = StreamIO -> IO ()
streamClose StreamIO
stream IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
_ :: SomeException) -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Register the AutoNAT server handler (/libp2p/autonat/1.0.0).
--
-- The dial-back deliberately bypasses the connection pool: reusing the
-- requester's existing connection would always report success. Instead a
-- fresh transport dial + upgrade verifies both reachability and identity,
-- and the probe connection is closed immediately (go-libp2p uses a
-- separate dialer host for the same reason).
registerAutoNATHandler :: Switch -> IO ()
registerAutoNATHandler :: Switch -> IO ()
registerAutoNATHandler Switch
sw =
  Switch -> ProtocolId -> StreamHandler -> IO ()
setStreamHandler Switch
sw ProtocolId
autoNATProtocolId (StreamHandler -> IO ()) -> StreamHandler -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn StreamIO
stream ->
    let config :: AutoNATConfig
config = AutoNATConfig
          { natThreshold :: Int
natThreshold = Int
3
          , natDialBack :: PeerId -> [Multiaddr] -> IO (Either [Char] Multiaddr)
natDialBack  = Switch -> PeerId -> [Multiaddr] -> IO (Either [Char] Multiaddr)
freshDialBack Switch
sw
          }
    in AutoNATConfig -> StreamIO -> PeerId -> Multiaddr -> IO ()
handleAutoNAT AutoNATConfig
config StreamIO
stream (Connection -> PeerId
connPeerId Connection
conn) (Connection -> Multiaddr
connRemoteAddr Connection
conn)

-- | Dial back a peer on a fresh connection, verify its identity, and close.
-- Returns the address that actually succeeded, not the first candidate.
freshDialBack :: Switch -> PeerId -> [Multiaddr] -> IO (Either String Multiaddr)
freshDialBack :: Switch -> PeerId -> [Multiaddr] -> IO (Either [Char] Multiaddr)
freshDialBack Switch
_ PeerId
_ [] = Either [Char] Multiaddr -> IO (Either [Char] Multiaddr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] Multiaddr
forall a b. a -> Either a b
Left [Char]
"dial-back: no addresses")
freshDialBack Switch
sw PeerId
pid (Multiaddr
addr : [Multiaddr]
rest) = do
  result <- IO (Either [Char] ())
-> IO (Either SomeException (Either [Char] ()))
forall e a. Exception e => IO a -> IO (Either e a)
try (Switch -> PeerId -> Multiaddr -> IO (Either [Char] ())
probeAddr Switch
sw PeerId
pid Multiaddr
addr)
  case result of
    Right (Right ()) -> Either [Char] Multiaddr -> IO (Either [Char] Multiaddr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Multiaddr -> Either [Char] Multiaddr
forall a b. b -> Either a b
Right Multiaddr
addr)
    Right (Left [Char]
err)
      | [Multiaddr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Multiaddr]
rest -> Either [Char] Multiaddr -> IO (Either [Char] Multiaddr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] Multiaddr
forall a b. a -> Either a b
Left [Char]
err)
      | Bool
otherwise -> Switch -> PeerId -> [Multiaddr] -> IO (Either [Char] Multiaddr)
freshDialBack Switch
sw PeerId
pid [Multiaddr]
rest
    Left (SomeException
e :: SomeException)
      | [Multiaddr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Multiaddr]
rest -> Either [Char] Multiaddr -> IO (Either [Char] Multiaddr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] Multiaddr
forall a b. a -> Either a b
Left (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e))
      | Bool
otherwise -> Switch -> PeerId -> [Multiaddr] -> IO (Either [Char] Multiaddr)
freshDialBack Switch
sw PeerId
pid [Multiaddr]
rest

-- | Probe a single address: transport dial, upgrade, check peer identity.
probeAddr :: Switch -> PeerId -> Multiaddr -> IO (Either String ())
probeAddr :: Switch -> PeerId -> Multiaddr -> IO (Either [Char] ())
probeAddr Switch
sw PeerId
pid Multiaddr
addr = do
  mTransport <- Switch -> Multiaddr -> IO (Maybe Transport)
selectTransport Switch
sw Multiaddr
addr
  case mTransport of
    Maybe Transport
Nothing -> Either [Char] () -> IO (Either [Char] ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char]
"dial-back: no transport for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Multiaddr -> [Char]
forall a. Show a => a -> [Char]
show Multiaddr
addr))
    Just Transport
transport -> do
      rawConn <- Transport -> Multiaddr -> IO RawConnection
transportDial Transport
transport Multiaddr
addr
      conn <- upgradeOutbound (swIdentityKey sw) rawConn
      let matches = Connection -> PeerId
connPeerId Connection
conn PeerId -> PeerId -> Bool
forall a. Eq a => a -> a -> Bool
== PeerId
pid
      muxClose (connSession conn) `catch` \(SomeException
_ :: SomeException) -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      pure $ if matches
        then Right ()
        else Left "dial-back: peer identity mismatch"

-- | Register the Circuit Relay v2 hop handler
-- (/libp2p/circuit/relay/0.2.0/hop): serve RESERVE and CONNECT requests.
registerRelayHopHandler :: Switch -> RelayState -> IO ()
registerRelayHopHandler :: Switch -> RelayState -> IO ()
registerRelayHopHandler Switch
sw RelayState
relayState =
  Switch -> ProtocolId -> StreamHandler -> IO ()
setStreamHandler Switch
sw ProtocolId
hopProtocolId (StreamHandler -> IO ()) -> StreamHandler -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn StreamIO
stream -> do
    result <- StreamIO -> Int -> IO (Either [Char] HopMessage)
readHopMessage StreamIO
stream Int
maxRelayMessageSize
    case result of
      Left [Char]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Right HopMessage
msg -> case HopMessage -> Maybe HopMessageType
hopType HopMessage
msg of
        Just HopMessageType
HopReserve -> do
          ctx <- Switch -> Connection -> IO HopContext
switchHopContext Switch
sw Connection
conn
          handleReserve relayState ctx stream (connPeerId conn)
        Just HopMessageType
HopConnect -> do
          ctx <- Switch -> Connection -> IO HopContext
switchHopContext Switch
sw Connection
conn
          handleConnect relayState ctx stream (connPeerId conn) msg (openStopStream sw)
        Maybe HopMessageType
_ -> StreamIO -> HopMessage -> IO ()
writeHopMessage StreamIO
stream HopMessage
          { hopType :: Maybe HopMessageType
hopType = HopMessageType -> Maybe HopMessageType
forall a. a -> Maybe a
Just HopMessageType
HopStatus
          , 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 = RelayStatus -> Maybe RelayStatus
forall a. a -> Maybe a
Just RelayStatus
UnexpectedMessage
          }

-- | Build the per-request hop context from the Switch: the relay's own
-- identity (signs reservation vouchers), its listen addresses with the
-- @/p2p/\<relay\>@ suffix the circuit-v2 spec requires for reservation
-- addrs, and the address the requesting connection arrived over.
switchHopContext :: Switch -> Connection -> IO HopContext
switchHopContext :: Switch -> Connection -> IO HopContext
switchHopContext Switch
sw Connection
conn = do
  addrs <- Switch -> IO [Multiaddr]
switchListenAddrs Switch
sw
  let relayP2P = [Protocol] -> Multiaddr
Multiaddr [ByteString -> Protocol
P2P (PeerId -> ByteString
peerIdBytes (Switch -> PeerId
swLocalPeerId Switch
sw))]
  pure HopContext
    { hcRelayId    = swLocalPeerId sw
    , hcRelayKey   = swIdentityKey sw
    , hcRelayAddrs = map (`encapsulate` relayP2P) addrs
    , hcRemoteAddr = connRemoteAddr conn
    }

-- | Open a stop-protocol stream to the circuit target over an existing
-- connection. Returns Nothing when the target is not connected or the
-- stop protocol cannot be negotiated.
openStopStream :: Switch -> PeerId -> IO (Maybe StreamIO)
openStopStream :: Switch -> PeerId -> IO (Maybe StreamIO)
openStopStream Switch
sw PeerId
targetId = do
  result <- IO (Maybe StreamIO) -> IO (Either SomeException (Maybe StreamIO))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Maybe StreamIO) -> IO (Either SomeException (Maybe StreamIO)))
-> IO (Maybe StreamIO)
-> IO (Either SomeException (Maybe StreamIO))
forall a b. (a -> b) -> a -> b
$ do
    mConn <- STM (Maybe Connection) -> IO (Maybe Connection)
forall a. STM a -> IO a
atomically (STM (Maybe Connection) -> IO (Maybe Connection))
-> STM (Maybe Connection) -> IO (Maybe Connection)
forall a b. (a -> b) -> a -> b
$ TVar (Map PeerId [Connection]) -> PeerId -> STM (Maybe Connection)
lookupConn (Switch -> TVar (Map PeerId [Connection])
swConnPool Switch
sw) PeerId
targetId
    case mConn of
      Maybe Connection
Nothing -> Maybe StreamIO -> IO (Maybe StreamIO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe StreamIO
forall a. Maybe a
Nothing
      Just Connection
conn -> do
        streamOrErr <- Switch -> Connection -> IO (Either ResourceError StreamIO)
newStream Switch
sw Connection
conn
        case streamOrErr of
          Left ResourceError
_ -> Maybe StreamIO -> IO (Maybe StreamIO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe StreamIO
forall a. Maybe a
Nothing
          Right StreamIO
stream -> do
            negotiated <- StreamIO -> [ProtocolId] -> IO NegotiationResult
negotiateInitiator StreamIO
stream [ProtocolId
stopProtocolId]
            case negotiated of
              Accepted ProtocolId
_ -> Maybe StreamIO -> IO (Maybe StreamIO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StreamIO -> Maybe StreamIO
forall a. a -> Maybe a
Just StreamIO
stream)
              NegotiationResult
NoProtocol -> do
                StreamIO -> IO ()
streamClose StreamIO
stream IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
_ :: SomeException) -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Maybe StreamIO -> IO (Maybe StreamIO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe StreamIO
forall a. Maybe a
Nothing
  case result of
    Left (SomeException
_ :: SomeException) -> Maybe StreamIO -> IO (Maybe StreamIO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe StreamIO
forall a. Maybe a
Nothing
    Right Maybe StreamIO
mStream -> Maybe StreamIO -> IO (Maybe StreamIO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe StreamIO
mStream

-- | Register the Circuit Relay v2 stop handler
-- (/libp2p/circuit/relay/0.2.0/stop).
--
-- After the CONNECT/OK exchange the stop stream *is* the relayed
-- connection (specs/relay/circuit-v2), so it is handed to the circuit
-- transport's listener for the relay it arrived over. The Switch then
-- upgrades it like any other inbound raw connection.
--
-- The relay's advertised limit is not yet enforced (issue #269).
registerRelayStopHandler :: Switch -> CircuitState -> IO ()
registerRelayStopHandler :: Switch -> CircuitState -> IO ()
registerRelayStopHandler Switch
sw CircuitState
circuitState =
  Switch -> ProtocolId -> StreamHandler -> IO ()
setStreamHandler Switch
sw ProtocolId
stopProtocolId (StreamHandler -> IO ()) -> StreamHandler -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn StreamIO
stream -> do
    result <- StreamIO -> IO (Either [Char] (PeerId, Maybe RelayLimit))
handleStop StreamIO
stream
    case result of
      Left [Char]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Right (PeerId
sourcePeer, Maybe RelayLimit
_mLimit) ->
        CircuitState -> Connection -> PeerId -> StreamIO -> IO ()
acceptStopStream CircuitState
circuitState Connection
conn PeerId
sourcePeer StreamIO
stream

-- | Register the DCUtR handler (/libp2p/dcutr).
--
-- Answers the CONNECT/SYNC exchange with our listen addresses and dials
-- the initiator's addresses through the Switch for the hole punch.
registerDCUtRHandler :: Switch -> DCUtRUpgradeConfig -> IO ()
registerDCUtRHandler :: Switch -> DCUtRUpgradeConfig -> IO ()
registerDCUtRHandler Switch
sw DCUtRUpgradeConfig
upgradeConfig =
  Switch -> ProtocolId -> StreamHandler -> IO ()
setStreamHandler Switch
sw ProtocolId
dcutrProtocolId (StreamHandler -> IO ()) -> StreamHandler -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn StreamIO
stream -> do
    addrs <- Switch -> Maybe PeerId -> IO [Multiaddr]
dcutrOwnAddrs Switch
sw (Connection -> Maybe PeerId
relayObserver Connection
conn)
    let config = DCUtRConfig
          { dcMaxAttempts :: Int
dcMaxAttempts = DCUtRUpgradeConfig -> Int
ducMaxAttempts DCUtRUpgradeConfig
upgradeConfig
            -- We are peer A: the spec makes us the client of the
            -- simultaneous connect, and the dial must not be satisfied by
            -- the relay connection we are running this exchange over.
          , dcDialer :: Multiaddr -> IO (Either [Char] ())
dcDialer = \Multiaddr
addr ->
              Switch
-> DCUtRUpgradeConfig
-> Bool
-> PeerId
-> [Multiaddr]
-> IO (Either [Char] ())
holePunchDial Switch
sw DCUtRUpgradeConfig
upgradeConfig Bool
True (Connection -> PeerId
connPeerId Connection
conn) [Multiaddr
addr]
          }
    _ <- timeout (ducStreamTimeoutMicros upgradeConfig) (handleDCUtR config stream addrs)
    pure ()