commit e68ccc23bebde961767e47e6751dcf764b8503f2
author Nobuaki Sukegawa <nsuke@apache.org> Sun Dec 13 21:45:39 2015 +0900
committer Nobuaki Sukegawa <nsuke@apache.org> Sun Dec 13 23:48:22 2015 +0900
tree 9112b830eedaffd1fc1c22cb14f2504a5bd42a6d
parent ef2b5285f3be08e52000a60d3de2e2f8a30f892b

THRIFT-3482 Haskell JSON protocol does not encode binary field as Base64

lib/hs/src/Thrift/Protocol/JSON.hs

diff --git a/lib/hs/src/Thrift/Protocol/JSON.hs b/lib/hs/src/Thrift/Protocol/JSON.hs
index ea6bcf3..7f619e8 100644
--- a/lib/hs/src/Thrift/Protocol/JSON.hs
+++ b/lib/hs/src/Thrift/Protocol/JSON.hs
@@ -33,6 +33,8 @@
 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 (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_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 @@
                   , T_I64
                   , T_DOUBLE
                   , T_STRING
+                  , T_BINARY
                   ]
   where
     skipBetween :: Char -> Char -> Parser ()
@@ -208,6 +213,7 @@
   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 @@
                 (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 @@
   T_I64      -> "i64"
   T_DOUBLE   -> "dbl"
   T_STRING   -> "str"
+  T_BINARY   -> "str"
   _ -> error "Unrecognized Type"