Add Unix socket support

Author: sjoerdvisscher

grapesy/src/Network/GRPC/Client/Connection.hs

@@ -257,6 +257,9 @@ data Server =
 
     -- | Make secure connection (with TLS) to the given server
   | ServerSecure ServerValidation SslKeyLog Address
+
+    -- | Make a local connection over a Unix domain socket
+  | ServerUnix FilePath
   deriving stock (Show)
 
 {-------------------------------------------------------------------------------
@@ -429,6 +432,8 @@ stayConnected connParams initialServer connStateVar connOutOfScope = do
               connectInsecure connParams attempt addr
             ServerSecure validation sslKeyLog addr ->
               connectSecure connParams attempt validation sslKeyLog addr
+            ServerUnix path ->
+              connectUnix connParams attempt path
 
         thisReconnectPolicy <- atomically $ do
           putTMVar (attemptClosed attempt) $ either Just (\() -> Nothing) mRes
@@ -462,21 +467,21 @@ stayConnected connParams initialServer connStateVar connOutOfScope = do
                 atomically $ writeTVar connStateVar $ ConnectionNotReady
                 loop nextServer =<< f
 
+-- | Unix domain socket connection
+connectUnix :: ConnParams -> Attempt -> FilePath -> IO ()
+connectUnix connParams attempt path = do
+  client <- socket AF_UNIX Stream defaultProtocol
+  connect client $ SockAddrUnix path
+  connectSocket connParams attempt "localhost" client
+
 -- | Insecure connection (no TLS)
 connectInsecure :: ConnParams -> Attempt -> Address -> IO ()
 connectInsecure connParams attempt addr = do
     Run.runTCPClientWithSettings
         runSettings
         (addressHost addr)
-        (show $ addressPort addr) $ \sock ->
-      bracket (HTTP2.Client.allocSimpleConfig sock writeBufferSize)
-              HTTP2.Client.freeSimpleConfig $ \conf ->
-        HTTP2.Client.run clientConfig conf $ \sendRequest _aux -> do
-          let conn = Session.ConnectionToServer sendRequest
-          atomically $
-            writeTVar (attemptState attempt) $
-              ConnectionReady (attemptClosed attempt) conn
-          takeMVar $ attemptOutOfScope attempt
+        (show $ addressPort addr)
+        $ connectSocket connParams attempt (authority addr)
   where
     ConnParams{connHTTP2Settings} = connParams
 
@@ -485,6 +490,20 @@ connectInsecure connParams attempt addr = do
           Run.settingsOpenClientSocket = openClientSocket connHTTP2Settings
         }
 
+-- | Insecure connection over the given socket
+connectSocket :: ConnParams -> Attempt -> String -> Socket -> IO ()
+connectSocket connParams attempt connAuthority sock = do
+    bracket (HTTP2.Client.allocSimpleConfig sock writeBufferSize)
+            HTTP2.Client.freeSimpleConfig $ \conf ->
+      HTTP2.Client.run clientConfig conf $ \sendRequest _aux -> do
+        let conn = Session.ConnectionToServer sendRequest
+        atomically $
+          writeTVar (attemptState attempt) $
+            ConnectionReady (attemptClosed attempt) conn
+        takeMVar $ attemptOutOfScope attempt
+  where
+    ConnParams{connHTTP2Settings} = connParams
+
     settings :: HTTP2.Client.Settings
     settings = HTTP2.Client.defaultSettings {
           HTTP2.Client.maxConcurrentStreams =
@@ -498,7 +517,7 @@ connectInsecure connParams attempt addr = do
     clientConfig :: HTTP2.Client.ClientConfig
     clientConfig = overrideRateLimits connParams $
         HTTP2.Client.defaultClientConfig {
-            HTTP2.Client.authority = authority addr
+            HTTP2.Client.authority = connAuthority
           , HTTP2.Client.settings = settings
           , HTTP2.Client.connectionWindowSize =
                 fromIntegral $

grapesy/src/Network/GRPC/Server/Run.hs

@@ -66,7 +66,9 @@ data ServerConfig = ServerConfig {
   deriving stock (Show, Generic)
 
 -- | Offer insecure connection (no TLS)
-data InsecureConfig = InsecureConfig {
+data InsecureConfig =
+    -- | Insecure TCP connection
+    InsecureConfig {
       -- | Hostname
       insecureHost :: Maybe HostName
 
@@ -77,6 +79,11 @@ data InsecureConfig = InsecureConfig {
       -- 'getInsecureSocket' for a way to figure out what this port actually is.
     , insecurePort :: PortNumber
     }
+    -- | Insecure (but local) Unix domain socket connection
+  | InsecureUnix {
+      -- | Path to the socket
+      insecurePath :: FilePath
+    }
   deriving stock (Show, Generic)
 
 -- | Offer secure connection (over TLS)
@@ -297,14 +304,10 @@ runInsecure ::
   -> HTTP2.Server
   -> IO ()
 runInsecure http2 cfg socketTMVar server = do
-    withServerSocket
-        http2
-        socketTMVar
-        (insecureHost cfg)
-        (insecurePort cfg) $ \listenSock ->
+    openSock cfg $ \listenSock ->
       withTimeManager $ \mgr ->
         Run.runTCPServerWithSocket listenSock $ \clientSock -> do
-          when (http2TcpNoDelay http2) $ do
+          when (http2TcpNoDelay http2 && not isUnixSocket) $ do
             -- See description of 'withServerSocket'
             setSocketOption clientSock NoDelay 1
           when (http2TcpAbortiveClose http2) $ do
@@ -316,6 +319,22 @@ runInsecure http2 cfg socketTMVar server = do
     serverConfig :: HTTP2.ServerConfig
     serverConfig = mkServerConfig http2
 
+    openSock :: InsecureConfig -> (Socket -> IO a) -> IO a
+    openSock InsecureConfig{insecureHost, insecurePort} = do
+      withServerSocket
+        http2
+        socketTMVar
+        insecureHost
+        insecurePort
+    openSock InsecureUnix{insecurePath} = do
+      withUnixSocket
+        insecurePath
+        socketTMVar
+
+    isUnixSocket = case cfg of
+      InsecureConfig{} -> False
+      InsecureUnix{}   -> True
+
 {-------------------------------------------------------------------------------
   Secure (over TLS)
 -------------------------------------------------------------------------------}
@@ -420,3 +439,21 @@ withServerSocket http2Settings socketTMVar host port k = do
           ]
         ]
 
+-- | Create a Unix domain socket
+--
+-- Note that @TCP_NODELAY@ should not be set on unix domain sockets,
+-- otherwise clients would get their connection closed immediately.
+withUnixSocket :: FilePath -> TMVar Socket -> (Socket -> IO a) -> IO a
+withUnixSocket path socketTMVar k = do
+    bracket openServerSocket close $ \sock -> do
+      atomically $ putTMVar socketTMVar sock
+      k sock
+  where
+    openServerSocket :: IO Socket
+    openServerSocket = do
+      sock <- socket AF_UNIX Stream 0
+      setSocketOption sock ReuseAddr 1
+      withFdSocket sock setCloseOnExecIfNeeded
+      bind sock $ SockAddrUnix path
+      listen sock 1024
+      return sock