1-- 2-- Licensed to the Apache Software Foundation (ASF) under one 3-- or more contributor license agreements. See the NOTICE file 4-- distributed with this work for additional information 5-- regarding copyright ownership. The ASF licenses this file 6-- to you under the Apache License, Version 2.0 (the 7-- "License"); you may not use this file except in compliance 8-- with the License. You may obtain a copy of the License at 9-- 10-- http://www.apache.org/licenses/LICENSE-2.0 11-- 12-- Unless required by applicable law or agreed to in writing, 13-- software distributed under the License is distributed on an 14-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 15-- KIND, either express or implied. See the License for the 16-- specific language governing permissions and limitations 17-- under the License. 18-- 19 20{-# LANGUAGE OverloadedStrings #-} 21 22module Main where 23 24 25import qualified Control.Exception 26import qualified Data.ByteString.Lazy as DBL 27import qualified Data.HashMap.Strict as Map 28import qualified Data.HashSet as Set 29import qualified Data.Vector as Vector 30import qualified Network 31 32import Thrift.Protocol.Binary 33import Thrift.Server 34import Thrift.Transport.Handle 35 36import qualified ThriftTestUtils 37 38import qualified DebugProtoTest_Types as Types 39import qualified Inherited 40import qualified Inherited_Client as IClient 41import qualified Inherited_Iface as IIface 42import qualified Srv_Client as SClient 43import qualified Srv_Iface as SIface 44 45-- we don't actually need this import, but force it to check the code generator exports proper Haskell syntax 46import qualified Srv() 47 48 49data InheritedHandler = InheritedHandler 50instance SIface.Srv_Iface InheritedHandler where 51 janky _ arg = do 52 ThriftTestUtils.serverLog $ "Got janky method call: " ++ show arg 53 return $ 31 54 55 voidMethod _ = do 56 ThriftTestUtils.serverLog "Got voidMethod method call" 57 return () 58 59 primitiveMethod _ = do 60 ThriftTestUtils.serverLog "Got primitiveMethod call" 61 return $ 42 62 63 structMethod _ = do 64 ThriftTestUtils.serverLog "Got structMethod call" 65 return $ Types.CompactProtoTestStruct { 66 Types.compactProtoTestStruct_a_byte = 0x01, 67 Types.compactProtoTestStruct_a_i16 = 0x02, 68 Types.compactProtoTestStruct_a_i32 = 0x03, 69 Types.compactProtoTestStruct_a_i64 = 0x04, 70 Types.compactProtoTestStruct_a_double = 0.1, 71 Types.compactProtoTestStruct_a_string = "abcdef", 72 Types.compactProtoTestStruct_a_binary = DBL.empty, 73 Types.compactProtoTestStruct_true_field = True, 74 Types.compactProtoTestStruct_false_field = False, 75 Types.compactProtoTestStruct_empty_struct_field = Types.Empty, 76 77 Types.compactProtoTestStruct_byte_list = Vector.empty, 78 Types.compactProtoTestStruct_i16_list = Vector.empty, 79 Types.compactProtoTestStruct_i32_list = Vector.empty, 80 Types.compactProtoTestStruct_i64_list = Vector.empty, 81 Types.compactProtoTestStruct_double_list = Vector.empty, 82 Types.compactProtoTestStruct_string_list = Vector.empty, 83 Types.compactProtoTestStruct_binary_list = Vector.empty, 84 Types.compactProtoTestStruct_boolean_list = Vector.empty, 85 Types.compactProtoTestStruct_struct_list = Vector.empty, 86 87 Types.compactProtoTestStruct_byte_set = Set.empty, 88 Types.compactProtoTestStruct_i16_set = Set.empty, 89 Types.compactProtoTestStruct_i32_set = Set.empty, 90 Types.compactProtoTestStruct_i64_set = Set.empty, 91 Types.compactProtoTestStruct_double_set = Set.empty, 92 Types.compactProtoTestStruct_string_set = Set.empty, 93 Types.compactProtoTestStruct_binary_set = Set.empty, 94 Types.compactProtoTestStruct_boolean_set = Set.empty, 95 Types.compactProtoTestStruct_struct_set = Set.empty, 96 97 Types.compactProtoTestStruct_byte_byte_map = Map.empty, 98 Types.compactProtoTestStruct_i16_byte_map = Map.empty, 99 Types.compactProtoTestStruct_i32_byte_map = Map.empty, 100 Types.compactProtoTestStruct_i64_byte_map = Map.empty, 101 Types.compactProtoTestStruct_double_byte_map = Map.empty, 102 Types.compactProtoTestStruct_string_byte_map = Map.empty, 103 Types.compactProtoTestStruct_binary_byte_map = Map.empty, 104 Types.compactProtoTestStruct_boolean_byte_map = Map.empty, 105 106 Types.compactProtoTestStruct_byte_i16_map = Map.empty, 107 Types.compactProtoTestStruct_byte_i32_map = Map.empty, 108 Types.compactProtoTestStruct_byte_i64_map = Map.empty, 109 Types.compactProtoTestStruct_byte_double_map = Map.empty, 110 Types.compactProtoTestStruct_byte_string_map = Map.empty, 111 Types.compactProtoTestStruct_byte_binary_map = Map.empty, 112 Types.compactProtoTestStruct_byte_boolean_map = Map.empty, 113 114 Types.compactProtoTestStruct_list_byte_map = Map.empty, 115 Types.compactProtoTestStruct_set_byte_map = Map.empty, 116 Types.compactProtoTestStruct_map_byte_map = Map.empty, 117 118 Types.compactProtoTestStruct_byte_map_map = Map.empty, 119 Types.compactProtoTestStruct_byte_set_map = Map.empty, 120 Types.compactProtoTestStruct_byte_list_map = Map.empty, 121 122 Types.compactProtoTestStruct_field500 = 500, 123 Types.compactProtoTestStruct_field5000 = 5000, 124 Types.compactProtoTestStruct_field20000 = 20000 } 125 126 methodWithDefaultArgs _ arg = do 127 ThriftTestUtils.serverLog $ "Got methodWithDefaultArgs: " ++ show arg 128 return () 129 130 onewayMethod _ = do 131 ThriftTestUtils.serverLog "Got onewayMethod" 132 133instance IIface.Inherited_Iface InheritedHandler where 134 identity _ arg = do 135 ThriftTestUtils.serverLog $ "Got identity method: " ++ show arg 136 return arg 137 138client :: (String, Network.PortID) -> IO () 139client addr = do 140 to <- hOpen addr 141 let p = BinaryProtocol to 142 let ps = (p,p) 143 144 v1 <- SClient.janky ps 42 145 ThriftTestUtils.clientLog $ show v1 146 147 SClient.voidMethod ps 148 149 v2 <- SClient.primitiveMethod ps 150 ThriftTestUtils.clientLog $ show v2 151 152 v3 <- SClient.structMethod ps 153 ThriftTestUtils.clientLog $ show v3 154 155 SClient.methodWithDefaultArgs ps 42 156 157 SClient.onewayMethod ps 158 159 v4 <- IClient.identity ps 42 160 ThriftTestUtils.clientLog $ show v4 161 162 return () 163 164server :: Network.PortNumber -> IO () 165server port = do 166 ThriftTestUtils.serverLog "Ready..." 167 (runBasicServer InheritedHandler Inherited.process port) 168 `Control.Exception.catch` 169 (\(TransportExn s _) -> error $ "FAILURE: " ++ show s) 170 171main :: IO () 172main = ThriftTestUtils.runTest server client 173