WIP: fixing compiler errors in specs

test/SpecHelper.hs

@@ -2,16 +2,8 @@ module SpecHelper where
 
 import Network.Wai
 import Test.Hspec
-import Test.Hspec.Wai
-
-import Hasql as H
-import Hasql.Backend as B
-import Hasql.Postgres as P
 
 import Data.String.Conversions (cs)
-import Data.Monoid
-import Data.Text hiding (map)
-import qualified Data.Vector as V
 import Data.Time.Clock.POSIX (getPOSIXTime)
 import Control.Monad (void)
 
@@ -19,57 +11,44 @@ import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
                                   hRange, hAuthorization, hAccept)
 import Codec.Binary.Base64.String (encode)
 import Data.CaseInsensitive (CI(..))
-import Data.Maybe (fromMaybe)
+import Data.Pool
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
 import System.Process (readProcess)
 import Web.JWT (secret)
 
+import qualified Hasql.Connection  as H
+import qualified Hasql.Session     as H
+
 import PostgREST.App (app)
 import PostgREST.Config (AppConfig(..))
 import PostgREST.Middleware
 import PostgREST.Error(pgErrResponse)
-import PostgREST.DbStructure
 import PostgREST.Types
 
 dbString :: String
 dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test"
 
-cfg :: String -> Maybe Int -> AppConfig
+cfg :: String -> Maybe Integer -> AppConfig
 cfg conStr = AppConfig conStr 3000 "postgrest_test_anonymous" "test" (secret "safe") 10
 
 cfgDefault :: AppConfig
 cfgDefault = cfg dbString Nothing
 
-cfgLimitRows :: Int -> AppConfig
+cfgLimitRows :: Integer -> AppConfig
 cfgLimitRows = cfg dbString . Just
 
-testPoolOpts :: PoolSettings
-testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30
-
-pgSettings :: P.Settings
-pgSettings = P.StringSettings $ cs dbString
-
-specDbPool :: IO (H.Pool P.Postgres)
-specDbPool = H.acquirePool pgSettings testPoolOpts
-
-specDbStructure :: H.Pool P.Postgres -> IO DbStructure
-specDbStructure pool = do
-  dbOrError <- H.session pool $ H.tx specTxSettings
-    $ getDbStructure "test"
-  either (fail . show) return dbOrError
-
-withApp :: AppConfig -> DbStructure -> H.Pool P.Postgres
+withApp :: AppConfig -> DbStructure -> Pool H.Connection
         -> ActionWith Application -> IO ()
 withApp config dbStructure pool perform = do
-  perform $ middle $ \req resp -> do
+  perform $ defaultMiddle $ \req resp -> do
     time <- getPOSIXTime
     body <- strictRequestBody req
-    result <- liftIO $ H.session pool $ H.tx specTxSettings
-      $ runWithClaims config time (app dbStructure config body) req
-    either (resp . pgErrResponse) resp result
+    let handleReq = H.run (runWithClaims config time (app dbStructure config body) req)
 
-  where middle = defaultMiddle
+    withResource pool $ \c -> do
+      resOrError <- handleReq c
+      either (resp . pgErrResponse) resp resOrError
 
 setupDb :: IO ()
 setupDb = do
@@ -107,14 +86,6 @@ authHeaderJWT :: String -> Header
 authHeaderJWT token =
   (hAuthorization, cs $ "Bearer " ++ token)
 
-testPool :: IO(H.Pool P.Postgres)
-testPool = H.acquirePool pgSettings testPoolOpts
-
-clearTable :: Text -> IO ()
-clearTable table = do
-  pool <- testPool
-  void . liftIO $ H.session pool $ H.tx Nothing $
-    H.unitEx $ B.Stmt ("truncate table test." <> table <> " cascade") V.empty True
-
-specTxSettings :: Maybe (TxIsolationLevel, Maybe Bool)
-specTxSettings = Just (H.ReadCommitted, Just True)
+testPool :: IO (Pool (Either H.ConnectionError H.Connection))
+testPool = createPool (H.acquire . cs $ dbString)
+  (either (const $ return ()) H.release) 1 1 1