Update to network 3.0 with backward compatibility for network <= 2.8

Database/MongoDB/Connection.hs

@@ -30,7 +30,6 @@ import Control.Applicative ((<$>))
 #endif
 
 import Control.Monad (forM_)
-import Network (HostName, PortID(..), connectTo)
 import System.IO.Unsafe (unsafePerformIO)
 import System.Timeout (timeout)
 import Text.ParserCombinators.Parsec (parse, many1, letter, digit, char, eof,
@@ -48,6 +47,7 @@ import Data.Text (Text)
 import qualified Data.Bson as B
 import qualified Data.Text as T
 
+import Database.MongoDB.Internal.Network (HostName, PortID(..), connectTo)
 import Database.MongoDB.Internal.Protocol (Pipe, newPipe, close, isClosed)
 import Database.MongoDB.Internal.Util (untilSuccess, liftIOE,
                                        updateAssocs, shuffle, mergesortM)
@@ -79,11 +79,7 @@ showHostPort :: Host -> String
 -- TODO: Distinguish Service and UnixSocket port
 showHostPort (Host hostname port) = hostname ++ ":" ++ portname  where
     portname = case port of
-        Service s -> s
         PortNumber p -> show p
-#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
-        UnixSocket s -> s
-#endif
 
 readHostPortM :: (Monad m) => String -> m Host
 -- ^ Read string \"hostname:port\" as @Host hosthame (PortNumber port)@ or \"hostname\" as @host hostname@ (default port). Fail if string does not match either syntax.

Database/MongoDB/Internal/Network.hs

@@ -0,0 +1,32 @@
+-- | Compatibility layer for network package, including newtype 'PortID'
+{-# LANGUAGE CPP, PackageImports #-}
+
+module Database.MongoDB.Internal.Network (PortID(..), N.HostName, connectTo) where
+
+import Control.Exception (bracketOnError)
+import Network.BSD as BSD
+import System.IO (Handle, IOMode(ReadWriteMode))
+
+#if !MIN_VERSION_network(2, 8, 0)
+import qualified Network as N
+#else
+import qualified Network.Socket as N
+#endif
+
+newtype PortID = PortNumber N.PortNumber deriving (Show, Eq, Ord)
+
+-- Taken from network 2.8's connectTo
+-- 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
+        )

Database/MongoDB/Internal/Util.hs

@@ -1,9 +1,7 @@
--- | Miscellaneous general functions and Show, Eq, and Ord instances for PortID
+-- | Miscellaneous general functions
 
 {-# LANGUAGE FlexibleInstances, UndecidableInstances, StandaloneDeriving #-}
 {-# LANGUAGE CPP #-}
--- PortID instances
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Database.MongoDB.Internal.Util where
 
@@ -14,7 +12,6 @@ import Control.Exception (handle, throwIO, Exception)
 import Control.Monad (liftM, liftM2)
 import Data.Bits (Bits, (.|.))
 import Data.Word (Word8)
-import Network (PortID(..))
 import Numeric (showHex)
 import System.Random (newStdGen)
 import System.Random.Shuffle (shuffle')
@@ -28,12 +25,6 @@ import Data.Text (Text)
 
 import qualified Data.Text as T
 
-#if !MIN_VERSION_network(2, 4, 1)
-deriving instance Show PortID
-deriving instance Eq PortID
-#endif
-deriving instance Ord PortID
-
 -- | A monadic sort implementation derived from the non-monadic one in ghc's Prelude
 mergesortM :: Monad m => (a -> a -> m Ordering) -> [a] -> m [a]
 mergesortM cmp = mergesortM' cmp . map wrap

Database/MongoDB/Transport/Tls.hs

@@ -39,7 +39,7 @@ import Database.MongoDB.Internal.Protocol (newPipeWith)
 import Database.MongoDB.Transport (Transport(Transport))
 import qualified Database.MongoDB.Transport as T
 import System.IO.Error (mkIOError, eofErrorType)
-import Network (connectTo, HostName, PortID)
+import Database.MongoDB.Internal.Network (connectTo, HostName, PortID)
 import qualified Network.TLS as TLS
 import qualified Network.TLS.Extra.Cipher as TLS
 import Database.MongoDB.Query (access, slaveOk, retrieveServerData)

mongoDB.cabal

@@ -19,6 +19,12 @@ Build-type:     Simple
 Stability:      alpha
 Extra-Source-Files: CHANGELOG.md
 
+-- Imitated from https://github.com/mongodb-haskell/bson/pull/18
+Flag _old-network
+  description: Control whether to use <http://hackage.haskell.org/package/network-bsd network-bsd>
+  default: False
+  manual: False
+
 Library
   GHC-options:      -Wall
   default-language: Haskell2010
@@ -54,14 +60,22 @@ Library
                     , base64-bytestring >= 1.0.0.1
                     , nonce >= 1.0.5
 
+  if flag(_old-network)
+     -- "Network.BSD" is only available in network < 2.9
+     build-depends: network < 2.9
+  else
+     -- "Network.BSD" has been moved into its own package `network-bsd`
+     build-depends: network-bsd >= 2.7 && < 2.9
+
   Exposed-modules:  Database.MongoDB
                     Database.MongoDB.Admin
                     Database.MongoDB.Connection
                     Database.MongoDB.GridFS
                     Database.MongoDB.Query
                     Database.MongoDB.Transport
                     Database.MongoDB.Transport.Tls
-  Other-modules:    Database.MongoDB.Internal.Protocol
+  Other-modules:    Database.MongoDB.Internal.Network
+                    Database.MongoDB.Internal.Protocol
                     Database.MongoDB.Internal.Util
 
 Source-repository head

stack-ghc80.yaml

@@ -0,0 +1,4 @@
+resolver: lts-9.21
+flags:
+  mongoDB:
+    _old-network: true

stack-ghc82.yaml

@@ -0,0 +1,4 @@
+resolver: lts-11.22
+flags:
+  mongoDB:
+    _old-network: true

stack-ghc84.yaml

@@ -0,0 +1,4 @@
+resolver: lts-12.26
+flags:
+  mongoDB:
+    _old-network: true

stack-ghc86-network3.yaml

@@ -0,0 +1,6 @@
+resolver: lts-13.23
+extra-deps:
+- git: [email protected]:hvr/bson.git # https://github.com/mongodb-haskell/bson/pull/18
+  commit: 2fc8d04120c0758201762b8e22254aeb6d574f41
+- network-bsd-2.8.1.0
+- network-3.1.0.0

stack-ghc86.yaml

@@ -0,0 +1,4 @@
+resolver: lts-13.23
+flags:
+  mongoDB:
+    _old-network: true