Adding upstream version 16.2.11+ds.upstream/16.2.11+dsupstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 114 insertions, 0 deletions

diff --git a/src/jaegertracing/thrift/lib/hs/src/Thrift.hs b/src/jaegertracing/thrift/lib/hs/src/Thrift.hs
new file mode 100644
index 000000000..658020991
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/hs/src/Thrift.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+--
+-- 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
+    ( module Thrift.Transport
+    , module Thrift.Protocol
+    , AppExnType(..)
+    , AppExn(..)
+    , readAppExn
+    , writeAppExn
+    , ThriftException(..)
+    ) where
+
+import Control.Exception
+
+import Data.Int
+import Data.Text.Lazy ( Text, pack, unpack )
+import Data.Text.Lazy.Encoding
+import Data.Typeable ( Typeable )
+import qualified Data.HashMap.Strict as Map
+
+import Thrift.Protocol
+import Thrift.Transport
+import Thrift.Types
+
+data ThriftException = ThriftException
+  deriving ( Show, Typeable )
+instance Exception ThriftException
+
+data AppExnType
+    = AE_UNKNOWN
+    | AE_UNKNOWN_METHOD
+    | AE_INVALID_MESSAGE_TYPE
+    | AE_WRONG_METHOD_NAME
+    | AE_BAD_SEQUENCE_ID
+    | AE_MISSING_RESULT
+    | AE_INTERNAL_ERROR
+    | AE_PROTOCOL_ERROR
+    | AE_INVALID_TRANSFORM
+    | AE_INVALID_PROTOCOL
+    | AE_UNSUPPORTED_CLIENT_TYPE
+      deriving ( Eq, Show, Typeable )
+
+instance Enum AppExnType where
+    toEnum 0 = AE_UNKNOWN
+    toEnum 1 = AE_UNKNOWN_METHOD
+    toEnum 2 = AE_INVALID_MESSAGE_TYPE
+    toEnum 3 = AE_WRONG_METHOD_NAME
+    toEnum 4 = AE_BAD_SEQUENCE_ID
+    toEnum 5 = AE_MISSING_RESULT
+    toEnum 6 = AE_INTERNAL_ERROR
+    toEnum 7 = AE_PROTOCOL_ERROR
+    toEnum 8 = AE_INVALID_TRANSFORM
+    toEnum 9 = AE_INVALID_PROTOCOL
+    toEnum 10 = AE_UNSUPPORTED_CLIENT_TYPE
+    toEnum t = error $ "Invalid AppExnType " ++ show t
+
+    fromEnum AE_UNKNOWN = 0
+    fromEnum AE_UNKNOWN_METHOD = 1
+    fromEnum AE_INVALID_MESSAGE_TYPE = 2
+    fromEnum AE_WRONG_METHOD_NAME = 3
+    fromEnum AE_BAD_SEQUENCE_ID = 4
+    fromEnum AE_MISSING_RESULT = 5
+    fromEnum AE_INTERNAL_ERROR = 6
+    fromEnum AE_PROTOCOL_ERROR = 7
+    fromEnum AE_INVALID_TRANSFORM = 8
+    fromEnum AE_INVALID_PROTOCOL = 9
+    fromEnum AE_UNSUPPORTED_CLIENT_TYPE = 10
+
+data AppExn = AppExn { ae_type :: AppExnType, ae_message :: String }
+  deriving ( Show, Typeable )
+instance Exception AppExn
+
+writeAppExn :: Protocol p => p -> AppExn -> IO ()
+writeAppExn pt ae = writeVal pt $ TStruct $ Map.fromList
+                    [ (1, ("message", TString $ encodeUtf8 $ pack $ ae_message ae))
+                    , (2, ("type", TI32 $ fromIntegral $ fromEnum (ae_type ae)))
+                    ]
+
+readAppExn :: Protocol p => p -> IO AppExn
+readAppExn pt = do
+    let typemap = Map.fromList [(1,("message",T_STRING)),(2,("type",T_I32))]
+    TStruct fields <- readVal pt $ T_STRUCT typemap
+    return $ readAppExnFields fields
+
+readAppExnFields :: Map.HashMap Int16 (Text, ThriftVal) -> AppExn
+readAppExnFields fields = AppExn{
+  ae_message = maybe undefined unwrapMessage $ Map.lookup 1 fields,
+  ae_type    = maybe undefined unwrapType $ Map.lookup 2 fields
+  }
+  where
+    unwrapMessage (_, TString s) = unpack $ decodeUtf8 s
+    unwrapMessage _ = undefined
+    unwrapType (_, TI32 i) = toEnum $ fromIntegral i
+    unwrapType _ = undefined