Thrift now a TLP - INFRA-3116
git-svn-id: https://svn.apache.org/repos/asf/thrift/branches/0.1.x@1028168 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/hs/src/Thrift.hs b/lib/hs/src/Thrift.hs
new file mode 100644
index 0000000..291bcae
--- /dev/null
+++ b/lib/hs/src/Thrift.hs
@@ -0,0 +1,111 @@
+--
+-- 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
+
+ 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 (fromEnum (ae_type ae))
+ writeFieldEnd pt
+ writeFieldStop pt
+ writeStructEnd pt
+
+readAppExn :: (Protocol p, Transport t) => p t -> IO AppExn
+readAppExn pt = do
+ readStructBegin pt
+ rec <- readAppExnFields pt (AppExn {ae_type = undefined, ae_message = undefined})
+ readStructEnd pt
+ return rec
+
+readAppExnFields pt rec = do
+ (n, ft, id) <- readFieldBegin pt
+ if ft == T_STOP
+ then return rec
+ else case id of
+ 1 -> if ft == T_STRING then
+ do s <- readString pt
+ readAppExnFields pt rec{ae_message = s}
+ else do skip pt ft
+ readAppExnFields pt rec
+ 2 -> if ft == T_I32 then
+ do i <- readI32 pt
+ readAppExnFields pt rec{ae_type = (toEnum i)}
+ else do skip pt ft
+ readAppExnFields pt rec
+ _ -> do skip pt ft
+ readFieldEnd pt
+ readAppExnFields pt rec
+
diff --git a/lib/hs/src/Thrift/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs
new file mode 100644
index 0000000..8fa060e
--- /dev/null
+++ b/lib/hs/src/Thrift/Protocol.hs
@@ -0,0 +1,191 @@
+--
+-- 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.Typeable ( Typeable )
+import Data.Int
+
+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
+
+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
+
+
+class Protocol a where
+ getTransport :: Transport t => a t -> t
+
+ writeMessageBegin :: Transport t => a t -> (String, MessageType, Int) -> 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, Int) -> IO ()
+ writeFieldEnd :: Transport t => a t -> IO ()
+ writeFieldStop :: Transport t => a t -> IO ()
+ writeMapBegin :: Transport t => a t -> (ThriftType, ThriftType, Int) -> IO ()
+ writeMapEnd :: Transport t => a t -> IO ()
+ writeListBegin :: Transport t => a t -> (ThriftType, Int) -> IO ()
+ writeListEnd :: Transport t => a t -> IO ()
+ writeSetBegin :: Transport t => a t -> (ThriftType, Int) -> IO ()
+ writeSetEnd :: Transport t => a t -> IO ()
+
+ writeBool :: Transport t => a t -> Bool -> IO ()
+ writeByte :: Transport t => a t -> Int -> IO ()
+ writeI16 :: Transport t => a t -> Int -> IO ()
+ writeI32 :: Transport t => a t -> Int -> 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 -> String -> IO ()
+
+
+ readMessageBegin :: Transport t => a t -> IO (String, MessageType, Int)
+ 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, Int)
+ readFieldEnd :: Transport t => a t -> IO ()
+ readMapBegin :: Transport t => a t -> IO (ThriftType, ThriftType, Int)
+ readMapEnd :: Transport t => a t -> IO ()
+ readListBegin :: Transport t => a t -> IO (ThriftType, Int)
+ readListEnd :: Transport t => a t -> IO ()
+ readSetBegin :: Transport t => a t -> IO (ThriftType, Int)
+ readSetEnd :: Transport t => a t -> IO ()
+
+ readBool :: Transport t => a t -> IO Bool
+ readByte :: Transport t => a t -> IO Int
+ readI16 :: Transport t => a t -> IO Int
+ readI32 :: Transport t => a t -> IO Int
+ 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 String
+
+
+skip :: (Protocol p, Transport t) => p t -> ThriftType -> IO ()
+skip p T_STOP = return ()
+skip p 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_ s (skip p k >> skip p v)
+ readMapEnd p
+skip p T_SET = do (t, n) <- readSetBegin p
+ replicateM_ n (skip p t)
+ readSetEnd p
+skip p T_LIST = do (t, n) <- readListBegin p
+ replicateM_ 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
diff --git a/lib/hs/src/Thrift/Protocol/Binary.hs b/lib/hs/src/Thrift/Protocol/Binary.hs
new file mode 100644
index 0000000..3f798ce
--- /dev/null
+++ b/lib/hs/src/Thrift/Protocol/Binary.hs
@@ -0,0 +1,147 @@
+--
+-- 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 Data.Bits
+import Data.Int
+import Data.List ( foldl' )
+
+import GHC.Exts
+import GHC.Word
+
+import Thrift.Protocol
+import Thrift.Transport
+
+
+version_mask = 0xffff0000
+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 .|. (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 p = 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) [toEnum $ if b then 1 else 0]
+ writeByte p b = tWrite (getTransport p) (getBytes b 1)
+ writeI16 p b = tWrite (getTransport p) (getBytes b 2)
+ writeI32 p b = tWrite (getTransport p) (getBytes b 4)
+ writeI64 p b = tWrite (getTransport p) (getBytes b 8)
+ writeDouble p d = writeI64 p (fromIntegral $ floatBits d)
+ writeString p s = writeI32 p (length s) >> tWrite (getTransport p) s
+ writeBinary = writeString
+
+ 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 $ 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 $ fromIntegral (composeBytes bs :: Int8)
+ readI16 p = do
+ bs <- tReadAll (getTransport p) 2
+ return $ fromIntegral (composeBytes bs :: Int16)
+ readI32 p = composeBytes `fmap` tReadAll (getTransport p) 4
+ readI64 p = composeBytes `fmap` tReadAll (getTransport p) 8
+ readDouble p = do
+ bs <- readI64 p
+ return $ floatOfBits $ fromIntegral bs
+ readString p = readI32 p >>= tReadAll (getTransport p)
+ readBinary = readString
+
+
+-- | Write a type as a byte
+writeType :: (Protocol p, Transport t) => p t -> ThriftType -> IO ()
+writeType p t = writeByte p (fromEnum t)
+
+-- | Read a byte as though it were a ThriftType
+readType :: (Protocol p, Transport t) => p t -> IO ThriftType
+readType p = toEnum `fmap` readByte p
+
+composeBytes :: (Bits b, Enum t) => [t] -> b
+composeBytes = (foldl' fn 0) . (map $ fromIntegral . fromEnum)
+ where fn acc b = (acc `shiftL` 8) .|. b
+
+getByte :: Bits a => a -> Int -> a
+getByte i n = 255 .&. (i `shiftR` (8 * n))
+
+getBytes :: (Bits a, Integral a) => a -> Int -> String
+getBytes i 0 = []
+getBytes i n = (toEnum $ fromIntegral $ getByte i (n-1)):(getBytes i (n-1))
+
+floatBits :: Double -> Word64
+floatBits (D# d#) = W64# (unsafeCoerce# d#)
+
+floatOfBits :: Word64 -> Double
+floatOfBits (W64# b#) = D# (unsafeCoerce# b#)
+
diff --git a/lib/hs/src/Thrift/Server.hs b/lib/hs/src/Thrift/Server.hs
new file mode 100644
index 0000000..770965f
--- /dev/null
+++ b/lib/hs/src/Thrift/Server.hs
@@ -0,0 +1,65 @@
+--
+-- 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 (\(e :: SomeException) -> return ())
+ (loop $ proc ps)
+ where loop m = do { continue <- m; when continue (loop m) }
diff --git a/lib/hs/src/Thrift/Transport.hs b/lib/hs/src/Thrift/Transport.hs
new file mode 100644
index 0000000..29f50d0
--- /dev/null
+++ b/lib/hs/src/Thrift/Transport.hs
@@ -0,0 +1,60 @@
+--
+-- 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 )
+
+
+class Transport a where
+ tIsOpen :: a -> IO Bool
+ tClose :: a -> IO ()
+ tRead :: a -> Int -> IO String
+ tWrite :: a -> String ->IO ()
+ tFlush :: a -> IO ()
+ tReadAll :: a -> Int -> IO String
+
+ tReadAll a 0 = return []
+ tReadAll a len = do
+ result <- tRead a len
+ let rlen = length result
+ when (rlen == 0) (throw $ TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN)
+ if len <= rlen
+ then return result
+ else (result ++) `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 )
+
diff --git a/lib/hs/src/Thrift/Transport/Handle.hs b/lib/hs/src/Thrift/Transport/Handle.hs
new file mode 100644
index 0000000..e49456b
--- /dev/null
+++ b/lib/hs/src/Thrift/Transport/Handle.hs
@@ -0,0 +1,58 @@
+--
+-- 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 ( replicateM )
+
+import Network
+
+import System.IO
+import System.IO.Error ( isEOFError )
+
+import Thrift.Transport
+
+
+instance Transport Handle where
+ tIsOpen = hIsOpen
+ tClose h = hClose h
+ tRead h n = replicateM n (hGetChar h) `catch` handleEOF
+ tWrite h s = mapM_ (hPutChar 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 e = if isEOFError e
+ then return []
+ else throw $ TransportExn "TChannelTransport: Could not read" TE_UNKNOWN