2019-05-30 01:02:37 +00:00
|
|
|
-- | Compatibility layer for network package, including newtype 'PortID'
|
2019-05-30 18:33:13 +00:00
|
|
|
{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
|
2019-05-30 01:02:37 +00:00
|
|
|
|
|
|
|
module Database.MongoDB.Internal.Network (PortID(..), N.HostName, connectTo) where
|
|
|
|
|
|
|
|
|
2019-05-30 17:28:23 +00:00
|
|
|
#if !MIN_VERSION_network(2, 9, 0)
|
2019-05-30 17:02:06 +00:00
|
|
|
|
2019-05-30 01:02:37 +00:00
|
|
|
import qualified Network as N
|
2019-05-30 17:02:06 +00:00
|
|
|
import System.IO (Handle)
|
|
|
|
|
2019-05-30 01:02:37 +00:00
|
|
|
#else
|
2019-05-30 17:02:06 +00:00
|
|
|
|
|
|
|
import Control.Exception (bracketOnError)
|
|
|
|
import Network.BSD as BSD
|
2019-05-30 01:02:37 +00:00
|
|
|
import qualified Network.Socket as N
|
2019-05-30 17:02:06 +00:00
|
|
|
import System.IO (Handle, IOMode(ReadWriteMode))
|
|
|
|
|
2019-05-30 01:02:37 +00:00
|
|
|
#endif
|
|
|
|
|
2019-05-30 17:02:06 +00:00
|
|
|
|
|
|
|
-- | Wraps network's 'PortNumber'
|
2019-05-30 17:28:23 +00:00
|
|
|
-- Used to ease compatibility between older and newer network versions.
|
2019-05-30 18:33:13 +00:00
|
|
|
newtype PortID = PortNumber N.PortNumber deriving (Enum, Eq, Integral, Num, Ord, Read, Real, Show)
|
2019-05-30 01:02:37 +00:00
|
|
|
|
2019-05-30 17:02:06 +00:00
|
|
|
|
2019-05-30 17:28:23 +00:00
|
|
|
#if !MIN_VERSION_network(2, 9, 0)
|
2019-05-30 17:02:06 +00:00
|
|
|
|
|
|
|
-- Unwrap our newtype and use network's PortID and connectTo
|
|
|
|
connectTo :: N.HostName -- Hostname
|
|
|
|
-> PortID -- Port Identifier
|
|
|
|
-> IO Handle -- Connected Socket
|
|
|
|
connectTo hostname (PortNumber port) = N.connectTo hostname (N.PortNumber port)
|
|
|
|
|
|
|
|
#else
|
|
|
|
|
|
|
|
-- Copied implementation from network 2.8's 'connectTo', but using our 'PortID' newtype.
|
2019-05-30 01:02:37 +00:00
|
|
|
-- https://github.com/haskell/network/blob/e73f0b96c9da924fe83f3c73488f7e69f712755f/Network.hs#L120-L129
|
|
|
|
connectTo :: N.HostName -- Hostname
|
|
|
|
-> PortID -- Port Identifier
|
|
|
|
-> IO Handle -- Connected Socket
|
|
|
|
connectTo hostname (PortNumber port) = do
|
|
|
|
proto <- BSD.getProtocolNumber "tcp"
|
|
|
|
bracketOnError
|
|
|
|
(N.socket N.AF_INET N.Stream proto)
|
|
|
|
(N.close) -- only done if there's an error
|
|
|
|
(\sock -> do
|
|
|
|
he <- BSD.getHostByName hostname
|
|
|
|
N.connect sock (N.SockAddrInet port (hostAddress he))
|
|
|
|
N.socketToHandle sock ReadWriteMode
|
|
|
|
)
|
2019-05-30 17:02:06 +00:00
|
|
|
#endif
|