Report sql errors to client

This commit is contained in:
Joe Nelson
2014-07-13 11:09:44 -07:00
parent a28553dd45
commit c4550f97b0
+11 -2
View File
@@ -3,8 +3,10 @@
module Main where module Main where
import Control.Applicative import Control.Applicative
import Control.Exception (try)
import Database.HDBC.PostgreSQL (connectPostgreSQL) import Database.HDBC.PostgreSQL (connectPostgreSQL)
import Database.HDBC.Types (SqlError, seErrorMsg)
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp hiding (Connection) import Network.Wai.Handler.Warp hiding (Connection)
@@ -14,6 +16,9 @@ import Network.HTTP.Types.Method
import Options.Applicative hiding (columns) import Options.Applicative hiding (columns)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as BS
import PgStructure (printTables, printColumns) import PgStructure (printTables, printColumns)
import PgQuery (selectWhere) import PgQuery (selectWhere)
@@ -45,7 +50,7 @@ main = do
app :: AppConfig -> Application app :: AppConfig -> Application
app config req respond = do app config req respond = do
r <- r <- try $
case path of case path of
[] -> responseLBS status200 [json] <$> (printTables =<< conn) [] -> responseLBS status200 [json] <$> (printTables =<< conn)
[table] -> responseLBS status200 [json] <$> [table] -> responseLBS status200 [json] <$>
@@ -54,7 +59,7 @@ app config req respond = do
else selectWhere table qq =<< conn ) else selectWhere table qq =<< conn )
_ -> return $ responseLBS status404 [] "" _ -> return $ responseLBS status404 [] ""
respond r respond $ either sqlErrorHandler id r
where where
path = pathInfo req path = pathInfo req
@@ -62,3 +67,7 @@ app config req respond = do
json = (hContentType, "application/json") json = (hContentType, "application/json")
conn = connectPostgreSQL $ configDbUri config conn = connectPostgreSQL $ configDbUri config
qq = queryString req qq = queryString req
sqlErrorHandler :: SqlError -> Response
sqlErrorHandler e =
responseLBS status400 [] $ BL.fromChunks [BS.pack (seErrorMsg e)]