diff options
| author | krasimir <krasimir@chalmers.se> | 2010-07-31 10:45:59 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2010-07-31 10:45:59 +0000 |
| commit | c8acc8fe116b2e967896f7e31586b83bc826de0e (patch) | |
| tree | ccfa8cc3c0ab27e2a65e12f766873b3cc1129668 /src | |
| parent | f2619d010d8ca3f25ec2130f48e72c504913b1a2 (diff) | |
fix: PGFService should type-check the trees that comes from the user
Diffstat (limited to 'src')
| -rw-r--r-- | src/server/PGFService.hs | 14 | ||||
| -rw-r--r-- | src/server/gf-server.cabal | 3 |
2 files changed, 13 insertions, 4 deletions
diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index 35919d4ab..c65ba2993 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -8,6 +8,7 @@ import URLEncoding import Network.FastCGI import Text.JSON +import Text.PrettyPrint (render, text, (<+>)) import qualified Codec.Binary.UTF8.String as UTF8 (encodeString, decodeString) import qualified Data.ByteString.Lazy as BS @@ -65,9 +66,16 @@ pgfMain pgf command = getText = liftM (maybe "" (urlDecodeUnicode . UTF8.decodeString)) $ getInput "input" getTree :: CGI PGF.Tree - getTree = do mt <- getInput "tree" - t <- maybe (throwCGIError 400 "No tree given" ["No tree given"]) return mt - maybe (throwCGIError 400 "Bad tree" ["Bad tree: " ++ t]) return (PGF.readExpr t) + getTree = do ms <- getInput "tree" + s <- maybe (throwCGIError 400 "No tree given" ["No tree given"]) return ms + t <- maybe (throwCGIError 400 "Bad tree" ["tree: " ++ s]) return (PGF.readExpr s) + t <- either (\err -> throwCGIError 400 "Type incorrect tree" + ["tree: " ++ PGF.showExpr [] t + ,render (text "error:" <+> PGF.ppTcError err) + ]) + (return . fst) + (PGF.inferExpr pgf t) + return t getCat :: CGI (Maybe PGF.Type) getCat = diff --git a/src/server/gf-server.cabal b/src/server/gf-server.cabal index 353dc499b..fa576db4e 100644 --- a/src/server/gf-server.cabal +++ b/src/server/gf-server.cabal @@ -18,7 +18,8 @@ executable pgf-server fastcgi >= 3001.0.2.2, json >= 0.3.3, utf8-string >= 0.3.1.1, - bytestring + bytestring, + pretty if !os(windows) build-depends: unix main-is: PGFService.hs |