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