THRIFT-3145 JSON protocol does not handle bool and empty containers correctly
Client: Haskell
Patch: Nobuaki Sukegawa
Fix bool and empty map and add test
This closes #740
diff --git a/lib/hs/CMakeLists.txt b/lib/hs/CMakeLists.txt
index b5d1d20..7653ed6 100644
--- a/lib/hs/CMakeLists.txt
+++ b/lib/hs/CMakeLists.txt
@@ -41,6 +41,7 @@
test/Spec.hs
test/BinarySpec.hs
test/CompactSpec.hs
+ test/JSONSpec.hs
)
set(hs_enable_test "--enable-tests")
endif()
diff --git a/lib/hs/src/Thrift/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs
index 31e48b5..8467f40 100644
--- a/lib/hs/src/Thrift/Protocol.hs
+++ b/lib/hs/src/Thrift/Protocol.hs
@@ -107,7 +107,7 @@
runParser :: (Protocol p, Transport t, Show a) => p t -> Parser a -> IO a
runParser prot p = refill >>= getResult . parse p
where
- refill = handle handleEOF $ toStrict <$> tRead (getTransport prot) 1
+ refill = handle handleEOF $ toStrict <$> tReadAll (getTransport prot) 1
getResult (Done _ a) = return a
getResult (Partial k) = refill >>= getResult . k
getResult f = throw $ ProtocolExn PE_INVALID_DATA (show f)
diff --git a/lib/hs/src/Thrift/Protocol/JSON.hs b/lib/hs/src/Thrift/Protocol/JSON.hs
index ba19ad7..ea6bcf3 100644
--- a/lib/hs/src/Thrift/Protocol/JSON.hs
+++ b/lib/hs/src/Thrift/Protocol/JSON.hs
@@ -49,9 +49,10 @@
import Thrift.Types
import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Lazy.Char8 as LBSC
import qualified Data.Text.Lazy as LT
--- | The JSON Protocol data uses the standard 'TSimpleJSONProtocol'. Data is
+-- | The JSON Protocol data uses the standard 'TJSONProtocol'. Data is
-- encoded as a JSON 'ByteString'
data JSONProtocol t = JSONProtocol t
-- ^ Construct a 'JSONProtocol' with a 'Transport'
@@ -105,7 +106,7 @@
else mempty) <>
B.char8 ']'
buildJSONValue (TSet ty entries) = buildJSONValue (TList ty entries)
-buildJSONValue (TBool b) = if b then B.string8 "true" else B.string8 "false"
+buildJSONValue (TBool b) = if b then B.char8 '1' else B.char8 '0'
buildJSONValue (TByte b) = buildShowable b
buildJSONValue (TI16 i) = buildShowable i
buildJSONValue (TI32 i) = buildShowable i
@@ -160,7 +161,7 @@
then lexeme (PC.char8 ',') *> parseJSONList ty
else return []
parseJSONValue T_BOOL =
- (TBool True <$ string "true") <|> (TBool False <$ string "false")
+ (TBool True <$ PC.char8 '1') <|> (TBool False <$ PC.char8 '0')
parseJSONValue T_BYTE = TByte <$> signed decimal
parseJSONValue T_I16 = TI16 <$> signed decimal
parseJSONValue T_I32 = TI32 <$> signed decimal
@@ -202,9 +203,12 @@
parseJSONMap :: ThriftType -> ThriftType -> Parser [(ThriftVal, ThriftVal)]
parseJSONMap kt vt =
- ((,) <$> lexeme (PC.char8 '"' *> parseJSONValue kt <* PC.char8 '"') <*>
+ ((,) <$> lexeme (parseJSONKey kt) <*>
(lexeme (PC.char8 ':') *> lexeme (parseJSONValue vt))) `sepBy`
lexeme (PC.char8 ',')
+ where
+ parseJSONKey T_STRING = parseJSONValue T_STRING
+ parseJSONKey kt = PC.char8 '"' *> parseJSONValue kt <* PC.char8 '"'
parseJSONList :: ThriftType -> Parser [ThriftVal]
parseJSONList ty = lexeme (parseJSONValue ty) `sepBy` lexeme (PC.char8 ',')
diff --git a/lib/hs/test/JSONSpec.hs b/lib/hs/test/JSONSpec.hs
new file mode 100644
index 0000000..079be02
--- /dev/null
+++ b/lib/hs/test/JSONSpec.hs
@@ -0,0 +1,195 @@
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+-- http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+module JSONSpec where
+
+import Test.Hspec
+import Test.Hspec.QuickCheck (prop)
+
+import qualified Data.ByteString.Lazy.Char8 as C
+
+import Thrift.Types
+import Thrift.Transport
+import Thrift.Transport.Memory
+import Thrift.Protocol
+import Thrift.Protocol.JSON
+
+tString :: [Char] -> ThriftVal
+tString = TString . C.pack
+
+spec :: Spec
+spec = do
+ describe "JSONProtocol" $ do
+ describe "bool" $ do
+ it "writes true as 1" $ do
+ let val = True
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto (TBool val)
+ bin <-tRead trans 100
+ (C.unpack bin) `shouldBe` ['1']
+
+ it "writes false as 0" $ do
+ let val = False
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto (TBool val)
+ bin <- tRead trans 100
+ (C.unpack bin) `shouldBe` ['0']
+
+ prop "round trip" $ \val -> do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto $ TBool val
+ val2 <- readVal proto T_BOOL
+ val2 `shouldBe` (TBool val)
+
+ describe "string" $ do
+ it "writes" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto (TString $ C.pack "\"a")
+ bin <- tRead trans 100
+ (C.unpack bin) `shouldBe` "\"\\\"a\""
+
+ it "reads" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ tWrite trans $ C.pack "\"\\\"a\""
+ val <- readVal proto (T_STRING)
+ val `shouldBe` (TString $ C.pack "\"a")
+
+ prop "round trip" $ \val -> do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto (TString $ C.pack val)
+ val2 <- readVal proto (T_STRING)
+ val2 `shouldBe` (TString $ C.pack val)
+
+ describe "list" $ do
+ it "writes empty list" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto (TList T_BYTE [])
+ bin <- tRead trans 100
+ (C.unpack bin) `shouldBe` "[\"i8\",0]"
+
+ it "reads empty" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ tWrite trans (C.pack "[\"i8\",0]")
+ val <- readVal proto (T_LIST T_BYTE)
+ val `shouldBe` (TList T_BYTE [])
+
+ it "writes single element" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto (TList T_BYTE [TByte 0])
+ bin <- tRead trans 100
+ (C.unpack bin) `shouldBe` "[\"i8\",1,0]"
+
+ it "reads single element" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ tWrite trans (C.pack "[\"i8\",1,0]")
+ val <- readVal proto (T_LIST T_BYTE)
+ val `shouldBe` (TList T_BYTE [TByte 0])
+
+ it "reads elements" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ tWrite trans (C.pack "[\"i8\",2,42, 43]")
+ val <- readVal proto (T_LIST T_BYTE)
+ val `shouldBe` (TList T_BYTE [TByte 42, TByte 43])
+
+ prop "round trip" $ \val -> do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto $ (TList T_STRING $ map tString val)
+ val2 <- readVal proto $ T_LIST T_STRING
+ val2 `shouldBe` (TList T_STRING $ map tString val)
+
+ describe "set" $ do
+ it "writes empty" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto (TSet T_BYTE [])
+ bin <- tRead trans 100
+ (C.unpack bin) `shouldBe` "[\"i8\",0]"
+
+ it "reads empty" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ tWrite trans (C.pack "[\"i8\",0]")
+ val <- readVal proto (T_SET T_BYTE)
+ val `shouldBe` (TSet T_BYTE [])
+
+ it "reads single element" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ tWrite trans (C.pack "[\"i8\",1,0]")
+ val <- readVal proto (T_SET T_BYTE)
+ val `shouldBe` (TSet T_BYTE [TByte 0])
+
+ it "reads elements" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ tWrite trans (C.pack "[\"i8\",2,42, 43]")
+ val <- readVal proto (T_SET T_BYTE)
+ val `shouldBe` (TSet T_BYTE [TByte 42, TByte 43])
+
+ prop "round trip" $ \val -> do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto $ (TSet T_STRING $ map tString val)
+ val2 <- readVal proto $ T_SET T_STRING
+ val2 `shouldBe` (TSet T_STRING $ map tString val)
+
+ describe "map" $ do
+ it "writes empty" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto (TMap T_BYTE T_BYTE [])
+ bin <- tRead trans 100
+ (C.unpack bin) `shouldBe`"[\"i8\",\"i8\",0,{}]"
+
+ it "reads empty" $ do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ tWrite trans (C.pack "[\"i8\",\"i8\",0,{}]")
+ val <- readVal proto (T_MAP T_BYTE T_BYTE)
+ val `shouldBe` (TMap T_BYTE T_BYTE [])
+
+ it "reads string-string" $ do
+ let bin = "[\"str\",\"str\",2,{\"a\":\"2\",\"b\":\"blah\"}]"
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ tWrite trans (C.pack bin)
+ val <- readVal proto (T_MAP T_STRING T_STRING)
+ val`shouldBe` (TMap T_STRING T_STRING [(tString "a", tString "2"), (tString "b", tString "blah")])
+
+ prop "round trip" $ \val -> do
+ trans <- openMemoryBuffer
+ let proto = JSONProtocol trans
+ writeVal proto $ (TMap T_STRING T_STRING $ map toKV val)
+ val2 <- readVal proto $ T_MAP T_STRING T_STRING
+ val2 `shouldBe` (TMap T_STRING T_STRING $ map toKV val)
+ where
+ toKV v = (tString v, tString v)
+
diff --git a/lib/hs/test/Spec.hs b/lib/hs/test/Spec.hs
index 0f5a816..7ec9a99 100644
--- a/lib/hs/test/Spec.hs
+++ b/lib/hs/test/Spec.hs
@@ -26,6 +26,7 @@
import qualified BinarySpec
import qualified CompactSpec
+import qualified JSONSpec
main :: IO ()
main = hspec spec
@@ -34,3 +35,4 @@
spec = do
describe "Binary" BinarySpec.spec
describe "Compact" CompactSpec.spec
+ describe "JSON" JSONSpec.spec
diff --git a/test/known_failures_Linux.json b/test/known_failures_Linux.json
index 2293c5c..3e9240f 100644
--- a/test/known_failures_Linux.json
+++ b/test/known_failures_Linux.json
@@ -34,8 +34,6 @@
"csharp-go_compact_framed-ip-ssl",
"csharp-go_json_buffered-ip-ssl",
"csharp-go_json_framed-ip-ssl",
- "csharp-hs_json_buffered-ip",
- "csharp-hs_json_framed-ip",
"csharp-nodejs_binary_buffered-ip-ssl",
"csharp-nodejs_binary_framed-ip-ssl",
"csharp-nodejs_compact_buffered-ip-ssl",
@@ -60,35 +58,19 @@
"erl-rb_compact_framed-ip",
"go-dart_binary_framed-ip",
"go-dart_json_framed-ip",
- "go-hs_json_buffered-ip",
- "go-hs_json_framed-ip",
"go-perl_binary_buffered-ip-ssl",
"go-perl_binary_framed-ip-ssl",
- "hs-cpp_json_buffered-ip",
- "hs-cpp_json_framed-ip",
"hs-csharp_binary_framed-ip",
"hs-csharp_compact_framed-ip",
- "hs-csharp_json_buffered-ip",
"hs-csharp_json_framed-ip",
"hs-dart_binary_framed-ip",
- "hs-dart_json_buffered-ip",
"hs-dart_json_framed-ip",
- "hs-go_json_buffered-ip",
- "hs-go_json_framed-ip",
- "hs-java_json_buffered-ip",
- "hs-java_json_framed-fastframed-ip",
- "hs-java_json_framed-ip",
"hs-nodejs_json_buffered-ip",
"hs-nodejs_json_framed-ip",
"hs-py3_json_buffered-ip",
"hs-py3_json_framed-ip",
"hs-py_json_buffered-ip",
"hs-py_json_framed-ip",
- "hs-rb_json_buffered-ip",
- "hs-rb_json_framed-ip",
- "java-hs_json_buffered-ip",
- "java-hs_json_fastframed-framed-ip",
- "java-hs_json_framed-ip",
"java-perl_binary_buffered-ip-ssl",
"java-perl_binary_fastframed-framed-ip-ssl",
"java-perl_binary_framed-ip-ssl",
@@ -103,16 +85,10 @@
"perl-perl_binary_buffered-ip-ssl",
"perl-perl_binary_framed-ip-ssl",
"perl-php_binary_framed-ip",
- "py-hs_json_buffered-ip",
- "py-hs_json_framed-ip",
"py-perl_accel-binary_buffered-ip-ssl",
"py-perl_accel-binary_framed-ip-ssl",
"py-perl_binary_buffered-ip-ssl",
"py-perl_binary_framed-ip-ssl",
- "py3-hs_json_buffered-ip",
- "py3-hs_json_framed-ip",
"py3-perl_binary_buffered-ip-ssl",
- "py3-perl_binary_framed-ip-ssl",
- "rb-hs_json_buffered-ip",
- "rb-hs_json_framed-ip"
+ "py3-perl_binary_framed-ip-ssl"
]