diff options
Diffstat (limited to 'lib/hs/src/Thrift/Protocol.hs')
| -rw-r--r-- | lib/hs/src/Thrift/Protocol.hs | 191 |
1 files changed, 191 insertions, 0 deletions
diff --git a/lib/hs/src/Thrift/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs new file mode 100644 index 000000000..8fa060ea5 --- /dev/null +++ b/lib/hs/src/Thrift/Protocol.hs @@ -0,0 +1,191 @@ +-- +-- 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.Protocol + ( Protocol(..) + , skip + , MessageType(..) + , ThriftType(..) + , ProtocolExn(..) + , ProtocolExnType(..) + ) where + +import Control.Monad ( replicateM_, unless ) +import Control.Exception + +import Data.Typeable ( Typeable ) +import Data.Int + +import Thrift.Transport + + +data ThriftType + = T_STOP + | T_VOID + | T_BOOL + | T_BYTE + | T_DOUBLE + | T_I16 + | T_I32 + | T_I64 + | T_STRING + | T_STRUCT + | T_MAP + | T_SET + | T_LIST + deriving ( Eq ) + +instance Enum ThriftType where + fromEnum T_STOP = 0 + fromEnum T_VOID = 1 + fromEnum T_BOOL = 2 + fromEnum T_BYTE = 3 + fromEnum T_DOUBLE = 4 + fromEnum T_I16 = 6 + fromEnum T_I32 = 8 + fromEnum T_I64 = 10 + fromEnum T_STRING = 11 + fromEnum T_STRUCT = 12 + fromEnum T_MAP = 13 + fromEnum T_SET = 14 + fromEnum T_LIST = 15 + + toEnum 0 = T_STOP + toEnum 1 = T_VOID + toEnum 2 = T_BOOL + toEnum 3 = T_BYTE + toEnum 4 = T_DOUBLE + toEnum 6 = T_I16 + toEnum 8 = T_I32 + toEnum 10 = T_I64 + toEnum 11 = T_STRING + toEnum 12 = T_STRUCT + toEnum 13 = T_MAP + toEnum 14 = T_SET + toEnum 15 = T_LIST + +data MessageType + = M_CALL + | M_REPLY + | M_EXCEPTION + deriving ( Eq ) + +instance Enum MessageType where + fromEnum M_CALL = 1 + fromEnum M_REPLY = 2 + fromEnum M_EXCEPTION = 3 + + toEnum 1 = M_CALL + toEnum 2 = M_REPLY + toEnum 3 = M_EXCEPTION + + +class Protocol a where + getTransport :: Transport t => a t -> t + + writeMessageBegin :: Transport t => a t -> (String, MessageType, Int) -> IO () + writeMessageEnd :: Transport t => a t -> IO () + + writeStructBegin :: Transport t => a t -> String -> IO () + writeStructEnd :: Transport t => a t -> IO () + writeFieldBegin :: Transport t => a t -> (String, ThriftType, Int) -> IO () + writeFieldEnd :: Transport t => a t -> IO () + writeFieldStop :: Transport t => a t -> IO () + writeMapBegin :: Transport t => a t -> (ThriftType, ThriftType, Int) -> IO () + writeMapEnd :: Transport t => a t -> IO () + writeListBegin :: Transport t => a t -> (ThriftType, Int) -> IO () + writeListEnd :: Transport t => a t -> IO () + writeSetBegin :: Transport t => a t -> (ThriftType, Int) -> IO () + writeSetEnd :: Transport t => a t -> IO () + + writeBool :: Transport t => a t -> Bool -> IO () + writeByte :: Transport t => a t -> Int -> IO () + writeI16 :: Transport t => a t -> Int -> IO () + writeI32 :: Transport t => a t -> Int -> IO () + writeI64 :: Transport t => a t -> Int64 -> IO () + writeDouble :: Transport t => a t -> Double -> IO () + writeString :: Transport t => a t -> String -> IO () + writeBinary :: Transport t => a t -> String -> IO () + + + readMessageBegin :: Transport t => a t -> IO (String, MessageType, Int) + readMessageEnd :: Transport t => a t -> IO () + + readStructBegin :: Transport t => a t -> IO String + readStructEnd :: Transport t => a t -> IO () + readFieldBegin :: Transport t => a t -> IO (String, ThriftType, Int) + readFieldEnd :: Transport t => a t -> IO () + readMapBegin :: Transport t => a t -> IO (ThriftType, ThriftType, Int) + readMapEnd :: Transport t => a t -> IO () + readListBegin :: Transport t => a t -> IO (ThriftType, Int) + readListEnd :: Transport t => a t -> IO () + readSetBegin :: Transport t => a t -> IO (ThriftType, Int) + readSetEnd :: Transport t => a t -> IO () + + readBool :: Transport t => a t -> IO Bool + readByte :: Transport t => a t -> IO Int + readI16 :: Transport t => a t -> IO Int + readI32 :: Transport t => a t -> IO Int + readI64 :: Transport t => a t -> IO Int64 + readDouble :: Transport t => a t -> IO Double + readString :: Transport t => a t -> IO String + readBinary :: Transport t => a t -> IO String + + +skip :: (Protocol p, Transport t) => p t -> ThriftType -> IO () +skip p T_STOP = return () +skip p T_VOID = return () +skip p T_BOOL = readBool p >> return () +skip p T_BYTE = readByte p >> return () +skip p T_I16 = readI16 p >> return () +skip p T_I32 = readI32 p >> return () +skip p T_I64 = readI64 p >> return () +skip p T_DOUBLE = readDouble p >> return () +skip p T_STRING = readString p >> return () +skip p T_STRUCT = do readStructBegin p + skipFields p + readStructEnd p +skip p T_MAP = do (k, v, s) <- readMapBegin p + replicateM_ s (skip p k >> skip p v) + readMapEnd p +skip p T_SET = do (t, n) <- readSetBegin p + replicateM_ n (skip p t) + readSetEnd p +skip p T_LIST = do (t, n) <- readListBegin p + replicateM_ n (skip p t) + readListEnd p + + +skipFields :: (Protocol p, Transport t) => p t -> IO () +skipFields p = do + (_, t, _) <- readFieldBegin p + unless (t == T_STOP) (skip p t >> readFieldEnd p >> skipFields p) + + +data ProtocolExnType + = PE_UNKNOWN + | PE_INVALID_DATA + | PE_NEGATIVE_SIZE + | PE_SIZE_LIMIT + | PE_BAD_VERSION + deriving ( Eq, Show, Typeable ) + +data ProtocolExn = ProtocolExn ProtocolExnType String + deriving ( Show, Typeable ) +instance Exception ProtocolExn |