thrift (empty) → 0.6.0
raw patch · 10 files changed
+1063/−0 lines, 10 filesdep +HTTPdep +basedep +binarysetup-changed
Dependencies added: HTTP, base, binary, bytestring, ghc-prim, network
Files
- LICENSE +202/−0
- Setup.lhs +21/−0
- src/Thrift.hs +116/−0
- src/Thrift/Protocol.hs +194/−0
- src/Thrift/Protocol/Binary.hs +161/−0
- src/Thrift/Server.hs +66/−0
- src/Thrift/Transport.hs +63/−0
- src/Thrift/Transport/Handle.hs +66/−0
- src/Thrift/Transport/HttpClient.hs +127/−0
- thrift.cabal +47/−0
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed 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.
+ Setup.lhs view
@@ -0,0 +1,21 @@+#!/usr/bin/env runhaskell++> -- 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.++> import Distribution.Simple+> main = defaultMain
+ src/Thrift.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+--+-- 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+ ( module Thrift.Transport+ , module Thrift.Protocol+ , AppExnType(..)+ , AppExn(..)+ , readAppExn+ , writeAppExn+ , ThriftException(..)+ ) where++import Control.Monad ( when )+import Control.Exception++import Data.Typeable ( Typeable )++import Thrift.Transport+import Thrift.Protocol+++data ThriftException = ThriftException+ deriving ( Show, Typeable )+instance Exception ThriftException++data AppExnType+ = AE_UNKNOWN+ | AE_UNKNOWN_METHOD+ | AE_INVALID_MESSAGE_TYPE+ | AE_WRONG_METHOD_NAME+ | AE_BAD_SEQUENCE_ID+ | AE_MISSING_RESULT+ deriving ( Eq, Show, Typeable )++instance Enum AppExnType where+ toEnum 0 = AE_UNKNOWN+ toEnum 1 = AE_UNKNOWN_METHOD+ toEnum 2 = AE_INVALID_MESSAGE_TYPE+ toEnum 3 = AE_WRONG_METHOD_NAME+ toEnum 4 = AE_BAD_SEQUENCE_ID+ toEnum 5 = AE_MISSING_RESULT+ toEnum t = error $ "Invalid AppExnType " ++ show t++ fromEnum AE_UNKNOWN = 0+ fromEnum AE_UNKNOWN_METHOD = 1+ fromEnum AE_INVALID_MESSAGE_TYPE = 2+ fromEnum AE_WRONG_METHOD_NAME = 3+ fromEnum AE_BAD_SEQUENCE_ID = 4+ fromEnum AE_MISSING_RESULT = 5++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 pt ae = do+ writeStructBegin pt "TApplicationException"++ when (ae_message ae /= "") $ do+ writeFieldBegin pt ("message", T_STRING , 1)+ writeString pt (ae_message ae)+ writeFieldEnd pt++ writeFieldBegin pt ("type", T_I32, 2);+ writeI32 pt (fromIntegral $ fromEnum (ae_type ae))+ writeFieldEnd pt+ writeFieldStop pt+ writeStructEnd pt++readAppExn :: (Protocol p, Transport t) => p t -> IO AppExn+readAppExn pt = do+ _ <- readStructBegin pt+ record <- readAppExnFields pt (AppExn {ae_type = undefined, ae_message = undefined})+ readStructEnd pt+ return record++readAppExnFields :: forall (a :: * -> *) t. (Protocol a, Transport t) => a t -> AppExn -> IO AppExn +readAppExnFields pt record = do+ (_, ft, tag) <- readFieldBegin pt+ if ft == T_STOP+ then return record+ else case tag of+ 1 -> if ft == T_STRING then+ do s <- readString pt+ readAppExnFields pt record{ae_message = s}+ else do skip pt ft+ readAppExnFields pt record+ 2 -> if ft == T_I32 then+ do i <- readI32 pt+ readAppExnFields pt record{ae_type = (toEnum $ fromIntegral i)}+ else do skip pt ft+ readAppExnFields pt record+ _ -> do skip pt ft+ readFieldEnd pt+ readAppExnFields pt record+
+ src/Thrift/Protocol.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE DeriveDataTypeable #-}+--+-- 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+ ( Protocol(..)+ , skip+ , MessageType(..)+ , ThriftType(..)+ , ProtocolExn(..)+ , ProtocolExnType(..)+ ) where++import Control.Monad ( replicateM_, unless )+import Control.Exception+import Data.Int+import Data.Typeable ( Typeable )+import Data.ByteString.Lazy++import Thrift.Transport+++data ThriftType+ = T_STOP+ | T_VOID+ | T_BOOL+ | T_BYTE+ | T_DOUBLE+ | T_I16+ | T_I32+ | T_I64+ | T_STRING+ | T_STRUCT+ | T_MAP+ | T_SET+ | T_LIST+ deriving ( Eq )++instance Enum ThriftType where+ fromEnum T_STOP = 0+ fromEnum T_VOID = 1+ fromEnum T_BOOL = 2+ fromEnum T_BYTE = 3+ fromEnum T_DOUBLE = 4+ fromEnum T_I16 = 6+ fromEnum T_I32 = 8+ fromEnum T_I64 = 10+ fromEnum T_STRING = 11+ fromEnum T_STRUCT = 12+ fromEnum T_MAP = 13+ fromEnum T_SET = 14+ fromEnum T_LIST = 15++ toEnum 0 = T_STOP+ toEnum 1 = T_VOID+ toEnum 2 = T_BOOL+ toEnum 3 = T_BYTE+ toEnum 4 = T_DOUBLE+ toEnum 6 = T_I16+ toEnum 8 = T_I32+ toEnum 10 = T_I64+ toEnum 11 = T_STRING+ toEnum 12 = T_STRUCT+ toEnum 13 = T_MAP+ toEnum 14 = T_SET+ toEnum 15 = T_LIST+ toEnum t = error $ "Invalid ThriftType " ++ show t++data MessageType+ = M_CALL+ | M_REPLY+ | M_EXCEPTION+ deriving ( Eq )++instance Enum MessageType where+ fromEnum M_CALL = 1+ fromEnum M_REPLY = 2+ fromEnum M_EXCEPTION = 3++ toEnum 1 = M_CALL+ toEnum 2 = M_REPLY+ toEnum 3 = M_EXCEPTION+ toEnum t = error $ "Invalid MessageType " ++ show t+++class Protocol a where+ getTransport :: Transport t => a t -> t++ writeMessageBegin :: Transport t => a t -> (String, MessageType, Int32) -> IO ()+ writeMessageEnd :: Transport t => a t -> IO ()++ writeStructBegin :: Transport t => a t -> String -> IO ()+ writeStructEnd :: Transport t => a t -> IO ()+ writeFieldBegin :: Transport t => a t -> (String, ThriftType, Int16) -> IO ()+ writeFieldEnd :: Transport t => a t -> IO ()+ writeFieldStop :: Transport t => a t -> IO ()+ writeMapBegin :: Transport t => a t -> (ThriftType, ThriftType, Int32) -> IO ()+ writeMapEnd :: Transport t => a t -> IO ()+ writeListBegin :: Transport t => a t -> (ThriftType, Int32) -> IO ()+ writeListEnd :: Transport t => a t -> IO ()+ writeSetBegin :: Transport t => a t -> (ThriftType, Int32) -> IO ()+ writeSetEnd :: Transport t => a t -> IO ()++ writeBool :: Transport t => a t -> Bool -> IO ()+ writeByte :: Transport t => a t -> Int8 -> IO ()+ writeI16 :: Transport t => a t -> Int16 -> IO ()+ writeI32 :: Transport t => a t -> Int32 -> IO ()+ writeI64 :: Transport t => a t -> Int64 -> IO ()+ writeDouble :: Transport t => a t -> Double -> IO ()+ writeString :: Transport t => a t -> String -> IO ()+ writeBinary :: Transport t => a t -> ByteString -> IO ()+++ readMessageBegin :: Transport t => a t -> IO (String, MessageType, Int32)+ readMessageEnd :: Transport t => a t -> IO ()++ readStructBegin :: Transport t => a t -> IO String+ readStructEnd :: Transport t => a t -> IO ()+ readFieldBegin :: Transport t => a t -> IO (String, ThriftType, Int16)+ readFieldEnd :: Transport t => a t -> IO ()+ readMapBegin :: Transport t => a t -> IO (ThriftType, ThriftType, Int32)+ readMapEnd :: Transport t => a t -> IO ()+ readListBegin :: Transport t => a t -> IO (ThriftType, Int32)+ readListEnd :: Transport t => a t -> IO ()+ readSetBegin :: Transport t => a t -> IO (ThriftType, Int32)+ readSetEnd :: Transport t => a t -> IO ()++ readBool :: Transport t => a t -> IO Bool+ readByte :: Transport t => a t -> IO Int8+ readI16 :: Transport t => a t -> IO Int16+ readI32 :: Transport t => a t -> IO Int32+ readI64 :: Transport t => a t -> IO Int64+ readDouble :: Transport t => a t -> IO Double+ readString :: Transport t => a t -> IO String+ readBinary :: Transport t => a t -> IO ByteString+++skip :: (Protocol p, Transport t) => p t -> ThriftType -> IO ()+skip _ T_STOP = return ()+skip _ T_VOID = return ()+skip p T_BOOL = readBool p >> return ()+skip p T_BYTE = readByte p >> return ()+skip p T_I16 = readI16 p >> return ()+skip p T_I32 = readI32 p >> return ()+skip p T_I64 = readI64 p >> return ()+skip p T_DOUBLE = readDouble p >> return ()+skip p T_STRING = readString p >> return ()+skip p T_STRUCT = do _ <- readStructBegin p+ skipFields p+ readStructEnd p+skip p T_MAP = do (k, v, s) <- readMapBegin p+ replicateM_ (fromIntegral s) (skip p k >> skip p v)+ readMapEnd p+skip p T_SET = do (t, n) <- readSetBegin p+ replicateM_ (fromIntegral n) (skip p t)+ readSetEnd p+skip p T_LIST = do (t, n) <- readListBegin p+ replicateM_ (fromIntegral n) (skip p t)+ readListEnd p+++skipFields :: (Protocol p, Transport t) => p t -> IO ()+skipFields p = do+ (_, t, _) <- readFieldBegin p+ unless (t == T_STOP) (skip p t >> readFieldEnd p >> skipFields p)+++data ProtocolExnType+ = PE_UNKNOWN+ | PE_INVALID_DATA+ | PE_NEGATIVE_SIZE+ | PE_SIZE_LIMIT+ | PE_BAD_VERSION+ deriving ( Eq, Show, Typeable )++data ProtocolExn = ProtocolExn ProtocolExnType String+ deriving ( Show, Typeable )+instance Exception ProtocolExn
+ src/Thrift/Protocol/Binary.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE MagicHash #-}+--+-- 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.Binary+ ( module Thrift.Protocol+ , BinaryProtocol(..)+ ) where++import Control.Exception ( throw )+import Control.Monad ( liftM )++import qualified Data.Binary+import Data.Bits+import Data.Int++import GHC.Exts+import GHC.Word++import Thrift.Protocol+import Thrift.Transport++import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Lazy.Char8 as LBSChar8++version_mask :: Int32+version_mask = 0xffff0000++version_1 :: Int32+version_1 = 0x80010000++data BinaryProtocol a = Transport a => BinaryProtocol a+++instance Protocol BinaryProtocol where+ getTransport (BinaryProtocol t) = t++ writeMessageBegin p (n, t, s) = do+ writeI32 p (version_1 .|. (fromIntegral $ fromEnum t))+ writeString p n+ writeI32 p s+ writeMessageEnd _ = return ()++ writeStructBegin _ _ = return ()+ writeStructEnd _ = return ()+ writeFieldBegin p (_, t, i) = writeType p t >> writeI16 p i+ writeFieldEnd _ = return ()+ writeFieldStop p = writeType p T_STOP+ writeMapBegin p (k, v, n) = writeType p k >> writeType p v >> writeI32 p n+ writeMapEnd _ = return ()+ writeListBegin p (t, n) = writeType p t >> writeI32 p n+ writeListEnd _ = return ()+ writeSetBegin p (t, n) = writeType p t >> writeI32 p n+ writeSetEnd _ = return ()++ writeBool p b = tWrite (getTransport p) $ LBS.singleton $ toEnum $ if b then 1 else 0+ writeByte p b = tWrite (getTransport p) $ Data.Binary.encode b+ writeI16 p b = tWrite (getTransport p) $ Data.Binary.encode b+ writeI32 p b = tWrite (getTransport p) $ Data.Binary.encode b+ writeI64 p b = tWrite (getTransport p) $ Data.Binary.encode b+ writeDouble p d = writeI64 p (fromIntegral $ floatBits d)+ writeString p s = writeI32 p (fromIntegral $ length s) >> tWrite (getTransport p) (LBSChar8.pack s)+ writeBinary p s = writeI32 p (fromIntegral $ LBS.length s) >> tWrite (getTransport p) s++ readMessageBegin p = do+ ver <- readI32 p+ if (ver .&. version_mask /= version_1)+ then throw $ ProtocolExn PE_BAD_VERSION "Missing version identifier"+ else do+ s <- readString p+ sz <- readI32 p+ return (s, toEnum $ fromIntegral $ ver .&. 0xFF, sz)+ readMessageEnd _ = return ()+ readStructBegin _ = return ""+ readStructEnd _ = return ()+ readFieldBegin p = do+ t <- readType p+ n <- if t /= T_STOP then readI16 p else return 0+ return ("", t, n)+ readFieldEnd _ = return ()+ readMapBegin p = do+ kt <- readType p+ vt <- readType p+ n <- readI32 p+ return (kt, vt, n)+ readMapEnd _ = return ()+ readListBegin p = do+ t <- readType p+ n <- readI32 p+ return (t, n)+ readListEnd _ = return ()+ readSetBegin p = do+ t <- readType p+ n <- readI32 p+ return (t, n)+ readSetEnd _ = return ()++ readBool p = (== 1) `fmap` readByte p++ readByte p = do+ bs <- tReadAll (getTransport p) 1+ return $ Data.Binary.decode bs++ readI16 p = do+ bs <- tReadAll (getTransport p) 2+ return $ Data.Binary.decode bs++ readI32 p = do+ bs <- tReadAll (getTransport p) 4+ return $ Data.Binary.decode bs++ readI64 p = do+ bs <- tReadAll (getTransport p) 8+ return $ Data.Binary.decode bs++ readDouble p = do+ bs <- readI64 p+ return $ floatOfBits $ fromIntegral bs++ readString p = do+ i <- readI32 p+ LBSChar8.unpack `liftM` tReadAll (getTransport p) (fromIntegral i)++ readBinary p = do+ i <- readI32 p+ tReadAll (getTransport p) (fromIntegral i)+++-- | Write a type as a byte+writeType :: (Protocol p, Transport t) => p t -> ThriftType -> IO ()+writeType p t = writeByte p (fromIntegral $ fromEnum t)++-- | Read a byte as though it were a ThriftType+readType :: (Protocol p, Transport t) => p t -> IO ThriftType+readType p = do+ b <- readByte p+ return $ toEnum $ fromIntegral b++floatBits :: Double -> Word64+floatBits (D# d#) = W64# (unsafeCoerce# d#)++floatOfBits :: Word64 -> Double+floatOfBits (W64# b#) = D# (unsafeCoerce# b#)+
+ src/Thrift/Server.hs view
@@ -0,0 +1,66 @@+{-# 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.+--++module Thrift.Server+ ( runBasicServer+ , runThreadedServer+ ) where++import Control.Concurrent ( forkIO )+import Control.Exception+import Control.Monad ( forever, when )++import Network++import System.IO++import Thrift+import Thrift.Transport.Handle()+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))+ -> h+ -> (h -> (i t, o t) -> IO Bool)+ -> PortID+ -> IO a+runThreadedServer accepter hand proc_ port = do+ socket <- listenOn port+ acceptLoop (accepter socket) (proc_ hand)++-- | A basic threaded binary protocol socket server.+runBasicServer :: h+ -> (h -> (BinaryProtocol Handle, BinaryProtocol Handle) -> IO Bool)+ -> PortNumber+ -> IO a+runBasicServer hand proc_ port = runThreadedServer binaryAccept hand proc_ (PortNumber port)+ where binaryAccept s = do+ (h, _, _) <- accept s+ return (BinaryProtocol h, BinaryProtocol h)++acceptLoop :: IO t -> (t -> IO Bool) -> IO a+acceptLoop accepter proc_ = forever $+ do ps <- accepter+ forkIO $ handle (\(_ :: SomeException) -> return ())+ (loop $ proc_ ps)+ where loop m = do { continue <- m; when continue (loop m) }
+ src/Thrift/Transport.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE DeriveDataTypeable #-}+--+-- 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+ ( Transport(..)+ , TransportExn(..)+ , TransportExnType(..)+ ) where++import Control.Monad ( when )+import Control.Exception ( Exception, throw )++import Data.Typeable ( Typeable )++import qualified Data.ByteString.Lazy as LBS+import Data.Monoid++class Transport a where+ tIsOpen :: a -> IO Bool+ tClose :: a -> IO ()+ tRead :: a -> Int -> IO LBS.ByteString+ tWrite :: a -> LBS.ByteString -> IO ()+ tFlush :: a -> IO ()+ tReadAll :: a -> Int -> IO LBS.ByteString++ tReadAll _ 0 = return mempty+ tReadAll a len = do+ result <- tRead a len+ let rlen = fromIntegral $ LBS.length result+ when (rlen == 0) (throw $ TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN)+ if len <= rlen+ then return result+ else (result `mappend`) `fmap` (tReadAll a (len - rlen))++data TransportExn = TransportExn String TransportExnType+ deriving ( Show, Typeable )+instance Exception TransportExn++data TransportExnType+ = TE_UNKNOWN+ | TE_NOT_OPEN+ | TE_ALREADY_OPEN+ | TE_TIMED_OUT+ | TE_END_OF_FILE+ deriving ( Eq, Show, Typeable )+
+ src/Thrift/Transport/Handle.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+--+-- 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.Handle+ ( module Thrift.Transport+ , HandleSource(..)+ ) where++import Control.Exception ( throw )+import Control.Monad ()++import Network++import System.IO+import System.IO.Error ( isEOFError )++import Thrift.Transport++import qualified Data.ByteString.Lazy as LBS+import Data.Monoid++instance Transport Handle where+ tIsOpen = hIsOpen+ tClose h = hClose h+ tRead h n = LBS.hGet h n `catch` handleEOF+ tWrite h s = LBS.hPut h s+ tFlush = hFlush+++-- | Type class for all types that can open a Handle. This class is used to+-- replace tOpen in the Transport type class.+class HandleSource s where+ hOpen :: s -> IO Handle++instance HandleSource FilePath where+ hOpen s = openFile s ReadWriteMode++instance HandleSource (HostName, PortID) where+ hOpen = uncurry connectTo+++handleEOF :: forall a (m :: * -> *).(Monoid a, Monad m) => IOError -> m a+handleEOF e = if isEOFError e+ then return mempty+ else throw $ TransportExn "TChannelTransport: Could not read" TE_UNKNOWN
+ src/Thrift/Transport/HttpClient.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE FlexibleInstances #-}+--+-- 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.HttpClient+ ( module Thrift.Transport+ , HttpClient (..)+ , openHttpClient+ ) where++import Thrift.Transport+import Network.URI+import Network.HTTP hiding (port, host)++import Control.Monad (liftM)+import Data.Maybe (fromJust)+import Data.Monoid (mappend, mempty)+import Control.Exception (throw)+import Control.Concurrent.MVar+import qualified Data.Binary.Builder as B+import qualified Data.ByteString.Lazy as LBS+++-- | 'HttpClient', or THttpClient implements the Thrift Transport+-- | Layer over http or https.+data HttpClient =+ HttpClient {+ hstream :: HandleStream LBS.ByteString,+ uri :: URI,+ writeBuffer :: WriteBuffer,+ readBuffer :: ReadBuffer+ }++uriAuth :: URI -> URIAuth+uriAuth = fromJust . uriAuthority++host :: URI -> String+host = uriRegName . uriAuth++port :: URI -> Int+port uri_ =+ if portStr == mempty then+ httpPort+ else+ read portStr+ where+ portStr = dropWhile (== ':') $ uriPort $ uriAuth uri_+ httpPort = 80++-- | Use 'openHttpClient' to create an HttpClient connected to @uri@+openHttpClient :: URI -> IO HttpClient+openHttpClient uri_ = do+ stream <- openTCPConnection (host uri_) (port uri_)+ wbuf <- newWriteBuffer+ rbuf <- newReadBuffer+ return $ HttpClient stream uri_ wbuf rbuf++instance Transport HttpClient where++ tClose = close . hstream++ tRead hclient n = readBuf (readBuffer hclient) n++ tWrite hclient = writeBuf (writeBuffer hclient)++ tFlush hclient = do+ body <- flushBuf $ writeBuffer hclient+ let request = Request {+ rqURI = uri hclient,+ rqHeaders = [+ mkHeader HdrContentType "application/x-thrift",+ mkHeader HdrContentLength $ show $ LBS.length body],+ rqMethod = POST,+ rqBody = body+ }++ res <- sendHTTP (hstream hclient) request+ case res of+ Right response -> do+ fillBuf (readBuffer hclient) (rspBody response)+ Left _ -> do+ throw $ TransportExn "THttpConnection: HTTP failure from server" TE_UNKNOWN+ return ()++ tIsOpen _ = return True+-- Mini IO buffers++type WriteBuffer = MVar (B.Builder)++newWriteBuffer :: IO WriteBuffer+newWriteBuffer = newMVar mempty++writeBuf :: WriteBuffer -> LBS.ByteString -> IO ()+writeBuf w s = modifyMVar_ w $ return . (\builder ->+ builder `mappend` (B.fromLazyByteString s))++flushBuf :: WriteBuffer -> IO (LBS.ByteString)+flushBuf w = B.toLazyByteString `liftM` swapMVar w mempty+++type ReadBuffer = MVar (LBS.ByteString)++newReadBuffer :: IO ReadBuffer+newReadBuffer = newMVar mempty++fillBuf :: ReadBuffer -> LBS.ByteString -> IO ()+fillBuf r s = swapMVar r s >> return ()++readBuf :: ReadBuffer -> Int -> IO (LBS.ByteString)+readBuf r n = modifyMVar r $ return . flipPair . LBS.splitAt (fromIntegral n)+ where flipPair (a, b) = (b, a)
+ thrift.cabal view
@@ -0,0 +1,47 @@+--+-- 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.+--++Name: thrift+Version: 0.6.0+Cabal-Version: >= 1.4+License: OtherLicense+Category: Foreign+Build-Type: Simple+Synopsis: Haskell bindings for the Apache Thrift RPC system+Homepage: http://thrift.apache.org+Bug-Reports: https://issues.apache.org/jira/browse/THRIFT+Maintainer: dev@thrift.apache.org+License-File: LICENSE++Description:+ Haskell bindings for the Apache Thrift RPC system. Requires the use of the thrift code generator.++Library+ Hs-Source-Dirs:+ src+ Build-Depends:+ base >= 4, base < 5, network, ghc-prim, binary, bytestring, HTTP+ Exposed-Modules:+ Thrift, Thrift.Protocol, Thrift.Transport, Thrift.Protocol.Binary+ Thrift.Transport.Handle, Thrift.Transport.HttpClient, Thrift.Server+ Extensions:+ DeriveDataTypeable, ExistentialQuantification, FlexibleInstances,+ KindSignatures, MagicHash, RankNTypes,+ ScopedTypeVariables, TypeSynonymInstances+