8000 First test, connection tests · postgres-haskell/postgres-wire@f463f48 · GitHub
[go: up one dir, main page]
Skip to content

Commit f463f48

Browse files
VyacheslavHashovVyacheslavHashov
committed
First test, connection tests
1 parent 04058b4 commit f463f48

File tree

6 files changed

+93
-59
lines changed

6 files changed

+93
-59
lines changed

‎postgres-wire.cabal

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -47,12 +47,18 @@ library
4747

4848
test-suite postgres-wire-test
4949
type: exitcode-stdio-1.0
50-
hs-source-dirs: test
51-
main-is: Spec.hs
50+
hs-source-dirs: tests
51+
main-is: test.hs
5252
build-depends: base
5353
, postgres-wire
54+
, tasty
55+
, tasty-hunit
5456
ghc-options: -threaded -rtsopts -with-rtsopts=-N
5557
default-language: Haskell2010
58+
default-extensions:
59+
OverloadedStrings
60+
OverloadedLists
61+
GeneralizedNewtypeDeriving
5662

5763
source-repository head
5864
type: git

‎src/Database/PostgreSQL/Driver.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,5 @@
11
module Database.PostgreSQL.Driver where
22

3+
import Database.PostgreSQL.Driver.Connection
4+
import Database.PostgreSQL.Driver.Settings
5+

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

Lines changed: 16 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ import Crypto.Hash (hash, Digest, MD5)
2727
import Database.PostgreSQL.Protocol.Encoders
2828
import Database.PostgreSQL.Protocol.Decoders
2929
import Database.PostgreSQL.Protocol.Types
30+
3031
import Database.PostgreSQL.Driver.Settings
3132
import Database.PostgreSQL.Driver.StatementStorage
3233
import Database.PostgreSQL.Driver.Types
@@ -47,7 +48,7 @@ type ServerMessageFilter = ServerMessage -> Bool
4748

4849
type NotificationHandler = Notification -> IO ()
4950

50-
-- All possible errors
51+
-- All possible at errors
5152
data Error
5253
= PostgresError ErrorDesc
5354
| ImpossibleError
@@ -143,7 +144,6 @@ authorize rawConn settings = do
143144
case pushChunk (runGetIncremental decodeAuthResponse) r of
144145
BG.Done rest _ r -> case r of
145146
AuthenticationOk -> do
146-
putStrLn "Auth ok"
147147
-- TODO parse parameters
148148
pure $ Right $ parseParameters rest
149149
AuthenticationCleartextPassword ->
@@ -162,13 +162,11 @@ authorize rawConn settings = do
162162
performPasswordAuth
163163
:: PasswordText -> IO (Either AuthError ConnectionParameters)
164164
performPasswordAuth password = do
165-
putStrLn $ "sending password" ++ show password
166165
sendMessage rawConn $ PasswordMessage password
167166
r <- rReceive rawConn 4096
168167
case pushChunk (runGetIncremental decodeAuthResponse) r of
169168
BG.Done rest _ r -> case r of
170169
AuthenticationOk -> do
171-
putStrLn "Auth ok"
172170
pure $ Right $ parseParameters rest
173171
AuthErrorResponse desc ->
174172
pure $ Left $ AuthPostgresError desc
@@ -305,6 +303,7 @@ data Query = Query
305303
, qResultFormat :: Format
306304
} deriving (Show)
307305

306+
-- | Public
308307
sendBatch :: Connection -> [Query] -> IO ()
309308
sendBatch conn = traverse_ sendSingle
310309
where
@@ -317,15 +316,27 @@ sendBatch conn = traverse_ sendSingle
317316
Bind pname sname (qParamsFormat q) (qValues q) (qResultFormat q)
318317
sendMessage s $ Execute pname noLimitToReceive
319318

319+
-- | Public
320+
sendBatchAndSync :: Connection -> [Query] -> IO ()
321+
sendBatchAndSync conn qs = sendBatch conn qs >> sendSync conn
322+
323+
-- | Public
324+
sendBatchAndFlush :: Connection -> [Query] -> IO ()
325+
sendBatchAndFlush conn qs = sendBatch conn qs >> sendFlush conn
326+
327+
-- | Public
320328
sendSync :: Connection -> IO ()
321329
sendSync conn = sendMessage (connRawConnection conn) Sync
322330

331+
-- | Public
323332
sendFlush :: Connection -> IO ()
324333
sendFlush conn = sendMessage (connRawConnection conn) Flush
325334

335+
-- | Public
326336
readNextData :: Connection -> IO (Either Error DataMessage)
327337
readNextData conn = readChan $ connOutDataChan conn
328338

