fix: PGFService should type-check the trees that comes from the user

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"
+    getTree = do ms <- getInput "tree"
-                 t <- maybe (throwCGIError 400 "No tree given" ["No tree given"]) return mt
+                 s <- maybe (throwCGIError 400 "No tree given" ["No tree given"]) return ms
-                 maybe (throwCGIError 400 "Bad tree" ["Bad tree: " ++ t]) return (PGF.readExpr t)
+                 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 = 

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