Subversion Repositories SmartDukaan

--

-- 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