diff --git a/compiler/cpp/src/generate/t_hs_generator.cc b/compiler/cpp/src/generate/t_hs_generator.cc index d2867ea80fe..247c9a8886e 100644 --- a/compiler/cpp/src/generate/t_hs_generator.cc +++ b/compiler/cpp/src/generate/t_hs_generator.cc @@ -1367,6 +1367,11 @@ void t_hs_generator::generate_deserialize_type(ofstream& out, t_type* type, stri out << "E.decodeUtf8 "; } out << val; + if (((t_base_type*)type)->is_binary()) { + // Since wire type of binary is the same as string, we actually receive T.TString not + // T.TBinary + out << "; T.TString " << val << " -> " << val; + } } else if (type->is_enum()) { out << "P.toEnum $ P.fromIntegral " << val; @@ -1539,7 +1544,7 @@ string t_hs_generator::type_to_enum(t_type* type) { case t_base_type::TYPE_VOID: return "T.T_VOID"; case t_base_type::TYPE_STRING: - return "T.T_STRING"; + return ((t_base_type*)type)->is_binary() ? "T.T_BINARY" : "T.T_STRING"; case t_base_type::TYPE_BOOL: return "T.T_BOOL"; case t_base_type::TYPE_I8: @@ -1687,7 +1692,7 @@ string t_hs_generator::type_to_constructor(t_type* type) { case t_base_type::TYPE_VOID: throw "invalid type: T_VOID"; case t_base_type::TYPE_STRING: - return "T.TString"; + return ((t_base_type*)type)->is_binary() ? "T.TBinary" : "T.TString"; case t_base_type::TYPE_BOOL: return "T.TBool"; case t_base_type::TYPE_I8: diff --git a/lib/hs/Thrift.cabal b/lib/hs/Thrift.cabal index f0a09aa20bf..6f6a150ee86 100644 --- a/lib/hs/Thrift.cabal +++ b/lib/hs/Thrift.cabal @@ -40,7 +40,7 @@ Library Hs-Source-Dirs: src Build-Depends: - base >= 4, base < 5, containers, ghc-prim, attoparsec, binary, bytestring >= 0.10, hashable, HTTP, text, unordered-containers, vector, QuickCheck, split + base >= 4, base < 5, containers, ghc-prim, attoparsec, binary, bytestring >= 0.10, base64-bytestring, hashable, HTTP, text, unordered-containers, vector, QuickCheck, split if flag(network-uri) build-depends: network-uri >= 2.6, network >= 2.6 else diff --git a/lib/hs/src/Thrift/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs index 8467f404e7f..ed779a27d5f 100644 --- a/lib/hs/src/Thrift/Protocol.hs +++ b/lib/hs/src/Thrift/Protocol.hs @@ -102,6 +102,7 @@ getTypeOf v = case v of TI32{} -> T_I32 TI64{} -> T_I64 TString{} -> T_STRING + TBinary{} -> T_BINARY TDouble{} -> T_DOUBLE runParser :: (Protocol p, Transport t, Show a) => p t -> Parser a -> IO a diff --git a/lib/hs/src/Thrift/Protocol/Binary.hs b/lib/hs/src/Thrift/Protocol/Binary.hs index ac78483cbf8..2d35305dcda 100644 --- a/lib/hs/src/Thrift/Protocol/Binary.hs +++ b/lib/hs/src/Thrift/Protocol/Binary.hs @@ -104,6 +104,7 @@ buildBinaryValue (TDouble d) = doubleBE d buildBinaryValue (TString s) = int32BE len <> lazyByteString s where len :: Int32 = fromIntegral (LBS.length s) +buildBinaryValue (TBinary s) = buildBinaryValue (TString s) buildBinaryStruct :: Map.HashMap Int16 (LT.Text, ThriftVal) -> Builder buildBinaryStruct = Map.foldrWithKey combine mempty @@ -121,7 +122,7 @@ buildBinaryList = foldr (mappend . buildBinaryValue) mempty -- | Reading Functions parseBinaryValue :: ThriftType -> P.Parser ThriftVal -parseBinaryValue (T_STRUCT _) = TStruct <$> parseBinaryStruct +parseBinaryValue (T_STRUCT tmap) = TStruct <$> parseBinaryStruct tmap parseBinaryValue (T_MAP _ _) = do kt <- parseType vt <- parseType @@ -141,18 +142,23 @@ parseBinaryValue T_I16 = TI16 . Binary.decode . LBS.fromStrict <$> P.take 2 parseBinaryValue T_I32 = TI32 . Binary.decode . LBS.fromStrict <$> P.take 4 parseBinaryValue T_I64 = TI64 . Binary.decode . LBS.fromStrict <$> P.take 8 parseBinaryValue T_DOUBLE = TDouble . bsToDouble <$> P.take 8 -parseBinaryValue T_STRING = do - i :: Int32 <- Binary.decode . LBS.fromStrict <$> P.take 4 - TString . LBS.fromStrict <$> P.take (fromIntegral i) +parseBinaryValue T_STRING = parseBinaryString TString +parseBinaryValue T_BINARY = parseBinaryString TBinary parseBinaryValue ty = error $ "Cannot read value of type " ++ show ty -parseBinaryStruct :: P.Parser (Map.HashMap Int16 (LT.Text, ThriftVal)) -parseBinaryStruct = Map.fromList <$> P.manyTill parseField (matchType T_STOP) +parseBinaryString ty = do + i :: Int32 <- Binary.decode . LBS.fromStrict <$> P.take 4 + ty . LBS.fromStrict <$> P.take (fromIntegral i) + +parseBinaryStruct :: TypeMap -> P.Parser (Map.HashMap Int16 (LT.Text, ThriftVal)) +parseBinaryStruct tmap = Map.fromList <$> P.manyTill parseField (matchType T_STOP) where parseField = do t <- parseType n <- Binary.decode . LBS.fromStrict <$> P.take 2 - v <- parseBinaryValue t + v <- case (t, Map.lookup n tmap) of + (T_STRING, Just (_, T_BINARY)) -> parseBinaryValue T_BINARY + _ -> parseBinaryValue t return (n, ("", v)) parseBinaryMap :: ThriftType -> ThriftType -> Int32 -> P.Parser [(ThriftVal, ThriftVal)] diff --git a/lib/hs/src/Thrift/Protocol/Compact.hs b/lib/hs/src/Thrift/Protocol/Compact.hs index 759466b53dc..07113df2130 100644 --- a/lib/hs/src/Thrift/Protocol/Compact.hs +++ b/lib/hs/src/Thrift/Protocol/Compact.hs @@ -124,6 +124,7 @@ buildCompactValue (TDouble d) = doubleLE d buildCompactValue (TString s) = buildVarint len <> lazyByteString s where len = fromIntegral (LBS.length s) :: Word32 +buildCompactValue (TBinary s) = buildCompactValue (TString s) buildCompactStruct :: Map.HashMap Int16 (LT.Text, ThriftVal) -> Builder buildCompactStruct = flip (loop 0) mempty . Map.toList @@ -146,7 +147,7 @@ buildCompactList = foldr (mappend . buildCompactValue) mempty -- | Reading Functions parseCompactValue :: ThriftType -> Parser ThriftVal -parseCompactValue (T_STRUCT _) = TStruct <$> parseCompactStruct +parseCompactValue (T_STRUCT tmap) = TStruct <$> parseCompactStruct tmap parseCompactValue (T_MAP kt' vt') = do n <- parseVarint id if n == 0 @@ -164,13 +165,16 @@ parseCompactValue T_I16 = TI16 <$> parseVarint zigZagToI16 parseCompactValue T_I32 = TI32 <$> parseVarint zigZagToI32 parseCompactValue T_I64 = TI64 <$> parseVarint zigZagToI64 parseCompactValue T_DOUBLE = TDouble . bsToDoubleLE <$> P.take 8 -parseCompactValue T_STRING = do - len :: Word32 <- parseVarint id - TString . LBS.fromStrict <$> P.take (fromIntegral len) +parseCompactValue T_STRING = parseCompactString TString +parseCompactValue T_BINARY = parseCompactString TBinary parseCompactValue ty = error $ "Cannot read value of type " ++ show ty -parseCompactStruct :: Parser (Map.HashMap Int16 (LT.Text, ThriftVal)) -parseCompactStruct = Map.fromList <$> parseFields 0 +parseCompactString ty = do + len :: Word32 <- parseVarint id + ty . LBS.fromStrict <$> P.take (fromIntegral len) + +parseCompactStruct :: TypeMap -> Parser (Map.HashMap Int16 (LT.Text, ThriftVal)) +parseCompactStruct tmap = Map.fromList <$> parseFields 0 where parseFields :: Int16 -> Parser [(Int16, (LT.Text, ThriftVal))] parseFields lastId = do @@ -185,7 +189,9 @@ parseCompactStruct = Map.fromList <$> parseFields 0 else parseVarint zigZagToI16 val <- if ty == T_BOOL then return (TBool $ (w .&. 0x0F) == 0x01) - else parseCompactValue ty + else case (ty, Map.lookup fid tmap) of + (T_STRING, Just (_, T_BINARY)) -> parseCompactValue T_BINARY + _ -> parseCompactValue ty ((fid, (LT.empty, val)) : ) <$> parseFields fid parseCompactMap :: ThriftType -> ThriftType -> Int32 -> @@ -255,6 +261,7 @@ fromTType ty = case ty of T_I64 -> 0x06 T_DOUBLE -> 0x07 T_STRING -> 0x08 + T_BINARY -> 0x08 T_LIST{} -> 0x09 T_SET{} -> 0x0A T_MAP{} -> 0x0B @@ -271,6 +278,7 @@ typeOf v = case v of TI64 _ -> 0x06 TDouble _ -> 0x07 TString _ -> 0x08 + TBinary _ -> 0x08 TList{} -> 0x09 TSet{} -> 0x0A TMap{} -> 0x0B diff --git a/lib/hs/src/Thrift/Protocol/JSON.hs b/lib/hs/src/Thrift/Protocol/JSON.hs index ea6bcf3bbcc..7f619e8cbf1 100644 --- a/lib/hs/src/Thrift/Protocol/JSON.hs +++ b/lib/hs/src/Thrift/Protocol/JSON.hs @@ -33,6 +33,8 @@ import Control.Monad import Data.Attoparsec.ByteString as P import Data.Attoparsec.ByteString.Char8 as PC import Data.Attoparsec.ByteString.Lazy as LP +import Data.ByteString.Base64.Lazy as B64C +import Data.ByteString.Base64 as B64 import Data.ByteString.Lazy.Builder as B import Data.ByteString.Internal (c2w, w2c) import Data.Functor @@ -113,6 +115,7 @@ buildJSONValue (TI32 i) = buildShowable i buildJSONValue (TI64 i) = buildShowable i buildJSONValue (TDouble d) = buildShowable d buildJSONValue (TString s) = B.char8 '\"' <> escape s <> B.char8 '\"' +buildJSONValue (TBinary s) = B.char8 '\"' <> (B.lazyByteString . B64C.encode $ s) <> B.char8 '\"' buildJSONStruct :: Map.HashMap Int16 (LT.Text, ThriftVal) -> Builder buildJSONStruct = mconcat . intersperse (B.char8 ',') . Map.foldrWithKey buildField [] @@ -168,6 +171,7 @@ parseJSONValue T_I32 = TI32 <$> signed decimal parseJSONValue T_I64 = TI64 <$> signed decimal parseJSONValue T_DOUBLE = TDouble <$> double parseJSONValue T_STRING = TString <$> escapedString +parseJSONValue T_BINARY = TBinary <$> base64String parseJSONValue T_STOP = fail "parseJSONValue: cannot parse type T_STOP" parseJSONValue T_VOID = fail "parseJSONValue: cannot parse type T_VOID" @@ -182,6 +186,7 @@ parseAnyValue = choice $ , T_I64 , T_DOUBLE , T_STRING + , T_BINARY ] where skipBetween :: Char -> Char -> Parser () @@ -208,6 +213,7 @@ parseJSONMap kt vt = lexeme (PC.char8 ',') where parseJSONKey T_STRING = parseJSONValue T_STRING + parseJSONKey T_BINARY = parseJSONValue T_BINARY parseJSONKey kt = PC.char8 '"' *> parseJSONValue kt <* PC.char8 '"' parseJSONList :: ThriftType -> Parser [ThriftVal] @@ -218,6 +224,20 @@ escapedString = PC.char8 '"' *> (LBS.pack <$> P.many' (escapedChar <|> notChar8 '"')) <* PC.char8 '"' +base64String :: Parser LBS.ByteString +base64String = PC.char8 '"' *> + (decodeBase64 . LBSC.pack <$> P.many' (PC.notChar '"')) <* + PC.char8 '"' + where + decodeBase64 b = + let padded = case (LBS.length b) `mod` 4 of + 2 -> LBS.append b "==" + 3 -> LBS.append b "=" + _ -> b in + case B64C.decode padded of + Right s -> s + Left x -> error x + escapedChar :: Parser Word8 escapedChar = PC.char8 '\\' *> (c2w <$> choice [ '\SOH' <$ P.string "u0001" @@ -327,5 +347,6 @@ getTypeName ty = B.string8 $ case ty of T_I64 -> "i64" T_DOUBLE -> "dbl" T_STRING -> "str" + T_BINARY -> "str" _ -> error "Unrecognized Type" diff --git a/lib/hs/src/Thrift/Types.hs b/lib/hs/src/Thrift/Types.hs index b90c42c1785..8719e72b98c 100644 --- a/lib/hs/src/Thrift/Types.hs +++ b/lib/hs/src/Thrift/Types.hs @@ -53,6 +53,7 @@ data ThriftVal = TStruct (Map.HashMap Int16 (Text, ThriftVal)) | TI32 Int32 | TI64 Int64 | TString LBS.ByteString + | TBinary LBS.ByteString | TDouble Double deriving (Eq, Show) @@ -70,6 +71,7 @@ data ThriftType | T_I32 | T_I64 | T_STRING + | T_BINARY | T_STRUCT TypeMap | T_MAP ThriftType ThriftType | T_SET ThriftType @@ -89,6 +91,7 @@ instance Enum ThriftType where fromEnum T_I32 = 8 fromEnum T_I64 = 10 fromEnum T_STRING = 11 + fromEnum T_BINARY = 11 fromEnum (T_STRUCT _) = 12 fromEnum (T_MAP _ _) = 13 fromEnum (T_SET _) = 14 @@ -103,6 +106,7 @@ instance Enum ThriftType where toEnum 8 = T_I32 toEnum 10 = T_I64 toEnum 11 = T_STRING + -- toEnum 11 = T_BINARY toEnum 12 = T_STRUCT Map.empty toEnum 13 = T_MAP T_VOID T_VOID toEnum 14 = T_SET T_VOID diff --git a/lib/hs/test/BinarySpec.hs b/lib/hs/test/BinarySpec.hs index 50396101ad8..d692fabe37a 100644 --- a/lib/hs/test/BinarySpec.hs +++ b/lib/hs/test/BinarySpec.hs @@ -66,3 +66,26 @@ spec = do writeVal proto (TString val) bin <- tRead trans 7 (LBS.unpack bin) `shouldBe` [0, 0, 0, 3, 97, 97, 97] + + describe "binary" $ do + it "writes" $ do + trans <- openMemoryBuffer + let proto = BinaryProtocol trans + writeVal proto (TBinary $ LBS.pack [42, 43, 44]) + bin <- tRead trans 100 + (LBS.unpack bin) `shouldBe` [0, 0, 0, 3, 42, 43, 44] + + it "reads" $ do + trans <- openMemoryBuffer + let proto = BinaryProtocol trans + tWrite trans $ LBS.pack [0, 0, 0, 3, 42, 43, 44] + val <- readVal proto (T_BINARY) + val `shouldBe` (TBinary $ LBS.pack [42, 43, 44]) + + prop "round trip" $ \val -> do + trans <- openMemoryBuffer + let proto = BinaryProtocol trans + writeVal proto (TBinary $ LBS.pack val) + val2 <- readVal proto (T_BINARY) + val2 `shouldBe` (TBinary $ LBS.pack val) + diff --git a/lib/hs/test/CompactSpec.hs b/lib/hs/test/CompactSpec.hs index 22708b43299..5540e7b5ee8 100644 --- a/lib/hs/test/CompactSpec.hs +++ b/lib/hs/test/CompactSpec.hs @@ -56,3 +56,26 @@ spec = do writeVal proto $ TDouble val val2 <- readVal proto T_DOUBLE val2 `shouldBe` (TDouble val) + + describe "binary" $ do + it "writes" $ do + trans <- openMemoryBuffer + let proto = CompactProtocol trans + writeVal proto (TBinary $ LBS.pack [42, 43, 44]) + bin <- tRead trans 100 + (LBS.unpack bin) `shouldBe` [3, 42, 43, 44] + + it "reads" $ do + trans <- openMemoryBuffer + let proto = CompactProtocol trans + tWrite trans $ LBS.pack [3, 42, 43, 44] + val <- readVal proto (T_BINARY) + val `shouldBe` (TBinary $ LBS.pack [42, 43, 44]) + + prop "round trip" $ \val -> do + trans <- openMemoryBuffer + let proto = CompactProtocol trans + writeVal proto (TBinary $ LBS.pack val) + val2 <- readVal proto (T_BINARY) + val2 `shouldBe` (TBinary $ LBS.pack val) + diff --git a/lib/hs/test/JSONSpec.hs b/lib/hs/test/JSONSpec.hs index 079be0205e6..022c8265e81 100644 --- a/lib/hs/test/JSONSpec.hs +++ b/lib/hs/test/JSONSpec.hs @@ -22,6 +22,7 @@ module JSONSpec where import Test.Hspec import Test.Hspec.QuickCheck (prop) +import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.Char8 as C import Thrift.Types @@ -82,6 +83,35 @@ spec = do val2 <- readVal proto (T_STRING) val2 `shouldBe` (TString $ C.pack val) + describe "binary" $ do + it "writes with padding" $ do + trans <- openMemoryBuffer + let proto = JSONProtocol trans + writeVal proto (TBinary $ LBS.pack [1]) + bin <- tRead trans 100 + (C.unpack bin) `shouldBe` "\"AQ==\"" + + it "reads with padding" $ do + trans <- openMemoryBuffer + let proto = JSONProtocol trans + tWrite trans $ C.pack "\"AQ==\"" + val <- readVal proto (T_BINARY) + val `shouldBe` (TBinary $ LBS.pack [1]) + + it "reads without padding" $ do + trans <- openMemoryBuffer + let proto = JSONProtocol trans + tWrite trans $ C.pack "\"AQ\"" + val <- readVal proto (T_BINARY) + val `shouldBe` (TBinary $ LBS.pack [1]) + + prop "round trip" $ \val -> do + trans <- openMemoryBuffer + let proto = JSONProtocol trans + writeVal proto (TBinary $ LBS.pack val) + val2 <- readVal proto (T_BINARY) + val2 `shouldBe` (TBinary $ LBS.pack val) + describe "list" $ do it "writes empty list" $ do trans <- openMemoryBuffer diff --git a/test/crossrunner/report.py b/test/crossrunner/report.py index defc486b61c..3f9100226de 100644 --- a/test/crossrunner/report.py +++ b/test/crossrunner/report.py @@ -57,7 +57,7 @@ def collect_failures(results): fails = known fails_json = json.dumps(sorted(set(fails)), indent=2, separators=(',', ': ')) if save: - with open(os.path.join(testdir, FAIL_JSON % platform.system()), 'w+') as fp: + with logfile_open(os.path.join(testdir, FAIL_JSON % platform.system()), 'w+') as fp: fp.write(fails_json) sys.stdout.write('Successfully updated known failures.\n') if out: @@ -180,7 +180,7 @@ def match(line): return False def _open(self): - self.out = open(self.logpath, 'w+') + self.out = logfile_open(self.logpath, 'w+') def _close(self): self.out.close() @@ -324,7 +324,7 @@ def _render_result(self, test): def _write_html_data(self): """Writes JSON data to be read by result html""" results = [self._render_result(r) for r in self._tests] - with open(self.out_path, 'w+') as fp: + with logfile_open(self.out_path, 'w+') as fp: fp.write(json.dumps({ 'date': self._format_date(), 'revision': str(self._revision), @@ -343,7 +343,7 @@ def add_prog_log(fp, test, prog_kind): with logfile_open(path, 'r') as prog_fp: print(prog_fp.read(), file=fp) filename = title.replace(' ', '_') + '.log' - with open(os.path.join(self.logdir, filename), 'w+') as fp: + with logfile_open(os.path.join(self.logdir, filename), 'w+') as fp: for test in map(self._tests.__getitem__, indexes): fp.write('TEST: [%s]\n' % test.name) add_prog_log(fp, test, test.server.kind) diff --git a/test/hs/DebugProtoTest_Main.hs b/test/hs/DebugProtoTest_Main.hs old mode 100755 new mode 100644 diff --git a/test/hs/TestClient.hs b/test/hs/TestClient.hs index 0ebc0fd0a1e..d1ebb3cd076 100644 --- a/test/hs/TestClient.hs +++ b/test/hs/TestClient.hs @@ -168,13 +168,13 @@ runClient p = do } putStrLn "testNest" nestOut <- Client.testNest prot nestIn - when (nestIn /= nestOut) exitSuccess + when (nestIn /= nestOut) exitFailure -- Map Test let mapIn = Map.fromList $ map (\i -> (i, i-10)) [1..5] putStrLn "testMap" mapOut <- Client.testMap prot mapIn - when (mapIn /= mapOut) exitSuccess + when (mapIn /= mapOut) exitFailure -- Set Test let setIn = Set.fromList [-2..3] diff --git a/test/hs/TestServer.hs b/test/hs/TestServer.hs old mode 100755 new mode 100644 diff --git a/test/hs/ThriftTest_Main.hs b/test/hs/ThriftTest_Main.hs old mode 100755 new mode 100644 diff --git a/test/known_failures_Linux.json b/test/known_failures_Linux.json index 3e9240f797a..be51eccdae3 100644 --- a/test/known_failures_Linux.json +++ b/test/known_failures_Linux.json @@ -7,9 +7,6 @@ "cpp-cpp_json_http-ip", "cpp-dart_binary_http-ip", "cpp-dart_json_http-ip", - "cpp-hs_json_buffered-ip", - "cpp-hs_json_framed-ip", - "cpp-hs_json_http-ip", "cpp-java_binary_http-ip", "cpp-java_binary_http-ip-ssl", "cpp-java_compact_http-ip", @@ -65,8 +62,6 @@ "hs-csharp_json_framed-ip", "hs-dart_binary_framed-ip", "hs-dart_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", @@ -74,12 +69,6 @@ "java-perl_binary_buffered-ip-ssl", "java-perl_binary_fastframed-framed-ip-ssl", "java-perl_binary_framed-ip-ssl", - "nodejs-hs_binary_buffered-ip", - "nodejs-hs_binary_framed-ip", - "nodejs-hs_compact_buffered-ip", - "nodejs-hs_compact_framed-ip", - "nodejs-hs_json_buffered-ip", - "nodejs-hs_json_framed-ip", "nodejs-perl_binary_buffered-ip-ssl", "nodejs-perl_binary_framed-ip-ssl", "perl-perl_binary_buffered-ip-ssl", diff --git a/test/tests.json b/test/tests.json index be7d52bbf89..c816d6ef590 100644 --- a/test/tests.json +++ b/test/tests.json @@ -181,6 +181,7 @@ "timeout": 10, "command": [ "TestClient.py", + "--verbose", "--host=localhost", "--genpydir=gen-py" ]