339+
-- | Public
329340
-- SHOULD BE called after every sended `Sync` message
330341
-- skips all messages except `ReadyForQuery`
331342
readReadyForQuery :: Connection -> IO (Either Error ())
@@ -347,6 +358,7 @@ waitReadyForQueryCollect conn = do
347358
ReadForQuery{} -> pure []
348359
m -> (m:) <$> waitReadyForQueryCollect conn
349360

361+
-- | Public
350362
describeStatement
351363
:: Connection
352364
-> StatementSQL
@@ -367,52 +379,3 @@ describeStatement conn stmt = do
367379
xs -> maybe (error "Impossible happened") (Left . PostgresError )
368380
$ findFirstError xs
369381

370-
query1 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["1", "3"] Text Text
371-
query2 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["a", "3"] Text Text
372-
query3 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["3", "3"] Text Text
373-
query4 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["4", "3"] Text Text
374-
375-
376-
test :: IO ()
377-
test = do
378-
c <- connect defaultConnectionSettings
379-
sendBatch c queries
380-
sendSync c
381-
readResults c $ length queries
382-
readReadyForQuery c >>= print
383-
close c
384-
where
385-
queries = [query1, query2, query3, query4 ]
386-
readResults c 0 = pure ()
387-
readResults c n = do
388-
r <- readNextData c
389-
print r
390-
case r of
391-
Left _ -> pure ()
392-
Right _ -> readResults c $ n - 1
393-
394-
-- sendBatchAndSync :: IsQuery a => [a] -> Connection -> IO ()
395-
-- sendBatchAndSync = undefined
396-
397-
-- sendBatchAndFlush :: IsQuery a => [a] -> Connection -> IO ()
398-
-- sendBatchAndFlush = undefined
399-
400-
-- internal helper
401-
-- sendBatch :: IsQuery a => [a] -> Connection -> IO ()
402-
-- sendBatch = undefined
403-
404-
405-
testDescribe1 :: IO ()
406-
testDescribe1 = do
407-
c <- connect defaultConnectionSettings
408-
r <- describeStatement c $ StatementSQL "start transaction"
409-
print r
410-
close c
411-
412-
testDescribe2 :: IO ()
413-
testDescribe2 = do
414-
c <- connect defaultConnectionSettings
415-
r <- describeStatement c $ StatementSQL "select count(*) from a where v > $1"
416-
print r
417-
close c
418-

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

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,3 @@
1-
{-# language OverloadedStrings #-}
2-
31
module Database.PostgreSQL.Driver.Settings where
42

53
import Data.Word (Word16)

‎test/Spec.hs

Lines changed: 0 additions & 2 deletions
This file was deleted.

‎tests/test.hs

Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
import Test.Tasty
2+
import Test.Tasty.HUnit
3+
4+
import Database.PostgreSQL.Driver.Connection
5+
import Database.PostgreSQL.Driver.Settings
6+
import Database.PostgreSQL.Protocol.Types
7+
8+
main :: IO ()
9+
main = defaultMain $ testGroup "Postgres-wire"
10+
[ testConnection
11+
]
12+
13+
testConnection :: TestTree
14+
testConnection = testGroup "Connection" $
15+
map (\(name, settings) -> testCase name $ connectAndClose settings)
16+
[ ("Connection to default socket", defaultConnectionSettings
17+
{ settingsHost = "" })
18+
, ("Connection to Unix socket", defaultConnectionSettings
19+
{ settingsHost = "/var/run/postgresql" })
20+
, ("Connection to TCP ipv4 socket", defaultConnectionSettings
21+
{ settingsHost = "localhost" })
22+
]
23+
where
24+
connectAndClose settings = connect settings >>= close
25+
26+
27+
query1 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["1", "3"] Text Text
28+
query2 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["a", "3"] Text Text
29+
query3 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["3", "3"] Text Text
30+
query4 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["4", "3"] Text Text
31+
32+
33+
test :: IO ()
34+
test = do
35+
c <- connect defaultConnectionSettings
36+
sendBatch c queries
37+
sendSync c
38+
readResults c $ length queries
39+
readReadyForQuery c >>= print
40+
close c
41+
where
42+
queries = [query1, query2, query3, query4 ]
43+
readResults c 0 = pure ()
44+
readResults c n = do
45+
r <- readNextData c
46+
print r
47+
case r of
48+
Left _ -> pure ()
49+
Right _ -> readResults c $ n - 1
50+
51+
52+
53+
testDescribe1 :: IO ()
54+
testDescribe1 = do
55+
c <- connect defaultConnectionSettings
56+
r <- describeStatement c $ StatementSQL "start transaction"
57+
print r
58+
close c
59+
60+
testDescribe2 :: IO ()
61+
testDescribe2 = do
62+
c <- connect defaultConnectionSettings
63+
r <- describeStatement c $ StatementSQL "select count(*) from a where v > $1"
64+
print r
65+
close c
66+

0 commit comments

Comments
 (0)
0