From 27da46a79d3d465f5bcdfe8d2ac9d7614273e9ab Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Mon, 29 Jul 2013 16:05:54 +0000
Subject: [PATCH] Cloud & PGF service: use Content-Type application/json for
 JSON output

This is in accordance with RFC 4627. http://tools.ietf.org/html/rfc4627
Use application/javascript for JSONP output.
---
 src/compiler/GFServer.hs   | 20 ++++++++++++--------
 src/server/FastCGIUtils.hs | 26 ++++++++++++--------------
 2 files changed, 24 insertions(+), 22 deletions(-)

diff --git a/src/compiler/GFServer.hs b/src/compiler/GFServer.hs
index b45862aca..2ba645268 100644
--- a/src/compiler/GFServer.hs
+++ b/src/compiler/GFServer.hs
@@ -324,7 +324,7 @@ serveStaticFile' path =
      if ext `elem` [".cgi",".fcgi",".sh",".php"]
        then return $ resp400 $ "Unsupported file type: "++ext
        else do b <- doesFileExist path
-               if b then fmap (ok200' (ct t)) $ rdFile path
+               if b then fmap (ok200' (ct t "")) $ rdFile path
                     else do cwd <- getCurrentDirectory
                             logPutStrLn $ "Not found: "++path++" cwd="++cwd
                             return (resp404 path)
@@ -334,15 +334,16 @@ logPutStrLn s = liftIO . hPutStrLn stderr $ s
 
 -- * JSONP output
 
-jsonp qs = json200' $ maybe id apply (lookup "jsonp" qs)
+jsonp qs =  maybe json200 apply (lookup "jsonp" qs)
   where
-    apply f json = f++"("++json++")"
+    apply f = jsonp200' $ \ json -> f++"("++json++")"
 
 -- * Standard HTTP responses
 ok200        = Response 200 [plainUTF8,noCache,xo] . encodeString
 ok200' t     = Response 200 [t,xo]
 json200 x    = json200' id x
 json200' f   = ok200' jsonUTF8 . encodeString . f . encode
+jsonp200' f  = ok200' jsonpUTF8 . encodeString . f . encode
 html200      = ok200' htmlUTF8 . encodeString
 resp204      = Response 204 [xo] "" -- no content
 resp400 msg  = Response 400 [plain,xo] $ "Bad request: "++msg++"\n"
@@ -355,11 +356,14 @@ instance Error Response where
   strMsg = resp500
 
 -- * Content types
-plain = ct "text/plain"
-plainUTF8 = ct "text/plain; charset=UTF-8"
-jsonUTF8 = ct "text/javascript; charset=UTF-8"
-htmlUTF8 = ct "text/html; charset=UTF-8"
-ct t = ("Content-Type",t)
+plain = ct "text/plain" ""
+plainUTF8 = ct "text/plain" csutf8
+jsonUTF8 = ct "application/json" csutf8 -- http://www.ietf.org/rfc/rfc4627.txt
+jsonpUTF8 = ct "application/javascript" csutf8
+htmlUTF8 = ct "text/html" csutf8
+
+ct t cs = ("Content-Type",t++cs)
+csutf8 = "; charset=UTF-8"
 xo = ("Access-Control-Allow-Origin","*") -- Allow cross origin requests
      -- https://developer.mozilla.org/en-US/docs/HTTP/Access_control_CORS
 
diff --git a/src/server/FastCGIUtils.hs b/src/server/FastCGIUtils.hs
index 6c93b2801..e65987b6d 100644
--- a/src/server/FastCGIUtils.hs
+++ b/src/server/FastCGIUtils.hs
@@ -167,11 +167,11 @@ outputJSONP = outputEncodedJSONP . encode
 outputEncodedJSONP :: String -> CGI CGIResult
 outputEncodedJSONP json = 
     do mc <- getInput "jsonp"
-       let str = case mc of
-                   Nothing -> json
-                   Just c  -> c ++ "(" ++ json ++ ")"
-       setHeader "Content-Type" "text/javascript; charset=utf-8"
-       outputStrict $ UTF8.encodeString str
+       let (ty,str) = case mc of
+                        Nothing -> ("json",json)
+                        Just c  -> ("javascript",c ++ "(" ++ json ++ ")")
+           ct = "application/"++ty++"; charset=utf-8"
+       outputStrict ct $ UTF8.encodeString str
 
 outputPNG :: BS.ByteString -> CGI CGIResult
 outputPNG x = do
@@ -186,18 +186,16 @@ outputBinary x = do
        outputFPS x
 
 outputHTML :: String -> CGI CGIResult
-outputHTML x = do
-       setHeader "Content-Type" "text/html; charset=utf-8"
-       outputStrict $ UTF8.encodeString x
+outputHTML = outputStrict "text/html; charset=utf-8" . UTF8.encodeString
 
 outputPlain :: String -> CGI CGIResult
-outputPlain x = do
-       setHeader "Content-Type" "text/plain; charset=utf-8"
-       outputStrict $ UTF8.encodeString x
+outputPlain = outputStrict "text/plain; charset=utf-8" . UTF8.encodeString 
 
-outputStrict :: String -> CGI CGIResult
-outputStrict x | x == x = do setXO ; output x
-               | otherwise = fail "I am the pope."
+outputStrict :: String -> String -> CGI CGIResult
+outputStrict ct x | x == x = do setHeader "Content-Type" ct
+                                setXO
+                                output x
+                  | otherwise = fail "I am the pope."
 
 setXO = setHeader "Access-Control-Allow-Origin" "*"
      -- https://developer.mozilla.org/en-US/docs/HTTP/Access_control_CORS