8000 Receiver exception · postgres-haskell/postgres-wire@9fd5d0c · GitHub
[go: up one dir, main page]
Skip to content

Commit 9fd5d0c

Browse files
VyacheslavHashovVyacheslavHashov
committed
Receiver exception
1 parent be419d7 commit 9fd5d0c

File tree

6 files changed

+55
-40
lines changed

6 files changed

+55
-40
lines changed

‎src/Database/PostgreSQL/Driver.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,8 +19,9 @@ module Database.PostgreSQL.Driver
1919
, CachePolicy(..)
2020
, sendBatchAndSync
2121
, sendBatchAndFlush
22-
, readNextData
23-
, waitReadyForQuery
22+
-- TODO
23+
-- , readNextData
24+
-- , waitReadyForQuery
2425
, sendSimpleQuery
2526
, describeStatement
2627
-- * Errors

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

Lines changed: 19 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -33,19 +33,19 @@ import Database.PostgreSQL.Driver.RawConnection
3333

3434
-- | Public
3535
-- Connection parametrized by message type in chan.
36-
data AbsConnection msg = AbsConnection
36+
data AbsConnection mt = AbsConnection
3737
{ connRawConnection :: RawConnection
3838
, connReceiverThread :: Weak ThreadId
3939
, connStatementStorage :: StatementStorage
4040
, connParameters :: ConnectionParameters
41-
, connOutChan :: OutChan msg
41+
, connOutChan :: OutChan (Either ReceiverException mt)
4242
}
4343

44-
type Connection = AbsConnection (Either Error DataRows)
45-
type ConnectionCommon = AbsConnection (Either Error ServerMessage)
44+
type Connection = AbsConnection DataMessage
45+
type ConnectionCommon = AbsConnection ServerMessage
4646

47-
type InDataChan = InChan (Either Error DataRows)
48-
type InAllChan = InChan (Either Error ServerMessage)
47+
type InDataChan = InChan (Either ReceiverException DataMessage)
48+
type InAllChan = InChan (Either ReceiverException ServerMessage)
4949

5050
-- | Parameters of the current connection.
5151
-- We store only the parameters that cannot change after startup.
@@ -77,7 +77,6 @@ connect :: ConnectionSettings -> IO (Either Error Connection)
7777
connect settings = connectWith settings $ \rawConn params ->
7878
buildConnection rawConn params
7979
(receiverThread rawConn)
80-
(Left . UnexpectedError)
8180

8281
connectCommon
8382
:: ConnectionSettings
@@ -94,7 +93,6 @@ connectCommon' settings msgFilter = connectWith settings $ \rawConn params ->
9493
buildConnection rawConn params
9594
(\chan -> receiverThreadCommon rawConn chan
9695
msgFilter defaultNotificationHandler)
97-
(Left . UnexpectedError)
9896

9997
connectWith
10098
:: ConnectionSettings
@@ -142,7 +140,9 @@ authorize rawConn settings = do
142140
throwAuthErrorInIO $ AuthNotSupported "GSS"
143141
AuthErrorResponse desc ->
144142
throwErrorInIO $ PostgresError desc
145-
Left reason -> throwErrorInIO . DecodeError $ BS.pack reason
143+
Left reason -> error "handle error here"
144+
-- TODO handle errors
145+
-- throwErrorInIO . DecodeError $ BS.pack reason
146146

147147
performPasswordAuth password = do
148148
sendMessage rawConn $ PasswordMessage password
@@ -158,18 +158,15 @@ buildConnection
158158
:: RawConnection
159159
-> ConnectionParameters
160160
-- action in receiver thread
161-
-> (InChan c -> IO ())
162-
-- transform exception to message to inform the other thread
163-
-- about unexpected error
164-
-> (SomeException -> c)
161+
-> (InChan (Either ReceiverException c) -> IO ())
165162
-> IO (AbsConnection c)
166-
buildConnection rawConn connParams receiverAction transformExc = do
163+
buildConnection rawConn connParams receiverAction = do
167164
(inChan, outChan) <- newChan
168165
storage <- newStatementStorage
169166

