    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE TypeFamilies #-}

    -- Copyright (C) 2009-2012 John Millikin <john@john-millikin.com>
    --
    -- Licensed under the Apache License, Version 2.0 (the "License");
    -- you may not use this file except in compliance with the License.
    -- You may obtain a copy of the License at
    --
    --     http://www.apache.org/licenses/LICENSE-2.0
    --
    -- Unless required by applicable law or agreed to in writing, software
    -- distributed under the License is distributed on an "AS IS" BASIS,
    -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    -- See the License for the specific language governing permissions and
    -- limitations under the License.

    -- | Support for defining custom transport mechanisms. Most users will not
    -- need to care about the types defined in this module.
    module DBus.Transport
        (
        -- * Transports
          Transport(..)
        , TransportOpen(..)
        , TransportListen(..)

        -- * Transport errors
        , TransportError
        , transportError
        , transportErrorMessage
        , transportErrorAddress

        -- * Socket transport
        , SocketTransport
        , socketTransportOptionBacklog
        , socketTransportCredentials
        ) where

    import           Control.Concurrent (rtsSupportsBoundThreads, threadWaitWrite)
    import           Control.Exception
    import           Control.Monad (when)
    import qualified Data.ByteString
    import qualified Data.ByteString.Builder as Builder
    import           Data.ByteString.Internal (ByteString(PS))
    import qualified Data.ByteString.Lazy as Lazy
    import           Data.ByteString.Unsafe (unsafeUseAsCString)
    import qualified Data.Kind
    import qualified Data.Map as Map
    import           Data.Maybe (fromMaybe)
    import           Data.Monoid
    import           Data.Typeable (Typeable)
    import           Foreign.C (CInt, CUInt)
    import           Foreign.ForeignPtr (withForeignPtr)
    import           Foreign.Marshal.Array (peekArray)
    import           Foreign.Ptr (castPtr, plusPtr)
    import           Foreign.Storable (sizeOf)
    import           Network.Socket
    import           Network.Socket.Internal (NullSockAddr(..))
    import qualified Network.Socket.Address
    import           Network.Socket.ByteString (recvMsg)
    import qualified System.Info
    import           System.IO.Unsafe (unsafeDupablePerformIO)
    import           System.Posix.Types (Fd)
    import           Prelude

    import           DBus

    -- | Thrown from transport methods when an error occurs.
    data TransportError = TransportError
        { TransportError -> String
    transportErrorMessage :: String
        , TransportError -> Maybe Address
    transportErrorAddress :: Maybe Address
        }
        deriving (TransportError -> TransportError -> Bool
    (TransportError -> TransportError -> Bool)
    -> (TransportError -> TransportError -> Bool) -> Eq TransportError
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TransportError -> TransportError -> Bool
    == :: TransportError -> TransportError -> Bool
    $c/= :: TransportError -> TransportError -> Bool
    /= :: TransportError -> TransportError -> Bool
    Eq, Int -> TransportError -> ShowS
    [TransportError] -> ShowS
    TransportError -> String
    (Int -> TransportError -> ShowS)
    -> (TransportError -> String)
    -> ([TransportError] -> ShowS)
    -> Show TransportError
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TransportError -> ShowS
    showsPrec :: Int -> TransportError -> ShowS
    $cshow :: TransportError -> String
    show :: TransportError -> String
    $cshowList :: [TransportError] -> ShowS
    showList :: [TransportError] -> ShowS
    Show, Typeable)

    instance Exception TransportError

    transportError :: String -> TransportError
    transportError :: String -> TransportError
    transportError String
    msg = String -> Maybe Address -> TransportError
    TransportError String
    msg Maybe Address
    forall a. Maybe a
    Nothing

    -- | A 'Transport' can exchange bytes with a remote peer.
    class Transport t where
        -- | Additional options that this transport type may use when establishing
        -- a connection.
        data TransportOptions t :: Data.Kind.Type

        -- | Default values for this transport's options.
        transportDefaultOptions :: TransportOptions t

        -- | Send a 'ByteString' over the transport.
        --
        -- Throws a 'TransportError' if an error occurs.
        transportPut :: t -> ByteString -> IO ()

        -- | Send a 'ByteString' and Unix file descriptors over the transport.
        --
        -- Throws a 'TransportError' if an error occurs.
        transportPutWithFds :: t -> ByteString -> [Fd] -> IO ()
        transportPutWithFds t
    t ByteString
    bs [Fd]
    _fds = t -> ByteString -> IO ()
    forall t. Transport t => t -> ByteString -> IO ()
    transportPut t
    t ByteString
    bs

        -- | Receive a 'ByteString' of the given size from the transport. The
        -- transport should block until sufficient bytes are available, and
        -- only return fewer than the requested amount if there will not be
        -- any more data.
        --
        -- Throws a 'TransportError' if an error occurs.
        transportGet :: t -> Int -> IO ByteString

        -- | Receive a 'ByteString' of the given size from the transport, plus
        -- any Unix file descriptors that arrive with the byte data. The
        -- transport should block until sufficient bytes are available, and
        -- only return fewer than the requested amount if there will not be
        -- any more data.
        --
        -- Throws a 'TransportError' if an error occurs.
        transportGetWithFds :: t -> Int -> IO (ByteString, [Fd])
        transportGetWithFds t
    t Int
    n = do
            bs <- t -> Int -> IO ByteString
    forall t. Transport t => t -> Int -> IO ByteString
    transportGet t
    t Int
    n
            return (bs, [])

        -- | Close an open transport, and release any associated resources
        -- or handles.
        transportClose :: t -> IO ()

    -- | A 'Transport' which can open a connection to a remote peer.
    class Transport t => TransportOpen t where
        -- | Open a connection to the given address, using the given options.
        --
        -- Throws a 'TransportError' if the connection could not be
        -- established.
        transportOpen :: TransportOptions t -> Address -> IO t

    -- | A 'Transport' which can listen for and accept connections from remote
    -- peers.
    class Transport t => TransportListen t where
        -- | Used for transports that listen on a port or address.
        data TransportListener t :: Data.Kind.Type

        -- | Begin listening for connections on the given address, using the
        -- given options.
        --
        -- Throws a 'TransportError' if it's not possible to listen at that
        -- address (for example, if the port is already in use).
        transportListen :: TransportOptions t -> Address -> IO (TransportListener t)

        -- | Accept a new connection.
        --
        -- Throws a 'TransportError' if some error happens before the
        -- transport is ready to exchange bytes.
        transportAccept :: TransportListener t -> IO t

        -- | Close an open listener.
        transportListenerClose :: TransportListener t -> IO ()

        -- | Get the address to use to connect to a listener.
        transportListenerAddress :: TransportListener t -> Address

        -- | Get the UUID allocated to this transport listener.
        --
        -- See 'randomUUID'.
        transportListenerUUID :: TransportListener t -> UUID

    -- | Supports connecting over Unix or TCP sockets.
    --
    -- Unix sockets are similar to pipes, but exist as special files in the
    -- filesystem. On Linux, /abstract sockets/ have a path-like address, but do
    -- not actually have entries in the filesystem.
    --
    -- TCP sockets may use either IPv4 or IPv6.
    data SocketTransport = SocketTransport (Maybe Address) Socket

    instance Transport SocketTransport where
        data TransportOptions SocketTransport = SocketTransportOptions
            {
            -- | The maximum size of the connection queue for a listening
            -- socket.
              TransportOptions SocketTransport -> Int
    socketTransportOptionBacklog :: Int
            }
        transportDefaultOptions :: TransportOptions SocketTransport
    transportDefaultOptions = Int -> TransportOptions SocketTransport
    SocketTransportOptions Int
    30
        transportPut :: SocketTransport -> ByteString -> IO ()
    transportPut SocketTransport
    st ByteString
    bytes = SocketTransport -> ByteString -> [Fd] -> IO ()
    forall t. Transport t => t -> ByteString -> [Fd] -> IO ()
    transportPutWithFds SocketTransport
    st ByteString
    bytes []
        transportPutWithFds :: SocketTransport -> ByteString -> [Fd] -> IO ()
    transportPutWithFds (SocketTransport Maybe Address
    addr Socket
    s) ByteString
    bytes [Fd]
    fds = Maybe Address -> IO () -> IO ()
    forall a. Maybe Address -> IO a -> IO a
    catchIOException Maybe Address
    addr (Socket -> ByteString -> [Fd] -> IO ()
    sendWithFds Socket
    s ByteString
    bytes [Fd]
    fds)
        transportGet :: SocketTransport -> Int -> IO ByteString
    transportGet SocketTransport
    st Int
    n = (ByteString, [Fd]) -> ByteString
    forall a b. (a, b) -> a
    fst ((ByteString, [Fd]) -> ByteString)
    -> IO (ByteString, [Fd]) -> IO ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SocketTransport -> Int -> IO (ByteString, [Fd])
    forall t. Transport t => t -> Int -> IO (ByteString, [Fd])
    transportGetWithFds SocketTransport
    st Int
    n
        transportGetWithFds :: SocketTransport -> Int -> IO (ByteString, [Fd])
    transportGetWithFds (SocketTransport Maybe Address
    addr Socket
    s) Int
    n = Maybe Address -> IO (ByteString, [Fd]) -> IO (ByteString, [Fd])
    forall a. Maybe Address -> IO a -> IO a
    catchIOException Maybe Address
    addr (Socket -> Int -> IO (ByteString, [Fd])
    recvWithFds Socket
    s Int
    n)
        transportClose :: SocketTransport -> IO ()
    transportClose (SocketTransport Maybe Address
    addr Socket
    s) = Maybe Address -> IO () -> IO ()
    forall a. Maybe Address -> IO a -> IO a
    catchIOException Maybe Address
    addr (Socket -> IO ()
    close Socket
    s)

    sendWithFds :: Socket -> ByteString -> [Fd] -> IO ()
    sendWithFds :: Socket -> ByteString -> [Fd] -> IO ()
    sendWithFds Socket
    s ByteString
    msg [Fd]
    fds = Int -> IO ()
    loop Int
    0 where
        loop :: Int -> IO ()
    loop Int
    acc  = do
            let cmsgs :: [Cmsg]
    cmsgs = if Int
    acc Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then ([Fd] -> Cmsg
    forall a. ControlMessage a => a -> Cmsg
    encodeCmsg ([Fd] -> Cmsg) -> (Fd -> [Fd]) -> Fd -> Cmsg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Fd -> [Fd]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure :: Fd -> [Fd]) (Fd -> Cmsg) -> [Fd] -> [Cmsg]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Fd]
    fds) else []
            n <- ByteString -> (CString -> IO Int) -> IO Int
    forall a. ByteString -> (CString -> IO a) -> IO a
    unsafeUseAsCString ByteString
    msg ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \CString
    cstr -> do
                let buf :: [(Ptr Word8, Int)]
    buf = [(Ptr (ZonkAny 1) -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    plusPtr (CString -> Ptr (ZonkAny 1)
    forall a b. Ptr a -> Ptr b
    castPtr CString
    cstr) Int
    acc, Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    acc)]
                Socket
    -> NullSockAddr
    -> [(Ptr Word8, Int)]
    -> [Cmsg]
    -> MsgFlag
    -> IO Int
    forall sa.
    SocketAddress sa =>
    Socket -> sa -> [(Ptr Word8, Int)] -> [Cmsg] -> MsgFlag -> IO Int
    Network.Socket.Address.sendBufMsg Socket
    s NullSockAddr
    NullSockAddr [(Ptr Word8, Int)]
    buf [Cmsg]
    cmsgs MsgFlag
    forall a. Monoid a => a
    mempty
            waitWhen0 n s -- copy Network.Socket.ByteString.sendAll
            when (acc + n < len) $ do
                loop (acc + n)
        len :: Int
    len = ByteString -> Int
    Data.ByteString.length ByteString
    msg

    recvWithFds :: Socket -> Int -> IO (ByteString, [Fd])
    recvWithFds :: Socket -> Int -> IO (ByteString, [Fd])
    recvWithFds Socket
    s = Builder -> [Fd] -> Int -> IO (ByteString, [Fd])
    loop Builder
    forall a. Monoid a => a
    mempty [] where
        loop :: Builder -> [Fd] -> Int -> IO (ByteString, [Fd])
    loop Builder
    accBuf [Fd]
    accFds Int
    n = do
            (_sa, buf, cmsgs, flag) <- Socket
    -> Int
    -> Int
    -> MsgFlag
    -> IO (SockAddr, ByteString, [Cmsg], MsgFlag)
    recvMsg Socket
    s (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    n Int
    chunkSize) Int
    cmsgsSize MsgFlag
    forall a. Monoid a => a
    mempty
            let recvLen = ByteString -> Int
    Data.ByteString.length ByteString
    buf
                accBuf' = Builder
    accBuf Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    Builder.byteString ByteString
    buf
                accFds' = [Fd]
    accFds [Fd] -> [Fd] -> [Fd]
    forall a. Semigroup a => a -> a -> a
    <> [Cmsg] -> [Fd]
    decodeFdCmsgs [Cmsg]
    cmsgs
            case flag of
                MsgFlag
    MSG_CTRUNC -> TransportError -> IO (ByteString, [Fd])
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError (String
    "Unexpected MSG_CTRUNC: more than " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall a. Show a => a -> String
    show Int
    maxFds String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " file descriptors?"))
                -- no data means unexpected end of connection; maybe the remote end went away.
                MsgFlag
    _ | Int
    recvLen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    || Int
    recvLen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    n -> do
                    (ByteString, [Fd]) -> IO (ByteString, [Fd])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LazyByteString -> ByteString
    Lazy.toStrict (Builder -> LazyByteString
    Builder.toLazyByteString Builder
    accBuf'), [Fd]
    accFds')
                MsgFlag
    _ -> Builder -> [Fd] -> Int -> IO (ByteString, [Fd])
    loop Builder
    accBuf' [Fd]
    accFds' (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    recvLen)
        chunkSize :: Int
    chunkSize = Int
    4096
        maxFds :: Int
    maxFds = Int
    16 -- same as DBUS_DEFAULT_MESSAGE_UNIX_FDS in DBUS reference implementation
        cmsgsSize :: Int
    cmsgsSize = CInt -> Int
    forall a. Storable a => a -> Int
    sizeOf (CInt
    forall a. HasCallStack => a
    undefined :: CInt) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    maxFds

    instance TransportOpen SocketTransport where
        transportOpen :: TransportOptions SocketTransport -> Address -> IO SocketTransport
    transportOpen TransportOptions SocketTransport
    _ Address
    a = case Address -> String
    addressMethod Address
    a of
            String
    "unix" -> Address -> IO SocketTransport
    openUnix Address
    a
            String
    "tcp" -> Address -> IO SocketTransport
    openTcp Address
    a
            String
    method -> TransportError -> IO SocketTransport
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError (String
    "Unknown address method: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    method))
                { transportErrorAddress = Just a
                }

    instance TransportListen SocketTransport where
        data TransportListener SocketTransport = SocketTransportListener Address UUID Socket
        transportListen :: TransportOptions SocketTransport
    -> Address -> IO (TransportListener SocketTransport)
    transportListen TransportOptions SocketTransport
    opts Address
    a = do
            uuid <- IO UUID
    randomUUID
            (a', sock) <- case addressMethod a of
                String
    "unix" -> UUID
    -> Address
    -> TransportOptions SocketTransport
    -> IO (Address, Socket)
    listenUnix UUID
    uuid Address
    a TransportOptions SocketTransport
    opts
                String
    "tcp" -> UUID
    -> Address
    -> TransportOptions SocketTransport
    -> IO (Address, Socket)
    listenTcp UUID
    uuid Address
    a TransportOptions SocketTransport
    opts
                String
    method -> TransportError -> IO (Address, Socket)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError (String
    "Unknown address method: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    method))
                    { transportErrorAddress = Just a
                    }
            return (SocketTransportListener a' uuid sock)
        transportAccept :: TransportListener SocketTransport -> IO SocketTransport
    transportAccept (SocketTransportListener Address
    a UUID
    _ Socket
    s) = Maybe Address -> IO SocketTransport -> IO SocketTransport
    forall a. Maybe Address -> IO a -> IO a
    catchIOException (Address -> Maybe Address
    forall a. a -> Maybe a
    Just Address
    a) (IO SocketTransport -> IO SocketTransport)
    -> IO SocketTransport -> IO SocketTransport
    forall a b. (a -> b) -> a -> b
    $ do
            (s', _) <- Socket -> IO (Socket, SockAddr)
    accept Socket
    s
            return (SocketTransport Nothing s')
        transportListenerClose :: TransportListener SocketTransport -> IO ()
    transportListenerClose (SocketTransportListener Address
    a UUID
    _ Socket
    s) = Maybe Address -> IO () -> IO ()
    forall a. Maybe Address -> IO a -> IO a
    catchIOException (Address -> Maybe Address
    forall a. a -> Maybe a
    Just Address
    a) (Socket -> IO ()
    close Socket
    s)
        transportListenerAddress :: TransportListener SocketTransport -> Address
    transportListenerAddress (SocketTransportListener Address
    a UUID
    _ Socket
    _) = Address
    a
        transportListenerUUID :: TransportListener SocketTransport -> UUID
    transportListenerUUID (SocketTransportListener Address
    _ UUID
    uuid Socket
    _) = UUID
    uuid

    -- | Returns the processID, userID, and groupID of the socket's peer.
    --
    -- See 'getPeerCredential'.
    socketTransportCredentials :: SocketTransport -> IO (Maybe CUInt, Maybe CUInt, Maybe CUInt)
    socketTransportCredentials :: SocketTransport -> IO (Maybe CUInt, Maybe CUInt, Maybe CUInt)
    socketTransportCredentials (SocketTransport Maybe Address
    a Socket
    s) = Maybe Address
    -> IO (Maybe CUInt, Maybe CUInt, Maybe CUInt)
    -> IO (Maybe CUInt, Maybe CUInt, Maybe CUInt)
    forall a. Maybe Address -> IO a -> IO a
    catchIOException Maybe Address
    a (Socket -> IO (Maybe CUInt, Maybe CUInt, Maybe CUInt)
    getPeerCredential Socket
    s)

    openUnix :: Address -> IO SocketTransport
    openUnix :: Address -> IO SocketTransport
    openUnix Address
    transportAddr = IO SocketTransport
    go where
        params :: Map String String
    params = Address -> Map String String
    addressParameters Address
    transportAddr
        param :: String -> Maybe String
    param String
    key = String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    key Map String String
    params

        tooMany :: String
    tooMany = String
    "Only one of 'path' or 'abstract' may be specified for the\
                  \ 'unix' transport."
        tooFew :: String
    tooFew = String
    "One of 'path' or 'abstract' must be specified for the\
                 \ 'unix' transport."

        path :: Either String String
    path = case (String -> Maybe String
    param String
    "path", String -> Maybe String
    param String
    "abstract") of
            (Just String
    x, Maybe String
    Nothing) -> String -> Either String String
    forall a b. b -> Either a b
    Right String
    x
            (Maybe String
    Nothing, Just String
    x) -> String -> Either String String
    forall a b. b -> Either a b
    Right (Char
    '\x00' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    x)
            (Maybe String
    Nothing, Maybe String
    Nothing) -> String -> Either String String
    forall a b. a -> Either a b
    Left String
    tooFew
            (Maybe String, Maybe String)
    _ -> String -> Either String String
    forall a b. a -> Either a b
    Left String
    tooMany

        go :: IO SocketTransport
    go = case Either String String
    path of
            Left String
    err -> TransportError -> IO SocketTransport
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError String
    err)
                { transportErrorAddress = Just transportAddr
                }
            Right String
    p -> Maybe Address -> IO SocketTransport -> IO SocketTransport
    forall a. Maybe Address -> IO a -> IO a
    catchIOException (Address -> Maybe Address
    forall a. a -> Maybe a
    Just Address
    transportAddr) (IO SocketTransport -> IO SocketTransport)
    -> IO SocketTransport -> IO SocketTransport
    forall a b. (a -> b) -> a -> b
    $ IO Socket
    -> (Socket -> IO ())
    -> (Socket -> IO SocketTransport)
    -> IO SocketTransport
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracketOnError
                (Family -> SocketType -> CInt -> IO Socket
    socket Family
    AF_UNIX SocketType
    Stream CInt
    defaultProtocol)
                Socket -> IO ()
    close
                (\Socket
    sock -> do
                    Socket -> SockAddr -> IO ()
    connect Socket
    sock (String -> SockAddr
    SockAddrUnix String
    p)
                    SocketTransport -> IO SocketTransport
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Address -> Socket -> SocketTransport
    SocketTransport (Address -> Maybe Address
    forall a. a -> Maybe a
    Just Address
    transportAddr) Socket
    sock))

    tcpHostname :: Maybe String -> Either a Network.Socket.Family -> String
    tcpHostname :: forall a. Maybe String -> Either a Family -> String
    tcpHostname (Just String
    host) Either a Family
    _ = String
    host
    tcpHostname Maybe String
    Nothing (Right Family
    AF_INET) = String
    "127.0.0.1"
    tcpHostname Maybe String
    Nothing (Right Family
    AF_INET6) = String
    "::1"
    tcpHostname Maybe String
    _ Either a Family
    _ = String
    "localhost"

    openTcp :: Address -> IO SocketTransport
    openTcp :: Address -> IO SocketTransport
    openTcp Address
    transportAddr = IO SocketTransport
    go where
        params :: Map String String
    params = Address -> Map String String
    addressParameters Address
    transportAddr
        param :: String -> Maybe String
    param String
    key = String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    key Map String String
    params

        hostname :: String
    hostname = Maybe String -> Either String Family -> String
    forall a. Maybe String -> Either a Family -> String
    tcpHostname (String -> Maybe String
    param String
    "host") Either String Family
    getFamily
        unknownFamily :: a -> String
    unknownFamily a
    x = String
    "Unknown socket family for TCP transport: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    x
        getFamily :: Either String Family
    getFamily = case String -> Maybe String
    param String
    "family" of
            Just String
    "ipv4" -> Family -> Either String Family
    forall a b. b -> Either a b
    Right Family
    AF_INET
            Just String
    "ipv6" -> Family -> Either String Family
    forall a b. b -> Either a b
    Right Family
    AF_INET6
            Maybe String
    Nothing     -> Family -> Either String Family
    forall a b. b -> Either a b
    Right Family
    AF_UNSPEC
            Just String
    x      -> String -> Either String Family
    forall a b. a -> Either a b
    Left (ShowS
    forall a. Show a => a -> String
    unknownFamily String
    x)
        missingPort :: String
    missingPort = String
    "TCP transport requires the `port' parameter."
        badPort :: a -> String
    badPort a
    x = String
    "Invalid socket port for TCP transport: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    x
        getPort :: Either String PortNumber
    getPort = case String -> Maybe String
    param String
    "port" of
            Maybe String
    Nothing -> String -> Either String PortNumber
    forall a b. a -> Either a b
    Left String
    missingPort
            Just String
    x -> case String -> Maybe PortNumber
    readPortNumber String
    x of
                Just PortNumber
    port -> PortNumber -> Either String PortNumber
    forall a b. b -> Either a b
    Right PortNumber
    port
                Maybe PortNumber
    Nothing -> String -> Either String PortNumber
    forall a b. a -> Either a b
    Left (ShowS
    forall a. Show a => a -> String
    badPort String
    x)

        getAddresses :: Family -> IO [AddrInfo]
    getAddresses Family
    family_ = Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
    forall (t :: * -> *).
    GetAddrInfo t =>
    Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
    getAddrInfo (AddrInfo -> Maybe AddrInfo
    forall a. a -> Maybe a
    Just (AddrInfo
    defaultHints
            { addrFlags = [AI_ADDRCONFIG]
            , addrFamily = family_
            , addrSocketType = Stream
            })) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    hostname) Maybe String
    forall a. Maybe a
    Nothing

        openOneSocket :: [AddrInfo] -> IO Socket
    openOneSocket [] = TransportError -> IO Socket
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError String
    "openTcp: no addresses")
            { transportErrorAddress = Just transportAddr
            }
        openOneSocket (AddrInfo
    addr:[AddrInfo]
    addrs) = do
            tried <- IO Socket -> IO (Either IOException Socket)
    forall e a. Exception e => IO a -> IO (Either e a)
    Control.Exception.try (IO Socket -> IO (Either IOException Socket))
    -> IO Socket -> IO (Either IOException Socket)
    forall a b. (a -> b) -> a -> b
    $ IO Socket
    -> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracketOnError
                (Family -> SocketType -> CInt -> IO Socket
    socket (AddrInfo -> Family
    addrFamily AddrInfo
    addr) (AddrInfo -> SocketType
    addrSocketType AddrInfo
    addr) (AddrInfo -> CInt
    addrProtocol AddrInfo
    addr))
                Socket -> IO ()
    close
                (\Socket
    sock -> do
                    Socket -> SockAddr -> IO ()
    connect Socket
    sock (AddrInfo -> SockAddr
    addrAddress AddrInfo
    addr)
                    Socket -> IO Socket
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Socket
    sock)
            case tried of
                Left IOException
    err -> case [AddrInfo]
    addrs of
                    [] -> TransportError -> IO Socket
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError (IOException -> String
    forall a. Show a => a -> String
    show (IOException
    err :: IOException)))
                        { transportErrorAddress = Just transportAddr
                        }
                    [AddrInfo]
    _ -> [AddrInfo] -> IO Socket
    openOneSocket [AddrInfo]
    addrs
                Right Socket
    sock -> Socket -> IO Socket
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Socket
    sock

        go :: IO SocketTransport
    go = case Either String PortNumber
    getPort of
            Left String
    err -> TransportError -> IO SocketTransport
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError String
    err)
                { transportErrorAddress = Just transportAddr
                }
            Right PortNumber
    port -> case Either String Family
    getFamily of
                Left String
    err -> TransportError -> IO SocketTransport
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError String
    err)
                    { transportErrorAddress = Just transportAddr
                    }
                Right Family
    family_ -> Maybe Address -> IO SocketTransport -> IO SocketTransport
    forall a. Maybe Address -> IO a -> IO a
    catchIOException (Address -> Maybe Address
    forall a. a -> Maybe a
    Just Address
    transportAddr) (IO SocketTransport -> IO SocketTransport)
    -> IO SocketTransport -> IO SocketTransport
    forall a b. (a -> b) -> a -> b
    $ do
                    addrs <- Family -> IO [AddrInfo]
    getAddresses Family
    family_
                    sock <- openOneSocket (map (setPort port) addrs)
                    return (SocketTransport (Just transportAddr) sock)

    listenUnix :: UUID -> Address -> TransportOptions SocketTransport -> IO (Address, Socket)
    listenUnix :: UUID
    -> Address
    -> TransportOptions SocketTransport
    -> IO (Address, Socket)
    listenUnix UUID
    uuid Address
    origAddr TransportOptions SocketTransport
    opts = IO (Either String (Address, String))
    getPath IO (Either String (Address, String))
    -> (Either String (Address, String) -> IO (Address, Socket))
    -> IO (Address, Socket)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Either String (Address, String) -> IO (Address, Socket)
    go where
        params :: Map String String
    params = Address -> Map String String
    addressParameters Address
    origAddr
        param :: String -> Maybe String
    param String
    key = String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    key Map String String
    params

        tooMany :: String
    tooMany = String
    "Only one of 'abstract', 'path', or 'tmpdir' may be\
                  \ specified for the 'unix' transport."
        tooFew :: String
    tooFew = String
    "One of 'abstract', 'path', or 'tmpdir' must be specified\
                 \ for the 'unix' transport."

        getPath :: IO (Either String (Address, String))
    getPath = case (String -> Maybe String
    param String
    "abstract", String -> Maybe String
    param String
    "path", String -> Maybe String
    param String
    "tmpdir") of
            (Just String
    path, Maybe String
    Nothing, Maybe String
    Nothing) -> let
                addr :: Address
    addr = String -> [(String, String)] -> Address
    address_ String
    "unix"
                    [ (String
    "abstract", String
    path)
                    , (String
    "guid", UUID -> String
    formatUUID UUID
    uuid)
                    ]
                in Either String (Address, String)
    -> IO (Either String (Address, String))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Address, String) -> Either String (Address, String)
    forall a b. b -> Either a b
    Right (Address
    addr, Char
    '\x00' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    path))
            (Maybe String
    Nothing, Just String
    path, Maybe String
    Nothing) -> let
                addr :: Address
    addr = String -> [(String, String)] -> Address
    address_ String
    "unix"
                    [ (String
    "path", String
    path)
                    , (String
    "guid", UUID -> String
    formatUUID UUID
    uuid)
                    ]
                in Either String (Address, String)
    -> IO (Either String (Address, String))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Address, String) -> Either String (Address, String)
    forall a b. b -> Either a b
    Right (Address
    addr, String
    path))
            (Maybe String
    Nothing, Maybe String
    Nothing, Just String
    x) -> do
                let fileName :: String
    fileName = String
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "/haskell-dbus-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ UUID -> String
    formatUUID UUID
    uuid

                -- Abstract paths are supported on Linux, but not on
                -- other Unix-like systems.
                let ([(String, String)]
    addrParams, String
    path) = if String
    System.Info.os String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "linux"
                        then ([(String
    "abstract", String
    fileName)], Char
    '\x00' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    fileName)
                        else ([(String
    "path", String
    fileName)], String
    fileName)

                let addr :: Address
    addr = String -> [(String, String)] -> Address
    address_ String
    "unix" ([(String, String)]
    addrParams [(String, String)] -> [(String, String)] -> [(String, String)]
    forall a. [a] -> [a] -> [a]
    ++ [(String
    "guid", UUID -> String
    formatUUID UUID
    uuid)])
                Either String (Address, String)
    -> IO (Either String (Address, String))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Address, String) -> Either String (Address, String)
    forall a b. b -> Either a b
    Right (Address
    addr, String
    path))
            (Maybe String
    Nothing, Maybe String
    Nothing, Maybe String
    Nothing) -> Either String (Address, String)
    -> IO (Either String (Address, String))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String (Address, String)
    forall a b. a -> Either a b
    Left String
    tooFew)
            (Maybe String, Maybe String, Maybe String)
    _ -> Either String (Address, String)
    -> IO (Either String (Address, String))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String (Address, String)
    forall a b. a -> Either a b
    Left String
    tooMany)

        go :: Either String (Address, String) -> IO (Address, Socket)
    go Either String (Address, String)
    path = case Either String (Address, String)
    path of
            Left String
    err -> TransportError -> IO (Address, Socket)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError String
    err)
                { transportErrorAddress = Just origAddr
                }
            Right (Address
    addr, String
    p) -> Maybe Address -> IO (Address, Socket) -> IO (Address, Socket)
    forall a. Maybe Address -> IO a -> IO a
    catchIOException (Address -> Maybe Address
    forall a. a -> Maybe a
    Just Address
    origAddr) (IO (Address, Socket) -> IO (Address, Socket))
    -> IO (Address, Socket) -> IO (Address, Socket)
    forall a b. (a -> b) -> a -> b
    $ IO Socket
    -> (Socket -> IO ())
    -> (Socket -> IO (Address, Socket))
    -> IO (Address, Socket)
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracketOnError
                (Family -> SocketType -> CInt -> IO Socket
    socket Family
    AF_UNIX SocketType
    Stream CInt
    defaultProtocol)
                Socket -> IO ()
    close
                (\Socket
    sock -> do
                    Socket -> SockAddr -> IO ()
    bind Socket
    sock (String -> SockAddr
    SockAddrUnix String
    p)
                    Socket -> Int -> IO ()
    Network.Socket.listen Socket
    sock (TransportOptions SocketTransport -> Int
    socketTransportOptionBacklog TransportOptions SocketTransport
    opts)
                    (Address, Socket) -> IO (Address, Socket)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Address
    addr, Socket
    sock))

    listenTcp :: UUID -> Address -> TransportOptions SocketTransport -> IO (Address, Socket)
    listenTcp :: UUID
    -> Address
    -> TransportOptions SocketTransport
    -> IO (Address, Socket)
    listenTcp UUID
    uuid Address
    origAddr TransportOptions SocketTransport
    opts = IO (Address, Socket)
    go where
        params :: Map String String
    params = Address -> Map String String
    addressParameters Address
    origAddr
        param :: String -> Maybe String
    param String
    key = String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    key Map String String
    params

        unknownFamily :: a -> String
    unknownFamily a
    x = String
    "Unknown socket family for TCP transport: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    x
        getFamily :: Either String Family
    getFamily = case String -> Maybe String
    param String
    "family" of
            Just String
    "ipv4" -> Family -> Either String Family
    forall a b. b -> Either a b
    Right Family
    AF_INET
            Just String
    "ipv6" -> Family -> Either String Family
    forall a b. b -> Either a b
    Right Family
    AF_INET6
            Maybe String
    Nothing     -> Family -> Either String Family
    forall a b. b -> Either a b
    Right Family
    AF_UNSPEC
            Just String
    x      -> String -> Either String Family
    forall a b. a -> Either a b
    Left (ShowS
    forall a. Show a => a -> String
    unknownFamily String
    x)

        badPort :: a -> String
    badPort a
    x = String
    "Invalid socket port for TCP transport: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    x
        getPort :: Either String PortNumber
    getPort = case String -> Maybe String
    param String
    "port" of
            Maybe String
    Nothing -> PortNumber -> Either String PortNumber
    forall a b. b -> Either a b
    Right PortNumber
    0
            Just String
    x -> case String -> Maybe PortNumber
    readPortNumber String
    x of
                Just PortNumber
    port -> PortNumber -> Either String PortNumber
    forall a b. b -> Either a b
    Right PortNumber
    port
                Maybe PortNumber
    Nothing -> String -> Either String PortNumber
    forall a b. a -> Either a b
    Left (ShowS
    forall a. Show a => a -> String
    badPort String
    x)

        paramBind :: Maybe String
    paramBind = case String -> Maybe String
    param String
    "bind" of
            Just String
    "*" -> Maybe String
    forall a. Maybe a
    Nothing
            Just String
    x -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    x
            Maybe String
    Nothing -> String -> Maybe String
    forall a. a -> Maybe a
    Just (Maybe String -> Either String Family -> String
    forall a. Maybe String -> Either a Family -> String
    tcpHostname (String -> Maybe String
    param String
    "host") Either String Family
    getFamily)

        getAddresses :: Family -> IO [AddrInfo]
    getAddresses Family
    family_ = Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
    forall (t :: * -> *).
    GetAddrInfo t =>
    Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
    getAddrInfo (AddrInfo -> Maybe AddrInfo
    forall a. a -> Maybe a
    Just (AddrInfo
    defaultHints
            { addrFlags = [AI_ADDRCONFIG, AI_PASSIVE]
            , addrFamily = family_
            , addrSocketType = Stream
            })) Maybe String
    paramBind Maybe String
    forall a. Maybe a
    Nothing

        bindAddrs :: Socket -> [AddrInfo] -> IO ()
    bindAddrs Socket
    _ [] = TransportError -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError String
    "listenTcp: no addresses")
            { transportErrorAddress = Just origAddr
            }
        bindAddrs Socket
    sock (AddrInfo
    addr:[AddrInfo]
    addrs) = do
            tried <- IO () -> IO (Either IOException ())
    forall e a. Exception e => IO a -> IO (Either e a)
    Control.Exception.try (Socket -> SockAddr -> IO ()
    bind Socket
    sock (AddrInfo -> SockAddr
    addrAddress AddrInfo
    addr))
            case tried of
                Left IOException
    err -> case [AddrInfo]
    addrs of
                    [] -> TransportError -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError (IOException -> String
    forall a. Show a => a -> String
    show (IOException
    err :: IOException)))
                        { transportErrorAddress = Just origAddr
                        }
                    [AddrInfo]
    _ -> Socket -> [AddrInfo] -> IO ()
    bindAddrs Socket
    sock [AddrInfo]
    addrs
                Right ()
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        sockAddr :: PortNumber -> Address
    sockAddr PortNumber
    port = String -> [(String, String)] -> Address
    address_ String
    "tcp" [(String, String)]
    p where
            p :: [(String, String)]
    p = [(String, String)]
    baseParams [(String, String)] -> [(String, String)] -> [(String, String)]
    forall a. [a] -> [a] -> [a]
    ++ [(String, String)]
    hostParam [(String, String)] -> [(String, String)] -> [(String, String)]
    forall a. [a] -> [a] -> [a]
    ++ [(String, String)]
    familyParam
            baseParams :: [(String, String)]
    baseParams =
                [ (String
    "port", PortNumber -> String
    forall a. Show a => a -> String
    show PortNumber
    port)
                , (String
    "guid", UUID -> String
    formatUUID UUID
    uuid)
                ]
            hostParam :: [(String, String)]
    hostParam = case String -> Maybe String
    param String
    "host" of
                Just String
    x -> [(String
    "host", String
    x)]
                Maybe String
    Nothing -> []
            familyParam :: [(String, String)]
    familyParam = case String -> Maybe String
    param String
    "family" of
                Just String
    x -> [(String
    "family", String
    x)]
                Maybe String
    Nothing -> []

        go :: IO (Address, Socket)
    go = case Either String PortNumber
    getPort of
            Left String
    err -> TransportError -> IO (Address, Socket)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError String
    err)
                { transportErrorAddress = Just origAddr
                }
            Right PortNumber
    port -> case Either String Family
    getFamily of
                Left String
    err -> TransportError -> IO (Address, Socket)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError String
    err)
                    { transportErrorAddress = Just origAddr
                    }
                Right Family
    family_ -> Maybe Address -> IO (Address, Socket) -> IO (Address, Socket)
    forall a. Maybe Address -> IO a -> IO a
    catchIOException (Address -> Maybe Address
    forall a. a -> Maybe a
    Just Address
    origAddr) (IO (Address, Socket) -> IO (Address, Socket))
    -> IO (Address, Socket) -> IO (Address, Socket)
    forall a b. (a -> b) -> a -> b
    $ do
                    sockAddrs <- Family -> IO [AddrInfo]
    getAddresses Family
    family_
                    bracketOnError
                        (socket family_ Stream defaultProtocol)
                        close
                        (\Socket
    sock -> do
                            Socket -> SocketOption -> Int -> IO ()
    setSocketOption Socket
    sock SocketOption
    ReuseAddr Int
    1
                            Socket -> [AddrInfo] -> IO ()
    bindAddrs Socket
    sock ((AddrInfo -> AddrInfo) -> [AddrInfo] -> [AddrInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (PortNumber -> AddrInfo -> AddrInfo
    setPort PortNumber
    port) [AddrInfo]
    sockAddrs)

                            Socket -> Int -> IO ()
    Network.Socket.listen Socket
    sock (TransportOptions SocketTransport -> Int
    socketTransportOptionBacklog TransportOptions SocketTransport
    opts)
                            sockPort <- Socket -> IO PortNumber
    socketPort Socket
    sock
                            return (sockAddr sockPort, sock))

    catchIOException :: Maybe Address -> IO a -> IO a
    catchIOException :: forall a. Maybe Address -> IO a -> IO a
    catchIOException Maybe Address
    addr IO a
    io = do
        tried <- IO a -> IO (Either IOException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try IO a
    io
        case tried of
            Right a
    a -> a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a
            Left IOException
    err -> TransportError -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> TransportError
    transportError (IOException -> String
    forall a. Show a => a -> String
    show (IOException
    err :: IOException)))
                { transportErrorAddress = addr
                }

    address_ :: String -> [(String, String)] -> Address
    address_ :: String -> [(String, String)] -> Address
    address_ String
    method [(String, String)]
    params = Address
    addr where
        Just Address
    addr = String -> Map String String -> Maybe Address
    address String
    method ([(String, String)] -> Map String String
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(String, String)]
    params)

    setPort :: PortNumber -> AddrInfo -> AddrInfo
    setPort :: PortNumber -> AddrInfo -> AddrInfo
    setPort PortNumber
    port AddrInfo
    info = case AddrInfo -> SockAddr
    addrAddress AddrInfo
    info of
        (SockAddrInet  PortNumber
    _ HostAddress
    x) -> AddrInfo
    info { addrAddress = SockAddrInet port x }
        (SockAddrInet6 PortNumber
    _ HostAddress
    x HostAddress6
    y HostAddress
    z) -> AddrInfo
    info { addrAddress = SockAddrInet6 port x y z }
        SockAddr
    _ -> AddrInfo
    info

    readPortNumber :: String -> Maybe PortNumber
    readPortNumber :: String -> Maybe PortNumber
    readPortNumber String
    s = do
        case (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    '0' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '9') String
    s of
            [] -> () -> Maybe ()
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            String
    _ -> Maybe ()
    forall a. Maybe a
    Nothing
        let word :: Integer
    word = String -> Integer
    forall a. Read a => String -> a
    read String
    s :: Integer
        if Integer
    word Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0 Bool -> Bool -> Bool
    && Integer
    word Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    65535
            then PortNumber -> Maybe PortNumber
    forall a. a -> Maybe a
    Just (Integer -> PortNumber
    forall a. Num a => Integer -> a
    fromInteger Integer
    word)
            else Maybe PortNumber
    forall a. Maybe a
    Nothing

    -- | Copied from Network.Socket.ByteString.IO
    waitWhen0 :: Int -> Socket -> IO ()
    waitWhen0 :: Int -> Socket -> IO ()
    waitWhen0 Int
    0 Socket
    s = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    rtsSupportsBoundThreads (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Socket -> (CInt -> IO ()) -> IO ()
    forall r. Socket -> (CInt -> IO r) -> IO r
    withFdSocket Socket
    s ((CInt -> IO ()) -> IO ()) -> (CInt -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \CInt
    fd -> Fd -> IO ()
    threadWaitWrite (Fd -> IO ()) -> Fd -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CInt -> Fd
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    fd
    waitWhen0 Int
    _ Socket
    _ = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    decodeFdCmsgs :: [Cmsg] -> [Fd]
    decodeFdCmsgs :: [Cmsg] -> [Fd]
    decodeFdCmsgs [Cmsg]
    cmsgs =
        (Cmsg -> [Fd]) -> [Cmsg] -> [Fd]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ([Fd] -> Maybe [Fd] -> [Fd]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [Fd] -> [Fd]) -> (Cmsg -> Maybe [Fd]) -> Cmsg -> [Fd]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cmsg -> Maybe [Fd]
    decodeFdCmsg) [Cmsg]
    cmsgs

    -- | Special decode function to handle > 1 Fd. Should be able to replace with a function
    -- from the network package in future (https://github.com/haskell/network/issues/566)
    decodeFdCmsg :: Cmsg -> Maybe [Fd]
    decodeFdCmsg :: Cmsg -> Maybe [Fd]
    decodeFdCmsg (Cmsg CmsgId
    cmsid (PS ForeignPtr Word8
    fptr Int
    off Int
    len))
      | CmsgId
    cmsid CmsgId -> CmsgId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CmsgId
    CmsgIdFds = Maybe [Fd]
    forall a. Maybe a
    Nothing
      | Bool
    otherwise =
        IO (Maybe [Fd]) -> Maybe [Fd]
    forall a. IO a -> a
    unsafeDupablePerformIO (IO (Maybe [Fd]) -> Maybe [Fd]) -> IO (Maybe [Fd]) -> Maybe [Fd]
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8
    -> (Ptr Word8 -> IO (Maybe [Fd])) -> IO (Maybe [Fd])
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    fptr ((Ptr Word8 -> IO (Maybe [Fd])) -> IO (Maybe [Fd]))
    -> (Ptr Word8 -> IO (Maybe [Fd])) -> IO (Maybe [Fd])
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    p0 -> do
          let p :: Ptr Fd
    p = Ptr (ZonkAny 0) -> Ptr Fd
    forall a b. Ptr a -> Ptr b
    castPtr (Ptr Word8
    p0 Ptr Word8 -> Int -> Ptr (ZonkAny 0)
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off)
              numFds :: Int
    numFds = Int
    len Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Fd -> Int
    forall a. Storable a => a -> Int
    sizeOf (Fd
    forall a. HasCallStack => a
    undefined :: Fd)
          [Fd] -> Maybe [Fd]
    forall a. a -> Maybe a
    Just ([Fd] -> Maybe [Fd]) -> IO [Fd] -> IO (Maybe [Fd])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Ptr Fd -> IO [Fd]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray Int
    numFds Ptr Fd
    p