-- | Utility functions
--
-- Note: this module is bound to change even more than the rest of the API :)
module Network.Transport.Util (spawn) where

import Network.Transport
  ( Transport
  , EndPoint(..)
  , EndPointAddress
  , newEndPoint
  )
import Control.Exception (throwIO)
import Control.Concurrent (forkIO)

-- | Create a new end point, fork a new thread, and run the specified IO operation on that thread.
--
-- Returns the address of the new end point.
spawn :: Transport -> (EndPoint -> IO ()) -> IO EndPointAddress
spawn :: Transport -> (EndPoint -> IO ()) -> IO EndPointAddress
spawn Transport
transport EndPoint -> IO ()
proc = do
  -- `newEndPoint` used to be done in a separate thread, in case it was slow.
  -- However, in this case, care must be taken to appropriately handle asynchronous exceptions.
  -- Instead, for reliability, we now create the new endpoint in this thread.
  Either (TransportError NewEndPointErrorCode) EndPoint
mEndPoint <- Transport
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint Transport
transport
  case Either (TransportError NewEndPointErrorCode) EndPoint
mEndPoint of
    Left TransportError NewEndPointErrorCode
err -> TransportError NewEndPointErrorCode -> IO EndPointAddress
forall e a. Exception e => e -> IO a
throwIO TransportError NewEndPointErrorCode
err
    Right EndPoint
endPoint -> do
      IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ EndPoint -> IO ()
proc EndPoint
endPoint
      EndPointAddress -> IO EndPointAddress
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EndPointAddress -> IO EndPointAddress)
-> EndPointAddress -> IO EndPointAddress
forall a b. (a -> b) -> a -> b
$ EndPoint -> EndPointAddress
address EndPoint
endPoint