ceph/src/jaegertracing/thrift/lib/hs/src/Thrift.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE RankNTypes #-}
   4 --
   5 -- Licensed to the Apache Software Foundation (ASF) under one
   6 -- or more contributor license agreements. See the NOTICE file
   7 -- distributed with this work for additional information
   8 -- regarding copyright ownership. The ASF licenses this file
   9 -- to you under the Apache License, Version 2.0 (the
  10 -- "License"); you may not use this file except in compliance
  11 -- with the License. You may obtain a copy of the License at
  12 --
  13 --   http://www.apache.org/licenses/LICENSE-2.0
  14 --
  15 -- Unless required by applicable law or agreed to in writing,
  16 -- software distributed under the License is distributed on an
  17 -- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  18 -- KIND, either express or implied. See the License for the
  19 -- specific language governing permissions and limitations
  20 -- under the License.
  21 --
  22
  23 module Thrift
  24     ( module Thrift.Transport
  25     , module Thrift.Protocol
  26     , AppExnType(..)
  27     , AppExn(..)
  28     , readAppExn
  29     , writeAppExn
  30     , ThriftException(..)
  31     ) where
  32
  33 import Control.Exception
  34
  35 import Data.Int
  36 import Data.Text.Lazy ( Text, pack, unpack )
  37 import Data.Text.Lazy.Encoding
  38 import Data.Typeable ( Typeable )
  39 import qualified Data.HashMap.Strict as Map
  40
  41 import Thrift.Protocol
  42 import Thrift.Transport
  43 import Thrift.Types
  44
  45 data ThriftException = ThriftException
  46   deriving ( Show, Typeable )
  47 instance Exception ThriftException
  48
  49 data AppExnType
  50     = AE_UNKNOWN
  51     | AE_UNKNOWN_METHOD
  52     | AE_INVALID_MESSAGE_TYPE
  53     | AE_WRONG_METHOD_NAME
  54     | AE_BAD_SEQUENCE_ID
  55     | AE_MISSING_RESULT
  56     | AE_INTERNAL_ERROR
  57     | AE_PROTOCOL_ERROR
  58     | AE_INVALID_TRANSFORM
  59     | AE_INVALID_PROTOCOL
  60     | AE_UNSUPPORTED_CLIENT_TYPE
  61       deriving ( Eq, Show, Typeable )
  62
  63 instance Enum AppExnType where
  64     toEnum 0 = AE_UNKNOWN
  65     toEnum 1 = AE_UNKNOWN_METHOD
  66     toEnum 2 = AE_INVALID_MESSAGE_TYPE
  67     toEnum 3 = AE_WRONG_METHOD_NAME
  68     toEnum 4 = AE_BAD_SEQUENCE_ID
  69     toEnum 5 = AE_MISSING_RESULT
  70     toEnum 6 = AE_INTERNAL_ERROR
  71     toEnum 7 = AE_PROTOCOL_ERROR
  72     toEnum 8 = AE_INVALID_TRANSFORM
  73     toEnum 9 = AE_INVALID_PROTOCOL
  74     toEnum 10 = AE_UNSUPPORTED_CLIENT_TYPE
  75     toEnum t = error $ "Invalid AppExnType " ++ show t
  76
  77     fromEnum AE_UNKNOWN = 0
  78     fromEnum AE_UNKNOWN_METHOD = 1
  79     fromEnum AE_INVALID_MESSAGE_TYPE = 2
  80     fromEnum AE_WRONG_METHOD_NAME = 3
  81     fromEnum AE_BAD_SEQUENCE_ID = 4
  82     fromEnum AE_MISSING_RESULT = 5
  83     fromEnum AE_INTERNAL_ERROR = 6
  84     fromEnum AE_PROTOCOL_ERROR = 7
  85     fromEnum AE_INVALID_TRANSFORM = 8
  86     fromEnum AE_INVALID_PROTOCOL = 9
  87     fromEnum AE_UNSUPPORTED_CLIENT_TYPE = 10
  88
  89 data AppExn = AppExn { ae_type :: AppExnType, ae_message :: String }
  90   deriving ( Show, Typeable )
  91 instance Exception AppExn
  92
  93 writeAppExn :: Protocol p => p -> AppExn -> IO ()
  94 writeAppExn pt ae = writeVal pt $ TStruct $ Map.fromList
  95                     [ (1, ("message", TString $ encodeUtf8 $ pack $ ae_message ae))
  96                     , (2, ("type", TI32 $ fromIntegral $ fromEnum (ae_type ae)))
  97                     ]
  98
  99 readAppExn :: Protocol p => p -> IO AppExn
 100 readAppExn pt = do
 101     let typemap = Map.fromList [(1,("message",T_STRING)),(2,("type",T_I32))]
 102     TStruct fields <- readVal pt $ T_STRUCT typemap
 103     return $ readAppExnFields fields
 104
 105 readAppExnFields :: Map.HashMap Int16 (Text, ThriftVal) -> AppExn
 106 readAppExnFields fields = AppExn{
 107   ae_message = maybe undefined unwrapMessage $ Map.lookup 1 fields,
 108   ae_type    = maybe undefined unwrapType $ Map.lookup 2 fields
 109   }
 110   where
 111     unwrapMessage (_, TString s) = unpack $ decodeUtf8 s
 112     unwrapMessage _ = undefined
 113     unwrapType (_, TI32 i) = toEnum $ fromIntegral i
 114     unwrapType _ = undefined