Feature tests pass, unit test does not

src/Dbapi.hs

@@ -21,7 +21,7 @@ import Network.Wai
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Char8 as BS
 
-import Database.HDBC.PostgreSQL (connectPostgreSQL')
+import Database.HDBC.PostgreSQL (Connection)
 import Database.HDBC.Types (SqlError, seErrorMsg)
 import PgStructure (printTables, printColumns)
 
@@ -52,9 +52,8 @@ jsonBodyAction req handler = do
 jsonBody :: Request -> IO (Either String SqlRow)
 jsonBody = (fmap JSON.eitherDecode) . strictRequestBody
 
-app ::  AppConfig -> Application
+app :: Connection -> Application
-app config req respond = do
+app conn req respond = do
-  conn <- connectPostgreSQL' $ configDbUri config
   r <- try $
     case (path, verb) of
       ([], _) ->

src/Main.hs

@@ -5,6 +5,7 @@
 module Main where
 import Dbapi
 import Network.Wai.Handler.Warp hiding (Connection)
+import Database.HDBC.PostgreSQL (connectPostgreSQL')
 
 import Control.Applicative
 import Options.Applicative hiding (columns)
@@ -21,10 +22,12 @@ argParser = AppConfig
 main :: IO ()
 main = do
   conf <- execParser (info (helper <*> argParser) describe)
+  let port = configPort conf
+  let dburi = configDbUri conf
 
   Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String)
-  run (configPort conf) $ app conf
+  conn <- connectPostgreSQL' dburi
+  run port $ app conn
 
   where
     describe = progDesc "create a REST API to an existing Postgres database"
-

test/Feature/RangeSpec.hs

@@ -8,7 +8,6 @@ import Test.Hspec.Wai.JSON
 import SpecHelper
 
 import Network.HTTP.Types
-import Dbapi (app)
 
 spec :: Spec
 spec = around appWithFixture $ do
@@ -74,7 +73,9 @@ spec = around appWithFixture $ do
         it "returns whole range with status 200" $ do
           get "/auto_incrementing_pk" `shouldRespondWith` 206
 
-  -- describe "Posting new record" $ do
+  describe "Posting new record" $ do
-  --   context "into a table with auto-incrementing pk" $ do
+    context "into a table with auto-incrementing pk" $ do
-  --     it "does not require pk in the payload" $ do
+      it "does not require pk in the payload" $ do
-  --       undefined
+        post "/auto_incrementing_pk" [json|
+          { "non_nullable_string":"not null"} |]
+          `shouldRespondWith` 200

test/Main.hs

@@ -1,10 +1,14 @@
 module Main where
 
+import Database.HDBC (runRaw, disconnect)
 import Test.Hspec
 import Spec
+import SpecHelper (openConnection, loadFixture)
 
 main :: IO ()
 main = do
-  putStrLn "before spec"
+  c <-openConnection
+  runRaw c "drop schema if exists \"1\" cascade"
+  loadFixture "schema" c
+  disconnect c
   hspec spec
-  putStrLn "after spec"

test/SpecHelper.hs

@@ -10,8 +10,6 @@ import Control.Exception.Base (bracket)
 
 import Dbapi (app, AppConfig(..))
 
-import Debug.Trace
-
 cfg :: AppConfig
 cfg = AppConfig "postgres://postgres:@localhost:5432/dbapi_test" 9000
 
@@ -23,21 +21,17 @@ withDatabaseConnection = bracket openConnection disconnect
 
 loadFixture :: String -> Connection -> IO ()
 loadFixture name conn = do
-  runRaw conn "begin;"
   sql <- readFile $ "test/fixtures/" ++ name ++ ".sql"
   runRaw conn sql
 
-rollbackFixture :: Connection -> IO ()
-rollbackFixture = flip runRaw "rollback;"
-
 dbWithSchema :: ActionWith Connection -> IO ()
 dbWithSchema action = withDatabaseConnection $ \c -> do
-  trace "Load fixture" loadFixture "schema" c
+  runRaw c "begin;"
-  trace "act" action (c)
+  action c
-  trace "rollback" rollbackFixture c
+  rollback c
 
 appWithFixture :: ActionWith Application -> IO ()
 appWithFixture action = withDatabaseConnection $ \c -> do
-  loadFixture "schema" c
+  runRaw c "begin;"
-  action (app cfg)
+  action $ app c
-  rollbackFixture c
+  rollback c

test/Unit/PgQuerySpec.hs

@@ -6,7 +6,7 @@ import Test.Hspec
 
 import Database.HDBC
 
-import PgQuery (insert)
+import PgQuery (insert, getRows, RangedResult(..))
 import Types (SqlRow(..))
 
 import SpecHelper
@@ -20,7 +20,3 @@ spec = around dbWithSchema $ do
         ]) conn
       r <- quickQuery conn "select count(1) from auto_incrementing_pk" []
       [[toSql (1 :: Int)]] `shouldBe` r
-
-  describe "insert again" $
-    it "is true" $ \_ ->
-      True `shouldBe` True