| {-# LANGUAGE ScopedTypeVariables #-} |
| -- |
| -- 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. |
| -- |
| |
| {-# LANGUAGE OverloadedStrings #-} |
| |
| module Main where |
| |
| |
| import qualified Control.Exception |
| import qualified Data.HashMap.Strict as Map |
| import qualified Data.HashSet as Set |
| import qualified Data.Vector as Vector |
| |
| import qualified Network |
| |
| import Thrift |
| import Thrift.Protocol.Binary |
| import Thrift.Server |
| import Thrift.Transport.Handle |
| |
| import qualified ThriftTestUtils |
| |
| import qualified ThriftTest |
| import qualified ThriftTest_Client as Client |
| import qualified ThriftTest_Iface as Iface |
| import qualified ThriftTest_Types as Types |
| |
| |
| data TestHandler = TestHandler |
| instance Iface.ThriftTest_Iface TestHandler where |
| testVoid _ = return () |
| |
| testString _ s = do |
| ThriftTestUtils.serverLog $ show s |
| return s |
| |
| testByte _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testI32 _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testI64 _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testDouble _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testBinary _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testStruct _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testNest _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testMap _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testStringMap _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testSet _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testList _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testEnum _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testTypedef _ x = do |
| ThriftTestUtils.serverLog $ show x |
| return x |
| |
| testMapMap _ _ = do |
| return (Map.fromList [(1, Map.fromList [(2, 2)])]) |
| |
| testInsanity _ x = do |
| return (Map.fromList [(1, Map.fromList [(Types.ONE, x)])]) |
| |
| testMulti _ _ _ _ _ _ _ = do |
| return (Types.Xtruct "" 0 0 0) |
| |
| testException _ _ = do |
| Control.Exception.throw (Types.Xception 1 "bya") |
| |
| testMultiException _ _ _ = do |
| Control.Exception.throw (Types.Xception 1 "xyz") |
| |
| testOneway _ i = do |
| ThriftTestUtils.serverLog $ show i |
| |
| |
| client :: (String, Network.PortID) -> IO () |
| client addr = do |
| to <- hOpen addr |
| let ps = (BinaryProtocol to, BinaryProtocol to) |
| |
| v1 <- Client.testString ps "bya" |
| ThriftTestUtils.clientLog $ show v1 |
| |
| v2 <- Client.testByte ps 8 |
| ThriftTestUtils.clientLog $ show v2 |
| |
| v3 <- Client.testByte ps (-8) |
| ThriftTestUtils.clientLog $ show v3 |
| |
| v4 <- Client.testI32 ps 32 |
| ThriftTestUtils.clientLog $ show v4 |
| |
| v5 <- Client.testI32 ps (-32) |
| ThriftTestUtils.clientLog $ show v5 |
| |
| v6 <- Client.testI64 ps 64 |
| ThriftTestUtils.clientLog $ show v6 |
| |
| v7 <- Client.testI64 ps (-64) |
| ThriftTestUtils.clientLog $ show v7 |
| |
| v8 <- Client.testDouble ps 3.14 |
| ThriftTestUtils.clientLog $ show v8 |
| |
| v9 <- Client.testDouble ps (-3.14) |
| ThriftTestUtils.clientLog $ show v9 |
| |
| -- TODO: Client.testBinary ... |
| |
| v10 <- Client.testMap ps (Map.fromList [(1,1),(2,2),(3,3)]) |
| ThriftTestUtils.clientLog $ show v10 |
| |
| v11 <- Client.testStringMap ps (Map.fromList [("a","123"),("a b","with spaces "),("same","same"),("0","numeric key")]) |
| ThriftTestUtils.clientLog $ show v11 |
| |
| v12 <- Client.testList ps (Vector.fromList [1,2,3,4,5]) |
| ThriftTestUtils.clientLog $ show v12 |
| |
| v13 <- Client.testSet ps (Set.fromList [1,2,3,4,5]) |
| ThriftTestUtils.clientLog $ show v13 |
| |
| v14 <- Client.testStruct ps (Types.Xtruct "hi" 4 5 0) |
| ThriftTestUtils.clientLog $ show v14 |
| |
| (testException ps "bad") `Control.Exception.catch` testExceptionHandler |
| |
| (testMultiException ps "ok") `Control.Exception.catch` testMultiExceptionHandler1 |
| (testMultiException ps "bad") `Control.Exception.catch` testMultiExceptionHandler2 `Control.Exception.catch` testMultiExceptionHandler3 |
| |
| -- ( (Client.testMultiException ps "e" "e2">> ThriftTestUtils.clientLog "bad") `Control.Exception.catch` |
| |
| tClose to |
| where testException ps msg = do |
| _ <- Client.testException ps "e" |
| ThriftTestUtils.clientLog msg |
| return () |
| |
| testExceptionHandler (e :: Types.Xception) = do |
| ThriftTestUtils.clientLog $ show e |
| |
| testMultiException ps msg = do |
| _ <- Client.testMultiException ps "e" "e2" |
| ThriftTestUtils.clientLog msg |
| return () |
| |
| testMultiExceptionHandler1 (e :: Types.Xception) = do |
| ThriftTestUtils.clientLog $ show e |
| |
| testMultiExceptionHandler2 (e :: Types.Xception2) = do |
| ThriftTestUtils.clientLog $ show e |
| |
| testMultiExceptionHandler3 (_ :: Control.Exception.SomeException) = do |
| ThriftTestUtils.clientLog "ok" |
| |
| |
| server :: Network.PortNumber -> IO () |
| server port = do |
| ThriftTestUtils.serverLog "Ready..." |
| (runBasicServer TestHandler ThriftTest.process port) |
| `Control.Exception.catch` |
| (\(TransportExn s _) -> error $ "FAILURE: " ++ s) |
| |
| |
| main :: IO () |
| main = ThriftTestUtils.runTest server client |