summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2019-01-13 14:37:57 +0300
committerdefanor <defanor@uberspace.net>2019-01-13 14:37:57 +0300
commit8cf0dd8156e4f51dc731650caf12366e3b736b76 (patch)
tree9f5542776fbb3e78d0480fd4c9f894e8568120d7
parentd85046a9f6c251a3b7d46100f054a2fee4b01375 (diff)
downloadpgxhtml-8cf0dd8156e4f51dc731650caf12366e3b736b76.zip
pgxhtml-8cf0dd8156e4f51dc731650caf12366e3b736b76.tar.gz
pgxhtml-8cf0dd8156e4f51dc731650caf12366e3b736b76.tar.bz2
Handle FormatError and QueryError
In addition to SqlError. ResultError handling should be added as well, and perhaps the resulting XML should be refined.
-rw-r--r--Main.hs34
-rw-r--r--README.md2
2 files changed, 30 insertions, 6 deletions
diff --git a/Main.hs b/Main.hs
index 41abeb1..25126ed 100644
--- a/Main.hs
+++ b/Main.hs
@@ -62,7 +62,7 @@ import Network.Wai.Middleware.Timeout (timeout)
import Network.Wai.Cli (defWaiMain)
import Control.Monad (join)
import Control.Arrow ((***))
-import Control.Exception (bracket, finally, handle)
+import Control.Exception (bracket, finally, catches, Handler(..))
import System.FilePath (replaceExtension, takeFileName, (</>))
import System.Envy (decodeEnv, FromEnv(..), envMaybe, (.!=))
@@ -139,8 +139,11 @@ makeParams = M.fromList . mapMaybe makeParam
, LiteralExpr (BS.unpack v))
makeParam _ = Nothing
-errorXML :: PT.Query -> [Action] -> SqlError -> XmlTree
-errorXML q p e = mkRoot []
+mkAttr :: String -> String -> XmlTree
+mkAttr k v = mkTree (XAttr $ mkName k) [mkTree (XText v) []]
+
+sqlErrorXML :: PT.Query -> [Action] -> SqlError -> XmlTree
+sqlErrorXML q p e = mkRoot []
[mkTree (XTag (mkName "sql_error")
[ mkAttr "template" (show q)
, mkAttr "parameters" (show p)
@@ -151,7 +154,24 @@ errorXML q p e = mkRoot []
, mkAttr "hint" (BS.unpack $ sqlErrorHint e)
])
[]]
- where mkAttr k v = mkTree (XAttr $ mkName k) [mkTree (XText v) []]
+
+-- todo: perhaps encode parameters separately, as an array
+formatErrorXML :: FormatError -> XmlTree
+formatErrorXML (FormatError m (PT.Query q) p) = mkRoot []
+ [mkTree (XTag (mkName "format_error")
+ [ mkAttr "message" m
+ , mkAttr "query" (BS.unpack q)
+ , mkAttr "params" (show p)
+ ])
+ []]
+
+queryErrorXML :: QueryError -> XmlTree
+queryErrorXML (QueryError m (PT.Query q)) = mkRoot []
+ [mkTree (XTag (mkName "query_error")
+ [ mkAttr "message" m
+ , mkAttr "query" (BS.unpack q)
+ ])
+ []]
serve :: EnvConfig -> IO Connection -> Application
serve conf ioc req respond = do
@@ -174,7 +194,11 @@ serve conf ioc req respond = do
[(hContentType, "application/xhtml+xml")]
(fromString $ concat $
"<?xml version=\"1.0\"?>\n" : "<!DOCTYPE html>\n" : rc)
- handle (resp badRequest400 . errorXML q' params)
+ flip catches [ Handler $ resp badRequest400 . sqlErrorXML q' params
+ , Handler $ resp badRequest400 . formatErrorXML
+ , Handler $ resp badRequest400 . queryErrorXML
+ -- todo: handle ResultError as well
+ ]
$ bracket ioc cancelAndClose $ \c -> do
r <- query c q' params
case r of
diff --git a/README.md b/README.md
index 2a67dbd..9d4e64a 100644
--- a/README.md
+++ b/README.md
@@ -41,7 +41,7 @@ URL query parameters are made visible to XSLTs as `xsl:param`
parameters. The documents they get applied to are either the results
of SQL queries (which are expected to return a single XML document,
using `query_to_xml` or similar functions), or error documents (which
-contain error details) in case of an SQL error.
+contain error details) in case of an error.
The XSLTs are taken from `XSLT_DIR`, using file name from the URL
query, with its extension changed to `xsl`.