170167
let createReceiverThread = mask_ $ forkIOWithUnmask $ \unmask ->
171168
unmask (receiverAction inChan)
172-
`catch` (writeChan inChan . transformExc)
169+
`catch` (writeChan inChan . Left . ReceiverException)
173170

174171
-- When receiver thread dies by any unexpected exception, than message
175172
-- would be written in its chan.
@@ -189,7 +186,8 @@ buildConnection rawConn connParams receiverAction transformExc = do
189186
parseParameters :: B.ByteString -> Either Error ConnectionParameters
190187
parseParameters str = do
191188
dict <- go str HM.empty
192-
serverVersion <- maybe (Left $ DecodeError "server version") Right .
189+
-- TODO handle error
190+
serverVersion <- maybe (error "handle error") Right .
193191
parseServerVersion =<< lookupKey "server_version" dict
194192
serverEncoding <- lookupKey "server_encoding" dict
195193
integerDatetimes <- parseIntegerDatetimes <$>
@@ -201,7 +199,8 @@ parseParameters str = do
201199
}
202200
where
203201
lookupKey key = maybe
204-
(Left . DecodeError $ "Missing connection parameter " <> key ) Right
202+
-- TODO
203+
(error "handle errors") Right
205204
. HM.lookup key
206205
go str dict | B.null str = Right dict
207206
| otherwise = case runDecode
@@ -210,7 +209,9 @@ parseParameters str = do
210209
ParameterStatus name value -> go rest $ HM.insert name value dict
211210
-- messages like `BackendData` not handled
212211
_ -> go rest dict
213-
Left reason -> Left . DecodeError $ BS.pack reason
212+
Left reason -> error "handle error here"
213+
-- TODO
214+
-- Left . DecodeError $ BS.pack reason
214215

215216
handshakeTls :: RawConnection -> IO ()
216217
handshakeTls _ = pure ()

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

Lines changed: 12 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -6,16 +6,25 @@ import System.Socket (AddressInfoException)
66

77
import Database.PostgreSQL.Protocol.Types (ErrorDesc)
88

9+
-- All possible exceptions:
10+
-- SocketException
11+
-- DecodeException.
12+
913
-- All possible errors.
1014
data Error
15+
-- Error sended by PostgreSQL, not application error.
1116
= PostgresError ErrorDesc
12-
| DecodeError ByteString
1317
| AuthError AuthError
14-
| ImpossibleError ByteString
15-
| UnexpectedError SomeException
18+
-- Receiver errors that may occur in receiver thread. When such error occur
19+
-- it means that receiver thread died.
20+
| ReceiverError ReceiverException
21+
deriving (Show)
22+
23+
newtype ReceiverException = ReceiverException SomeException
1624
deriving (Show)
1725

1826
-- Errors that might occur at authorization phase.
27+
-- Non-recoverable.
1928
data AuthError
2029
= AuthNotSupported ByteString
2130
| AuthInvalidAddress

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

Lines changed: 11 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module Database.PostgreSQL.Driver.Query where
33
import Control.Concurrent.Chan.Unagi
44
import Data.Foldable
55
import Data.Monoid
6+
import Data.Bifunctor
67
import qualified Data.Vector as V
78
import qualified Data.ByteString as B
89

@@ -36,20 +37,14 @@ sendBatchAndSync = sendBatchEndBy Sync
3637
sendSimpleQuery :: ConnectionCommon -> B.ByteString -> IO (Either Error ())
3738
sendSimpleQuery conn q = do
3839
sendMessage (connRawConnection conn) $ SimpleQuery (StatementSQL q)
39-
waitReadyForQuery conn
40+
pure $ pure ()
41+
-- TODO
42+
-- waitReadyForQuery conn
4043

