8000 Abstraction over unix sockets · postgres-haskell/postgres-wire@91b7444 · GitHub
[go: up one dir, main page]
Skip to content

Commit 91b7444

Browse files
VyacheslavHashovVyacheslavHashov
committed
Abstraction over unix sockets
1 parent 7cb19ec commit 91b7444

File tree

2 files changed

+54
-17
lines changed

2 files changed

+54
-17
lines changed

‎src/Database/PostgreSQL/Connection.hs

Lines changed: 48 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ module Database.PostgreSQL.Connection where
99

1010

1111
import qualified Data.ByteString as B
12+
import qualified Data.ByteString.Char8 as BS(pack)
1213
import Data.ByteString.Lazy (toStrict)
1314
import Data.ByteString.Builder (Builder, toLazyByteString)
1415
import Control.Monad
@@ -72,29 +73,60 @@ data RawConnection = RawConnection
7273
, rReceive :: Int -> IO B.ByteString
7374
}
7475

76+
defaultUnixPathDirectory :: B.ByteString
77+
defaultUnixPathDirectory = "/var/run/postgresql"
78+
79+
unixPathFilename :: B.ByteString
80+
unixPathFilename = ".s.PGSQL."
81+
7582
address :: SocketAddress Unix
7683
address = fromJust $ socketAddressUnixPath "/var/run/postgresql/.s.PGSQL.5432"
7784

78-
connect :: ConnectionSettings -> IO Connection
79-
connect settings = do
80-
s <- socket
85+
createRawConnection :: ConnectionSettings -> IO RawConnection
86+
createRawConnection settings = do
87+
(s, address) <- createSocket settings
8188
Socket.connect s address
82-
sendStartMessage s $ consStartupMessage settings
83-
r <- Socket.receive s 4096 mempty
89+
pure $ constructRawConnection s
90+
where
91+
createSocket settings
92+
| host == "" = unixSocket defaultUnixPathDirectory
93+
| "/" `B.isPrefixOf` host = unixSocket host
94+
| otherwise = tcpSocket
95+
where
96+
host = settingsHost settings
97+
unixSocket dirPath = do
98+
-- 47 - `/`
99+
let dir = B.reverse . B.dropWhile (== 47) $ B.reverse dirPath
100+
path = dir <> "/" <> unixPathFilename
101+
<> BS.pack (show $ settingsPort settings)
102+
-- TODO check for Nothing
103+
address = fromJust $ socketAddressUnixPath path
104+
s <- socket :: IO (Socket Unix Stream Unix)
105+
pure (s, address)
106+
tcpSocket = do
107+
undefined
108+
109+
constructRawConnection :: Socket f t p -> RawConnection
110+
constructRawConnection s = RawConnection
111+
{ rFlush = pure ()
112+
, rClose = Socket.close s
113+
, rSend = \msg -> void $ Socket.send s msg mempty
114+
, rReceive = \n -> Socket.receive s n mempty
115+
}
116+
117+
connect :: ConnectionSettings -> IO Connection
118+
connect settings = do
119+
rawConn <- createRawConnection settings
120+
sendStartMessage rawConn $ consStartupMessage settings
121+
r <- rReceive rawConn 4096
84122
readAuthMessage r
85123

86124
(inDataChan, outDataChan) <- newChan
87125
(inAllChan, outAllChan) <- newChan
88-
let rawConnection = RawConnection
89-
{ rFlush = pure ()
90-
, rClose = Socket.close s
91-
, rSend = \msg -> void $ Socket.send s msg mempty
92-
, rReceive = \n -> Socket.receive s n mempty
93-
}
94-
tid <- forkIO $ receiverThread rawConnection inDataChan inAllChan
126+
tid <- forkIO $ receiverThread rawConn inDataChan inAllChan
95127
storage <- newStatementStorage
96128
pure Connection
97-
{ connRawConnection = rawConnection
129+
{ connRawConnection = rawConn
98130
, connReceiverThread = tid
99131
, connOutDataChan = outDataChan
100132
, connOutAllChan = outAllChan
@@ -115,10 +147,10 @@ consStartupMessage :: ConnectionSettings -> StartMessage
115147
consStartupMessage stg = StartupMessage
116148
(Username $ settingsUser stg) (DatabaseName $ settingsDatabase stg)
117149

118-
sendStartMessage :: UnixSocket -> StartMessage -> IO ()
119-
sendStartMessage sock msg = void $ do
150+
sendStartMessage :: RawConnection -> StartMessage -> IO ()
151+
sendStartMessage rawConn msg = void $ do
120152
let smsg = toStrict . toLazyByteString $ encodeStartMessage msg
121-
Socket.send sock smsg mempty
153+
rSend rawConn smsg
122154

123155
sendMessage :: RawConnection -> ClientMessage -> IO ()
124156
sendMessage rawConn msg = void $ do

‎src/Database/PostgreSQL/Settings.hs

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,12 @@ import Data.ByteString (ByteString)
77

88
-- | Connection settings to PostgreSQL
99
data ConnectionSettings = ConnectionSettings
10-
{ -- On empty string a Unix socket will be used.
10+
{ -- Host maybe IP-address or hostname.
11+
-- If starts with slash, it recognized as directory where unix socket
12+
-- file is located. Format is dir/.s.PGSQL.nnnn, where nnnn is port
13+
-- number.
14+
-- On empty string default unix socket path will be used
15+
-- Only ipv4 is supported now.
1116
settingsHost :: ByteString
1217
, settingsPort :: Word16
1318
, settingsDatabase :: ByteString

0 commit comments

Comments
 (0)
0