8000 Small refactor RawConnection · postgres-haskell/postgres-wire@fa38fed · GitHub
[go: up one dir, main page]
Skip to content

Commit fa38fed

Browse files
VyacheslavHashovVyacheslavHashov
committed
Small refactor RawConnection
1 parent 2144602 commit fa38fed

File tree

2 files changed

+61
-58
lines changed

2 files changed

+61
-58
lines changed

‎src/Database/PostgreSQL/Driver/Connection.hs

Lines changed: 54 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,31 @@ import Database.PostgreSQL.Driver.StatementStorage
2929
import Database.PostgreSQL.Driver.Error
3030
import Database.PostgreSQL.Driver.RawConnection
3131

32+
-- | Public
33+
data Connection = Connection
34+
{ connRawConnection :: RawConnection
35+
, connReceiverThread :: ThreadId
36 8000 +
-- channel only for Data messages
37+
, connOutDataChan :: OutChan (Either Error DataMessage)
38+
-- channel for all the others messages
39+
, connOutAllChan :: OutChan ServerMessage
40+
, connStatementStorage :: StatementStorage
41+
, connParameters :: ConnectionParameters
42+
, connMode :: IORef ConnectionMode
43+
}
44+
45+
-- | Parameters of the current connection.
46+
-- We store only the parameters that cannot change after startup.
47+
-- For more information about additional parameters see
48+
-- PostgreSQL documentation.
49+
data ConnectionParameters = ConnectionParameters
50+
{ paramServerVersion :: ServerVersion
51+
-- | character set name
52+
, paramServerEncoding :: B.ByteString
53+
-- | True if integer datetimes used
54+
, paramIntegerDatetimes :: Bool
55+
} deriving (Show)
56+
3257
data ConnectionMode
3358
-- | In this mode, all result's data is ignored
3459
= SimpleQueryMode
@@ -44,7 +69,7 @@ type NotificationHandler = Notification -> IO ()
4469
defaultNotificationHandler :: NotificationHandler
4570
defaultNotificationHandler = const $ pure ()
4671

47-
type Dispatcher
72+
type DataDispatcher
4873
= InChan (Either Error DataMessage)
4974
-> ServerMessage
5075
-> [V.Vector (Maybe B.ByteString)]
@@ -53,30 +78,6 @@ type Dispatcher
5378
data DataMessage = DataMessage [V.Vector (Maybe B.ByteString)]
5479
deriving (Show, Eq)
5580

56-
-- | Parameters of the current connection.
57-
-- We store only the parameters that cannot change after startup.
58-
-- For more information about additional parameters see
59-
-- PostgreSQL documentation.
60-
data ConnectionParameters = ConnectionParameters
61-
{ paramServerVersion :: ServerVersion
62-
-- | character set name
63-
, paramServerEncoding :: B.ByteString
64-
-- | True if integer datetimes used
65-
, paramIntegerDatetimes :: Bool
66-
} deriving (Show)
67-
68-
-- | Public
69-
data Connection = Connection
70-
{ connRawConnection :: RawConnection
71-
, connReceiverThread :: ThreadId
72-
-- channel only for Data messages
73-
, connOutDataChan :: OutChan (Either Error DataMessage)
74-
-- channel for all the others messages
75-
, connOutAllChan :: OutChan ServerMessage
76-
, connStatementStorage :: StatementStorage
77-
, connParameters :: ConnectionParameters
78-
, connMode :: IORef ConnectionMode
79-
}
8081

8182
-- | Public
8283
connect :: ConnectionSettings -> IO (Either Error Connection)
@@ -93,30 +94,6 @@ connectWith settings msgFilter =
9394
either throwErrorInIO (\params ->
9495
Right <$> buildConnection rawConn params msgFilter))
9596

96-
buildConnection
97-
:: RawConnection
98-
-> ConnectionParameters
99-
-> ServerMessageFilter
100-
-> IO Connection
101-
buildConnection rawConn connParams msgFilter = do
102-
(inDataChan, outDataChan) <- newChan
103-
(inAllChan, outAllChan) <- newChan
104-
storage <- newStatementStorage
105-
modeRef <- newIORef defaultConnectionMode
106-
107-
tid <- forkIO $
108-
receiverThread msgFilter rawConn inDataChan inAllChan modeRef
109-
defaultNotificationHandler
110-
pure Connection
111-
{ connRawConnection = rawConn
112-
, connReceiverThread = tid
113-
, connOutDataChan = outDataChan
114-
, connOutAllChan = outAllChan
115-
, connStatementStorage = storage
116-
, connParameters = connParams
117-
, connMode = modeRef
118-
}
119-
12097
-- | Authorizes on the server and reads connection parameters.
12198
authorize
12299
:: RawConnection
@@ -160,6 +137,30 @@ authorize rawConn settings = do
160137
(settingsPassword settings <> settingsUser settings) <> salt)
161138
md5Hash bs = BS.pack $ show (hash bs :: Digest MD5)
162139

