Tests compile, run, and fail

Temporarily disabled unit tests

test/Main.hs

@@ -1,6 +1,6 @@
 module Main where
 
-import Database.HDBC (runRaw, disconnect)
+import Database.PostgreSQL.Simple
 import Test.Hspec
 import Spec
 import SpecHelper (openConnection, loadFixture)
@@ -8,10 +8,10 @@ import SpecHelper (openConnection, loadFixture)
 main :: IO ()
 main = do
   c <-openConnection
-  runRaw c "drop schema if exists \"1\" cascade"
-  runRaw c "drop schema if exists private cascade"
-  runRaw c "drop schema if exists dbapi cascade"
+  _ <- execute_ c "drop schema if exists \"1\" cascade"
+  _ <- execute_ c "drop schema if exists private cascade"
+  _ <- execute_ c "drop schema if exists dbapi cascade"
   loadFixture "roles" c
   loadFixture "schema" c
-  disconnect c
+  close c
   hspec spec

test/SpecHelper.hs

@@ -4,11 +4,12 @@ import Network.Wai
 import Test.Hspec
 import Test.Hspec.Wai
 
-import Database.HDBC
-import Database.HDBC.PostgreSQL
+import Database.PostgreSQL.Simple
+import Database.PostgreSQL.Simple.Types
 
 import Data.String.Conversions (cs)
 import Control.Exception.Base (bracket, finally)
+import Control.Monad (void)
 
 import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
                                   hRange, hAuthorization)
@@ -20,8 +21,9 @@ import Network.Wai.Middleware.Cors (cors)
 
 import Middleware(clientErrors, withSavepoint, authenticated, Environment(..))
 
-import Dbapi (app, corsPolicy, AppConfig(..))
-import PgQuery(addUser)
+import App (app)
+import Config (corsPolicy, AppConfig(..))
+import Auth (addUser)
 
 isLeft :: Either a b -> Bool
 isLeft (Left _ ) = True
@@ -31,41 +33,41 @@ cfg :: AppConfig
 cfg = AppConfig "postgres://dbapi_test:@localhost:5432/dbapi_test" 9000 "dbapi_anonymous" False 10
 
 openConnection :: IO Connection
-openConnection = connectPostgreSQL' $ configDbUri cfg
+openConnection = connectPostgreSQL $ cs $ configDbUri cfg
 
 withDatabaseConnection :: (Connection -> IO ()) -> IO ()
-withDatabaseConnection = bracket openConnection disconnect
+withDatabaseConnection = bracket openConnection close
 
 loadFixture :: String -> Connection -> IO ()
 loadFixture name conn = do
   sql <- readFile $ "test/fixtures/" ++ name ++ ".sql"
-  runRaw conn sql
+  void $ execute_ conn $ Query (cs sql)
 
 dbWithSchema :: ActionWith Connection -> IO ()
 dbWithSchema action = withDatabaseConnection $ \c -> do
-  runRaw c "begin;"
+  _ <- execute_ c "begin;"
   action c
   rollback c
 
 withUser :: BS.ByteString -> BS.ByteString -> BS.ByteString ->
             ActionWith Connection -> ActionWith Connection
 withUser name pass role action conn = do
-  addUser name pass role conn
+  _ <- addUser conn name pass role
   finally (action conn) $ do
-    _ <- run conn "delete from dbapi.auth where id=?" [toSql name]
-    runRaw conn "commit"
+    _ <- execute conn "delete from dbapi.auth where id=?" $ Only name
+    execute_ conn "commit"
 
 withApp :: ActionWith Application -> ActionWith Connection
 withApp action conn = do
-  runRaw conn "begin;"
+  _ <- execute_ conn "begin;"
   action $ cors corsPolicy $ authenticated "dbapi_anonymous" app conn
   rollback conn
 
 appWithFixture :: ActionWith Application -> IO ()
 appWithFixture action = withDatabaseConnection $ \c -> do
-  runRaw c "begin;"
+  _ <- execute_ c "begin;"
   action $ cors corsPolicy . clientErrors  $
-    (authenticated "dbapi_anonymous" . withSavepoint Test) app c
+    (authenticated "dbapi_anonymous" . Middleware.withSavepoint Test) app c
   rollback c
 
 rangeHdrs :: ByteRange -> [Header]

test/TestTypes.hs

@@ -1,18 +1,16 @@
 module TestTypes (
   IncPK(..)
 , CompoundPK(..)
-, incFromList
-, compoundFromList
+-- , incFromList
+-- , compoundFromList
 ) where
 
 import qualified Data.Aeson as JSON
 import Data.Aeson ((.:))
-import Data.Maybe (fromJust)
+-- import Data.Maybe (fromJust)
 import Control.Applicative ((<$>), (<*>))
 import Control.Monad (mzero)
 
-import Database.HDBC (SqlValue, fromSql)
-
 data IncPK = IncPK {
   incId :: Int
 , incNullableStr :: Maybe String
@@ -28,12 +26,12 @@ instance JSON.FromJSON IncPK where
     r .: "inserted_at"
   parseJSON _ = mzero
 
-incFromList :: [(String, SqlValue)] -> IncPK
-incFromList row = IncPK
-  (fromSql . fromJust $ lookup "id" row)
-  (fromSql . fromJust $ lookup "nullable_string" row)
-  (fromSql . fromJust $ lookup "non_nullable_string" row)
-  (fromSql . fromJust $ lookup "inserted_at" row)
+-- incFromList :: [(String, SqlValue)] -> IncPK
+-- incFromList row = IncPK
+--   (fromSql . fromJust $ lookup "id" row)
+--   (fromSql . fromJust $ lookup "nullable_string" row)
+--   (fromSql . fromJust $ lookup "non_nullable_string" row)
+--   (fromSql . fromJust $ lookup "inserted_at" row)
 
 data CompoundPK = CompoundPK {
   compoundK1 :: Int
@@ -48,8 +46,8 @@ instance JSON.FromJSON CompoundPK where
     r .: "extra"
   parseJSON _ = mzero
 
-compoundFromList :: [(String, SqlValue)] -> CompoundPK
-compoundFromList row = CompoundPK
-  (fromSql . fromJust $ lookup "k1" row)
-  (fromSql . fromJust $ lookup "k2" row)
-  (fromSql . fromJust $ lookup "extra" row)
+-- compoundFromList :: [(String, SqlValue)] -> CompoundPK
+-- compoundFromList row = CompoundPK
+--   (fromSql . fromJust $ lookup "k1" row)
+--   (fromSql . fromJust $ lookup "k2" row)
+--   (fromSql . fromJust $ lookup "extra" row)

test/fixtures/roles.sql

@@ -11,7 +11,6 @@ BEGIN
 END;
 $$;
 
-select pg_temp.create_role_if_not_exists('dbapi_anonymous', 'with nologin');
-select pg_temp.create_role_if_not_exists('test_default_role', 'with nologin');
-
-select pg_temp.create_role_if_not_exists('dbapi_test_author', 'with nologin');
+select pg_temp.create_role_if_not_exists('dbapi_anonymous', 'with nologin') as a
+     , pg_temp.create_role_if_not_exists('test_default_role', 'with nologin') as b
+     , pg_temp.create_role_if_not_exists('dbapi_test_author', 'with nologin') into temp shh;