From 045b6d15fbf299b5a09a20e3045209d7dcc31908 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Tue, 13 Aug 2019 07:24:05 +0200
Subject: [PATCH] Escape special characters in the encoded strings

Fixes #2.
---
 CHANGELOG.md                          |  2 ++
 graphql.cabal                         |  3 +-
 src/Language/GraphQL/Encoder.hs       | 46 +++++++++++++++------------
 tests/Language/GraphQL/EncoderSpec.hs | 21 ++++++++++++
 4 files changed, 50 insertions(+), 22 deletions(-)
 create mode 100644 tests/Language/GraphQL/EncoderSpec.hs

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` "\"\\\"\""