1{-# LANGUAGE ScopedTypeVariables #-} 2-- 3-- Licensed to the Apache Software Foundation (ASF) under one 4-- or more contributor license agreements. See the NOTICE file 5-- distributed with this work for additional information 6-- regarding copyright ownership. The ASF licenses this file 7-- to you under the Apache License, Version 2.0 (the 8-- "License"); you may not use this file except in compliance 9-- with the License. You may obtain a copy of the License at 10-- 11-- http://www.apache.org/licenses/LICENSE-2.0 12-- 13-- Unless required by applicable law or agreed to in writing, 14-- software distributed under the License is distributed on an 15-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16-- KIND, either express or implied. See the License for the 17-- specific language governing permissions and limitations 18-- under the License. 19-- 20 21{-# LANGUAGE OverloadedStrings #-} 22 23module Main where 24 25 26import qualified Control.Exception 27import qualified Data.HashMap.Strict as Map 28import qualified Data.HashSet as Set 29import qualified Data.Vector as Vector 30 31import qualified Network 32 33import Thrift 34import Thrift.Protocol.Binary 35import Thrift.Server 36import Thrift.Transport.Handle 37 38import qualified ThriftTestUtils 39 40import qualified ThriftTest 41import qualified ThriftTest_Client as Client 42import qualified ThriftTest_Iface as Iface 43import qualified ThriftTest_Types as Types 44 45 46data TestHandler = TestHandler 47instance Iface.ThriftTest_Iface TestHandler where 48 testVoid _ = return () 49 50 testString _ s = do 51 ThriftTestUtils.serverLog $ show s 52 return s 53 54 testByte _ x = do 55 ThriftTestUtils.serverLog $ show x 56 return x 57 58 testI32 _ x = do 59 ThriftTestUtils.serverLog $ show x 60 return x 61 62 testI64 _ x = do 63 ThriftTestUtils.serverLog $ show x 64 return x 65 66 testDouble _ x = do 67 ThriftTestUtils.serverLog $ show x 68 return x 69 70 testBinary _ x = do 71 ThriftTestUtils.serverLog $ show x 72 return x 73 74 testStruct _ x = do 75 ThriftTestUtils.serverLog $ show x 76 return x 77 78 testNest _ x = do 79 ThriftTestUtils.serverLog $ show x 80 return x 81 82 testMap _ x = do 83 ThriftTestUtils.serverLog $ show x 84 return x 85 86 testStringMap _ x = do 87 ThriftTestUtils.serverLog $ show x 88 return x 89 90 testSet _ x = do 91 ThriftTestUtils.serverLog $ show x 92 return x 93 94 testList _ x = do 95 ThriftTestUtils.serverLog $ show x 96 return x 97 98 testEnum _ x = do 99 ThriftTestUtils.serverLog $ show x 100 return x 101 102 testTypedef _ x = do 103 ThriftTestUtils.serverLog $ show x 104 return x 105 106 testMapMap _ _ = do 107 return (Map.fromList [(1, Map.fromList [(2, 2)])]) 108 109 testInsanity _ x = do 110 return (Map.fromList [(1, Map.fromList [(Types.Numberz_ONE, x)])]) 111 112 testMulti _ _ _ _ _ _ _ = do 113 return (Types.Xtruct "" 0 0 0) 114 115 testException _ _ = do 116 Control.Exception.throw (Types.Xception 1 "bya") 117 118 testMultiException _ _ _ = do 119 Control.Exception.throw (Types.Xception 1 "xyz") 120 121 testOneway _ i = do 122 ThriftTestUtils.serverLog $ show i 123 124 125client :: (String, Network.PortID) -> IO () 126client addr = do 127 to <- hOpen addr 128 let ps = (BinaryProtocol to, BinaryProtocol to) 129 130 v1 <- Client.testString ps "bya" 131 ThriftTestUtils.clientLog $ show v1 132 133 v2 <- Client.testByte ps 8 134 ThriftTestUtils.clientLog $ show v2 135 136 v3 <- Client.testByte ps (-8) 137 ThriftTestUtils.clientLog $ show v3 138 139 v4 <- Client.testI32 ps 32 140 ThriftTestUtils.clientLog $ show v4 141 142 v5 <- Client.testI32 ps (-32) 143 ThriftTestUtils.clientLog $ show v5 144 145 v6 <- Client.testI64 ps 64 146 ThriftTestUtils.clientLog $ show v6 147 148 v7 <- Client.testI64 ps (-64) 149 ThriftTestUtils.clientLog $ show v7 150 151 v8 <- Client.testDouble ps 3.14 152 ThriftTestUtils.clientLog $ show v8 153 154 v9 <- Client.testDouble ps (-3.14) 155 ThriftTestUtils.clientLog $ show v9 156 157 -- TODO: Client.testBinary ... 158 159 v10 <- Client.testMap ps (Map.fromList [(1,1),(2,2),(3,3)]) 160 ThriftTestUtils.clientLog $ show v10 161 162 v11 <- Client.testStringMap ps (Map.fromList [("a","123"),("a b","with spaces "),("same","same"),("0","numeric key")]) 163 ThriftTestUtils.clientLog $ show v11 164 165 v12 <- Client.testList ps (Vector.fromList [1,2,3,4,5]) 166 ThriftTestUtils.clientLog $ show v12 167 168 v13 <- Client.testSet ps (Set.fromList [1,2,3,4,5]) 169 ThriftTestUtils.clientLog $ show v13 170 171 v14 <- Client.testStruct ps (Types.Xtruct "hi" 4 5 0) 172 ThriftTestUtils.clientLog $ show v14 173 174 (testException ps "bad") `Control.Exception.catch` testExceptionHandler 175 176 (testMultiException ps "ok") `Control.Exception.catch` testMultiExceptionHandler1 177 (testMultiException ps "bad") `Control.Exception.catch` testMultiExceptionHandler2 `Control.Exception.catch` testMultiExceptionHandler3 178 179 -- ( (Client.testMultiException ps "e" "e2">> ThriftTestUtils.clientLog "bad") `Control.Exception.catch` 180 181 tClose to 182 where testException ps msg = do 183 _ <- Client.testException ps "e" 184 ThriftTestUtils.clientLog msg 185 return () 186 187 testExceptionHandler (e :: Types.Xception) = do 188 ThriftTestUtils.clientLog $ show e 189 190 testMultiException ps msg = do 191 _ <- Client.testMultiException ps "e" "e2" 192 ThriftTestUtils.clientLog msg 193 return () 194 195 testMultiExceptionHandler1 (e :: Types.Xception) = do 196 ThriftTestUtils.clientLog $ show e 197 198 testMultiExceptionHandler2 (e :: Types.Xception2) = do 199 ThriftTestUtils.clientLog $ show e 200 201 testMultiExceptionHandler3 (_ :: Control.Exception.SomeException) = do 202 ThriftTestUtils.clientLog "ok" 203 204 205server :: Network.PortNumber -> IO () 206server port = do 207 ThriftTestUtils.serverLog "Ready..." 208 (runBasicServer TestHandler ThriftTest.process port) 209 `Control.Exception.catch` 210 (\(TransportExn s _) -> error $ "FAILURE: " ++ s) 211 212 213main :: IO () 214main = ThriftTestUtils.runTest server client 215