THRIFT-3433 Doubles aren't interpreted correctly
Client: Haskell
Patch: Nobuaki Sukegawa
This closes #736
diff --git a/lib/hs/src/Thrift/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs
index ea58642..31e48b5 100644
--- a/lib/hs/src/Thrift/Protocol.hs
+++ b/lib/hs/src/Thrift/Protocol.hs
@@ -29,6 +29,7 @@
, versionMask
, version1
, bsToDouble
+ , bsToDoubleLE
) where
import Control.Exception
@@ -119,18 +120,22 @@
-- therefore the behavior of this function varies based on whether the local
-- machine is big endian or little endian.
bsToDouble :: BS.ByteString -> Double
-bsToDouble bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBs
- where
+bsToDoubleLE :: BS.ByteString -> Double
#if __BYTE_ORDER == __LITTLE_ENDIAN
- castBs chrPtr = do
- w <- peek (castPtr chrPtr)
- poke (castPtr chrPtr) (byteSwap w)
- peek (castPtr chrPtr)
+bsToDouble bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBsSwapped
+bsToDoubleLE bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBs
#else
- castBs = peek . castPtr
+bsToDouble bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBs
+bsToDoubleLE bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBsSwapped
#endif
-#if __BYTE_ORDER == __LITTLE_ENDIAN
+
+castBsSwapped chrPtr = do
+ w <- peek (castPtr chrPtr)
+ poke (castPtr chrPtr) (byteSwap w)
+ peek (castPtr chrPtr)
+castBs = peek . castPtr
+
-- | Swap endianness of a 64-bit word
byteSwap :: Word64 -> Word64
byteSwap w = (w `shiftL` 56 .&. 0xFF00000000000000) .|.
@@ -141,4 +146,3 @@
(w `shiftR` 24 .&. 0x0000000000FF0000) .|.
(w `shiftR` 40 .&. 0x000000000000FF00) .|.
(w `shiftR` 56 .&. 0x00000000000000FF)
-#endif
diff --git a/lib/hs/src/Thrift/Protocol/Compact.hs b/lib/hs/src/Thrift/Protocol/Compact.hs
index a329f4e..759466b 100644
--- a/lib/hs/src/Thrift/Protocol/Compact.hs
+++ b/lib/hs/src/Thrift/Protocol/Compact.hs
@@ -55,7 +55,7 @@
data CompactProtocol a = CompactProtocol a
-- ^ Constuct a 'CompactProtocol' with a 'Transport'
-protocolID, version, typeMask :: Int8
+protocolID, version, versionMask, typeMask, typeBits :: Word8
protocolID = 0x82 -- 1000 0010
version = 0x01
versionMask = 0x1f -- 0001 1111
@@ -69,8 +69,8 @@
getTransport (CompactProtocol t) = t
writeMessageBegin p (n, t, s) = tWrite (getTransport p) $ toLazyByteString $
- B.int8 protocolID <>
- B.int8 ((version .&. versionMask) .|.
+ B.word8 protocolID <>
+ B.word8 ((version .&. versionMask) .|.
(((fromIntegral $ fromEnum t) `shiftL`
typeShiftAmount) .&. typeMask)) <>
buildVarint (i32ToZigZag s) <>
@@ -120,7 +120,7 @@
buildCompactValue (TI16 i) = buildVarint $ i16ToZigZag i
buildCompactValue (TI32 i) = buildVarint $ i32ToZigZag i
buildCompactValue (TI64 i) = buildVarint $ i64ToZigZag i
-buildCompactValue (TDouble d) = doubleBE d
+buildCompactValue (TDouble d) = doubleLE d
buildCompactValue (TString s) = buildVarint len <> lazyByteString s
where
len = fromIntegral (LBS.length s) :: Word32
@@ -163,7 +163,7 @@
parseCompactValue T_I16 = TI16 <$> parseVarint zigZagToI16
parseCompactValue T_I32 = TI32 <$> parseVarint zigZagToI32
parseCompactValue T_I64 = TI64 <$> parseVarint zigZagToI64
-parseCompactValue T_DOUBLE = TDouble . bsToDouble <$> P.take 8
+parseCompactValue T_DOUBLE = TDouble . bsToDoubleLE <$> P.take 8
parseCompactValue T_STRING = do
len :: Word32 <- parseVarint id
TString . LBS.fromStrict <$> P.take (fromIntegral len)
diff --git a/lib/hs/src/Thrift/Transport/Memory.hs b/lib/hs/src/Thrift/Transport/Memory.hs
new file mode 100644
index 0000000..1c93af6
--- /dev/null
+++ b/lib/hs/src/Thrift/Transport/Memory.hs
@@ -0,0 +1,77 @@
+--
+-- 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 Thrift.Transport.Memory
+ ( openMemoryBuffer
+ , MemoryBuffer(..)
+ ) where
+
+import Data.ByteString.Lazy.Builder
+import Data.Functor
+import Data.IORef
+import Data.Monoid
+import qualified Data.ByteString.Lazy as LBS
+
+import Thrift.Transport
+
+
+data MemoryBuffer = MemoryBuffer {
+ writeBuffer :: IORef Builder,
+ readBuffer :: IORef LBS.ByteString
+}
+
+openMemoryBuffer :: IO MemoryBuffer
+openMemoryBuffer = do
+ wbuf <- newIORef mempty
+ rbuf <- newIORef mempty
+ return MemoryBuffer {
+ writeBuffer = wbuf,
+ readBuffer = rbuf
+ }
+
+instance Transport MemoryBuffer where
+ tIsOpen = const $ return False
+ tClose = const $ return ()
+ tFlush trans = do
+ let wBuf = writeBuffer trans
+ wb <- readIORef wBuf
+ modifyIORef (readBuffer trans) $ \rb -> mappend rb $ toLazyByteString wb
+ writeIORef wBuf mempty
+
+ tRead _ 0 = return mempty
+ tRead trans n = do
+ let rbuf = readBuffer trans
+ rb <- readIORef rbuf
+ let len = fromIntegral $ LBS.length rb
+ if len == 0
+ then do
+ tFlush trans
+ rb2 <- readIORef (readBuffer trans)
+ if (fromIntegral $ LBS.length rb2) == 0
+ then return mempty
+ else tRead trans n
+ else do
+ let (ret, remain) = LBS.splitAt (fromIntegral n) rb
+ writeIORef rbuf remain
+ return ret
+
+ tPeek trans = (fmap fst . LBS.uncons) <$> readIORef (readBuffer trans)
+
+ tWrite trans v = do
+ modifyIORef (writeBuffer trans) (<> lazyByteString v)