8000 Deleted Either from Decode · postgres-haskell/postgres-wire@35dbee5 · GitHub
[go: up one dir, main page]

Skip to content

Commit 35dbee5

Browse files
Deleted Either from Decode
1 parent b406bb2 commit 35dbee5

File tree

4 files changed

+20
-31
lines changed

4 files changed

+20
-31
lines changed

src/Database/PostgreSQL/Driver/Connection.hs

Lines changed: 12 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -50,8 +50,12 @@ type InDataChan = TQueue (Either ReceiverException DataMessage)
5050
type InAllChan = TQueue (Either ReceiverException ServerMessage)
5151

5252

53+
writeChan :: TQueue a -> a -> IO ()
5354
writeChan q = atomically . writeTQueue q
55+
56+
readChan :: TQueue a -> IO a
5457
readChan = atomically . readTQueue
58+
5559
-- | Parameters of the current connection.
5660
-- We store only the parameters that cannot change after startup.
5761
-- For more information about additional parameters see
@@ -124,7 +128,7 @@ authorize rawConn settings = do
124128
-- the startup phase.
125129
resp <- rReceive rawConn 4096
126130
case runDecode decodeAuthResponse resp of
127-
Right (rest, r) -> case r of
131+
(rest, r) -> case r of
128132
AuthenticationOk ->
129133
pure $ parseParameters rest
130134
AuthenticationCleartextPassword ->
@@ -139,9 +143,6 @@ authorize rawConn settings = do
139143
throwAuthErrorInIO $ AuthNotSupported "GSS"
140144
AuthErrorResponse desc ->
141145
throwErrorInIO $ PostgresError desc
142-
Left reason -> error "handle error here"
143-
-- TODO handle errors
144-
-- throwErrorInIO . DecodeError $ BS.pack reason
145146

146147
performPasswordAuth password = do
147148
sendMessage rawConn $ PasswordMessage password
@@ -204,13 +205,10 @@ parseParameters str = do
204205
go str dict | B.null str = Right dict
205206
| otherwise = case runDecode
206207
(decodeHeader >>= decodeServerMessage) str of
207-
Right (rest, v) -> case v of
208+
(rest, v) -> case v of
208209
ParameterStatus name value -> go rest $ HM.insert name value dict
209210
-- messages like `BackendData` not handled
210211
_ -> go rest dict
211-
Left reason -> error "handle error here"
212-
-- TODO
213-
-- Left . DecodeError $ BS.pack reason
214212

215213
handshakeTls :: RawConnection -> IO ()
216214
handshakeTls _ = pure ()
@@ -223,16 +221,12 @@ close conn = do
223221
rClose $ connRawConnection conn
224222

225223
-- | 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)
236230

237231
-- | Any exception prevents thread from future work
238232
receiverThreadCommon

src/Database/PostgreSQL/Protocol/Decoders.hs

Lines changed: 4 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -154,17 +154,13 @@ loopParseServerMessages readMoreAction callback = go Nothing ""
154154
-- Parse header
8000
155155
go Nothing bs
156156
| B.length bs < 5 = readMoreAndGo Nothing bs
157-
| otherwise = case runDecode decodeHeader bs of
158-
-- TODO handle error
159-
Left reason -> undefined
160-
Right (rest, h) -> go (Just h) rest
157+
| otherwise = let (rest, h) = runDecode decodeHeader bs
158+
in go (Just h) rest
161159
-- Parse body
162160
go (Just h@(Header _ len)) bs
163161
| B.length bs < len = readMoreAndGo (Just h) bs
164-
| otherwise = case runDecode (decodeServerMessage h) bs of
165-
-- TODO handle error
166-
Left reason -> undefined
167-
Right (rest, v) -> callback v >> go Nothing rest
162+
| otherwise = let (rest, v) = runDecode (decodeServerMessage h) bs
163+
in callback v >> go Nothing rest
168164

169165
{-# INLINE readMoreAndGo #-}
170166
readMoreAndGo :: Maybe Header -> B.ByteString -> IO ()

src/Database/PostgreSQL/Protocol/Store/Decode.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,10 +17,10 @@ import qualified Data.ByteString.Internal as B
1717
newtype Decode a = Decode (Peek a)
1818
deriving (Functor, Applicative, Monad)
1919

20-
runDecode :: Decode a -> B.ByteString -> Either String (B.ByteString, a)
20+
runDecode :: Decode a -> B.ByteString -> (B.ByteString, a)
2121
runDecode (Decode dec) bs =
2222
let (offset,v ) = decodeExPortionWith dec bs
23-
in Right (B.drop offset bs, v)
23+
in (B.drop offset bs, v)
2424
{-# INLINE runDecode #-}
2525

2626
fixed :: Int -> (Ptr Word8 -> IO a) -> Decode a

tests/Driver.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -231,9 +231,8 @@ testCorrectDatarows = withConnection $ \c -> do
231231
map (BS.pack . show ) [1 .. 1000] @=? go bs
232232
where
233233
go bs | B.null bs = []
234-
| otherwise = case runDecode decodeDataRow bs of
235-
Left e -> error $ show e
236-
Right (rest, v) -> v : go rest
234+
| otherwise = let (rest, v) = runDecode decodeDataRow bs
235+
in v : go rest
237236
-- TODO Right parser later
238237
decodeDataRow :: Decode B.ByteString
239238
decodeDataRow = do

0 commit comments

Comments
 (0)
0