diff --git a/Database/MongoDB/Connection.hs b/Database/MongoDB/Connection.hs index c53f157..5a5e110 100644 --- a/Database/MongoDB/Connection.hs +++ b/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. diff --git a/Database/MongoDB/Internal/Network.hs b/Database/MongoDB/Internal/Network.hs new file mode 100644 index 0000000..cd249a3 --- /dev/null +++ b/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 + ) diff --git a/Database/MongoDB/Internal/Util.hs b/Database/MongoDB/Internal/Util.hs index 8d84695..a1ac303 100644 --- a/Database/MongoDB/Internal/Util.hs +++ b/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 diff --git a/Database/MongoDB/Transport/Tls.hs b/Database/MongoDB/Transport/Tls.hs index cd6565b..696be93 100644 --- a/Database/MongoDB/Transport/Tls.hs +++ b/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) diff --git a/mongoDB.cabal b/mongoDB.cabal index f3c9e8c..c695701 100644 --- a/mongoDB.cabal +++ b/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 + 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 diff --git a/stack-ghc80.yaml b/stack-ghc80.yaml new file mode 100644 index 0000000..01f751a --- /dev/null +++ b/stack-ghc80.yaml @@ -0,0 +1,4 @@ +resolver: lts-9.21 +flags: + mongoDB: + _old-network: true diff --git a/stack-ghc82.yaml b/stack-ghc82.yaml new file mode 100644 index 0000000..c04f8a0 --- /dev/null +++ b/stack-ghc82.yaml @@ -0,0 +1,4 @@ +resolver: lts-11.22 +flags: + mongoDB: + _old-network: true diff --git a/stack-ghc84.yaml b/stack-ghc84.yaml new file mode 100644 index 0000000..1906340 --- /dev/null +++ b/stack-ghc84.yaml @@ -0,0 +1,4 @@ +resolver: lts-12.26 +flags: + mongoDB: + _old-network: true diff --git a/stack-ghc86-network3.yaml b/stack-ghc86-network3.yaml new file mode 100644 index 0000000..f13f71a --- /dev/null +++ b/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 diff --git a/stack-ghc86.yaml b/stack-ghc86.yaml new file mode 100644 index 0000000..cd17fca --- /dev/null +++ b/stack-ghc86.yaml @@ -0,0 +1,4 @@ +resolver: lts-13.23 +flags: + mongoDB: + _old-network: true