commit 3c420072ab5388c2c00d15ada72aec5b061c4d4d
author Nobuaki Sukegawa <nsuke@apache.org> Sun Jan 24 04:01:27 2016 +0900
committer James E. King, III <jking@apache.org> Thu Nov 30 16:15:25 2017 -0500
tree 3e90dcfceb50956b9dfaf5a0e112e479771efcaf
parent 214746619a6e44d8b3cc7394f3303e7bdf78c442

THRIFT-3580 THeader for Haskell
Client: hs

This closes #820
This closes #1423

test/hs/TestClient.hs

diff --git a/test/hs/TestClient.hs b/test/hs/TestClient.hs
index d1ebb3c..93fb591 100644
--- a/test/hs/TestClient.hs
+++ b/test/hs/TestClient.hs
@@ -46,6 +46,7 @@
 import Thrift.Protocol
 import Thrift.Protocol.Binary
 import Thrift.Protocol.Compact
+import Thrift.Protocol.Header
 import Thrift.Protocol.JSON
 
 data Options = Options
@@ -85,12 +86,14 @@
 data ProtocolType = Binary
                   | Compact
                   | JSON
+                  | Header
                   deriving (Show, Eq)
 
 getProtocol :: String -> ProtocolType
 getProtocol "binary"  = Binary
 getProtocol "compact" = Compact
 getProtocol "json"    = JSON
+getProtocol "header" = Header
 getProtocol p = error $ "Unsupported Protocol: " ++ p
 
 defaultOptions :: Options
@@ -104,7 +107,7 @@
   , testLoops    = 1
   }
 
-runClient :: (Protocol p, Transport t) => p t -> IO ()
+runClient :: Protocol p => p -> IO ()
 runClient p = do
   let prot = (p,p)
   putStrLn "Starting Tests"
@@ -266,6 +269,7 @@
                        Binary  -> runClient $ BinaryProtocol t
                        Compact -> runClient $ CompactProtocol t
                        JSON    -> runClient $ JSONProtocol t
+                       Header  -> createHeaderProtocol t t >>= runClient
     runTest loops p t = do
       let client = makeClient p t
       replicateM_ loops client

test/hs/TestServer.hs

diff --git a/test/hs/TestServer.hs b/test/hs/TestServer.hs
index 4a88649..b7731ab 100644
--- a/test/hs/TestServer.hs
+++ b/test/hs/TestServer.hs
@@ -48,6 +48,7 @@
 import Thrift.Transport.Handle
 import Thrift.Protocol.Binary
 import Thrift.Protocol.Compact
+import Thrift.Protocol.Header
 import Thrift.Protocol.JSON
 
 data Options = Options
@@ -90,11 +91,13 @@
 data ProtocolType = Binary
                   | Compact
                   | JSON
+                  | Header
 
 getProtocol :: String -> ProtocolType
 getProtocol "binary"  = Binary
 getProtocol "compact" = Compact
 getProtocol "json"    = JSON
+getProtocol "header"  = Header
 getProtocol p = error $"Unsupported Protocol: " ++ p
 
 defaultOptions :: Options
@@ -261,13 +264,19 @@
           t <- f socket
           return (p t, p t)
 
+        headerAcceptor f socket = do
+          t <- f socket
+          p <- createHeaderProtocol1 t
+          return (p, p)
+
         doRunServer p f = do
           runThreadedServer (acceptor p f) TestHandler ThriftTest.process . PortNumber . fromIntegral
 
         runServer p f port = case p of
-          Binary  -> do doRunServer BinaryProtocol f port
-          Compact -> do doRunServer CompactProtocol f port
-          JSON    -> do doRunServer JSONProtocol f port
+          Binary  -> doRunServer BinaryProtocol f port
+          Compact -> doRunServer CompactProtocol f port
+          JSON    -> doRunServer JSONProtocol f port
+          Header  -> runThreadedServer (headerAcceptor f) TestHandler ThriftTest.process (PortNumber $ fromIntegral port)
 
 parseFlags :: [String] -> Options -> Maybe Options
 parseFlags (flag : flags) opts = do

test/known_failures_Linux.json

diff --git a/test/known_failures_Linux.json b/test/known_failures_Linux.json
index c961988..754535f 100644
--- a/test/known_failures_Linux.json
+++ b/test/known_failures_Linux.json
@@ -229,6 +229,8 @@
   "go-java_json_http-ip",
   "go-java_json_http-ip-ssl",
   "go-nodejs_json_framed-ip",
+  "hs-csharp_binary_framed-ip",
+  "hs-csharp_compact_framed-ip",
   "hs-dart_binary_framed-ip",
   "hs-dart_compact_framed-ip",
   "hs-dart_json_framed-ip",
@@ -331,4 +333,4 @@
   "rs-dart_compact_framed-ip",
   "rs-dart_multi-binary_framed-ip",
   "rs-dart_multic-compact_framed-ip"
-]
\ No newline at end of file
+]

test/tests.json

diff --git a/test/tests.json b/test/tests.json
index 35d0a6c..c4e07ee 100644
--- a/test/tests.json
+++ b/test/tests.json
@@ -216,6 +216,7 @@
       "ip"
     ],
     "protocols": [
+      "header",
       "compact",
       "binary",
       "json"