From f463f48b80d5e3d8a951a23b7de48fe7105a2814 Mon Sep 17 00:00:00 2001 From: VyacheslavHashov Date: Sat, 28 Jan 2017 01:31:06 +0300 Subject: [PATCH] First test, connection tests --- postgres-wire.cabal | 10 ++- src/Database/PostgreSQL/Driver.hs | 3 + src/Database/PostgreSQL/Driver/Connection.hs | 69 +++++--------------- src/Database/PostgreSQL/Driver/Settings.hs | 2 - test/Spec.hs | 2 - tests/test.hs | 66 +++++++++++++++++++ 6 files changed, 93 insertions(+), 59 deletions(-) delete mode 100644 test/Spec.hs create mode 100644 tests/test.hs diff --git a/postgres-wire.cabal b/postgres-wire.cabal index 67c9500..1d6b032 100644 --- a/postgres-wire.cabal +++ b/postgres-wire.cabal @@ -47,12 +47,18 @@ library test-suite postgres-wire-test type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Spec.hs + hs-source-dirs: tests + main-is: test.hs build-depends: base , postgres-wire + , tasty + , tasty-hunit ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 + default-extensions: + OverloadedStrings + OverloadedLists + GeneralizedNewtypeDeriving source-repository head type: git diff --git a/src/Database/PostgreSQL/Driver.hs b/src/Database/PostgreSQL/Driver.hs index d16221f..dba7cbe 100644 --- a/src/Database/PostgreSQL/Driver.hs +++ b/src/Database/PostgreSQL/Driver.hs @@ -1,2 +1,5 @@ module Database.PostgreSQL.Driver where +import Database.PostgreSQL.Driver.Connection +import Database.PostgreSQL.Driver.Settings + diff --git a/src/Database/PostgreSQL/Driver/Connection.hs b/src/Database/PostgreSQL/Driver/Connection.hs index 34277ad..d3ad5d0 100644 --- a/src/Database/PostgreSQL/Driver/Connection.hs +++ b/src/Database/PostgreSQL/Driver/Connection.hs @@ -27,6 +27,7 @@ import Crypto.Hash (hash, Digest, MD5) import Database.PostgreSQL.Protocol.Encoders import Database.PostgreSQL.Protocol.Decoders import Database.PostgreSQL.Protocol.Types + import Database.PostgreSQL.Driver.Settings import Database.PostgreSQL.Driver.StatementStorage import Database.PostgreSQL.Driver.Types @@ -47,7 +48,7 @@ type ServerMessageFilter = ServerMessage -> Bool type NotificationHandler = Notification -> IO () --- All possible errors +-- All possible at errors data Error = PostgresError ErrorDesc | ImpossibleError @@ -143,7 +144,6 @@ authorize rawConn settings = do case pushChunk (runGetIncremental decodeAuthResponse) r of BG.Done rest _ r -> case r of AuthenticationOk -> do - putStrLn "Auth ok" -- TODO parse parameters pure $ Right $ parseParameters rest AuthenticationCleartextPassword -> @@ -162,13 +162,11 @@ authorize rawConn settings = do performPasswordAuth :: PasswordText -> IO (Either AuthError ConnectionParameters) performPasswordAuth password = do - putStrLn $ "sending password" ++ show password sendMessage rawConn $ PasswordMessage password r <- rReceive rawConn 4096 case pushChunk (runGetIncremental decodeAuthResponse) r of BG.Done rest _ r -> case r of AuthenticationOk -> do - putStrLn "Auth ok" pure $ Right $ parseParameters rest AuthErrorResponse desc -> pure $ Left $ AuthPostgresError desc @@ -305,6 +303,7 @@ data Query = Query , qResultFormat :: Format } deriving (Show) +-- | Public sendBatch :: Connection -> [Query] -> IO () sendBatch conn = traverse_ sendSingle where @@ -317,15 +316,27 @@ sendBatch conn = traverse_ sendSingle Bind pname sname (qParamsFormat q) (qValues q) (qResultFormat q) sendMessage s $ Execute pname noLimitToReceive +-- | Public +sendBatchAndSync :: Connection -> [Query] -> IO () +sendBatchAndSync conn qs = sendBatch conn qs >> sendSync conn + +-- | Public +sendBatchAndFlush :: Connection -> [Query] -> IO () +sendBatchAndFlush conn qs = sendBatch conn qs >> sendFlush conn + +-- | Public sendSync :: Connection -> IO () sendSync conn = sendMessage (connRawConnection conn) Sync +-- | Public sendFlush :: Connection -> IO () sendFlush conn = sendMessage (connRawConnection conn) Flush +-- | Public readNextData :: Connection -> IO (Either Error DataMessage) readNextData conn = readChan $ connOutDataChan conn +-- | Public -- SHOULD BE called after every sended `Sync` message -- skips all messages except `ReadyForQuery` readReadyForQuery :: Connection -> IO (Either Error ()) @@ -347,6 +358,7 @@ waitReadyForQueryCollect conn = do ReadForQuery{} -> pure [] m -> (m:) <$> waitReadyForQueryCollect conn +-- | Public describeStatement :: Connection -> StatementSQL @@ -367,52 +379,3 @@ describeStatement conn stmt = do xs -> maybe (error "Impossible happened") (Left . PostgresError ) $ findFirstError xs -query1 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["1", "3"] Text Text -query2 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["a", "3"] Text Text -query3 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["3", "3"] Text Text -query4 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["4", "3"] Text Text - - -test :: IO () -test = do - c <- connect defaultConnectionSettings - sendBatch c queries - sendSync c - readResults c $ length queries - readReadyForQuery c >>= print - close c - where - queries = [query1, query2, query3, query4 ] - readResults c 0 = pure () - readResults c n = do - r <- readNextData c - print r - case r of - Left _ -> pure () - Right _ -> readResults c $ n - 1 - --- sendBatchAndSync :: IsQuery a => [a] -> Connection -> IO () --- sendBatchAndSync = undefined - --- sendBatchAndFlush :: IsQuery a => [a] -> Connection -> IO () --- sendBatchAndFlush = undefined - --- internal helper --- sendBatch :: IsQuery a => [a] -> Connection -> IO () --- sendBatch = undefined - - -testDescribe1 :: IO () -testDescribe1 = do - c <- connect defaultConnectionSettings - r <- describeStatement c $ StatementSQL "start transaction" - print r - close c - -testDescribe2 :: IO () -testDescribe2 = do - c <- connect defaultConnectionSettings - r <- describeStatement c $ StatementSQL "select count(*) from a where v > $1" - print r - close c - diff --git a/src/Database/PostgreSQL/Driver/Settings.hs b/src/Database/PostgreSQL/Driver/Settings.hs index d70c44d..c5bae30 100644 --- a/src/Database/PostgreSQL/Driver/Settings.hs +++ b/src/Database/PostgreSQL/Driver/Settings.hs @@ -1,5 +1,3 @@ -{-# language OverloadedStrings #-} - module Database.PostgreSQL.Driver.Settings where import Data.Word (Word16) diff --git a/test/Spec.hs b/test/Spec.hs deleted file mode 100644 index cd4753f..0000000 --- a/test/Spec.hs +++ /dev/null @@ -1,2 +0,0 @@ -main :: IO () -main = putStrLn "Test suite not yet implemented" diff --git a/tests/test.hs b/tests/test.hs new file mode 100644 index 0000000..a71a735 --- /dev/null +++ b/tests/test.hs @@ -0,0 +1,66 @@ +import Test.Tasty +import Test.Tasty.HUnit + +import Database.PostgreSQL.Driver.Connection +import Database.PostgreSQL.Driver.Settings +import Database.PostgreSQL.Protocol.Types + +main :: IO () +main = defaultMain $ testGroup "Postgres-wire" + [ testConnection + ] + +testConnection :: TestTree +testConnection = testGroup "Connection" $ + map (\(name, settings) -> testCase name $ connectAndClose settings) + [ ("Connection to default socket", defaultConnectionSettings + { settingsHost = "" }) + , ("Connection to Unix socket", defaultConnectionSettings + { settingsHost = "/var/run/postgresql" }) + , ("Connection to TCP ipv4 socket", defaultConnectionSettings + { settingsHost = "localhost" }) + ] + where + connectAndClose settings = connect settings >>= close + + +query1 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["1", "3"] Text Text +query2 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["a", "3"] Text Text +query3 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["3", "3"] Text Text +query4 = Query "SELECT $1 + $2" [Oid 23, Oid 23] ["4", "3"] Text Text + + +test :: IO () +test = do + c <- connect defaultConnectionSettings + sendBatch c queries + sendSync c + readResults c $ length queries + readReadyForQuery c >>= print + close c + where + queries = [query1, query2, query3, query4 ] + readResults c 0 = pure () + readResults c n = do + r <- readNextData c + print r + case r of + Left _ -> pure () + Right _ -> readResults c $ n - 1 + + + +testDescribe1 :: IO () +testDescribe1 = do + c <- connect defaultConnectionSettings + r <- describeStatement c $ StatementSQL "start transaction" + print r + close c + +testDescribe2 :: IO () +testDescribe2 = do + c <- connect defaultConnectionSettings + r <- describeStatement c $ StatementSQL "select count(*) from a where v > $1" + print r + close c +