hasql wants to rowParse text not bytestring
This commit is contained in:
+8
-4
@@ -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
|
||||
|
||||
+6
-11
@@ -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)
|
||||
|
||||
+1
-1
@@ -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
|
||||
)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user