Gitiles
Code Review Sign In
gerrit.mcp.mirantis.com / packaging / sources / thrift / 1adbab031d1a452653a37c8bc220bddee334ff8d / . / lib / hs / src / Thrift.hs
blob: b3ce8a4044c2fcfd0186c454ba0605b9fdbf3686 [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
121 | M_UNKNOWN
122 deriving Eq
123 instance Enum Message_type where
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]124
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]125 fromEnum t = case t of
126 M_CALL -> 1
127 M_REPLY -> 2
128 M_EXCEPTION -> 3
129 M_UNKNOWN -> -1
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]130
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]131 toEnum t = case t of
132 1 -> M_CALL
133 2 -> M_REPLY
134 3 -> M_EXCEPTION
135 _ -> M_UNKNOWN
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]136
137
138
139
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]140 class Protocol a where
iproctor55aebc42008-02-11 22:59:01 +0000[diff] [blame]141 getTransport :: TTransport t => a t -> t
142 writeMessageBegin :: TTransport t => a t -> ([Char],Message_type,Int) -> IO ()
143 writeMessageEnd :: TTransport t => a t -> IO ()
144 writeStructBegin :: TTransport t => a t -> [Char] -> IO ()
145 writeStructEnd :: TTransport t => a t -> IO ()
146 writeFieldBegin :: TTransport t => a t -> ([Char], T_type,Int) -> IO ()
147 writeFieldEnd :: TTransport t => a t -> IO ()
148 writeFieldStop :: TTransport t => a t -> IO ()
149 writeMapBegin :: TTransport t => a t -> (T_type,T_type,Int) -> IO ()
150 writeMapEnd :: TTransport t => a t -> IO ()
151 writeListBegin :: TTransport t => a t -> (T_type,Int) -> IO ()
152 writeListEnd :: TTransport t => a t -> IO ()
153 writeSetBegin :: TTransport t => a t -> (T_type,Int) -> IO ()
154 writeSetEnd :: TTransport t => a t -> IO ()
155 writeBool :: TTransport t => a t -> Bool -> IO ()
156 writeByte :: TTransport t => a t -> Int -> IO ()
157 writeI16 :: TTransport t => a t -> Int -> IO ()
158 writeI32 :: TTransport t => a t -> Int -> IO ()
Bryan Duxburyf3c83cf2009-03-24 00:34:16 +0000[diff] [blame]159 writeI64 :: TTransport t => a t -> Int64 -> IO ()
iproctor55aebc42008-02-11 22:59:01 +0000[diff] [blame]160 writeDouble :: TTransport t => a t -> Double -> IO ()
161 writeString :: TTransport t => a t -> [Char] -> IO ()
162 writeBinary :: TTransport t => a t -> [Char] -> IO ()
163 readMessageBegin :: TTransport t => a t -> IO ([Char],Message_type,Int)
164 readMessageEnd :: TTransport t => a t -> IO ()
165 readStructBegin :: TTransport t => a t -> IO [Char]
166 readStructEnd :: TTransport t => a t -> IO ()
167 readFieldBegin :: TTransport t => a t -> IO ([Char],T_type,Int)
168 readFieldEnd :: TTransport t => a t -> IO ()
169 readMapBegin :: TTransport t => a t -> IO (T_type,T_type,Int)
170 readMapEnd :: TTransport t => a t -> IO ()
171 readListBegin :: TTransport t => a t -> IO (T_type,Int)
172 readListEnd :: TTransport t => a t -> IO ()
173 readSetBegin :: TTransport t => a t -> IO (T_type,Int)
174 readSetEnd :: TTransport t => a t -> IO ()
175 readBool :: TTransport t => a t -> IO Bool
176 readByte :: TTransport t => a t -> IO Int
177 readI16 :: TTransport t => a t -> IO Int
178 readI32 :: TTransport t => a t -> IO Int
Bryan Duxburyf3c83cf2009-03-24 00:34:16 +0000[diff] [blame]179 readI64 :: TTransport t => a t -> IO Int64
iproctor55aebc42008-02-11 22:59:01 +0000[diff] [blame]180 readDouble :: TTransport t => a t -> IO Double
181 readString :: TTransport t => a t -> IO [Char]
182 readBinary :: TTransport t => a t -> IO [Char]
183 skipFields :: TTransport t => a t -> IO ()
184 skipMapEntries :: TTransport t => a t -> Int -> T_type -> T_type -> IO ()
185 skipSetEntries :: TTransport t => a t -> Int -> T_type -> IO ()
186 skip :: TTransport t => a t -> T_type -> IO ()
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]187 skipFields a = do (_,ty,_) <- readFieldBegin a
188 if ty == T_STOP then
189 return ()
190 else do skip a ty
191 readFieldEnd a
192 skipFields a
193 skipMapEntries a n k v= if n == 0 then
194 return ()
195 else do skip a k
196 skip a v
197 skipMapEntries a (n-1) k v
198 skipSetEntries a n k = if n == 0 then
199 return ()
200 else do skip a k
201 skipSetEntries a (n-1) k
202 skip a typ = case typ of
203 T_STOP -> return ()
204 T_VOID -> return ()
205 T_BOOL -> do readBool a
206 return ()
207 T_BYTE -> do readByte a
208 return ()
209 T_I08 -> do readByte a
210 return ()
211 T_I16 -> do readI16 a
212 return ()
213 T_I32 -> do readI32 a
214 return ()
215 T_U64 -> do readI64 a
216 return ()
217 T_I64 -> do readI64 a
218 return ()
219 T_DOUBLE -> do readDouble a
220 return ()
221 T_STRING -> do readString a
222 return ()
223 T_UTF7 -> return ()
224 T_STRUCT -> do readStructBegin a
225 skipFields a
226 readStructEnd a
227 return ()
228 T_MAP -> do (k,v,s) <- readMapBegin a
229 skipMapEntries a s k v
230 readMapEnd a
231 return ()
232 T_SET -> do (ty,s) <- readSetBegin a
233 skipSetEntries a s ty
234 readSetEnd a
235 return ()
236 T_LIST -> do (ty,s) <- readListBegin a
237 skipSetEntries a s ty
238 readListEnd a
239 return ()
240 T_UTF8 -> return ()
241 T_UTF16 -> return ()
242 T_UNKNOWN -> return ()
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]243
244
245 data PE_type = PE_UNKNOWN
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]246 | PE_INVALID_DATA
247 | PE_NEGATIVE_SIZE
248 | PE_SIZE_LIMIT
249 | PE_BAD_VERSION
250 deriving (Eq, Data, Typeable)
251
252 data ProtocolExn = ProtocolExn PE_type [Char] deriving (Typeable, Data)
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]253
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]254 data AE_type = AE_UNKNOWN
255 | AE_UNKNOWN_METHOD
256 | AE_INVALID_MESSAGE_TYPE
257 | AE_WRONG_METHOD_NAME
258 | AE_BAD_SEQUENCE_ID
259 | AE_MISSING_RESULT
260 deriving (Eq, Data, Typeable)
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]261
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]262 instance Enum AE_type where
263 toEnum i = case i of
264 0 -> AE_UNKNOWN
265 1 -> AE_UNKNOWN_METHOD
266 2 -> AE_INVALID_MESSAGE_TYPE
267 3 -> AE_WRONG_METHOD_NAME
268 4 -> AE_BAD_SEQUENCE_ID
269 5 -> AE_MISSING_RESULT
270 _ -> AE_UNKNOWN
271 fromEnum t = case t of
272 AE_UNKNOWN -> 0
273 AE_UNKNOWN_METHOD -> 1
274 AE_INVALID_MESSAGE_TYPE -> 2
275 AE_WRONG_METHOD_NAME -> 3
276 AE_BAD_SEQUENCE_ID -> 4
277 AE_MISSING_RESULT -> 5
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]278
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]279 data AppExn = AppExn {ae_type :: AE_type, ae_message :: [Char]} deriving (Typeable, Data)
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]280
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]281 readAppExnFields pt rec = do (n,ft,id) <- readFieldBegin pt
282 if ft == T_STOP then return rec
283 else
284 case id of
285 1 -> if ft == T_STRING then
286 do s <- readString pt
287 readAppExnFields pt rec{ae_message = s}
288 else do skip pt ft
289 readAppExnFields pt rec
290 2 -> if ft == T_I32 then
291 do i <- readI32 pt
292 readAppExnFields pt rec{ae_type = (toEnum i)}
293 else do skip pt ft
294 readAppExnFields pt rec
295 _ -> do skip pt ft
296 readFieldEnd pt
297 readAppExnFields pt rec
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]298
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]299 readAppExn pt = do readStructBegin pt
300 rec <- readAppExnFields pt (AppExn {ae_type = undefined, ae_message = undefined})
301 readStructEnd pt
302 return rec
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]303
304
iproctorff8eb922007-07-25 19:06:13 +0000[diff] [blame]305 writeAppExn pt ae = do writeStructBegin pt "TApplicationException"
306 if ae_message ae /= "" then
307 do writeFieldBegin pt ("message",T_STRING,1)
308 writeString pt (ae_message ae)
309 writeFieldEnd pt
310 else return ()
311 writeFieldBegin pt ("type",T_I32,2);
312 writeI32 pt (fromEnum (ae_type ae))
313 writeFieldEnd pt
314 writeFieldStop pt
315 writeStructEnd pt
316
David Reiss0c90f6f2008-02-06 22:18:40 +0000[diff] [blame]317