diff --git a/Yesod/Content.hs b/Yesod/Content.hs index c622db4b..09fcb028 100644 --- a/Yesod/Content.hs +++ b/Yesod/Content.hs @@ -30,6 +30,8 @@ module Yesod.Content , RepHtmlJson (..) , RepPlain (..) , RepXml (..) + -- * Utilities + , formatW3 #if TEST , testSuite #endif @@ -46,6 +48,8 @@ import qualified Network.Wai as W import qualified Network.Wai.Enumerator as WE import Data.Function (on) +import Data.Time +import System.Locale #if TEST import Test.Framework (testGroup, Test) @@ -245,3 +249,7 @@ caseTypeByExt = do TypeJavascript @=? typeByExt (ext "foo.js") TypeHtml @=? typeByExt (ext "foo.html") #endif + +-- | Format a 'UTCTime' in W3 format; useful for setting cookies. +formatW3 :: UTCTime -> String +formatW3 = formatTime defaultTimeLocale "%FT%X-00:00" diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index 46cbc443..0f61cd6f 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -39,7 +39,6 @@ import qualified Network.Wai.Handler.CGI as CGI import System.Environment (getEnvironment) import qualified Data.ByteString.Char8 as B -import Web.Encodings import Web.Routes (encodePathInfo) import Control.Concurrent.MVar @@ -53,6 +52,7 @@ import Data.Maybe import Web.ClientSession import Data.Serialize +import Network.Wai.Parse #if TEST import Test.Framework (testGroup, Test) @@ -247,7 +247,7 @@ parseWaiRequest :: W.Request -> [(String, String)] -- ^ session -> IO Request parseWaiRequest env session' = do - let gets' = map (cs *** cs) $ decodeUrlPairs $ W.queryString env + let gets' = map (cs *** cs) $ parseQueryString $ W.queryString env let reqCookie = fromMaybe B.empty $ lookup W.Cookie $ W.requestHeaders env cookies' = map (cs *** cs) $ parseCookies reqCookie acceptLang = lookup W.AcceptLanguage $ W.requestHeaders env diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index f0119373..b3b87588 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -69,8 +69,8 @@ import Yesod.Request import Yesod.Content import Yesod.Internal import Web.Routes.Quasi (Routes) -import Data.List (foldl') -import Web.Encodings (encodeUrlPairs, encodeHtml) +import Data.List (foldl', intercalate) +import Text.Hamlet.Monad (htmlContentToText) import Control.Exception hiding (Handler, catch) import qualified Control.Exception as E @@ -92,7 +92,8 @@ import Control.Monad.Attempt import Data.Convertible.Text (cs) import Text.Hamlet -import Data.Text (Text) +import Numeric (showIntAtBase) +import Data.Char (ord, chr) data HandlerData sub master = HandlerData { handlerRequest :: Request @@ -260,6 +261,26 @@ redirectParams :: RedirectType -> Routes master -> [(String, String)] redirectParams rt url params = do r <- getUrlRender redirectString rt $ r url ++ '?' : encodeUrlPairs params + where + encodeUrlPairs = intercalate "&" . map encodeUrlPair + encodeUrlPair (x, []) = escape x + encodeUrlPair (x, y) = escape x ++ '=' : escape y + escape = concatMap escape' + escape' c + | 'A' < c && c < 'Z' = [c] + | 'a' < c && c < 'a' = [c] + | '0' < c && c < '9' = [c] + | c `elem` ".-~_" = [c] + | c == ' ' = "+" + | otherwise = '%' : myShowHex (ord c) "" + myShowHex :: Int -> ShowS + myShowHex n r = case showIntAtBase 16 (toChrHex) n r of + [] -> "00" + [c] -> ['0',c] + s -> s + toChrHex d + | d < 10 = chr (ord '0' + fromIntegral d) + | otherwise = chr (ord 'A' + fromIntegral (d - 10)) -- | Redirect to the given URL. redirectString :: RedirectType -> String -> GHandler sub master a @@ -321,11 +342,6 @@ getMessage = do clearSession msgKey fmap (fmap $ Encoded . cs) $ lookupSession msgKey --- | FIXME move this definition into hamlet -htmlContentToText :: HtmlContent -> Text -htmlContentToText (Encoded t) = t -htmlContentToText (Unencoded t) = encodeHtml t - -- | Bypass remaining handler code and output the given file. -- -- For some backends, this is more efficient than reading in the file to diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs index 10231b2f..ded93117 100644 --- a/Yesod/Helpers/AtomFeed.hs +++ b/Yesod/Helpers/AtomFeed.hs @@ -24,7 +24,6 @@ module Yesod.Helpers.AtomFeed import Yesod import Data.Time.Clock (UTCTime) -import Web.Encodings (formatW3) import Text.Hamlet.Monad import Text.Hamlet.Quasi diff --git a/Yesod/Helpers/Sitemap.hs b/Yesod/Helpers/Sitemap.hs index 9543c733..443209b3 100644 --- a/Yesod/Helpers/Sitemap.hs +++ b/Yesod/Helpers/Sitemap.hs @@ -24,7 +24,6 @@ module Yesod.Helpers.Sitemap ) where import Yesod -import Web.Encodings (formatW3) import Data.Time (UTCTime) data SitemapChangeFreq = Always diff --git a/Yesod/Json.hs b/Yesod/Json.hs index 71894f44..5683f4a8 100644 --- a/Yesod/Json.hs +++ b/Yesod/Json.hs @@ -21,11 +21,13 @@ module Yesod.Json import Text.Hamlet.Monad import Control.Applicative import Data.Text (pack) -import Web.Encodings +import qualified Data.Text as T +import Data.Char (isControl) import Yesod.Hamlet import Control.Monad (when) import Yesod.Handler import Web.Routes.Quasi (Routes) +import Numeric (showHex) #if TEST import Test.Framework (testGroup, Test) @@ -69,6 +71,23 @@ jsonScalar s = Json $ do outputString "\"" output $ encodeJson $ htmlContentToText s outputString "\"" + where + encodeJson = T.concatMap (T.pack . encodeJsonChar) + + encodeJsonChar '\b' = "\\b" + encodeJsonChar '\f' = "\\f" + encodeJsonChar '\n' = "\\n" + encodeJsonChar '\r' = "\\r" + encodeJsonChar '\t' = "\\t" + encodeJsonChar '"' = "\\\"" + encodeJsonChar '\\' = "\\\\" + encodeJsonChar c + | not $ isControl c = [c] + | c < '\x10' = '\\' : 'u' : '0' : '0' : '0' : hexxs + | c < '\x100' = '\\' : 'u' : '0' : '0' : hexxs + | c < '\x1000' = '\\' : 'u' : '0' : hexxs + where hexxs = showHex (fromEnum c) "" -- FIXME + encodeJsonChar c = [c] -- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"]. jsonList :: [Json url ()] -> Json url () diff --git a/Yesod/Request.hs b/Yesod/Request.hs index 3a7c918c..423488af 100644 --- a/Yesod/Request.hs +++ b/Yesod/Request.hs @@ -20,6 +20,7 @@ module Yesod.Request RequestBodyContents , Request (..) , RequestReader (..) + , FileInfo (..) -- * Convenience functions , waiRequest , languages @@ -40,7 +41,6 @@ module Yesod.Request ) where import qualified Network.Wai as W -import Web.Encodings import qualified Data.ByteString.Lazy as BL #if MIN_VERSION_transformers(0,2,0) import "transformers" Control.Monad.IO.Class @@ -48,6 +48,7 @@ import "transformers" Control.Monad.IO.Class import "transformers" Control.Monad.Trans #endif import Control.Monad (liftM) +import Network.Wai.Parse type ParamName = String type ParamValue = String @@ -58,6 +59,9 @@ class Monad m => RequestReader m where getRequest :: m Request instance RequestReader ((->) Request) where getRequest = id +instance Monad ((->) Request) where -- FIXME what's happening here? + return = const + f >>= g = \r -> g (f r) r -- | Get the list of supported languages supplied by the user. -- @@ -82,7 +86,7 @@ waiRequest = reqWaiRequest `liftM` getRequest -- | A tuple containing both the POST parameters and submitted files. type RequestBodyContents = ( [(ParamName, ParamValue)] - , [(ParamName, FileInfo String BL.ByteString)] + , [(ParamName, FileInfo BL.ByteString)] ) -- | The parsed request information. diff --git a/yesod.cabal b/yesod.cabal index 952e884e..3ac49169 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -36,7 +36,6 @@ library wai-extra >= 0.1.1 && < 0.2, authenticate >= 0.6.2 && < 0.7, bytestring >= 0.9.1.4 && < 0.10, - web-encodings >= 0.2.6 && < 0.3, directory >= 1 && < 1.1, text >= 0.5 && < 0.8, convertible-text >= 0.3.0 && < 0.4, @@ -50,7 +49,8 @@ library pureMD5 >= 1.1.0.0 && < 1.2, random >= 1.0.0.2 && < 1.1, control-monad-attempt >= 0.3 && < 0.4, - cereal >= 0.2 && < 0.3 + cereal >= 0.2 && < 0.3, + old-locale >= 1.0.0.2 && < 1.1 exposed-modules: Yesod Yesod.Content Yesod.Dispatch