| -- |
| -- 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 (TransportExn(..),TransportExn_Type(..),TTransport(..), T_type(..), Message_type(..), Protocol(..), AE_type(..), AppExn(..), readAppExn,writeAppExn,Thrift_exception(..), ProtocolExn(..), PE_type(..)) where |
| import Data.Generics |
| import Data.Int |
| import Control.Exception |
| |
| data Thrift_exception = Thrift_Error deriving Typeable |
| |
| data TransportExn_Type = TE_UNKNOWN |
| | TE_NOT_OPEN |
| | TE_ALREADY_OPEN |
| | TE_TIMED_OUT |
| | TE_END_OF_FILE |
| deriving (Eq,Typeable,Show) |
| |
| data TransportExn = TransportExn [Char] TransportExn_Type deriving (Show,Typeable) |
| |
| class TTransport a where |
| tisOpen :: a -> Bool |
| topen :: a -> IO a |
| tclose :: a -> IO a |
| tread :: a -> Int -> IO [Char] |
| twrite :: a -> [Char] ->IO () |
| tflush :: a -> IO () |
| treadAll :: a -> Int -> IO [Char] |
| treadAll a 0 = return [] |
| treadAll a len = |
| do ret <- tread a len |
| case ret of |
| [] -> throwDyn (TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN) |
| _ -> do |
| rl <- return (length ret) |
| if len <= rl then |
| return ret |
| else do r <- treadAll a (len-rl) |
| return (ret++r) |
| |
| |
| data T_type = T_STOP |
| | T_VOID |
| | T_BOOL |
| | T_BYTE |
| | T_I08 |
| | T_I16 |
| | T_I32 |
| | T_U64 |
| | T_I64 |
| | T_DOUBLE |
| | T_STRING |
| | T_UTF7 |
| | T_STRUCT |
| | T_MAP |
| | T_SET |
| | T_LIST |
| | T_UTF8 |
| | T_UTF16 |
| | T_UNKNOWN |
| deriving (Eq) |
| instance Enum T_type where |
| fromEnum t = case t of |
| T_STOP -> 0 |
| T_VOID -> 1 |
| T_BOOL -> 2 |
| T_BYTE -> 3 |
| T_I08 -> 3 |
| T_I16 -> 6 |
| T_I32 -> 8 |
| T_U64 -> 9 |
| T_I64 -> 10 |
| T_DOUBLE -> 4 |
| T_STRING -> 11 |
| T_UTF7 -> 11 |
| T_STRUCT -> 12 |
| T_MAP -> 13 |
| T_SET -> 14 |
| T_LIST -> 15 |
| T_UTF8 -> 16 |
| T_UTF16 -> 17 |
| T_UNKNOWN -> -1 |
| toEnum t = case t of |
| 0 -> T_STOP |
| 1 -> T_VOID |
| 2 -> T_BOOL |
| 3 -> T_BYTE |
| 6-> T_I16 |
| 8 -> T_I32 |
| 9 -> T_U64 |
| 10 -> T_I64 |
| 4 -> T_DOUBLE |
| 11 -> T_STRING |
| 12 -> T_STRUCT |
| 13 -> T_MAP |
| 14 -> T_SET |
| 15 -> T_LIST |
| 16 -> T_UTF8 |
| 17 -> T_UTF16 |
| _ -> T_UNKNOWN |
| |
| |
| data Message_type = M_CALL |
| | M_REPLY |
| | M_EXCEPTION |
| | M_UNKNOWN |
| deriving Eq |
| instance Enum Message_type where |
| |
| fromEnum t = case t of |
| M_CALL -> 1 |
| M_REPLY -> 2 |
| M_EXCEPTION -> 3 |
| M_UNKNOWN -> -1 |
| |
| toEnum t = case t of |
| 1 -> M_CALL |
| 2 -> M_REPLY |
| 3 -> M_EXCEPTION |
| _ -> M_UNKNOWN |
| |
| |
| |
| |
| class Protocol a where |
| getTransport :: TTransport t => a t -> t |
| writeMessageBegin :: TTransport t => a t -> ([Char],Message_type,Int) -> IO () |
| writeMessageEnd :: TTransport t => a t -> IO () |
| writeStructBegin :: TTransport t => a t -> [Char] -> IO () |
| writeStructEnd :: TTransport t => a t -> IO () |
| writeFieldBegin :: TTransport t => a t -> ([Char], T_type,Int) -> IO () |
| writeFieldEnd :: TTransport t => a t -> IO () |
| writeFieldStop :: TTransport t => a t -> IO () |
| writeMapBegin :: TTransport t => a t -> (T_type,T_type,Int) -> IO () |
| writeMapEnd :: TTransport t => a t -> IO () |
| writeListBegin :: TTransport t => a t -> (T_type,Int) -> IO () |
| writeListEnd :: TTransport t => a t -> IO () |
| writeSetBegin :: TTransport t => a t -> (T_type,Int) -> IO () |
| writeSetEnd :: TTransport t => a t -> IO () |
| writeBool :: TTransport t => a t -> Bool -> IO () |
| writeByte :: TTransport t => a t -> Int -> IO () |
| writeI16 :: TTransport t => a t -> Int -> IO () |
| writeI32 :: TTransport t => a t -> Int -> IO () |
| writeI64 :: TTransport t => a t -> Int64 -> IO () |
| writeDouble :: TTransport t => a t -> Double -> IO () |
| writeString :: TTransport t => a t -> [Char] -> IO () |
| writeBinary :: TTransport t => a t -> [Char] -> IO () |
| readMessageBegin :: TTransport t => a t -> IO ([Char],Message_type,Int) |
| readMessageEnd :: TTransport t => a t -> IO () |
| readStructBegin :: TTransport t => a t -> IO [Char] |
| readStructEnd :: TTransport t => a t -> IO () |
| readFieldBegin :: TTransport t => a t -> IO ([Char],T_type,Int) |
| readFieldEnd :: TTransport t => a t -> IO () |
| readMapBegin :: TTransport t => a t -> IO (T_type,T_type,Int) |
| readMapEnd :: TTransport t => a t -> IO () |
| readListBegin :: TTransport t => a t -> IO (T_type,Int) |
| readListEnd :: TTransport t => a t -> IO () |
| readSetBegin :: TTransport t => a t -> IO (T_type,Int) |
| readSetEnd :: TTransport t => a t -> IO () |
| readBool :: TTransport t => a t -> IO Bool |
| readByte :: TTransport t => a t -> IO Int |
| readI16 :: TTransport t => a t -> IO Int |
| readI32 :: TTransport t => a t -> IO Int |
| readI64 :: TTransport t => a t -> IO Int64 |
| readDouble :: TTransport t => a t -> IO Double |
| readString :: TTransport t => a t -> IO [Char] |
| readBinary :: TTransport t => a t -> IO [Char] |
| skipFields :: TTransport t => a t -> IO () |
| skipMapEntries :: TTransport t => a t -> Int -> T_type -> T_type -> IO () |
| skipSetEntries :: TTransport t => a t -> Int -> T_type -> IO () |
| skip :: TTransport t => a t -> T_type -> IO () |
| skipFields a = do (_,ty,_) <- readFieldBegin a |
| if ty == T_STOP then |
| return () |
| else do skip a ty |
| readFieldEnd a |
| skipFields a |
| skipMapEntries a n k v= if n == 0 then |
| return () |
| else do skip a k |
| skip a v |
| skipMapEntries a (n-1) k v |
| skipSetEntries a n k = if n == 0 then |
| return () |
| else do skip a k |
| skipSetEntries a (n-1) k |
| skip a typ = case typ of |
| T_STOP -> return () |
| T_VOID -> return () |
| T_BOOL -> do readBool a |
| return () |
| T_BYTE -> do readByte a |
| return () |
| T_I08 -> do readByte a |
| return () |
| T_I16 -> do readI16 a |
| return () |
| T_I32 -> do readI32 a |
| return () |
| T_U64 -> do readI64 a |
| return () |
| T_I64 -> do readI64 a |
| return () |
| T_DOUBLE -> do readDouble a |
| return () |
| T_STRING -> do readString a |
| return () |
| T_UTF7 -> return () |
| T_STRUCT -> do readStructBegin a |
| skipFields a |
| readStructEnd a |
| return () |
| T_MAP -> do (k,v,s) <- readMapBegin a |
| skipMapEntries a s k v |
| readMapEnd a |
| return () |
| T_SET -> do (ty,s) <- readSetBegin a |
| skipSetEntries a s ty |
| readSetEnd a |
| return () |
| T_LIST -> do (ty,s) <- readListBegin a |
| skipSetEntries a s ty |
| readListEnd a |
| return () |
| T_UTF8 -> return () |
| T_UTF16 -> return () |
| T_UNKNOWN -> return () |
| |
| |
| data PE_type = PE_UNKNOWN |
| | PE_INVALID_DATA |
| | PE_NEGATIVE_SIZE |
| | PE_SIZE_LIMIT |
| | PE_BAD_VERSION |
| deriving (Eq, Data, Typeable) |
| |
| data ProtocolExn = ProtocolExn PE_type [Char] deriving (Typeable, Data) |
| |
| data AE_type = AE_UNKNOWN |
| | AE_UNKNOWN_METHOD |
| | AE_INVALID_MESSAGE_TYPE |
| | AE_WRONG_METHOD_NAME |
| | AE_BAD_SEQUENCE_ID |
| | AE_MISSING_RESULT |
| deriving (Eq, Data, Typeable) |
| |
| instance Enum AE_type where |
| toEnum i = case i of |
| 0 -> AE_UNKNOWN |
| 1 -> AE_UNKNOWN_METHOD |
| 2 -> AE_INVALID_MESSAGE_TYPE |
| 3 -> AE_WRONG_METHOD_NAME |
| 4 -> AE_BAD_SEQUENCE_ID |
| 5 -> AE_MISSING_RESULT |
| _ -> AE_UNKNOWN |
| fromEnum t = case t of |
| AE_UNKNOWN -> 0 |
| AE_UNKNOWN_METHOD -> 1 |
| AE_INVALID_MESSAGE_TYPE -> 2 |
| AE_WRONG_METHOD_NAME -> 3 |
| AE_BAD_SEQUENCE_ID -> 4 |
| AE_MISSING_RESULT -> 5 |
| |
| data AppExn = AppExn {ae_type :: AE_type, ae_message :: [Char]} deriving (Typeable, Data) |
| |
| readAppExnFields pt rec = do (n,ft,id) <- readFieldBegin pt |
| if ft == T_STOP then return rec |
| else |
| case id of |
| 1 -> if ft == T_STRING then |
| do s <- readString pt |
| readAppExnFields pt rec{ae_message = s} |
| else do skip pt ft |
| readAppExnFields pt rec |
| 2 -> if ft == T_I32 then |
| do i <- readI32 pt |
| readAppExnFields pt rec{ae_type = (toEnum i)} |
| else do skip pt ft |
| readAppExnFields pt rec |
| _ -> do skip pt ft |
| readFieldEnd pt |
| readAppExnFields pt rec |
| |
| readAppExn pt = do readStructBegin pt |
| rec <- readAppExnFields pt (AppExn {ae_type = undefined, ae_message = undefined}) |
| readStructEnd pt |
| return rec |
| |
| |
| writeAppExn pt ae = do writeStructBegin pt "TApplicationException" |
| if ae_message ae /= "" then |
| do writeFieldBegin pt ("message",T_STRING,1) |
| writeString pt (ae_message ae) |
| writeFieldEnd pt |
| else return () |
| writeFieldBegin pt ("type",T_I32,2); |
| writeI32 pt (fromEnum (ae_type ae)) |
| writeFieldEnd pt |
| writeFieldStop pt |
| writeStructEnd pt |
| |
| |