summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2019-08-13 07:24:05 +0200
committerEugen Wissner <belka@caraus.de>2019-08-13 07:24:05 +0200
commit045b6d15fbf299b5a09a20e3045209d7dcc31908 (patch)
tree7327f904a288944d5b9c3d57a67020222c05e2ac
parent6604fba7f44b6016003b6750bb1c57e9c43b7544 (diff)
downloadgraphql-045b6d15fbf299b5a09a20e3045209d7dcc31908.tar.gz
Escape special characters in the encoded strings
Fixes #2.
-rw-r--r--CHANGELOG.md2
-rw-r--r--graphql.cabal3
-rw-r--r--src/Language/GraphQL/Encoder.hs46
-rw-r--r--tests/Language/GraphQL/EncoderSpec.hs21
4 files changed, 50 insertions, 22 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 61c9e33..d2aab3a 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,6 +5,8 @@ All notable changes to this project will be documented in this file.
### Added
- `executeWithName` executes an operation with the given name.
- Export `Language.GraphQL.Encoder.definition`.
+- Export `Language.GraphQL.Encoder.value`. Escapes \ and " in strings now.
+- Export `Language.GraphQL.Encoder.type'`.
### Changed
- `Operation` includes now possible operation name which allows to support
diff --git a/graphql.cabal b/graphql.cabal
index dc4bf54..0a43ff4 100644
--- a/graphql.cabal
+++ b/graphql.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
--- hash: dca80d6bcaa432cabc2499efc9f047c6f59546bc2ba75b35fed6efd694895598
+-- hash: cb68243309f47fc44768d14981c4f6f8b3f1bb9dc37dd17a63996418d6aac375
name: graphql
version: 0.4.0.0
@@ -66,6 +66,7 @@ test-suite tasty
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
+ Language.GraphQL.EncoderSpec
Language.GraphQL.ErrorSpec
Language.GraphQL.LexerSpec
Language.GraphQL.ParserSpec
diff --git a/src/Language/GraphQL/Encoder.hs b/src/Language/GraphQL/Encoder.hs
index b246e14..71c7145 100644
--- a/src/Language/GraphQL/Encoder.hs
+++ b/src/Language/GraphQL/Encoder.hs
@@ -8,6 +8,8 @@ module Language.GraphQL.Encoder
, document
, minified
, pretty
+ , type'
+ , value
) where
import Data.Foldable (fold)
@@ -84,7 +86,7 @@ variableDefinition :: Formatter -> VariableDefinition -> Text
variableDefinition formatter (VariableDefinition var ty dv)
= variable var
<> eitherFormat formatter ": " ":"
- <> type_ ty
+ <> type' ty
<> maybe mempty (defaultValue formatter) dv
defaultValue :: Formatter -> Value -> Text
@@ -160,8 +162,19 @@ fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
<> eitherFormat formatter " " mempty
<> selectionSet formatter sels
--- * Values
+-- * Directives
+
+directives :: Formatter -> Directives -> Text
+directives formatter@(Pretty _) = Text.Lazy.cons ' ' . spaces (directive formatter)
+directives Minified = spaces (directive Minified)
+
+directive :: Formatter -> Directive -> Text
+directive formatter (Directive name args)
+ = "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args
+-- * Miscellaneous
+
+-- | Converts a 'Value' into a string.
value :: Formatter -> Value -> Text
value _ (ValueVariable x) = variable x
value _ (ValueInt x) = toLazyText $ decimal x
@@ -177,9 +190,11 @@ booleanValue :: Bool -> Text
booleanValue True = "true"
booleanValue False = "false"
--- TODO: Escape characters
stringValue :: Text -> Text
-stringValue = quotes
+stringValue
+ = quotes
+ . Text.Lazy.replace "\"" "\\\""
+ . Text.Lazy.replace "\\" "\\\\"
listValue :: Formatter -> [Value] -> Text
listValue formatter = bracketsCommas formatter $ value formatter
@@ -201,25 +216,14 @@ objectField formatter (ObjectField name v)
| Pretty _ <- formatter = ": "
| Minified <- formatter = ":"
--- * Directives
-
-directives :: Formatter -> [Directive] -> Text
-directives formatter@(Pretty _) = Text.Lazy.cons ' ' . spaces (directive formatter)
-directives Minified = spaces (directive Minified)
-
-directive :: Formatter -> Directive -> Text
-directive formatter (Directive name args)
- = "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args
-
--- * Type Reference
-
-type_ :: Type -> Text
-type_ (TypeNamed x) = Text.Lazy.fromStrict x
-type_ (TypeList x) = listType x
-type_ (TypeNonNull x) = nonNullType x
+-- | Converts a 'Type' a type into a string.
+type' :: Type -> Text
+type' (TypeNamed x) = Text.Lazy.fromStrict x
+type' (TypeList x) = listType x
+type' (TypeNonNull x) = nonNullType x
listType :: Type -> Text
-listType x = brackets (type_ x)
+listType x = brackets (type' x)
nonNullType :: NonNullType -> Text
nonNullType (NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!"
diff --git a/tests/Language/GraphQL/EncoderSpec.hs b/tests/Language/GraphQL/EncoderSpec.hs
new file mode 100644
index 0000000..d2d4a00
--- /dev/null
+++ b/tests/Language/GraphQL/EncoderSpec.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GraphQL.EncoderSpec
+ ( spec
+ ) where
+
+import Language.GraphQL.AST ( Value(..))
+import Language.GraphQL.Encoder ( value
+ , minified
+ )
+import Test.Hspec ( Spec
+ , describe
+ , it
+ , shouldBe
+ )
+
+spec :: Spec
+spec = describe "value" $ do
+ it "escapes \\" $
+ value minified (ValueString "\\") `shouldBe` "\"\\\\\""
+ it "escapes quotes" $
+ value minified (ValueString "\"") `shouldBe` "\"\\\"\""