Gitiles
Code Review Sign In
gerrit.mcp.mirantis.com / packaging / sources / thrift / 4bc4231040186d9e0c35ff4d8211ce7b7e43aab5 / . / lib / hs / src / TBinaryProtocol.hs
blob: ff0df1627a63e418cefaa3c10eb674f6dec482b3 [file] [log] [blame]
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]1module TBinaryProtocol (TBinaryProtocol(..)) where
2 import Thrift
3 import Data.Bits
4 import Data.Int
5 import GHC.Exts
6 import GHC.Prim
7 import GHC.Word
8 import Control.Exception
9
iproctor55aebc42008-02-11 22:59:01 +0000[diff] [blame]10 data TBinaryProtocol a = TTransport a => TBinaryProtocol a
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]11
12 version_mask = 0xffff0000
13 version_1 = 0x80010000;
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]14
Bryan Duxburyf3c83cf2009-03-24 00:34:16 +0000[diff] [blame]15 getByte :: Bits a => a -> Int -> a
16 getByte i b = 255 .&. (shiftR i (8*b))
17
18 getBytes :: (Bits a, Integral a) => a -> Int -> String
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]19 getBytes i 0 = []
Bryan Duxburyf3c83cf2009-03-24 00:34:16 +0000[diff] [blame]20 getBytes i n = (toEnum $ fromIntegral $ getByte i (n-1)):(getBytes i (n-1))
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]21
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]22 floatBits :: Double -> Word64
23 floatBits (D# d#) = W64# (unsafeCoerce# d#)
24
25 floatOfBits :: Word64 -> Double
26 floatOfBits (W64# b#) = D# (unsafeCoerce# b#)
27
28 composeBytesH :: [Char] -> Int -> Word32
29 composeBytesH [] n = 0
30 composeBytesH (h:t) n = (shiftL (fromIntegral (fromEnum h) :: Word32) (8*n)) .|. (composeBytesH t (n-1))
31 compBytes :: [Char] -> Word32
32 compBytes b = composeBytesH b ((length b)-1)
33
34 composeBytes64H :: [Char] -> Int -> Word64
35 composeBytes64H [] n = 0
36 composeBytes64H (h:t) n = (shiftL (fromIntegral (fromEnum h) :: Word64) (8*n)) .|. (composeBytes64H t (n-1))
37 compBytes64 :: [Char] -> Word64
38 compBytes64 b = composeBytes64H b ((length b)-1)
iproctor55aebc42008-02-11 22:59:01 +0000[diff] [blame]39 instance Protocol TBinaryProtocol where
40 getTransport (TBinaryProtocol t) = t
41 writeBool (TBinaryProtocol tr) b = twrite tr (if b then [toEnum 1::Char] else [toEnum 0::Char])
42 writeByte (TBinaryProtocol tr) b = twrite tr (getBytes b 1)
43 writeI16 (TBinaryProtocol tr) b = twrite tr (getBytes b 2)
44 writeI32 (TBinaryProtocol tr) b = twrite tr (getBytes b 4)
45 writeI64 (TBinaryProtocol tr) b = twrite tr (getBytes b 8)
Bryan Duxburyf3c83cf2009-03-24 00:34:16 +0000[diff] [blame]46 writeDouble (TBinaryProtocol tr) b = writeI64 (TBinaryProtocol tr) (fromIntegral (floatBits b) :: Int64)
iproctor55aebc42008-02-11 22:59:01 +0000[diff] [blame]47 writeString (TBinaryProtocol tr) s = do twrite tr (getBytes (length s) 4)
48 twrite tr s
49 writeBinary = writeString
50 writeMessageBegin (TBinaryProtocol tr) (n,t,s) = do writeI32 (TBinaryProtocol tr) (version_1 .|. (fromEnum t))
51 writeString (TBinaryProtocol tr) n
52 writeI32 (TBinaryProtocol tr) s
53 writeMessageEnd (TBinaryProtocol tr) = return ()
54 writeStructBegin (TBinaryProtocol tr) s = return ()
55 writeStructEnd (TBinaryProtocol tr) = return ()
56 writeFieldBegin a (n,t,i) = do writeByte a (fromEnum t)
57 writeI16 a i
58 writeFieldEnd a = return ()
59 writeFieldStop a = writeByte a (fromEnum T_STOP)
60 writeMapBegin a (k,v,s) = do writeByte a (fromEnum k)
61 writeByte a (fromEnum v)
62 writeI32 a s
63 writeMapEnd a = return ()
64 writeListBegin a (t,s) = do writeByte a (fromEnum t)
65 writeI32 a s
66 writeListEnd a = return ()
67 writeSetBegin = writeListBegin
68 writeSetEnd a = return ()
69 readByte (TBinaryProtocol tr) = do b <- treadAll tr 1
70 return $ (fromIntegral (fromIntegral (compBytes b) :: Int8) :: Int)
71 readI16 (TBinaryProtocol tr) = do b <- treadAll tr 2
72 return $ (fromIntegral (fromIntegral (compBytes b) :: Int16) :: Int)
73 readI32 (TBinaryProtocol tr) = do b <- treadAll tr 4
74 return $ (fromIntegral (fromIntegral (compBytes b) :: Int32) :: Int)
75 readI64 (TBinaryProtocol tr) = do b <- treadAll tr 8
Bryan Duxburyf3c83cf2009-03-24 00:34:16 +0000[diff] [blame]76 return $ (fromIntegral (compBytes64 b) :: Int64)
iproctor55aebc42008-02-11 22:59:01 +0000[diff] [blame]77 readDouble (TBinaryProtocol tr) = do b <- readI64 (TBinaryProtocol tr)
78 return $ floatOfBits (fromIntegral b :: Word64)
79 readBool (TBinaryProtocol tr) = do b <- readByte (TBinaryProtocol tr)
80 return $ b == 1
81 readString (TBinaryProtocol tr) = do l <- readI32 (TBinaryProtocol tr)
82 treadAll tr l
83 readBinary = readString
84 readMessageBegin (TBinaryProtocol tr) = do ver <- readI32 (TBinaryProtocol tr)
85 if (ver .&. version_mask /= version_1) then
86 throwDyn (ProtocolExn PE_BAD_VERSION "Missing version identifier")
87 else do
88 s <- readString (TBinaryProtocol tr)
89 sz <- readI32 (TBinaryProtocol tr)
90 return (s,toEnum (ver .&. 0xFF) :: Message_type,fromIntegral sz :: Int)
91 readMessageEnd (TBinaryProtocol tr) = return ()
92 readStructBegin (TBinaryProtocol tr) = return ""
93 readStructEnd (TBinaryProtocol tr) = return ()
94 readFieldBegin (TBinaryProtocol tr) = do t <- readByte (TBinaryProtocol tr)
95 if (toEnum t :: T_type) /= T_STOP then
96 do s <- readI16 (TBinaryProtocol tr)
97 return ("",toEnum t :: T_type,fromIntegral s :: Int)
98 else return ("",toEnum t :: T_type,0)
99 readFieldEnd (TBinaryProtocol tr) = return ()
100 readMapBegin a = do kt <- readByte a
101 vt <- readByte a
102 s <- readI32 a
103 return (toEnum kt :: T_type,toEnum vt :: T_type,fromIntegral s :: Int)
104 readMapEnd a = return ()
105 readListBegin a = do b <- readByte a
106 s <- readI32 a
107 return (toEnum b :: T_type,fromIntegral s :: Int)
108 readListEnd a = return ()
109 readSetBegin = readListBegin
110 readSetEnd = readListEnd
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]111
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]112
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]113