4144
-- | Public
42-
readNextData :: Connection -> IO (Either Error DataRows)
43-
readNextData conn = readChan $ connOutChan conn
44-
45-
-- | Public
46-
-- MUST BE called after every sended `Sync` message
47-
-- discards all messages preceding `ReadyForQuery`
48-
waitReadyForQuery :: ConnectionCommon -> IO (Either Error ())
49-
waitReadyForQuery = fmap (>>= (liftError . findFirstError))
50-
. collectUntilReadyForQuery
51-
where
52-
liftError = maybe (Right ()) (Left . PostgresError)
45+
-- TODO
46+
-- readNextData :: Connection -> IO (Either Error DataRows)
47+
-- readNextData conn = readChan $ connOutChan conn
5348

5449
-- Helper
5550
sendBatchEndBy :: ClientMessage -> Connection -> [Query] -> IO ()
@@ -94,7 +89,7 @@ describeStatement conn stmt = do
9489
encodeClientMessage (Parse sname (StatementSQL stmt) V.empty)
9590
<> encodeClientMessage (DescribeStatement sname)
9691
<> encodeClientMessage Sync
97-
(parseMessages =<<) <$> collectUntilReadyForQuery conn
92+
(parseMessages =<<) . first ReceiverError <$> collectUntilReadyForQuery conn
9893
where
9994
sname = StatementName ""
10095
parseMessages msgs = case msgs of
@@ -103,14 +98,15 @@ describeStatement conn stmt = do
10398
[ParameterDescription params, RowDescription fields]
10499
-> Right (params, fields)
105100
xs -> Left . maybe
106-
(DecodeError "Unexpected response on a describe query")
101+
-- todo handle error
102+
(error "handle decode error")
107103
PostgresError
108104
$ findFirstError xs
109105

110106
-- Collects all messages preceding `ReadyForQuery`
111107
collectUntilReadyForQuery
112108
:: ConnectionCommon
113-
-> IO (Either Error [ServerMessage])
109+
-> IO (Either ReceiverException [ServerMessage])
114110
collectUntilReadyForQuery conn = do
115111
msg <- readChan $ connOutChan conn
116112
case msg of

‎src/Database/PostgreSQL/Protocol/Types.hs

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,14 @@ data ServerVersion = ServerVersion !Word8 !Word8 !Word8 !ByteString
5050
newtype DataRows = DataRows BL.ByteString
5151
deriving (Show)
5252

53+
-- | Ad-hoc type only for data rows.
54+
data DataMessage
55+
= DataError ErrorDesc
56+
| DataMessage DataRows
57+
-- ReadyForQuery received.
58+
| DataReady
59+
deriving (Show)
60+
5361
-- | Maximum number of rows to return, if portal contains a query that
5462
-- returns rows (ignored otherwise). Zero denotes "no limit".
5563
newtype RowsToReceive = RowsToReceive Int32 deriving (Show)

‎tests/Protocol.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -124,15 +124,15 @@ testExtendedQueryNoData = withConnectionCommonAll $ \c -> do
124124

125125
-- | Assert that list contains element satisfies predicat.
126126
assertContains
127-
:: Either Error [ServerMessage]
127+
:: Either ReceiverException [ServerMessage]
128128
-> (ServerMessage -> Bool)
129129
-> String -> Assertion
130130
assertContains (Left e) _ _ = assertFailure $ "Got Error" ++ show e
131131
assertContains (Right msgs) f name =
132132
assertBool ("Does not contain" ++ name) $ any f msgs
133133

134134
-- | Assert there are on `ErrorResponse` in the list.
135-
assertNoErrorResponse :: Either Error [ServerMessage] -> Assertion
135+
assertNoErrorResponse :: Either ReceiverException [ServerMessage] -> Assertion
136136
assertNoErrorResponse (Left e) = assertFailure $ "Got Error" ++ show e
137137
assertNoErrorResponse (Right msgs) =
138138
assertBool "Occured ErrorResponse" $ all (not . isError) msgs

0 commit comments

Comments
 (0)
0