From 8cf0dd8156e4f51dc731650caf12366e3b736b76 Mon Sep 17 00:00:00 2001 From: defanor Date: Sun, 13 Jan 2019 14:37:57 +0300 Subject: Handle FormatError and QueryError In addition to SqlError. ResultError handling should be added as well, and perhaps the resulting XML should be refined. --- Main.hs | 34 +++++++++++++++++++++++++++++----- README.md | 2 +- 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 $ "\n" : "\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`. -- cgit v1.2.3