shakespeare 2.0.6 → 2.0.7

raw patch · 6 files changed

+93/−9 lines, 6 filesdep +scientificdep +unordered-containersdep +vectordep ~aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: scientific, unordered-containers, vector

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Text/CssCommon.hs +0/−1
• Text/Julius.hs +73/−2
• Text/MkSizeType.hs +6/−5
• shakespeare.cabal +4/−1
• test/Text/Shakespeare/JsSpec.hs +6/−0

@@ -1,3 +1,7 @@+### 2.0.7++* Include aeson's JSON encoding and escape `<`, `>` and `&` to avoid XSS attacks+ ### 2.0.6  * Provide the `Text.Hamlet.Runtime` module

@@ -11,7 +11,6 @@ import Language.Haskell.TH import Data.Word (Word8) import Data.Bits-import Data.Text.Lazy.Builder (fromLazyText) import qualified Data.Text.Lazy as TL  renderCssUrl :: (url -> [(TS.Text, TS.Text)] -> TS.Text) -> CssUrl url -> TL.Text

@@ -1,6 +1,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- | A Shakespearean module for Javascript templates, introducing type-safe, -- compile-time variable and url interpolation.--@@ -50,7 +52,14 @@ import qualified Data.Text.Lazy as TL import Text.Shakespeare import Data.Aeson (Value)-import Data.Aeson.Encode (fromValue)+import Data.Aeson.Types (Value(..))+import Numeric (showHex)+import qualified Data.HashMap.Strict as H+import qualified Data.Vector as V+import Data.Text.Lazy.Builder (singleton, fromString)+import qualified Data.Text as T+import Data.Scientific (FPFormat(..), Scientific, base10Exponent)+import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)  renderJavascript :: Javascript -> TL.Text renderJavascript (Javascript b) = toLazyText b@@ -80,7 +89,69 @@     toJavascript :: a -> Javascript  instance ToJavascript Bool where toJavascript = Javascript . fromText . TS.toLower . TS.pack . show-instance ToJavascript Value where toJavascript = Javascript . fromValue+instance ToJavascript Value where toJavascript = Javascript . encodeToTextBuilder++-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be+-- embedded efficiently in a text-based protocol.+--+-- If you are going to immediately encode straight to a+-- 'L.ByteString', it is more efficient to use 'encodeToBuilder'+-- instead.+encodeToTextBuilder :: Value -> Builder+encodeToTextBuilder =+    go+  where+    go Null       = {-# SCC "go/Null" #-} "null"+    go (Bool b)   = {-# SCC "go/Bool" #-} if b then "true" else "false"+    go (Number s) = {-# SCC "go/Number" #-} fromScientific s+    go (String s) = {-# SCC "go/String" #-} string s+    go (Array v)+        | V.null v = {-# SCC "go/Array" #-} "[]"+        | otherwise = {-# SCC "go/Array" #-}+                      singleton '[' <>+                      go (V.unsafeHead v) <>+                      V.foldr f (singleton ']') (V.unsafeTail v)+      where f a z = singleton ',' <> go a <> z+    go (Object m) = {-# SCC "go/Object" #-}+        case H.toList m of+          (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs+          _      -> "{}"+      where f a z     = singleton ',' <> one a <> z+            one (k,v) = string k <> singleton ':' <> go v++string :: T.Text -> Builder+string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'+  where+    quote q = case T.uncons t of+                Nothing      -> fromText h+                Just (!c,t') -> fromText h <> escape c <> quote t'+        where (h,t) = {-# SCC "break" #-} T.break isEscape q+    isEscape c = c == '\"' ||+                 c == '\\' ||+                 c == '<'  ||+                 c == '>'  ||+                 c == '&'  ||+                 c < '\x20'+    escape '\"' = "\\\""+    escape '\\' = "\\\\"+    escape '\n' = "\\n"+    escape '\r' = "\\r"+    escape '\t' = "\\t"+    escape '<' = "\\u003c"+    escape '>' = "\\u003e"+    escape '&' = "\\u0026"++    escape c+        | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h+        | otherwise  = singleton c+        where h = showHex (fromEnum c) ""++fromScientific :: Scientific -> Builder+fromScientific s = formatScientificBuilder format prec s+  where+    (format, prec)+      | base10Exponent s < 0 = (Generic, Nothing)+      | otherwise            = (Fixed,   Just 0)  newtype RawJavascript = RawJavascript Builder instance ToJavascript RawJavascript where

@@ -2,6 +2,8 @@ module Text.MkSizeType (mkSizeType) where  import Language.Haskell.TH.Syntax+import Data.Text.Lazy.Builder (fromLazyText)+import qualified Data.Text.Lazy as TL  mkSizeType :: String -> String -> Q [Dec] mkSizeType name' unit = return [ dataDec name@@ -39,11 +41,10 @@ toCssInstanceDec name = InstanceD [] (instanceType "ToCss" name) [toCssDec]   where toCssDec = FunD (mkName "toCss") [Clause [] showBody []]         showBody = NormalB $ (AppE dot from) `AppE` ((AppE dot pack) `AppE` show')-        -- FIXME this whole section makes me a little nervous-        from = VarE (mkName "fromLazyText")-        pack = VarE (mkName "TL.pack")-        dot = VarE (mkName ".")-        show' = VarE (mkName "show")+        from = VarE 'fromLazyText+        pack = VarE 'TL.pack+        dot = VarE 'Prelude.fmap+        show' = VarE 'Prelude.show  instanceType :: String -> Name -> Type instanceType className name = AppT (ConT $ mkName className) (ConT name)

@@ -1,5 +1,5 @@ name:            shakespeare-version:         2.0.6+version:         2.0.7 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -49,6 +49,9 @@                    , blaze-html                    , exceptions                    , transformers+                   , vector+                   , unordered-containers+                   , scientific      exposed-modules: Text.Shakespeare.I18N                      Text.Shakespeare.Text

@@ -130,6 +130,12 @@ 
   it "JSON data" $ jelper "\"Hello \\\"World!\\\"\"" [julius|#{toJSON "Hello \"World!\""}|]
 
+  it "< escaping" $ jelper "\"\\u003c\"" [julius|#{toJSON "<"}|]
+
+  it "> escaping" $ jelper "\"\\u003e\"" [julius|#{toJSON ">"}|]
+
+  it "& escaping" $ jelper "\"\\u0026\"" [julius|#{toJSON "&"}|]
+
   it "boolean interpolation" $ jelper
     "true false true false true false"
     [julius|#{True} #{False} #{toJSON True} #{toJSON False} #{rawJS True} #{rawJS False}|]