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

Commit 0f60916

Browse files
VyacheslavHashovVyacheslavHashov
committed
Abstraction over TCP sockets
1 parent 91b7444 commit 0f60916

File tree

2 files changed

+27
-27
lines changed

2 files changed

+27
-27
lines changed

‎src/Database/PostgreSQL/Connection.hs

Lines changed: 26 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -22,9 +22,9 @@ import Data.Binary.Get ( runGetIncremental, pushChunk)
2222
import qualified Data.Binary.Get as BG (Decoder(..))
2323
import Data.Maybe (fromJust)
2424
import qualified Data.Vector as V
25-
import System.Socket (Socket, socket)
25+
import System.Socket hiding (connect, close, Error)
2626
import qualified System.Socket as Socket (connect, close, send, receive)
27-
import System.Socket.Family.Inet6
27+
import System.Socket.Family.Inet
2828
import System.Socket.Type.Stream
2929
import System.Socket.Protocol.TCP
3030
import System.Socket.Family.Unix
@@ -79,32 +79,32 @@ defaultUnixPathDirectory = "/var/run/postgresql"
7979
unixPathFilename :: B.ByteString
8080
unixPathFilename = ".s.PGSQL."
8181

82-
address :: SocketAddress Unix
83-
address = fromJust $ socketAddressUnixPath "/var/run/postgresql/.s.PGSQL.5432"
84-
8582
createRawConnection :: ConnectionSettings -> IO RawConnection
86-
createRawConnection settings = do
87-
(s, address) <- createSocket settings
88-
Socket.connect s address
89-
pure $ constructRawConnection s
83+
createRawConnection settings
84+
| host == "" = unixConnection defaultUnixPathDirectory
85+
| "/" `B.isPrefixOf` host = unixConnection host
86+
| otherwise = tcpConnection
9087
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
88+
host = settingsHost settings
89+
unixConnection dirPath = do
90+
-- 47 - `/`
91+
let dir = B.reverse . B.dropWhile (== 47) $ B.reverse dirPath
92+
path = dir <> "/" <> unixPathFilename
93+
<> BS.pack (show $ settingsPort settings)
94+
-- TODO check for Nothing
95+
address = fromJust $ socketAddressUnixPath path
96+
s <- socket :: IO (Socket Unix Stream Unix)
97+
Socket.connect s address
98+
pure $ constructRawConnection s
99+
tcpConnection = do
100+
addressInfo <- getAddressInfo (Just host) Nothing aiV4Mapped
101+
:: IO [AddressInfo Inet Stream TCP]
102+
let address = (socketAddress $ head addressInfo)
103+
{ inetPort = fromIntegral $ settingsPort settings }
104+
-- TODO check for empty
105+
s <- socket :: IO (Socket Inet Stream TCP)
106+
Socket.connect s address
107+
pure $ constructRawConnection s
108108

109109
constructRawConnection :: Socket f t p -> RawConnection
110110
constructRawConnection s = RawConnection

‎src/Database/PostgreSQL/Settings.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ data ConnectionSettings = ConnectionSettings
2222

2323
defaultConnectionSettings :: ConnectionSettings
2424
defaultConnectionSettings = ConnectionSettings
25-
{ settingsHost = ""
25+
{ settingsHost = "localhost"
2626
, settingsPort = 5432
2727
, settingsDatabase = "testdb"
2828
, settingsUser = "v"

0 commit comments

Comments
 (0)
0