140+
buildConnection
141+
:: RawConnection
142+
-> ConnectionParameters
143+
-> ServerMessageFilter
144+
-> IO Connection
145+
buildConnection rawConn connParams msgFilter = do
146+
(inDataChan, outDataChan) <- newChan
147+
(inAllChan, outAllChan) <- newChan
148+
storage <- newStatementStorage
149+
modeRef <- newIORef defaultConnectionMode
150+
151+
tid <- forkIO $
152+
receiverThread msgFilter rawConn inDataChan inAllChan modeRef
153+
defaultNotificationHandler
154+
pure Connection
155+
{ connRawConnection = rawConn
156+
, connReceiverThread = tid
157+
, connOutDataChan = outDataChan
158+
, connOutAllChan = outAllChan
159+
, connStatementStorage = storage
160+
, connParameters = connParams
161+
, connMode = modeRef
162+
}
163+
163164
-- | Parses connection parameters.
164165
parseParameters :: B.ByteString -> Either Error ConnectionParameters
165166
parseParameters str = do
@@ -196,6 +197,7 @@ close conn = do
196197
killThread $ connReceiverThread conn
197198
rClose $ connRawConnection conn
198199

200+
199201
receiverThread
200202
:: ServerMessageFilter
201203
-> RawConnection
@@ -227,17 +229,16 @@ receiverThread msgFilter rawConn dataChan allChan modeRef ntfHandler =
227229
dispatchIfNotification (NotificationResponse n) = ntfHandler n
228230
dispatchIfNotification _ = pure ()
229231

230-
231-
dispatch :: ConnectionMode -> Dispatcher
232+
dispatch :: ConnectionMode -> DataDispatcher
232233
dispatch SimpleQueryMode = dispatchSimple
233234
dispatch ExtendedQueryMode = dispatchExtended
234235

235236
-- | Dispatcher for the SimpleQuery mode.
236-
dispatchSimple :: Dispatcher
237+
dispatchSimple :: DataDispatcher
237238
dispatchSimple dataChan message = pure
238239

239240
-- | Dispatcher for the ExtendedQuery mode.
240-
dispatchExtended :: Dispatcher
241+
dispatchExtended :: DataDispatcher
241242
dispatchExtended dataChan message acc = case message of
242243
-- Command is completed, return the result
243244
CommandComplete _ -> do

‎src/Database/PostgreSQL/Driver/RawConnection.hs

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4,13 +4,14 @@ module Database.PostgreSQL.Driver.RawConnection where
44
import Control.Monad (void)
55
import Safe (headMay)
66
import Data.Monoid ((<>))
7+
import System.Socket (socket, AddressInfo(..), getAddressInfo, socketAddress,
8+
aiV4Mapped, Socket, connect, close, receive, send)
9+
import System.Socket.Family.Inet (Inet)
10+
import System.Socket.Type.Stream (Stream)
11+
import System.Socket.Protocol.TCP (TCP)
12+
import System.Socket.Family.Unix (Unix, socketAddressUnixPath)
713
import qualified Data.ByteString as B
814
import qualified Data.ByteString.Char8 as BS(pack)
9-
import System.Socket hiding (Error)
10-
import System.Socket.Family.Inet
11-
import System.Socket.Type.Stream
12-
import System.Socket.Protocol.TCP
13-
import System.Socket.Family.Unix
1415

1516
import Database.PostgreSQL.Driver.Error
1617
import Database.PostgreSQL.Driver.Settings
@@ -30,6 +31,7 @@ unixPathFilename :: B.ByteString
3031
unixPathFilename = ".s.PGSQL."
3132

3233
-- | Creates a raw connection and connects to a server.
34+
-- Throws `SocketException`, `AddressException`.
3335
createRawConnection :: ConnectionSettings -> IO (Either Error RawConnection)
3436
createRawConnection settings
3537
| host == "" = unixConnection defaultUnixPathDirectory

0 commit comments

Comments
 (0)
0