First test, connection tests

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

src/Database/PostgreSQL/Driver.hs

@@ -1,2 +1,5 @@
 module Database.PostgreSQL.Driver where
 
+import Database.PostgreSQL.Driver.Connection
+import Database.PostgreSQL.Driver.Settings
+

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
-

src/Database/PostgreSQL/Driver/Settings.hs

@@ -1,5 +1,3 @@
-{-# language OverloadedStrings #-}
-
 module Database.PostgreSQL.Driver.Settings where
 
 import Data.Word (Word16)

test/Spec.hs

@@ -1,2 +0,0 @@
-main :: IO ()
-main = putStrLn "Test suite not yet implemented"

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
+