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