Gitiles
Code Review Sign In
gerrit.mcp.mirantis.com / packaging / sources / thrift / ff8eb9288d57845319b65f1bfd3d4a13cecc3217 / . / lib / hs / src / Thrift.hs
blob: 4087b2ba40928ffecc83b96cefb283812d459a31 [file] [log] [blame]
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame^]1module Thrift (TransportExn(..),TransportExn_Type(..),TTransport(..), T_type(..), Message_type(..), Protocol(..), AE_type(..), AppExn(..), readAppExn,writeAppExn,Thrift_exception(..), ProtocolExn(..), PE_type(..)) where
2 import Data.Generics
3 import Data.Int
4 import Control.Exception
5
6 data Thrift_exception = Thrift_Error deriving Typeable
7
8 data TransportExn_Type = TE_UNKNOWN
9 | TE_NOT_OPEN
10 | TE_ALREADY_OPEN
11 | TE_TIMED_OUT
12 | TE_END_OF_FILE
13 deriving (Eq,Typeable,Show)
14
15 data TransportExn = TransportExn [Char] TransportExn_Type deriving (Show,Typeable)
16
17 class TTransport a where
18 tisOpen :: a -> Bool
19 topen :: a -> IO a
20 tclose :: a -> IO a
21 tread :: a -> Int -> IO [Char]
22 twrite :: a -> [Char] ->IO ()
23 tflush :: a -> IO ()
24 treadAll :: a -> Int -> IO [Char]
25 treadAll a 0 = return []
26 treadAll a len =
27 do ret <- tread a len
28 case ret of
29 [] -> throwDyn (TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN)
30 _ -> do
31 rl <- return (length ret)
32 if len <= rl then
33 return ret
34 else do r <- treadAll a (len-rl)
35 return (ret++r)
36
37
38 data T_type = T_STOP
39 | T_VOID
40 | T_BOOL
41 | T_BYTE
42 | T_I08
43 | T_I16
44 | T_I32
45 | T_U64
46 | T_I64
47 | T_DOUBLE
48 | T_STRING
49 | T_UTF7
50 | T_STRUCT
51 | T_MAP
52 | T_SET
53 | T_LIST
54 | T_UTF8
55 | T_UTF16
56 | T_UNKNOWN
57 deriving (Eq)
58 instance Enum T_type where
59 fromEnum t = case t of
60 T_STOP -> 0
61 T_VOID -> 1
62 T_BOOL -> 2
63 T_BYTE -> 3
64 T_I08 -> 3
65 T_I16 -> 6
66 T_I32 -> 8
67 T_U64 -> 9
68 T_I64 -> 10
69 T_DOUBLE -> 4
70 T_STRING -> 11
71 T_UTF7 -> 11
72 T_STRUCT -> 12
73 T_MAP -> 13
74 T_SET -> 14
75 T_LIST -> 15
76 T_UTF8 -> 16
77 T_UTF16 -> 17
78 T_UNKNOWN -> -1
79 toEnum t = case t of
80 0 -> T_STOP
81 1 -> T_VOID
82 2 -> T_BOOL
83 3 -> T_BYTE
84 6-> T_I16
85 8 -> T_I32
86 9 -> T_U64
87 10 -> T_I64
88 4 -> T_DOUBLE
89 11 -> T_STRING
90 12 -> T_STRUCT
91 13 -> T_MAP
92 14 -> T_SET
93 15 -> T_LIST
94 16 -> T_UTF8
95 17 -> T_UTF16
96 _ -> T_UNKNOWN
97
98
99 data Message_type = M_CALL
100 | M_REPLY
101 | M_EXCEPTION
102 | M_UNKNOWN
103 deriving Eq
104 instance Enum Message_type where
105
106 fromEnum t = case t of
107 M_CALL -> 1
108 M_REPLY -> 2
109 M_EXCEPTION -> 3
110 M_UNKNOWN -> -1
111
112 toEnum t = case t of
113 1 -> M_CALL
114 2 -> M_REPLY
115 3 -> M_EXCEPTION
116 _ -> M_UNKNOWN
117
118
119
120
121 class Protocol a where
122 pflush :: a -> IO ()
123 writeMessageBegin :: a -> ([Char],Message_type,Int) -> IO ()
124 writeMessageEnd :: a -> IO ()
125 writeStructBegin :: a -> [Char] -> IO ()
126 writeStructEnd :: a -> IO ()
127 writeFieldBegin :: a -> ([Char], T_type,Int) -> IO ()
128 writeFieldEnd :: a -> IO ()
129 writeFieldStop :: a -> IO ()
130 writeMapBegin :: a -> (T_type,T_type,Int) -> IO ()
131 writeMapEnd :: a -> IO ()
132 writeListBegin :: a -> (T_type,Int) -> IO ()
133 writeListEnd :: a -> IO ()
134 writeSetBegin :: a -> (T_type,Int) -> IO ()
135 writeSetEnd :: a -> IO ()
136 writeBool :: a -> Bool -> IO ()
137 writeByte :: a -> Int -> IO ()
138 writeI16 :: a -> Int -> IO ()
139 writeI32 :: a -> Int -> IO ()
140 writeI64 :: a -> Int -> IO ()
141 writeDouble :: a -> Double -> IO ()
142 writeString :: a -> [Char] -> IO ()
143 writeBinary :: a -> [Char] -> IO ()
144 readMessageBegin :: a -> IO ([Char],Message_type,Int)
145 readMessageEnd :: a -> IO ()
146 readStructBegin :: a -> IO [Char]
147 readStructEnd :: a -> IO ()
148 readFieldBegin :: a -> IO ([Char],T_type,Int)
149 readFieldEnd :: a -> IO ()
150 readMapBegin :: a -> IO (T_type,T_type,Int)
151 readMapEnd :: a -> IO ()
152 readListBegin :: a -> IO (T_type,Int)
153 readListEnd :: a -> IO ()
154 readSetBegin :: a -> IO (T_type,Int)
155 readSetEnd :: a -> IO ()
156 readBool :: a -> IO Bool
157 readByte :: a -> IO Int
158 readI16 :: a -> IO Int
159 readI32 :: a -> IO Int
160 readI64 :: a -> IO Int
161 readDouble :: a -> IO Double
162 readString :: a -> IO [Char]
163 readBinary :: a -> IO [Char]
164 skipFields :: a -> IO ()
165 skipMapEntries :: a -> Int -> T_type -> T_type -> IO ()
166 skipSetEntries :: a -> Int -> T_type -> IO ()
167 skip :: a -> T_type -> IO ()
168 skipFields a = do (_,ty,_) <- readFieldBegin a
169 if ty == T_STOP then
170 return ()
171 else do skip a ty
172 readFieldEnd a
173 skipFields a
174 skipMapEntries a n k v= if n == 0 then
175 return ()
176 else do skip a k
177 skip a v
178 skipMapEntries a (n-1) k v
179 skipSetEntries a n k = if n == 0 then
180 return ()
181 else do skip a k
182 skipSetEntries a (n-1) k
183 skip a typ = case typ of
184 T_STOP -> return ()
185 T_VOID -> return ()
186 T_BOOL -> do readBool a
187 return ()
188 T_BYTE -> do readByte a
189 return ()
190 T_I08 -> do readByte a
191 return ()
192 T_I16 -> do readI16 a
193 return ()
194 T_I32 -> do readI32 a
195 return ()
196 T_U64 -> do readI64 a
197 return ()
198 T_I64 -> do readI64 a
199 return ()
200 T_DOUBLE -> do readDouble a
201 return ()
202 T_STRING -> do readString a
203 return ()
204 T_UTF7 -> return ()
205 T_STRUCT -> do readStructBegin a
206 skipFields a
207 readStructEnd a
208 return ()
209 T_MAP -> do (k,v,s) <- readMapBegin a
210 skipMapEntries a s k v
211 readMapEnd a
212 return ()
213 T_SET -> do (ty,s) <- readSetBegin a
214 skipSetEntries a s ty
215 readSetEnd a
216 return ()
217 T_LIST -> do (ty,s) <- readListBegin a
218 skipSetEntries a s ty
219 readListEnd a
220 return ()
221 T_UTF8 -> return ()
222 T_UTF16 -> return ()
223 T_UNKNOWN -> return ()
224
225
226 data PE_type = PE_UNKNOWN
227 | PE_INVALID_DATA
228 | PE_NEGATIVE_SIZE
229 | PE_SIZE_LIMIT
230 | PE_BAD_VERSION
231 deriving (Eq, Data, Typeable)
232
233 data ProtocolExn = ProtocolExn PE_type [Char] deriving (Typeable, Data)
234
235 data AE_type = AE_UNKNOWN
236 | AE_UNKNOWN_METHOD
237 | AE_INVALID_MESSAGE_TYPE
238 | AE_WRONG_METHOD_NAME
239 | AE_BAD_SEQUENCE_ID
240 | AE_MISSING_RESULT
241 deriving (Eq, Data, Typeable)
242
243 instance Enum AE_type where
244 toEnum i = case i of
245 0 -> AE_UNKNOWN
246 1 -> AE_UNKNOWN_METHOD
247 2 -> AE_INVALID_MESSAGE_TYPE
248 3 -> AE_WRONG_METHOD_NAME
249 4 -> AE_BAD_SEQUENCE_ID
250 5 -> AE_MISSING_RESULT
251 _ -> AE_UNKNOWN
252 fromEnum t = case t of
253 AE_UNKNOWN -> 0
254 AE_UNKNOWN_METHOD -> 1
255 AE_INVALID_MESSAGE_TYPE -> 2
256 AE_WRONG_METHOD_NAME -> 3
257 AE_BAD_SEQUENCE_ID -> 4
258 AE_MISSING_RESULT -> 5
259
260 data AppExn = AppExn {ae_type :: AE_type, ae_message :: [Char]} deriving (Typeable, Data)
261
262 readAppExnFields pt rec = do (n,ft,id) <- readFieldBegin pt
263 if ft == T_STOP then return rec
264 else
265 case id of
266 1 -> if ft == T_STRING then
267 do s <- readString pt
268 readAppExnFields pt rec{ae_message = s}
269 else do skip pt ft
270 readAppExnFields pt rec
271 2 -> if ft == T_I32 then
272 do i <- readI32 pt
273 readAppExnFields pt rec{ae_type = (toEnum i)}
274 else do skip pt ft
275 readAppExnFields pt rec
276 _ -> do skip pt ft
277 readFieldEnd pt
278 readAppExnFields pt rec
279
280 readAppExn pt = do readStructBegin pt
281 rec <- readAppExnFields pt (AppExn {ae_type = undefined, ae_message = undefined})
282 readStructEnd pt
283 return rec
284
285
286 writeAppExn pt ae = do writeStructBegin pt "TApplicationException"
287 if ae_message ae /= "" then
288 do writeFieldBegin pt ("message",T_STRING,1)
289 writeString pt (ae_message ae)
290 writeFieldEnd pt
291 else return ()
292 writeFieldBegin pt ("type",T_I32,2);
293 writeI32 pt (fromEnum (ae_type ae))
294 writeFieldEnd pt
295 writeFieldStop pt
296 writeStructEnd pt
297
298