You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@thrift.apache.org by je...@apache.org on 2017/12/03 17:28:36 UTC
[1/2] thrift git commit: THRIFT-3580 THeader for Haskell Client: hs
Repository: thrift
Updated Branches:
refs/heads/0.11.0-rc0 [created] 327ebb6c2
THRIFT-3580 THeader for Haskell
Client: hs
This closes #820
This closes #1423
Project: http://git-wip-us.apache.org/repos/asf/thrift/repo
Commit: http://git-wip-us.apache.org/repos/asf/thrift/commit/fc0ff81e
Tree: http://git-wip-us.apache.org/repos/asf/thrift/tree/fc0ff81e
Diff: http://git-wip-us.apache.org/repos/asf/thrift/diff/fc0ff81e
Branch: refs/heads/0.11.0-rc0
Commit: fc0ff81ee7d4aa95a041c826dd5a83239ef98780
Parents: 1310dc1
Author: Nobuaki Sukegawa <ns...@apache.org>
Authored: Sun Jan 24 04:01:27 2016 +0900
Committer: Jens Geyer <je...@apache.org>
Committed: Sun Dec 3 17:45:33 2017 +0100
----------------------------------------------------------------------
.../cpp/src/thrift/generate/t_hs_generator.cc | 64 ++--
lib/hs/src/Thrift.hs | 4 +-
lib/hs/src/Thrift/Protocol.hs | 41 +--
lib/hs/src/Thrift/Protocol/Binary.hs | 59 +++-
lib/hs/src/Thrift/Protocol/Compact.hs | 62 ++--
lib/hs/src/Thrift/Protocol/Header.hs | 141 ++++++++
lib/hs/src/Thrift/Protocol/JSON.hs | 58 +--
lib/hs/src/Thrift/Server.hs | 6 +-
lib/hs/src/Thrift/Transport/Handle.hs | 14 +-
lib/hs/src/Thrift/Transport/Header.hs | 354 +++++++++++++++++++
lib/hs/thrift.cabal | 2 +
test/hs/TestClient.hs | 6 +-
test/hs/TestServer.hs | 15 +-
test/known_failures_Linux.json | 4 +-
test/tests.json | 1 +
15 files changed, 690 insertions(+), 141 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/compiler/cpp/src/thrift/generate/t_hs_generator.cc
----------------------------------------------------------------------
diff --git a/compiler/cpp/src/thrift/generate/t_hs_generator.cc b/compiler/cpp/src/thrift/generate/t_hs_generator.cc
index 30eb8fa..d0a8cb2 100644
--- a/compiler/cpp/src/thrift/generate/t_hs_generator.cc
+++ b/compiler/cpp/src/thrift/generate/t_hs_generator.cc
@@ -711,13 +711,13 @@ void t_hs_generator::generate_hs_struct_reader(ofstream& out, t_struct* tstruct)
string tmap = type_name(tstruct, "typemap_");
indent(out) << "to_" << sname << " _ = P.error \"not a struct\"" << endl;
- indent(out) << "read_" << sname << " :: (T.Transport t, T.Protocol p) => p t -> P.IO " << sname
+ indent(out) << "read_" << sname << " :: T.Protocol p => p -> P.IO " << sname
<< endl;
indent(out) << "read_" << sname << " iprot = to_" << sname;
out << " <$> T.readVal iprot (T.T_STRUCT " << tmap << ")" << endl;
indent(out) << "decode_" << sname
- << " :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> " << sname << endl;
+ << " :: T.StatelessProtocol p => p -> LBS.ByteString -> " << sname << endl;
indent(out) << "decode_" << sname << " iprot bs = to_" << sname << " $ ";
out << "T.deserializeVal iprot (T.T_STRUCT " << tmap << ") bs" << endl;
}
@@ -818,13 +818,13 @@ void t_hs_generator::generate_hs_struct_writer(ofstream& out, t_struct* tstruct)
indent_down();
// write
- indent(out) << "write_" << name << " :: (T.Protocol p, T.Transport t) => p t -> " << name
+ indent(out) << "write_" << name << " :: T.Protocol p => p -> " << name
<< " -> P.IO ()" << endl;
indent(out) << "write_" << name << " oprot record = T.writeVal oprot $ from_";
out << name << " record" << endl;
// encode
- indent(out) << "encode_" << name << " :: (T.Protocol p, T.Transport t) => p t -> " << name
+ indent(out) << "encode_" << name << " :: T.StatelessProtocol p => p -> " << name
<< " -> LBS.ByteString" << endl;
indent(out) << "encode_" << name << " oprot record = T.serializeVal oprot $ ";
out << "from_" << name << " record" << endl;
@@ -1085,8 +1085,9 @@ void t_hs_generator::generate_service_client(t_service* tservice) {
// Serialize the request header
string fname = (*f_iter)->get_name();
string msgType = (*f_iter)->is_oneway() ? "T.M_ONEWAY" : "T.M_CALL";
- indent(f_client_) << "T.writeMessageBegin op (\"" << fname << "\", " << msgType << ", seqn)"
+ indent(f_client_) << "T.writeMessage op (\"" << fname << "\", " << msgType << ", seqn) $"
<< endl;
+ indent_up();
indent(f_client_) << "write_" << argsname << " op (" << argsname << "{";
bool first = true;
@@ -1102,10 +1103,7 @@ void t_hs_generator::generate_service_client(t_service* tservice) {
first = false;
}
f_client_ << "})" << endl;
- indent(f_client_) << "T.writeMessageEnd op" << endl;
-
- // Write to the stream
- indent(f_client_) << "T.tFlush (T.getTransport op)" << endl;
+ indent_down();
indent_down();
if (!(*f_iter)->is_oneway()) {
@@ -1119,12 +1117,12 @@ void t_hs_generator::generate_service_client(t_service* tservice) {
indent(f_client_) << funname << " ip = do" << endl;
indent_up();
- indent(f_client_) << "(fname, mtype, rseqid) <- T.readMessageBegin ip" << endl;
+ indent(f_client_) << "T.readMessage ip $ \\(fname, mtype, rseqid) -> do" << endl;
+ indent_up();
indent(f_client_) << "M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; "
- "T.readMessageEnd ip ; X.throw exn }" << endl;
+ "X.throw exn }" << endl;
indent(f_client_) << "res <- read_" << resultname << " ip" << endl;
- indent(f_client_) << "T.readMessageEnd ip" << endl;
t_struct* xs = (*f_iter)->get_xceptions();
const vector<t_field*>& xceptions = xs->get_members();
@@ -1142,6 +1140,7 @@ void t_hs_generator::generate_service_client(t_service* tservice) {
// Close function
indent_down();
+ indent_down();
}
}
@@ -1180,11 +1179,11 @@ void t_hs_generator::generate_service_server(t_service* tservice) {
f_service_ << "do" << endl;
indent_up();
indent(f_service_) << "_ <- T.readVal iprot (T.T_STRUCT Map.empty)" << endl;
- indent(f_service_) << "T.writeMessageBegin oprot (name,T.M_EXCEPTION,seqid)" << endl;
+ indent(f_service_) << "T.writeMessage oprot (name,T.M_EXCEPTION,seqid) $" << endl;
+ indent_up();
indent(f_service_) << "T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN_METHOD (\"Unknown function "
"\" ++ LT.unpack name))" << endl;
- indent(f_service_) << "T.writeMessageEnd oprot" << endl;
- indent(f_service_) << "T.tFlush (T.getTransport oprot)" << endl;
+ indent_down();
indent_down();
}
@@ -1194,9 +1193,8 @@ void t_hs_generator::generate_service_server(t_service* tservice) {
indent(f_service_) << "process handler (iprot, oprot) = do" << endl;
indent_up();
- indent(f_service_) << "(name, typ, seqid) <- T.readMessageBegin iprot" << endl;
- indent(f_service_) << "proc_ handler (iprot,oprot) (name,typ,seqid)" << endl;
- indent(f_service_) << "T.readMessageEnd iprot" << endl;
+ indent(f_service_) << "T.readMessage iprot (" << endl;
+ indent(f_service_) << " proc_ handler (iprot,oprot))" << endl;
indent(f_service_) << "P.return P.True" << endl;
indent_down();
}
@@ -1286,11 +1284,11 @@ void t_hs_generator::generate_process_function(t_service* tservice, t_function*
if (tfunction->is_oneway()) {
indent(f_service_) << "P.return ()";
} else {
- indent(f_service_) << "T.writeMessageBegin oprot (\"" << tfunction->get_name()
- << "\", T.M_REPLY, seqid)" << endl;
- indent(f_service_) << "write_" << resultname << " oprot res" << endl;
- indent(f_service_) << "T.writeMessageEnd oprot" << endl;
- indent(f_service_) << "T.tFlush (T.getTransport oprot)";
+ indent(f_service_) << "T.writeMessage oprot (\"" << tfunction->get_name()
+ << "\", T.M_REPLY, seqid) $" << endl;
+ indent_up();
+ indent(f_service_) << "write_" << resultname << " oprot res";
+ indent_down();
}
if (n > 0) {
f_service_ << ")";
@@ -1307,11 +1305,11 @@ void t_hs_generator::generate_process_function(t_service* tservice, t_function*
indent(f_service_) << "let res = default_" << resultname << "{"
<< field_name(resultname, (*x_iter)->get_name()) << " = P.Just e}"
<< endl;
- indent(f_service_) << "T.writeMessageBegin oprot (\"" << tfunction->get_name()
- << "\", T.M_REPLY, seqid)" << endl;
- indent(f_service_) << "write_" << resultname << " oprot res" << endl;
- indent(f_service_) << "T.writeMessageEnd oprot" << endl;
- indent(f_service_) << "T.tFlush (T.getTransport oprot)";
+ indent(f_service_) << "T.writeMessage oprot (\"" << tfunction->get_name()
+ << "\", T.M_REPLY, seqid) $" << endl;
+ indent_up();
+ indent(f_service_) << "write_" << resultname << " oprot res";
+ indent_down();
} else {
indent(f_service_) << "P.return ()";
}
@@ -1324,11 +1322,11 @@ void t_hs_generator::generate_process_function(t_service* tservice, t_function*
indent_up();
if (!tfunction->is_oneway()) {
- indent(f_service_) << "T.writeMessageBegin oprot (\"" << tfunction->get_name()
- << "\", T.M_EXCEPTION, seqid)" << endl;
- indent(f_service_) << "T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN \"\")" << endl;
- indent(f_service_) << "T.writeMessageEnd oprot" << endl;
- indent(f_service_) << "T.tFlush (T.getTransport oprot)";
+ indent(f_service_) << "T.writeMessage oprot (\"" << tfunction->get_name()
+ << "\", T.M_EXCEPTION, seqid) $" << endl;
+ indent_up();
+ indent(f_service_) << "T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN \"\")";
+ indent_down();
} else {
indent(f_service_) << "P.return ()";
}
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/lib/hs/src/Thrift.hs
----------------------------------------------------------------------
diff --git a/lib/hs/src/Thrift.hs b/lib/hs/src/Thrift.hs
index 58a304b..6580209 100644
--- a/lib/hs/src/Thrift.hs
+++ b/lib/hs/src/Thrift.hs
@@ -90,13 +90,13 @@ data AppExn = AppExn { ae_type :: AppExnType, ae_message :: String }
deriving ( Show, Typeable )
instance Exception AppExn
-writeAppExn :: (Protocol p, Transport t) => p t -> AppExn -> IO ()
+writeAppExn :: Protocol p => p -> AppExn -> IO ()
writeAppExn pt ae = writeVal pt $ TStruct $ Map.fromList
[ (1, ("message", TString $ encodeUtf8 $ pack $ ae_message ae))
, (2, ("type", TI32 $ fromIntegral $ fromEnum (ae_type ae)))
]
-readAppExn :: (Protocol p, Transport t) => p t -> IO AppExn
+readAppExn :: Protocol p => p -> IO AppExn
readAppExn pt = do
let typemap = Map.fromList [(1,("message",T_STRING)),(2,("type",T_I32))]
TStruct fields <- readVal pt $ T_STRUCT typemap
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/lib/hs/src/Thrift/Protocol.hs
----------------------------------------------------------------------
diff --git a/lib/hs/src/Thrift/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs
index ed779a2..67a9175 100644
--- a/lib/hs/src/Thrift/Protocol.hs
+++ b/lib/hs/src/Thrift/Protocol.hs
@@ -22,12 +22,11 @@
module Thrift.Protocol
( Protocol(..)
+ , StatelessProtocol(..)
, ProtocolExn(..)
, ProtocolExnType(..)
, getTypeOf
, runParser
- , versionMask
- , version1
, bsToDouble
, bsToDoubleLE
) where
@@ -35,7 +34,6 @@ module Thrift.Protocol
import Control.Exception
import Data.Attoparsec.ByteString
import Data.Bits
-import Data.ByteString.Lazy (ByteString, toStrict)
import Data.ByteString.Unsafe
import Data.Functor ((<$>))
import Data.Int
@@ -44,37 +42,26 @@ import Data.Text.Lazy (Text)
import Data.Typeable (Typeable)
import Data.Word
import Foreign.Ptr (castPtr)
-import Foreign.Storable (Storable, peek, poke)
+import Foreign.Storable (peek, poke)
import System.IO.Unsafe
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as Map
+import qualified Data.ByteString.Lazy as LBS
-import Thrift.Types
import Thrift.Transport
-
-versionMask :: Int32
-versionMask = fromIntegral (0xffff0000 :: Word32)
-
-version1 :: Int32
-version1 = fromIntegral (0x80010000 :: Word32)
+import Thrift.Types
class Protocol a where
- getTransport :: Transport t => a t -> t
-
- writeMessageBegin :: Transport t => a t -> (Text, MessageType, Int32) -> IO ()
- writeMessageEnd :: Transport t => a t -> IO ()
- writeMessageEnd _ = return ()
-
- readMessageBegin :: Transport t => a t -> IO (Text, MessageType, Int32)
- readMessageEnd :: Transport t => a t -> IO ()
- readMessageEnd _ = return ()
+ readByte :: a -> IO LBS.ByteString
+ readVal :: a -> ThriftType -> IO ThriftVal
+ readMessage :: a -> ((Text, MessageType, Int32) -> IO b) -> IO b
- serializeVal :: Transport t => a t -> ThriftVal -> ByteString
- deserializeVal :: Transport t => a t -> ThriftType -> ByteString -> ThriftVal
+ writeVal :: a -> ThriftVal -> IO ()
+ writeMessage :: a -> (Text, MessageType, Int32) -> IO () -> IO ()
- writeVal :: Transport t => a t -> ThriftVal -> IO ()
- writeVal p = tWrite (getTransport p) . serializeVal p
- readVal :: Transport t => a t -> ThriftType -> IO ThriftVal
+class Protocol a => StatelessProtocol a where
+ serializeVal :: a -> ThriftVal -> LBS.ByteString
+ deserializeVal :: a -> ThriftType -> LBS.ByteString -> ThriftVal
data ProtocolExnType
= PE_UNKNOWN
@@ -105,10 +92,10 @@ getTypeOf v = case v of
TBinary{} -> T_BINARY
TDouble{} -> T_DOUBLE
-runParser :: (Protocol p, Transport t, Show a) => p t -> Parser a -> IO a
+runParser :: (Protocol p, Show a) => p -> Parser a -> IO a
runParser prot p = refill >>= getResult . parse p
where
- refill = handle handleEOF $ toStrict <$> tReadAll (getTransport prot) 1
+ refill = handle handleEOF $ LBS.toStrict <$> readByte prot
getResult (Done _ a) = return a
getResult (Partial k) = refill >>= getResult . k
getResult f = throw $ ProtocolExn PE_INVALID_DATA (show f)
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/lib/hs/src/Thrift/Protocol/Binary.hs
----------------------------------------------------------------------
diff --git a/lib/hs/src/Thrift/Protocol/Binary.hs b/lib/hs/src/Thrift/Protocol/Binary.hs
index 2d35305..7b0acd9 100644
--- a/lib/hs/src/Thrift/Protocol/Binary.hs
+++ b/lib/hs/src/Thrift/Protocol/Binary.hs
@@ -25,6 +25,8 @@
module Thrift.Protocol.Binary
( module Thrift.Protocol
, BinaryProtocol(..)
+ , versionMask
+ , version1
) where
import Control.Exception ( throw )
@@ -35,6 +37,7 @@ import Data.Functor
import Data.Int
import Data.Monoid
import Data.Text.Lazy.Encoding ( decodeUtf8, encodeUtf8 )
+import Data.Word
import Thrift.Protocol
import Thrift.Transport
@@ -47,37 +50,55 @@ import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as Map
import qualified Data.Text.Lazy as LT
-data BinaryProtocol a = BinaryProtocol a
+versionMask :: Int32
+versionMask = fromIntegral (0xffff0000 :: Word32)
+
+version1 :: Int32
+version1 = fromIntegral (0x80010000 :: Word32)
+
+data BinaryProtocol a = Transport a => BinaryProtocol a
+
+getTransport :: Transport t => BinaryProtocol t -> t
+getTransport (BinaryProtocol t) = t
-- NOTE: Reading and Writing functions rely on Builders and Data.Binary to
-- encode and decode data. Data.Binary assumes that the binary values it is
-- encoding to and decoding from are in BIG ENDIAN format, and converts the
-- endianness as necessary to match the local machine.
-instance Protocol BinaryProtocol where
- getTransport (BinaryProtocol t) = t
-
- writeMessageBegin p (n, t, s) = tWrite (getTransport p) $ toLazyByteString $
- buildBinaryValue (TI32 (version1 .|. fromIntegral (fromEnum t))) <>
- buildBinaryValue (TString $ encodeUtf8 n) <>
- buildBinaryValue (TI32 s)
-
- readMessageBegin p = runParser p $ do
- TI32 ver <- parseBinaryValue T_I32
- if ver .&. versionMask /= version1
- then throw $ ProtocolExn PE_BAD_VERSION "Missing version identifier"
- else do
- TString s <- parseBinaryValue T_STRING
- TI32 sz <- parseBinaryValue T_I32
- return (decodeUtf8 s, toEnum $ fromIntegral $ ver .&. 0xFF, sz)
+instance Transport t => Protocol (BinaryProtocol t) where
+ readByte p = tReadAll (getTransport p) 1
+ -- flushTransport p = tFlush (getTransport p)
+ writeMessage p (n, t, s) f = do
+ tWrite (getTransport p) messageBegin
+ f
+ tFlush $ getTransport p
+ where
+ messageBegin = toLazyByteString $
+ buildBinaryValue (TI32 (version1 .|. fromIntegral (fromEnum t))) <>
+ buildBinaryValue (TString $ encodeUtf8 n) <>
+ buildBinaryValue (TI32 s)
+
+ readMessage p = (readMessageBegin p >>=)
+ where
+ readMessageBegin p = runParser p $ do
+ TI32 ver <- parseBinaryValue T_I32
+ if ver .&. versionMask /= version1
+ then throw $ ProtocolExn PE_BAD_VERSION "Missing version identifier"
+ else do
+ TString s <- parseBinaryValue T_STRING
+ TI32 sz <- parseBinaryValue T_I32
+ return (decodeUtf8 s, toEnum $ fromIntegral $ ver .&. 0xFF, sz)
+
+ writeVal p = tWrite (getTransport p) . toLazyByteString . buildBinaryValue
+ readVal p = runParser p . parseBinaryValue
+instance Transport t => StatelessProtocol (BinaryProtocol t) where
serializeVal _ = toLazyByteString . buildBinaryValue
deserializeVal _ ty bs =
case LP.eitherResult $ LP.parse (parseBinaryValue ty) bs of
Left s -> error s
Right val -> val
- readVal p = runParser p . parseBinaryValue
-
-- | Writing Functions
buildBinaryValue :: ThriftVal -> Builder
buildBinaryValue (TStruct fields) = buildBinaryStruct fields <> buildType T_STOP
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/lib/hs/src/Thrift/Protocol/Compact.hs
----------------------------------------------------------------------
diff --git a/lib/hs/src/Thrift/Protocol/Compact.hs b/lib/hs/src/Thrift/Protocol/Compact.hs
index 07113df..f23970a 100644
--- a/lib/hs/src/Thrift/Protocol/Compact.hs
+++ b/lib/hs/src/Thrift/Protocol/Compact.hs
@@ -25,10 +25,11 @@
module Thrift.Protocol.Compact
( module Thrift.Protocol
, CompactProtocol(..)
+ , parseVarint
+ , buildVarint
) where
import Control.Applicative
-import Control.Exception ( throw )
import Control.Monad
import Data.Attoparsec.ByteString as P
import Data.Attoparsec.ByteString.Lazy as LP
@@ -40,7 +41,7 @@ import Data.Monoid
import Data.Word
import Data.Text.Lazy.Encoding ( decodeUtf8, encodeUtf8 )
-import Thrift.Protocol hiding (versionMask)
+import Thrift.Protocol
import Thrift.Transport
import Thrift.Types
@@ -64,38 +65,47 @@ typeBits = 0x07 -- 0000 0111
typeShiftAmount :: Int
typeShiftAmount = 5
+getTransport :: Transport t => CompactProtocol t -> t
+getTransport (CompactProtocol t) = t
-instance Protocol CompactProtocol where
- getTransport (CompactProtocol t) = t
+instance Transport t => Protocol (CompactProtocol t) where
+ readByte p = tReadAll (getTransport p) 1
+ writeMessage p (n, t, s) f = do
+ tWrite (getTransport p) messageBegin
+ f
+ tFlush $ getTransport p
+ where
+ messageBegin = toLazyByteString $
+ B.word8 protocolID <>
+ B.word8 ((version .&. versionMask) .|.
+ (((fromIntegral $ fromEnum t) `shiftL`
+ typeShiftAmount) .&. typeMask)) <>
+ buildVarint (i32ToZigZag s) <>
+ buildCompactValue (TString $ encodeUtf8 n)
- writeMessageBegin p (n, t, s) = tWrite (getTransport p) $ toLazyByteString $
- B.word8 protocolID <>
- B.word8 ((version .&. versionMask) .|.
- (((fromIntegral $ fromEnum t) `shiftL`
- typeShiftAmount) .&. typeMask)) <>
- buildVarint (i32ToZigZag s) <>
- buildCompactValue (TString $ encodeUtf8 n)
-
- readMessageBegin p = runParser p $ do
- pid <- fromIntegral <$> P.anyWord8
- when (pid /= protocolID) $ error "Bad Protocol ID"
- w <- fromIntegral <$> P.anyWord8
- let ver = w .&. versionMask
- when (ver /= version) $ error "Bad Protocol version"
- let typ = (w `shiftR` typeShiftAmount) .&. typeBits
- seqId <- parseVarint zigZagToI32
- TString name <- parseCompactValue T_STRING
- return (decodeUtf8 name, toEnum $ fromIntegral $ typ, seqId)
+ readMessage p f = readMessageBegin >>= f
+ where
+ readMessageBegin = runParser p $ do
+ pid <- fromIntegral <$> P.anyWord8
+ when (pid /= protocolID) $ error "Bad Protocol ID"
+ w <- fromIntegral <$> P.anyWord8
+ let ver = w .&. versionMask
+ when (ver /= version) $ error "Bad Protocol version"
+ let typ = (w `shiftR` typeShiftAmount) .&. typeBits
+ seqId <- parseVarint zigZagToI32
+ TString name <- parseCompactValue T_STRING
+ return (decodeUtf8 name, toEnum $ fromIntegral $ typ, seqId)
+ writeVal p = tWrite (getTransport p) . toLazyByteString . buildCompactValue
+ readVal p ty = runParser p $ parseCompactValue ty
+
+instance Transport t => StatelessProtocol (CompactProtocol t) where
serializeVal _ = toLazyByteString . buildCompactValue
deserializeVal _ ty bs =
case LP.eitherResult $ LP.parse (parseCompactValue ty) bs of
Left s -> error s
Right val -> val
- readVal p ty = runParser p $ parseCompactValue ty
-
-
-- | Writing Functions
buildCompactValue :: ThriftVal -> Builder
buildCompactValue (TStruct fields) = buildCompactStruct fields
@@ -283,7 +293,7 @@ typeOf v = case v of
TSet{} -> 0x0A
TMap{} -> 0x0B
TStruct{} -> 0x0C
-
+
typeFrom :: Word8 -> ThriftType
typeFrom w = case w of
0x01 -> T_BOOL
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/lib/hs/src/Thrift/Protocol/Header.hs
----------------------------------------------------------------------
diff --git a/lib/hs/src/Thrift/Protocol/Header.hs b/lib/hs/src/Thrift/Protocol/Header.hs
new file mode 100644
index 0000000..5f42db4
--- /dev/null
+++ b/lib/hs/src/Thrift/Protocol/Header.hs
@@ -0,0 +1,141 @@
+--
+-- 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.
+--
+
+
+module Thrift.Protocol.Header
+ ( module Thrift.Protocol
+ , HeaderProtocol(..)
+ , getProtocolType
+ , setProtocolType
+ , getHeaders
+ , getWriteHeaders
+ , setHeader
+ , setHeaders
+ , createHeaderProtocol
+ , createHeaderProtocol1
+ ) where
+
+import Thrift.Protocol
+import Thrift.Protocol.Binary
+import Thrift.Protocol.JSON
+import Thrift.Protocol.Compact
+import Thrift.Transport
+import Thrift.Transport.Header
+import Data.IORef
+import qualified Data.Map as Map
+
+data ProtocolWrap = forall a. (Protocol a) => ProtocolWrap(a)
+
+instance Protocol ProtocolWrap where
+ readByte (ProtocolWrap p) = readByte p
+ readVal (ProtocolWrap p) = readVal p
+ readMessage (ProtocolWrap p) = readMessage p
+ writeVal (ProtocolWrap p) = writeVal p
+ writeMessage (ProtocolWrap p) = writeMessage p
+
+data HeaderProtocol i o = (Transport i, Transport o) => HeaderProtocol {
+ trans :: HeaderTransport i o,
+ wrappedProto :: IORef ProtocolWrap
+ }
+
+createProtocolWrap :: Transport t => ProtocolType -> t -> ProtocolWrap
+createProtocolWrap typ t =
+ case typ of
+ TBinary -> ProtocolWrap $ BinaryProtocol t
+ TCompact -> ProtocolWrap $ CompactProtocol t
+ TJSON -> ProtocolWrap $ JSONProtocol t
+
+createHeaderProtocol :: (Transport i, Transport o) => i -> o -> IO(HeaderProtocol i o)
+createHeaderProtocol i o = do
+ t <- openHeaderTransport i o
+ pid <- readIORef $ protocolType t
+ proto <- newIORef $ createProtocolWrap pid t
+ return $ HeaderProtocol { trans = t, wrappedProto = proto }
+
+createHeaderProtocol1 :: Transport t => t -> IO(HeaderProtocol t t)
+createHeaderProtocol1 t = createHeaderProtocol t t
+
+resetProtocol :: (Transport i, Transport o) => HeaderProtocol i o -> IO ()
+resetProtocol p = do
+ pid <- readIORef $ protocolType $ trans p
+ writeIORef (wrappedProto p) $ createProtocolWrap pid $ trans p
+
+getWrapped = readIORef . wrappedProto
+
+setTransport :: (Transport i, Transport o) => HeaderProtocol i o -> HeaderTransport i o -> HeaderProtocol i o
+setTransport p t = p { trans = t }
+
+updateTransport :: (Transport i, Transport o) => HeaderProtocol i o -> (HeaderTransport i o -> HeaderTransport i o)-> HeaderProtocol i o
+updateTransport p f = setTransport p (f $ trans p)
+
+type Headers = Map.Map String String
+
+-- TODO: we want to set headers without recreating client...
+setHeader :: (Transport i, Transport o) => HeaderProtocol i o -> String -> String -> HeaderProtocol i o
+setHeader p k v = updateTransport p $ \t -> t { writeHeaders = Map.insert k v $ writeHeaders t }
+
+setHeaders :: (Transport i, Transport o) => HeaderProtocol i o -> Headers -> HeaderProtocol i o
+setHeaders p h = updateTransport p $ \t -> t { writeHeaders = h }
+
+-- TODO: make it public once we have first transform implementation for Haskell
+setTransforms :: (Transport i, Transport o) => HeaderProtocol i o -> [TransformType] -> HeaderProtocol i o
+setTransforms p trs = updateTransport p $ \t -> t { writeTransforms = trs }
+
+setTransform :: (Transport i, Transport o) => HeaderProtocol i o -> TransformType -> HeaderProtocol i o
+setTransform p tr = updateTransport p $ \t -> t { writeTransforms = tr:(writeTransforms t) }
+
+getWriteHeaders :: (Transport i, Transport o) => HeaderProtocol i o -> Headers
+getWriteHeaders = writeHeaders . trans
+
+getHeaders :: (Transport i, Transport o) => HeaderProtocol i o -> IO [(String, String)]
+getHeaders = readIORef . headers . trans
+
+getProtocolType :: (Transport i, Transport o) => HeaderProtocol i o -> IO ProtocolType
+getProtocolType p = readIORef $ protocolType $ trans p
+
+setProtocolType :: (Transport i, Transport o) => HeaderProtocol i o -> ProtocolType -> IO ()
+setProtocolType p typ = do
+ typ0 <- getProtocolType p
+ if typ == typ0
+ then return ()
+ else do
+ tSetProtocol (trans p) typ
+ resetProtocol p
+
+instance (Transport i, Transport o) => Protocol (HeaderProtocol i o) where
+ readByte p = tReadAll (trans p) 1
+
+ readVal p tp = do
+ proto <- getWrapped p
+ readVal proto tp
+
+ readMessage p f = do
+ tResetProtocol (trans p)
+ resetProtocol p
+ proto <- getWrapped p
+ readMessage proto f
+
+ writeVal p v = do
+ proto <- getWrapped p
+ writeVal proto v
+
+ writeMessage p x f = do
+ proto <- getWrapped p
+ writeMessage proto x f
+
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/lib/hs/src/Thrift/Protocol/JSON.hs
----------------------------------------------------------------------
diff --git a/lib/hs/src/Thrift/Protocol/JSON.hs b/lib/hs/src/Thrift/Protocol/JSON.hs
index 7f619e8..839eddc 100644
--- a/lib/hs/src/Thrift/Protocol/JSON.hs
+++ b/lib/hs/src/Thrift/Protocol/JSON.hs
@@ -29,12 +29,12 @@ module Thrift.Protocol.JSON
) where
import Control.Applicative
+import Control.Exception (bracket)
import Control.Monad
import Data.Attoparsec.ByteString as P
import Data.Attoparsec.ByteString.Char8 as PC
import Data.Attoparsec.ByteString.Lazy as LP
import Data.ByteString.Base64.Lazy as B64C
-import Data.ByteString.Base64 as B64
import Data.ByteString.Lazy.Builder as B
import Data.ByteString.Internal (c2w, w2c)
import Data.Functor
@@ -58,38 +58,48 @@ import qualified Data.Text.Lazy as LT
-- encoded as a JSON 'ByteString'
data JSONProtocol t = JSONProtocol t
-- ^ Construct a 'JSONProtocol' with a 'Transport'
+getTransport :: Transport t => JSONProtocol t -> t
+getTransport (JSONProtocol t) = t
-instance Protocol JSONProtocol where
- getTransport (JSONProtocol t) = t
+instance Transport t => Protocol (JSONProtocol t) where
+ readByte p = tReadAll (getTransport p) 1
- writeMessageBegin (JSONProtocol t) (s, ty, sq) = tWrite t $ toLazyByteString $
- B.char8 '[' <> buildShowable (1 :: Int32) <>
- B.string8 ",\"" <> escape (encodeUtf8 s) <> B.char8 '\"' <>
- B.char8 ',' <> buildShowable (fromEnum ty) <>
- B.char8 ',' <> buildShowable sq <>
- B.char8 ','
- writeMessageEnd (JSONProtocol t) = tWrite t "]"
- readMessageBegin p = runParser p $ skipSpace *> do
- _ver :: Int32 <- lexeme (PC.char8 '[') *> lexeme (signed decimal)
- bs <- lexeme (PC.char8 ',') *> lexeme escapedString
- case decodeUtf8' bs of
- Left _ -> fail "readMessage: invalid text encoding"
- Right str -> do
- ty <- toEnum <$> (lexeme (PC.char8 ',') *> lexeme (signed decimal))
- seqNum <- lexeme (PC.char8 ',') *> lexeme (signed decimal)
- _ <- PC.char8 ','
- return (str, ty, seqNum)
- readMessageEnd p = void $ runParser p (PC.char8 ']')
+ writeMessage (JSONProtocol t) (s, ty, sq) = bracket readMessageBegin readMessageEnd . const
+ where
+ readMessageBegin = tWrite t $ toLazyByteString $
+ B.char8 '[' <> buildShowable (1 :: Int32) <>
+ B.string8 ",\"" <> escape (encodeUtf8 s) <> B.char8 '\"' <>
+ B.char8 ',' <> buildShowable (fromEnum ty) <>
+ B.char8 ',' <> buildShowable sq <>
+ B.char8 ','
+ readMessageEnd _ = do
+ tWrite t "]"
+ tFlush t
+ readMessage p = bracket readMessageBegin readMessageEnd
+ where
+ readMessageBegin = runParser p $ skipSpace *> do
+ _ver :: Int32 <- lexeme (PC.char8 '[') *> lexeme (signed decimal)
+ bs <- lexeme (PC.char8 ',') *> lexeme escapedString
+ case decodeUtf8' bs of
+ Left _ -> fail "readMessage: invalid text encoding"
+ Right str -> do
+ ty <- toEnum <$> (lexeme (PC.char8 ',') *> lexeme (signed decimal))
+ seqNum <- lexeme (PC.char8 ',') *> lexeme (signed decimal)
+ _ <- PC.char8 ','
+ return (str, ty, seqNum)
+ readMessageEnd _ = void $ runParser p (PC.char8 ']')
+
+ writeVal p = tWrite (getTransport p) . toLazyByteString . buildJSONValue
+ readVal p ty = runParser p $ skipSpace *> parseJSONValue ty
+
+instance Transport t => StatelessProtocol (JSONProtocol t) where
serializeVal _ = toLazyByteString . buildJSONValue
deserializeVal _ ty bs =
case LP.eitherResult $ LP.parse (parseJSONValue ty) bs of
Left s -> error s
Right val -> val
- readVal p ty = runParser p $ skipSpace *> parseJSONValue ty
-
-
-- Writing Functions
buildJSONValue :: ThriftVal -> Builder
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/lib/hs/src/Thrift/Server.hs
----------------------------------------------------------------------
diff --git a/lib/hs/src/Thrift/Server.hs b/lib/hs/src/Thrift/Server.hs
index ed74ceb..543f338 100644
--- a/lib/hs/src/Thrift/Server.hs
+++ b/lib/hs/src/Thrift/Server.hs
@@ -38,10 +38,10 @@ import Thrift.Protocol.Binary
-- | A threaded sever that is capable of using any Transport or Protocol
-- instances.
-runThreadedServer :: (Transport t, Protocol i, Protocol o)
- => (Socket -> IO (i t, o t))
+runThreadedServer :: (Protocol i, Protocol o)
+ => (Socket -> IO (i, o))
-> h
- -> (h -> (i t, o t) -> IO Bool)
+ -> (h -> (i, o) -> IO Bool)
-> PortID
-> IO a
runThreadedServer accepter hand proc_ port = do
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/lib/hs/src/Thrift/Transport/Handle.hs
----------------------------------------------------------------------
diff --git a/lib/hs/src/Thrift/Transport/Handle.hs b/lib/hs/src/Thrift/Transport/Handle.hs
index b7d16e4..ff6295b 100644
--- a/lib/hs/src/Thrift/Transport/Handle.hs
+++ b/lib/hs/src/Thrift/Transport/Handle.hs
@@ -44,7 +44,13 @@ import Data.Monoid
instance Transport Handle where
tIsOpen = hIsOpen
tClose = hClose
- tRead h n = LBS.hGet h n `Control.Exception.catch` handleEOF mempty
+ tRead h n = read `Control.Exception.catch` handleEOF mempty
+ where
+ read = do
+ hLookAhead h
+ LBS.hGetNonBlocking h n
+ tReadAll _ 0 = return mempty
+ tReadAll h n = LBS.hGet h n `Control.Exception.catch` throwTransportExn
tPeek h = (Just . c2w <$> hLookAhead h) `Control.Exception.catch` handleEOF Nothing
tWrite = LBS.hPut
tFlush = hFlush
@@ -61,8 +67,12 @@ instance HandleSource FilePath where
instance HandleSource (HostName, PortID) where
hOpen = uncurry connectTo
+throwTransportExn :: IOError -> IO a
+throwTransportExn e = if isEOFError e
+ then throw $ TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN
+ else throw $ TransportExn "Handle tReadAll: Could not read" TE_UNKNOWN
handleEOF :: a -> IOError -> IO a
handleEOF a e = if isEOFError e
then return a
- else throw $ TransportExn "TChannelTransport: Could not read" TE_UNKNOWN
+ else throw $ TransportExn "Handle: Could not read" TE_UNKNOWN
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/lib/hs/src/Thrift/Transport/Header.hs
----------------------------------------------------------------------
diff --git a/lib/hs/src/Thrift/Transport/Header.hs b/lib/hs/src/Thrift/Transport/Header.hs
new file mode 100644
index 0000000..2dacad2
--- /dev/null
+++ b/lib/hs/src/Thrift/Transport/Header.hs
@@ -0,0 +1,354 @@
+--
+-- 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.
+--
+
+module Thrift.Transport.Header
+ ( module Thrift.Transport
+ , HeaderTransport(..)
+ , openHeaderTransport
+ , ProtocolType(..)
+ , TransformType(..)
+ , ClientType(..)
+ , tResetProtocol
+ , tSetProtocol
+ ) where
+
+import Thrift.Transport
+import Thrift.Protocol.Compact
+import Control.Applicative
+import Control.Exception ( throw )
+import Control.Monad
+import Data.Bits
+import Data.IORef
+import Data.Int
+import Data.Monoid
+import Data.Word
+
+import qualified Data.Attoparsec.ByteString as P
+import qualified Data.Binary as Binary
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as C
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Lazy.Builder as B
+import qualified Data.Map as Map
+
+data ProtocolType = TBinary | TCompact | TJSON deriving (Enum, Eq)
+data ClientType = HeaderClient | Framed | Unframed deriving (Enum, Eq)
+
+infoIdKeyValue = 1
+
+type Headers = Map.Map String String
+
+data TransformType = ZlibTransform deriving (Enum, Eq)
+
+fromTransportType :: TransformType -> Int16
+fromTransportType ZlibTransform = 1
+
+toTransportType :: Int16 -> TransformType
+toTransportType 1 = ZlibTransform
+toTransportType _ = throw $ TransportExn "HeaderTransport: Unknown transform ID" TE_UNKNOWN
+
+data HeaderTransport i o = (Transport i, Transport o) => HeaderTransport
+ { readBuffer :: IORef LBS.ByteString
+ , writeBuffer :: IORef B.Builder
+ , inTrans :: i
+ , outTrans :: o
+ , clientType :: IORef ClientType
+ , protocolType :: IORef ProtocolType
+ , headers :: IORef [(String, String)]
+ , writeHeaders :: Headers
+ , transforms :: IORef [TransformType]
+ , writeTransforms :: [TransformType]
+ }
+
+openHeaderTransport :: (Transport i, Transport o) => i -> o -> IO (HeaderTransport i o)
+openHeaderTransport i o = do
+ pid <- newIORef TCompact
+ rBuf <- newIORef LBS.empty
+ wBuf <- newIORef mempty
+ cType <- newIORef HeaderClient
+ h <- newIORef []
+ trans <- newIORef []
+ return HeaderTransport
+ { readBuffer = rBuf
+ , writeBuffer = wBuf
+ , inTrans = i
+ , outTrans = o
+ , clientType = cType
+ , protocolType = pid
+ , headers = h
+ , writeHeaders = Map.empty
+ , transforms = trans
+ , writeTransforms = []
+ }
+
+isFramed t = (/= Unframed) <$> readIORef (clientType t)
+
+readFrame :: (Transport i, Transport o) => HeaderTransport i o -> IO Bool
+readFrame t = do
+ let input = inTrans t
+ let rBuf = readBuffer t
+ let cType = clientType t
+ lsz <- tRead input 4
+ let sz = LBS.toStrict lsz
+ case P.parseOnly P.endOfInput sz of
+ Right _ -> do return False
+ Left _ -> do
+ case parseBinaryMagic sz of
+ Right _ -> do
+ writeIORef rBuf $ lsz
+ writeIORef cType Unframed
+ writeIORef (protocolType t) TBinary
+ return True
+ Left _ -> do
+ case parseCompactMagic sz of
+ Right _ -> do
+ writeIORef rBuf $ lsz
+ writeIORef cType Unframed
+ writeIORef (protocolType t) TCompact
+ return True
+ Left _ -> do
+ let len = Binary.decode lsz :: Int32
+ lbuf <- tReadAll input $ fromIntegral len
+ let buf = LBS.toStrict lbuf
+ case parseBinaryMagic buf of
+ Right _ -> do
+ writeIORef cType Framed
+ writeIORef (protocolType t) TBinary
+ writeIORef rBuf lbuf
+ return True
+ Left _ -> do
+ case parseCompactMagic buf of
+ Right _ -> do
+ writeIORef cType Framed
+ writeIORef (protocolType t) TCompact
+ writeIORef rBuf lbuf
+ return True
+ Left _ -> do
+ case parseHeaderMagic buf of
+ Right flags -> do
+ let (flags, seqNum, header, body) = extractHeader buf
+ writeIORef cType HeaderClient
+ handleHeader t header
+ payload <- untransform t body
+ writeIORef rBuf $ LBS.fromStrict $ payload
+ return True
+ Left _ ->
+ throw $ TransportExn "HeaderTransport: unkonwn client type" TE_UNKNOWN
+
+parseBinaryMagic = P.parseOnly $ P.word8 0x80 *> P.word8 0x01 *> P.word8 0x00 *> P.anyWord8
+parseCompactMagic = P.parseOnly $ P.word8 0x82 *> P.satisfy (\b -> b .&. 0x1f == 0x01)
+parseHeaderMagic = P.parseOnly $ P.word8 0x0f *> P.word8 0xff *> (P.count 2 P.anyWord8)
+
+parseI32 :: P.Parser Int32
+parseI32 = Binary.decode . LBS.fromStrict <$> P.take 4
+parseI16 :: P.Parser Int16
+parseI16 = Binary.decode . LBS.fromStrict <$> P.take 2
+
+extractHeader :: BS.ByteString -> (Int16, Int32, BS.ByteString, BS.ByteString)
+extractHeader bs =
+ case P.parse extractHeader_ bs of
+ P.Done remain (flags, seqNum, header) -> (flags, seqNum, header, remain)
+ _ -> throw $ TransportExn "HeaderTransport: Invalid header" TE_UNKNOWN
+ where
+ extractHeader_ = do
+ magic <- P.word8 0x0f *> P.word8 0xff
+ flags <- parseI16
+ seqNum <- parseI32
+ (headerSize :: Int) <- (* 4) . fromIntegral <$> parseI16
+ header <- P.take headerSize
+ return (flags, seqNum, header)
+
+handleHeader t header =
+ case P.parseOnly parseHeader header of
+ Right (pType, trans, info) -> do
+ writeIORef (protocolType t) pType
+ writeIORef (transforms t) trans
+ writeIORef (headers t) info
+ _ -> throw $ TransportExn "HeaderTransport: Invalid header" TE_UNKNOWN
+
+
+iw16 :: Int16 -> Word16
+iw16 = fromIntegral
+iw32 :: Int32 -> Word32
+iw32 = fromIntegral
+wi16 :: Word16 -> Int16
+wi16 = fromIntegral
+wi32 :: Word32 -> Int32
+wi32 = fromIntegral
+
+parseHeader :: P.Parser (ProtocolType, [TransformType], [(String, String)])
+parseHeader = do
+ protocolType <- toProtocolType <$> parseVarint wi16
+ numTrans <- fromIntegral <$> parseVarint wi16
+ trans <- replicateM numTrans parseTransform
+ info <- parseInfo
+ return (protocolType, trans, info)
+
+toProtocolType :: Int16 -> ProtocolType
+toProtocolType 0 = TBinary
+toProtocolType 1 = TJSON
+toProtocolType 2 = TCompact
+
+fromProtocolType :: ProtocolType -> Int16
+fromProtocolType TBinary = 0
+fromProtocolType TJSON = 1
+fromProtocolType TCompact = 2
+
+parseTransform :: P.Parser TransformType
+parseTransform = toTransportType <$> parseVarint wi16
+
+parseInfo :: P.Parser [(String, String)]
+parseInfo = do
+ n <- P.eitherP P.endOfInput (parseVarint wi32)
+ case n of
+ Left _ -> return []
+ Right n0 ->
+ replicateM (fromIntegral n0) $ do
+ klen <- parseVarint wi16
+ k <- P.take $ fromIntegral klen
+ vlen <- parseVarint wi16
+ v <- P.take $ fromIntegral vlen
+ return (C.unpack k, C.unpack v)
+
+parseString :: P.Parser BS.ByteString
+parseString = parseVarint wi32 >>= (P.take . fromIntegral)
+
+buildHeader :: HeaderTransport i o -> IO B.Builder
+buildHeader t = do
+ pType <- readIORef $ protocolType t
+ let pId = buildVarint $ iw16 $ fromProtocolType pType
+ let headerContent = pId <> (buildTransforms t) <> (buildInfo t)
+ let len = fromIntegral $ LBS.length $ B.toLazyByteString headerContent
+ -- TODO: length limit check
+ let padding = mconcat $ replicate (mod len 4) $ B.word8 0
+ let codedLen = B.int16BE (fromIntegral $ (quot (len - 1) 4) + 1)
+ let flags = 0
+ let seqNum = 0
+ return $ B.int16BE 0x0fff <> B.int16BE flags <> B.int32BE seqNum <> codedLen <> headerContent <> padding
+
+buildTransforms :: HeaderTransport i o -> B.Builder
+-- TODO: check length limit
+buildTransforms t =
+ let trans = writeTransforms t in
+ (buildVarint $ iw16 $ fromIntegral $ length trans) <>
+ (mconcat $ map (buildVarint . iw16 . fromTransportType) trans)
+
+buildInfo :: HeaderTransport i o -> B.Builder
+buildInfo t =
+ let h = Map.assocs $ writeHeaders t in
+ -- TODO: check length limit
+ case length h of
+ 0 -> mempty
+ len -> (buildVarint $ iw16 $ fromIntegral $ len) <> (mconcat $ map buildInfoEntry h)
+ where
+ buildInfoEntry (k, v) = buildVarStr k <> buildVarStr v
+ -- TODO: check length limit
+ buildVarStr s = (buildVarint $ iw16 $ fromIntegral $ length s) <> B.string8 s
+
+tResetProtocol :: (Transport i, Transport o) => HeaderTransport i o -> IO Bool
+tResetProtocol t = do
+ rBuf <- readIORef $ readBuffer t
+ writeIORef (clientType t) HeaderClient
+ readFrame t
+
+tSetProtocol :: (Transport i, Transport o) => HeaderTransport i o -> ProtocolType -> IO ()
+tSetProtocol t = writeIORef (protocolType t)
+
+transform :: HeaderTransport i o -> LBS.ByteString -> LBS.ByteString
+transform t bs =
+ foldr applyTransform bs $ writeTransforms t
+ where
+ -- applyTransform bs ZlibTransform =
+ -- throw $ TransportExn "HeaderTransport: not implemented: ZlibTransform " TE_UNKNOWN
+ applyTransform bs _ =
+ throw $ TransportExn "HeaderTransport: Unknown transform" TE_UNKNOWN
+
+untransform :: HeaderTransport i o -> BS.ByteString -> IO BS.ByteString
+untransform t bs = do
+ trans <- readIORef $ transforms t
+ return $ foldl unapplyTransform bs trans
+ where
+ -- unapplyTransform bs ZlibTransform =
+ -- throw $ TransportExn "HeaderTransport: not implemented: ZlibTransform " TE_UNKNOWN
+ unapplyTransform bs _ =
+ throw $ TransportExn "HeaderTransport: Unknown transform" TE_UNKNOWN
+
+instance (Transport i, Transport o) => Transport (HeaderTransport i o) where
+ tIsOpen t = do
+ tIsOpen (inTrans t)
+ tIsOpen (outTrans t)
+
+ tClose t = do
+ tClose(outTrans t)
+ tClose(inTrans t)
+
+ tRead t len = do
+ rBuf <- readIORef $ readBuffer t
+ if not $ LBS.null rBuf
+ then do
+ let (consumed, remain) = LBS.splitAt (fromIntegral len) rBuf
+ writeIORef (readBuffer t) remain
+ return consumed
+ else do
+ framed <- isFramed t
+ if not framed
+ then tRead (inTrans t) len
+ else do
+ ok <- readFrame t
+ if ok
+ then tRead t len
+ else return LBS.empty
+
+ tPeek t = do
+ rBuf <- readIORef (readBuffer t)
+ if not $ LBS.null rBuf
+ then return $ Just $ LBS.head rBuf
+ else do
+ framed <- isFramed t
+ if not framed
+ then tPeek (inTrans t)
+ else do
+ ok <- readFrame t
+ if ok
+ then tPeek t
+ else return Nothing
+
+ tWrite t buf = do
+ let wBuf = writeBuffer t
+ framed <- isFramed t
+ if framed
+ then modifyIORef wBuf (<> B.lazyByteString buf)
+ else
+ -- TODO: what should we do when switched to unframed in the middle ?
+ tWrite(outTrans t) buf
+
+ tFlush t = do
+ cType <- readIORef $ clientType t
+ case cType of
+ Unframed -> tFlush $ outTrans t
+ Framed -> flushBuffer t id mempty
+ HeaderClient -> buildHeader t >>= flushBuffer t (transform t)
+ where
+ flushBuffer t f header = do
+ wBuf <- readIORef $ writeBuffer t
+ writeIORef (writeBuffer t) mempty
+ let payload = B.toLazyByteString (header <> wBuf)
+ tWrite (outTrans t) $ Binary.encode (fromIntegral $ LBS.length payload :: Int32)
+ tWrite (outTrans t) $ f payload
+ tFlush (outTrans t)
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/lib/hs/thrift.cabal
----------------------------------------------------------------------
diff --git a/lib/hs/thrift.cabal b/lib/hs/thrift.cabal
index 9754ab2..5830679 100644
--- a/lib/hs/thrift.cabal
+++ b/lib/hs/thrift.cabal
@@ -49,6 +49,7 @@ Library
Thrift,
Thrift.Arbitraries
Thrift.Protocol,
+ Thrift.Protocol.Header,
Thrift.Protocol.Binary,
Thrift.Protocol.Compact,
Thrift.Protocol.JSON,
@@ -57,6 +58,7 @@ Library
Thrift.Transport.Empty,
Thrift.Transport.Framed,
Thrift.Transport.Handle,
+ Thrift.Transport.Header,
Thrift.Transport.HttpClient,
Thrift.Transport.IOBuffer,
Thrift.Transport.Memory,
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/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.Transport.HttpClient
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 @@ getTransport t host port = do return (NoTransport $ "Unsupported transport: " ++
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 @@ defaultOptions = Options
, 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 @@ main = do
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
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/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.Framed
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 @@ getTransport t = NoTransport $ "Unsupported transport: " ++ t
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 @@ main = do
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
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/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
+]
http://git-wip-us.apache.org/repos/asf/thrift/blob/fc0ff81e/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"
[2/2] thrift git commit: Version 0.11.0
Posted by je...@apache.org.
Version 0.11.0
Project: http://git-wip-us.apache.org/repos/asf/thrift/repo
Commit: http://git-wip-us.apache.org/repos/asf/thrift/commit/327ebb6c
Tree: http://git-wip-us.apache.org/repos/asf/thrift/tree/327ebb6c
Diff: http://git-wip-us.apache.org/repos/asf/thrift/diff/327ebb6c
Branch: refs/heads/0.11.0-rc0
Commit: 327ebb6c2b6df8bf075da02ef45a2a034e9b79ba
Parents: fc0ff81
Author: Jens Geyer <je...@apache.org>
Authored: Sun Dec 3 18:27:58 2017 +0100
Committer: Jens Geyer <je...@apache.org>
Committed: Sun Dec 3 18:27:58 2017 +0100
----------------------------------------------------------------------
CHANGES | 15 +--------------
1 file changed, 1 insertion(+), 14 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/thrift/blob/327ebb6c/CHANGES
----------------------------------------------------------------------
diff --git a/CHANGES b/CHANGES
index e0a3e0b..4009f26 100644
--- a/CHANGES
+++ b/CHANGES
@@ -7,18 +7,8 @@ Thrift 0.11.0
* [THRIFT-2740] - Perl coding standards
* [THRIFT-3610] - Streamline exception handling in Python server handler
* [THRIFT-3686] - Java processor should report internal error on uncaught exception
- * [THRIFT-4047] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
- * [THRIFT-4048] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
* [THRIFT-4049] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
- * [THRIFT-4050] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
- * [THRIFT-4051] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
- * [THRIFT-4052] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
* [THRIFT-4053] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
- * [THRIFT-4054] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
- * [THRIFT-4055] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
- * [THRIFT-4056] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
- * [THRIFT-4057] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
- * [THRIFT-4058] - Skip() should throw TProtocolException.INVALID_DATA on unknown data types
* [THRIFT-4136] - Align is_binary() method with is_string() to simplify those checks
* [THRIFT-4137] - Fix remaining undefined behavior invalid vptr casts in Thrift Compiler
* [THRIFT-4138] - Fix remaining undefined behavior invalid vptr casts in C++ library
@@ -107,7 +97,6 @@ Thrift 0.11.0
* [THRIFT-4134] - Fix remaining undefined behavior invalid vptr casts
* [THRIFT-4140] - Use of non-thread-safe function gmtime()
* [THRIFT-4141] - Installation of haxe in docker files refers to a redirect link and fails
- * [THRIFT-4146] - Appveyor builds are being triggered by apache master pushes
* [THRIFT-4147] - Rust: protocol should accept transports with non-static lifetime
* [THRIFT-4148] - [maven-thrift-plugin] compile error while import a thrift in dependency jar file.
* [THRIFT-4149] - System.out pollutes log files
@@ -193,7 +182,6 @@ Thrift 0.11.0
* [THRIFT-4376] - Coverity high impact issue resolution
* [THRIFT-4377] - haxe. socket handles leak in TSimpleServer
* [THRIFT-4381] - Wrong isset bitfield value after transmission
- * [THRIFT-4384] - Using multiple services simultaneously is not thread-safe.
* [THRIFT-4385] - Go remote client -u flag is broken
* [THRIFT-4392] - compiler/..../plugin.thrift structs mis-ordered blows up ocaml generator
* [THRIFT-4395] - Unable to build in the ubuntu-xenial docker image: clap 2.28 requires Rust 1.20
@@ -214,6 +202,7 @@ Thrift 0.11.0
* [THRIFT-3357] - Generate EnumSet/EnumMap where elements/keys are enums
* [THRIFT-3369] - Implement SSL/TLS support on C with c_glib
* [THRIFT-3467] - Go Maps for Thrift Sets Should Have Values of Type struct{}
+ * [THRIFT-3580] - THeader for Haskell
* [THRIFT-3627] - Missing basic code style consistency of JavaScript.
* [THRIFT-3706] - There's no support for Multiplexed protocol on c_glib library
* [THRIFT-3766] - Add getUnderlyingTransport() to TZlibTransport
@@ -223,7 +212,6 @@ Thrift 0.11.0
* [THRIFT-3859] - Unix Domain Socket Support in Objective-C
* [THRIFT-3921] - C++ code should print enums as strings
* [THRIFT-3926] - There should be an error emitted when http status code is not 200
- * [THRIFT-4000] - Add union test to Test Suite
* [THRIFT-4007] - Micro-optimization of TTransport.py
* [THRIFT-4040] - Add real cause of TNonblockingServerSocket error to exception
* [THRIFT-4064] - Update node library dependencies
@@ -240,7 +228,6 @@ Thrift 0.11.0
* [THRIFT-4126] - Validate objects in php extension
* [THRIFT-4130] - Ensure Apache Http connection is released back to pool after use
* [THRIFT-4151] - Thrift Mutex Contention Profiling (pthreads) should be disabled by default
- * [THRIFT-4168] - Travis CI builds are being triggered by apache master pushes
* [THRIFT-4176] - Implement a threaded and threadpool server type for Rust
* [THRIFT-4183] - Named pipe client blocks forever on Open() when there is no server at the other end
* [THRIFT-4190] - improve C# TThreadPoolServer defaults