Add module Database.MongoDB.Internal.Network.

Add flag imitating bson package PR for network changes.
Add stack files for compilation checking.

Both ghc86 builds work. Still need to fix ghc84 and under builds with older network code.

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,6 +60,13 @@ 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
@@ -61,7 +74,8 @@ Library
                     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: git@github.com: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