@@ -50,8 +50,12 @@ type InDataChan = TQueue (Either ReceiverException DataMessage)
50
50
type InAllChan = TQueue (Either ReceiverException ServerMessage )
51
51
52
52
53
+ writeChan :: TQueue a -> a -> IO ()
53
54
writeChan q = atomically . writeTQueue q
55
+
56
+ readChan :: TQueue a -> IO a
54
57
readChan = atomically . readTQueue
58
+
55
59
-- | Parameters of the current connection.
56
60
-- We store only the parameters that cannot change after startup.
57
61
-- For more information about additional parameters see
@@ -124,7 +128,7 @@ authorize rawConn settings = do
124
128
-- the startup phase.
125
129
resp <- rReceive rawConn 4096
126
130
case runDecode decodeAuthResponse resp of
127
- Right (rest, r) -> case r of
131
+ (rest, r) -> case r of
128
132
AuthenticationOk ->
129
133
pure $ parseParameters rest
130
134
AuthenticationCleartextPassword ->
@@ -139,9 +143,6 @@ authorize rawConn settings = do
139
143
throwAuthErrorInIO $ AuthNotSupported " GSS"
140
144
AuthErrorResponse desc ->
141
145
throwErrorInIO $ PostgresError desc
142
- Left reason -> error " handle error here"
143
- -- TODO handle errors
144
- -- throwErrorInIO . DecodeError $ BS.pack reason
145
146
146
147
performPasswordAuth password = do
147
148
sendMessage rawConn $ PasswordMessage password
@@ -204,13 +205,10 @@ parseParameters str = do
204
205
go str dict | B. null str = Right dict
205
206
| otherwise = case runDecode
206
207
(decodeHeader >>= decodeServerMessage) str of
207
- Right (rest, v) -> case v of
208
+ (rest, v) -> case v of
208
209
ParameterStatus name value -> go rest $ HM. insert name value dict
209
210
-- messages like `BackendData` not handled
210
211
_ -> go rest dict
211
- Left reason -> error " handle error here"
212
- -- TODO
213
- -- Left . DecodeError $ BS.pack reason
214
212
215
213
handshakeTls :: RawConnection -> IO ()
216
214
handshakeTls _ = pure ()
@@ -223,16 +221,12 @@ close conn = do
223
221
rClose $ connRawConnection conn
224
222
225
223
-- | Any exception prevents thread from future work
226
- receiverThread
227
- :: RawConnection
228
- -> InDataChan
229
- -> IO ()
230
- receiverThread rawConn dataChan =
231
- loopExtractDataRows
232
- -- TODO
233
- -- dont append strings. Allocate buffer manually and use unsafeReceive
234
- (\ bs -> (bs <> ) <$> rReceive rawConn 4096 )
235
- (writeChan dataChan . Right )
224
+ receiverThread :: RawConnection -> InDataChan -> IO ()
225
+ receiverThread rawConn dataChan = loopExtractDataRows
226
+ -- TODO
227
+ -- dont append strings. Allocate buffer manually and use unsafeReceive
228
+ (\ bs -> (bs <> ) <$> rReceive rawConn 4096 )
229
+ (writeChan dataChan . Right )
236
230
237
231
-- | Any exception prevents thread from future work
238
232
receiverThreadCommon
0 commit comments