Add support for Unix domain socket connection

Update corresponding parser in readHostPortM Update showHostPort
mongodb-haskell · Sep 11, 2019 · 4d1b2a0 · 4d1b2a0
1 parent 76d5f84
commit 4d1b2a0
Show file tree

Hide file tree

Showing 2 changed files with 38 additions and 11 deletions.
diff --git a/Database/MongoDB/Connection.hs b/Database/MongoDB/Connection.hs
@@ -29,10 +29,10 @@ import Data.List (intersect, partition, (\\), delete)
 import Control.Applicative ((<$>))
 #endif
 
-import Control.Monad (forM_)
+import Control.Monad (forM_, guard)
 import System.IO.Unsafe (unsafePerformIO)
 import System.Timeout (timeout)
-import Text.ParserCombinators.Parsec (parse, many1, letter, digit, char, eof,
+import Text.ParserCombinators.Parsec (parse, many1, letter, digit, char, anyChar, eof,
                                       spaces, try, (<|>))
 import qualified Data.List as List
 
@@ -76,24 +76,31 @@ host hostname = Host hostname defaultPort
 
 showHostPort :: Host -> String
 -- ^ Display host as \"host:port\"
--- TODO: Distinguish Service and UnixSocket port
-showHostPort (Host hostname port) = hostname ++ ":" ++ portname  where
-    portname = case port of
-        PortNumber p -> show p
+-- TODO: Distinguish Service port
+showHostPort (Host hostname (PortNumber port)) = hostname ++ ":" ++ show port
+#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
+showHostPort (Host _        (UnixSocket path)) = "unix:" ++ path
+#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.
--- TODO: handle Service and UnixSocket port
+-- TODO: handle Service port
 readHostPortM = either (fail . show) return . parse parser "readHostPort" where
     hostname = many1 (letter <|> digit <|> char '-' <|> char '.')
     parser = do
         spaces
         h <- hostname
         try (spaces >> eof >> return (host h)) <|> do
             _ <- char ':'
-            port :: Int <- read <$> many1 digit
-            spaces >> eof
-            return $ Host h (PortNumber $ fromIntegral port)
+            try (  do port :: Int <- read <$> many1 digit
+                      spaces >> eof
+                      return $ Host h (PortNumber $ fromIntegral port))
+#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
+              <|>  do guard (h == "unix")
+                      p <- many1 anyChar
+                      eof
+                      return $ Host "" (UnixSocket p)
+#endif
 
 readHostPort :: String -> Host
 -- ^ Read string \"hostname:port\" as @Host hostname (PortNumber port)@ or \"hostname\" as @host hostname@ (default port). Error if string does not match either syntax.

diff --git a/Database/MongoDB/Internal/Network.hs b/Database/MongoDB/Internal/Network.hs
@@ -21,7 +21,11 @@ import System.IO (Handle, IOMode(ReadWriteMode))
 
 -- | Wraps network's 'PortNumber'
 -- Used to ease compatibility between older and newer network versions.
-newtype PortID = PortNumber N.PortNumber deriving (Enum, Eq, Integral, Num, Ord, Read, Real, Show)
+data PortID = PortNumber N.PortNumber
+#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
+            | UnixSocket String
+#endif
+            deriving (Eq, Ord, Show)
 
 
 #if !MIN_VERSION_network(2, 9, 0)
@@ -32,6 +36,10 @@ connectTo :: N.HostName         -- Hostname
           -> IO Handle          -- Connected Socket
 connectTo hostname (PortNumber port) = N.connectTo hostname (N.PortNumber port)
 
+#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
+connectTo _ (UnixSocket path) = N.connectTo "" (N.UnixSocket path)
+#endif
+
 #else
 
 -- Copied implementation from network 2.8's 'connectTo', but using our 'PortID' newtype.
@@ -49,4 +57,16 @@ connectTo hostname (PortNumber port) = do
           N.connect sock (N.SockAddrInet port (hostAddress he))
           N.socketToHandle sock ReadWriteMode
         )
+
+#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
+connectTo _ (UnixSocket path) = do
+    bracketOnError
+        (N.socket N.AF_UNIX N.Stream 0)
+        (N.close)
+        (\sock -> do
+          N.connect sock (N.SockAddrUnix path)
+          N.socketToHandle sock ReadWriteMode
+        )
+#endif
+
 #endif