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.
This commit is contained in:
parent
5bb77518a8
commit
21cf023854
10 changed files with 72 additions and 17 deletions
|
@ -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.
|
||||
|
|
32
Database/MongoDB/Internal/Network.hs
Normal file
32
Database/MongoDB/Internal/Network.hs
Normal file
|
@ -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
|
||||
)
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
4
stack-ghc80.yaml
Normal file
4
stack-ghc80.yaml
Normal file
|
@ -0,0 +1,4 @@
|
|||
resolver: lts-9.21
|
||||
flags:
|
||||
mongoDB:
|
||||
_old-network: true
|
4
stack-ghc82.yaml
Normal file
4
stack-ghc82.yaml
Normal file
|
@ -0,0 +1,4 @@
|
|||
resolver: lts-11.22
|
||||
flags:
|
||||
mongoDB:
|
||||
_old-network: true
|
4
stack-ghc84.yaml
Normal file
4
stack-ghc84.yaml
Normal file
|
@ -0,0 +1,4 @@
|
|||
resolver: lts-12.26
|
||||
flags:
|
||||
mongoDB:
|
||||
_old-network: true
|
6
stack-ghc86-network3.yaml
Normal file
6
stack-ghc86-network3.yaml
Normal file
|
@ -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
|
4
stack-ghc86.yaml
Normal file
4
stack-ghc86.yaml
Normal file
|
@ -0,0 +1,4 @@
|
|||
resolver: lts-13.23
|
||||
flags:
|
||||
mongoDB:
|
||||
_old-network: true
|
Loading…
Reference in a new issue