diff --git a/src/App.hs b/src/App.hs index 34644bcb0..14376087b 100644 --- a/src/App.hs +++ b/src/App.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} -module App (app) where +module App (runApp, app) where import Control.Monad (join) import Data.Monoid ( (<>) ) @@ -8,7 +8,7 @@ import Control.Applicative import Control.Monad.IO.Class (liftIO, MonadIO) import Data.Text hiding (map) -import Data.Maybe (listToMaybe, fromMaybe) +import Data.Maybe (fromMaybe) import Text.Regex.TDFA ((=~)) import Data.Ord (comparing) import Data.Ranged.Ranges (emptyRange) @@ -33,6 +33,10 @@ import RangeQuery import PgStructure import Auth +runApp :: H.Postgres -> H.SessionSettings -> Application +runApp pg sess req respond = + respond =<< H.session pg sess (app req) + app :: Request -> H.Session H.Postgres IO Response app req = case (path, verb) of @@ -64,9 +68,9 @@ app req = . whereT qq $ selectStar qt ) - row <- H.tx Nothing $ listToMaybe <$> H.list select + row <- H.tx Nothing $ H.single select let (tableTotal, queryTotal, body) = - fromMaybe (0, 0, Just "" :: Maybe ByteString) row + fromMaybe (0, 0, Just "" :: Maybe Text) row from = fromMaybe 0 $ rangeOffset <$> range to = from+queryTotal contentRange = contentRangeH from to tableTotal diff --git a/src/Main.hs b/src/Main.hs index d3d1a0836..dbe80247a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -8,7 +8,6 @@ import Middleware import Control.Monad (unless) import Data.String.Conversions (cs) -import Network.Wai import Network.Wai.Middleware.Cors (cors) import Network.Wai.Handler.Warp hiding (Connection) import Network.Wai.Middleware.Gzip (gzip, def) @@ -32,26 +31,22 @@ main = do Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String) - let pgSettings = H.Postgres "localhost" 5432 "postgres" "" "postgres" + let pgSettings = H.Postgres "localhost" 5432 "dbapi_test" "" "dbapi_test" sessSettings <- maybe (fail "Improper session settings") return $ - H.sessionSettings 6 30 + H.sessionSettings 95 30 - let settings = setPort port - . setServerName (cs $ "dbapi/" <> prettyVersion) - $ defaultSettings + let appSettings = setPort port + . setServerName (cs $ "dbapi/" <> prettyVersion) + $ defaultSettings middle = (if configSecure conf then redirectInsecure else id) . gzip def . cors corsPolicy . clientErrors . staticPolicy (only [("favicon.ico", "static/favicon.ico")]) in - runSettings settings $ middle (runApp pgSettings sessSettings) + runSettings appSettings $ middle (runApp pgSettings sessSettings) -- . authenticated (cs $ configAnonRole conf) $ app where describe = progDesc "create a REST API to an existing Postgres database" prettyVersion = intercalate "." $ map show $ versionBranch version - -runApp :: H.Postgres -> H.SessionSettings -> Application -runApp pg sess req respond = - respond =<< H.session pg sess (app req) diff --git a/src/PgQuery.hs b/src/PgQuery.hs index fa8050728..a0147dde6 100644 --- a/src/PgQuery.hs +++ b/src/PgQuery.hs @@ -74,7 +74,7 @@ countRows t = asJsonWithCount :: StatementT asJsonWithCount (sql, params) = ( - "count(t), array_to_json(array_agg(row_to_json(t)))::character varying from (" <> sql <> ") t" + "count(t), array_to_json(array_agg(row_to_json(t)))::character varying from (" <> sql <> ") t" , params )