{-# LANGUAGE TypeSynonymInstances #-}------------------------------------------------------------------------------- |-- Module : Network.TCP-- Copyright : See LICENSE file-- License : BSD---- Maintainer : Ganesh Sittampalam <ganesh@earth.li>-- Stability : experimental-- Portability : non-portable (not tested)---- Some utility functions for working with the Haskell @network@ package. Mostly-- for internal use by the @Network.HTTP@ code.-------------------------------------------------------------------------------moduleNetwork.TCP(Connection ,EndPoint (..),openTCPPort ,isConnectedTo ,openTCPConnection ,socketConnection ,isTCPConnectedTo ,HandleStream ,HStream (..),StreamHooks (..),nullHooks ,setStreamHooks ,getStreamHooks ,hstreamToConnection )whereimportNetwork.Socket(Socket,SocketOption(KeepAlive),SocketType(Stream),connect,shutdown,ShutdownCmd(..),setSocketOption,getPeerName,socket,Family(AF_UNSPEC),defaultProtocol,getAddrInfo,defaultHints,addrFamily,withSocketsDo,addrSocketType,addrAddress)importqualifiedNetwork.Socket(close)importqualifiedNetwork.Stream asStream(Stream (readBlock ,readLine ,writeBlock ,close ,closeOnEnd ))importNetwork.Stream (ConnError (..),Result ,failWith ,failMisc )importNetwork.BufferType importNetwork.HTTP.Base (catchIO )importNetwork.Socket(socketToHandle)importData.Char(toLower)importData.Word(Word8)importControl.ConcurrentimportControl.Exception(onException)importControl.Monad(liftM,when)importSystem.IO(Handle,hFlush,IOMode(..),hClose)importSystem.IO.Error(isEOFError)importqualifiedData.ByteStringasStrictimportqualifiedData.ByteString.LazyasLazy----------------------------------------------------------------------------------- TCP Connections ------------------------------------------------------------------------------------------------- | The 'Connection' newtype is a wrapper that allows us to make-- connections an instance of the Stream class, without GHC extensions.-- While this looks sort of like a generic reference to the transport-- layer it is actually TCP specific, which can be seen in the-- implementation of the 'Stream Connection' instance.newtypeConnection =Connection (HandleStream String)newtypeHandleStream a =HandleStream {getRef ::MVar(Conn a )}dataEndPoint =EndPoint {epHost ::String,epPort ::Int}instanceEqEndPoint whereEndPoint host1 port1 == EndPoint host2 port2 =maptoLowerhost1 ==maptoLowerhost2 &&port1 ==port2 dataConn a =MkConn {connSock ::!Socket,connHandle ::Handle,connBuffer ::BufferOp a ,connInput ::Maybea ,connEndPoint ::EndPoint ,connHooks ::Maybe(StreamHooks a ),connCloseEOF ::Bool-- True => close socket upon reaching end-of-stream.}|ConnClosed deriving(Eq)hstreamToConnection::HandleStream String->Connection hstreamToConnection h =Connection h connHooks'::Conn a ->Maybe(StreamHooks a )connHooks' ConnClosed {}=NothingconnHooks'x =connHooksx -- all of these are post-op hooksdataStreamHooks ty =StreamHooks {hook_readLine ::(ty ->String)->Result ty ->IO(),hook_readBlock ::(ty ->String)->Int->Result ty ->IO(),hook_writeBlock ::(ty ->String)->ty ->Result ()->IO(),hook_close ::IO(),hook_name ::String-- hack alert: name of the hook itself.}instanceEqty =>Eq(StreamHooks ty )where(== )__=TruenullHooks::StreamHooks ty nullHooks =StreamHooks {hook_readLine=\__->return(),hook_readBlock=\___->return(),hook_writeBlock=\___->return(),hook_close=return(),hook_name=""}setStreamHooks::HandleStream ty ->StreamHooks ty ->IO()setStreamHooks h sh =modifyMVar_(getRefh )(\c ->returnc {connHooks=Justsh })getStreamHooks::HandleStream ty ->IO(Maybe(StreamHooks ty ))getStreamHooks h =readMVar(getRefh )>>=return.connHooks-- | @HStream@ overloads the use of 'HandleStream's, letting you-- overload the handle operations over the type that is communicated-- across the handle. It comes in handy for @Network.HTTP@ 'Request'-- and 'Response's as the payload representation isn't fixed, but overloaded.---- The library comes with instances for @ByteString@s and @String@, but-- should you want to plug in your own payload representation, defining-- your own @HStream@ instance _should_ be all that it takes.-- classBufferType bufType =>HStream bufType whereopenStream ::String->Int->IO(HandleStream bufType )openSocketStream ::String->Int->Socket->IO(HandleStream bufType )readLine ::HandleStream bufType ->IO(Result bufType )readBlock ::HandleStream bufType ->Int->IO(Result bufType )writeBlock ::HandleStream bufType ->bufType ->IO(Result ())close ::HandleStream bufType ->IO()closeQuick ::HandleStream bufType ->IO()closeOnEnd ::HandleStream bufType ->Bool->IO()instanceHStream Strict.ByteStringwhereopenStream =openTCPConnection openSocketStream =socketConnection readBlock c n =readBlockBS c n readLine c =readLineBS c writeBlock c str =writeBlockBS c str close c =closeIt c Strict.nullTruecloseQuick c =closeIt c Strict.nullFalsecloseOnEnd c f =closeEOF c f instanceHStream Lazy.ByteStringwhereopenStream =\a b ->openTCPConnection_ a b TrueopenSocketStream =\a b c ->socketConnection_ a b c TruereadBlock c n =readBlockBS c n readLine c =readLineBS c writeBlock c str =writeBlockBS c str close c =closeIt c Lazy.nullTruecloseQuick c =closeIt c Lazy.nullFalsecloseOnEnd c f =closeEOF c f instanceStream.Stream Connection wherereadBlock (Connection c )=Network.TCP.readBlock c readLine (Connection c )=Network.TCP.readLine c writeBlock (Connection c )=Network.TCP.writeBlock c close (Connection c )=Network.TCP.close c closeOnEnd (Connection c )f =Network.TCP.closeEOF c f instanceHStream StringwhereopenStream =openTCPConnection openSocketStream =socketConnection readBlock ref n =readBlockBS ref n -- This function uses a buffer, at this time the buffer is just 1000 characters.-- (however many bytes this is is left to the user to decypher)readLine ref =readLineBS ref -- The 'Connection' object allows no outward buffering, -- since in general messages are serialised in their entirety.writeBlock ref str =writeBlockBS ref str -- (stringToBuf str)-- Closes a Connection. Connection will no longer-- allow any of the other Stream functions. Notice that a Connection may close-- at any time before a call to this function. This function is idempotent.-- (I think the behaviour here is TCP specific)close c =closeIt c nullTrue-- Closes a Connection without munching the rest of the stream.closeQuick c =closeIt c nullFalsecloseOnEnd c f =closeEOF c f -- | @openTCPPort uri port@ establishes a connection to a remote-- host, using 'getHostByName' which possibly queries the DNS system, hence -- may trigger a network connection.openTCPPort::String->Int->IOConnection openTCPPort uri port =openTCPConnection uri port >>=return.Connection -- Add a "persistent" option? Current persistent is default.-- Use "Result" type for synchronous exception reporting?openTCPConnection::BufferType ty =>String->Int->IO(HandleStream ty )openTCPConnection uri port =openTCPConnection_ uri port FalseopenTCPConnection_::BufferType ty =>String->Int->Bool->IO(HandleStream ty )openTCPConnection_ uri port stashInput =do-- HACK: uri is sometimes obtained by calling Network.URI.uriRegName, and this includes-- the surrounding square brackets for an RFC 2732 host like [::1]. It's not clear whether-- it should, or whether all call sites should be using something different instead, but-- the simplest short-term fix is to strip any surrounding square brackets here.-- It shouldn't affect any as this is the only situation they can occur - see RFC 3986.letfixedUri =caseuri of'[':(rest @(c :_))|lastrest ==']'->ifc =='v'||c =='V'thenerror$"Unsupported post-IPv6 address "++uri elseinitrest _->uri -- use withSocketsDo here in case the caller hasn't used it, which would make getAddrInfo fail on Windows-- although withSocketsDo is supposed to wrap the entire program, in practice it is safe to use it locally-- like this as it just does a once-only installation of a shutdown handler to run at program exit,-- rather than actually shutting down after the actionaddrinfos <-withSocketsDo$getAddrInfo(Just$defaultHints{addrFamily=AF_UNSPEC,addrSocketType=Stream})(JustfixedUri )(Just.show$port )caseaddrinfos of[]->fail"openTCPConnection: getAddrInfo returned no address information"(a :_)->dos <-socket(addrFamilya )StreamdefaultProtocolonException(dosetSocketOptions KeepAlive1connects (addrAddressa )socketConnection_ fixedUri port s stashInput )(Network.Socket.closes )-- | @socketConnection@, like @openConnection@ but using a pre-existing 'Socket'.socketConnection::BufferType ty =>String->Int->Socket->IO(HandleStream ty )socketConnection hst port sock =socketConnection_ hst port sock False-- Internal function used to control the on-demand streaming of input-- for /lazy/ streams.socketConnection_::BufferType ty =>String->Int->Socket->Bool->IO(HandleStream ty )socketConnection_ hst port sock stashInput =doh <-socketToHandlesock ReadWriteModemb <-casestashInput of{True->liftMJust$buf_hGetContentsbufferOps h ;_->returnNothing}letconn =MkConn {connSock=sock ,connHandle=h ,connBuffer=bufferOps ,connInput=mb ,connEndPoint=EndPoint hst port ,connHooks=Nothing,connCloseEOF=False}v <-newMVarconn return(HandleStream v )closeConnection::HStream a =>HandleStream a ->IOBool->IO()closeConnection ref readL =do-- won't hold onto the lock for the duration-- we are draining it...ToDo: have Connection-- into a shutting-down state so that other-- threads will simply back off if/when attempting-- to also close it.c <-readMVar(getRefref )closeConn c `catchIO `(\_->return())modifyMVar_(getRefref )(\_->returnConnClosed )where-- Be kind to peer & close gracefully.closeConn ConnClosed =return()closeConnconn =doletsk =connSockconn hFlush(connHandleconn )shutdownsk ShutdownSendsuck readL hClose(connHandleconn )shutdownsk ShutdownReceiveNetwork.Socket.closesk suck::IOBool->IO()suck rd =dof <-rd iff thenreturn()elsesuck rd -- | Checks both that the underlying Socket is connected-- and that the connection peer matches the given-- host name (which is recorded locally).isConnectedTo::Connection ->EndPoint ->IOBoolisConnectedTo (Connection conn )endPoint =isTCPConnectedTo conn endPoint isTCPConnectedTo::HandleStream ty ->EndPoint ->IOBoolisTCPConnectedTo conn endPoint =dov <-readMVar(getRefconn )casev ofConnClosed ->returnFalse_|connEndPointv ==endPoint ->catchIO (getPeerName(connSockv )>>returnTrue)(const$returnFalse)|otherwise->returnFalsereadBlockBS::HStream a =>HandleStream a ->Int->IO(Result a )readBlockBS ref n =onNonClosedDo ref $\conn ->dox <-bufferGetBlock ref n maybe(return())(\h ->hook_readBlockh (buf_toStr$connBufferconn )n x )(connHooks' conn )returnx -- This function uses a buffer, at this time the buffer is just 1000 characters.-- (however many bytes this is is left for the user to decipher)readLineBS::HStream a =>HandleStream a ->IO(Result a )readLineBS ref =onNonClosedDo ref $\conn ->dox <-bufferReadLine ref maybe(return())(\h ->hook_readLineh (buf_toStr$connBufferconn )x )(connHooks' conn )returnx -- The 'Connection' object allows no outward buffering, -- since in general messages are serialised in their entirety.writeBlockBS::HandleStream a ->a ->IO(Result ())writeBlockBS ref b =onNonClosedDo ref $\conn ->dox <-bufferPutBlock (connBufferconn )(connHandleconn )b maybe(return())(\h ->hook_writeBlockh (buf_toStr$connBufferconn )b x )(connHooks' conn )returnx closeIt::HStream ty =>HandleStream ty ->(ty ->Bool)->Bool->IO()closeIt c p b =docloseConnection c (ifb thenreadLineBS c >>=\x ->casex of{Rightxs ->return(p xs );_->returnTrue}elsereturnTrue)conn <-readMVar(getRefc )maybe(return())(hook_close)(connHooks' conn )closeEOF::HandleStream ty ->Bool->IO()closeEOF c flg =modifyMVar_(getRefc )(\co ->returnco {connCloseEOF=flg })bufferGetBlock::HStream a =>HandleStream a ->Int->IO(Result a )bufferGetBlock ref n =onNonClosedDo ref $\conn ->docaseconnInputconn ofJustc ->dolet(a ,b )=buf_splitAt(connBufferconn )n c modifyMVar_(getRefref )(\co ->returnco {connInput=Justb })return(returna )_->docatchIO (buf_hGet(connBufferconn )(connHandleconn )n >>=return.return)(\e ->ifisEOFErrore thendowhen(connCloseEOFconn )$catchIO (closeQuick ref )(\_->return())return(return(buf_empty(connBufferconn )))elsereturn(failMisc (showe )))bufferPutBlock::BufferOp a ->Handle->a ->IO(Result ())bufferPutBlock ops h b =catchIO (buf_hPutops h b >>hFlushh >>return(return()))(\e ->return(failMisc (showe )))bufferReadLine::HStream a =>HandleStream a ->IO(Result a )bufferReadLine ref =onNonClosedDo ref $\conn ->docaseconnInputconn ofJustc ->dolet(a ,b0 )=buf_span(connBufferconn )(/='\n')c let(newl ,b1 )=buf_splitAt(connBufferconn )1b0 modifyMVar_(getRefref )(\co ->returnco {connInput=Justb1 })return(return(buf_append(connBufferconn )a newl ))_->catchIO (buf_hGetLine(connBufferconn )(connHandleconn )>>=return.return.appendNL (connBufferconn ))(\e ->ifisEOFErrore thendowhen(connCloseEOFconn )$catchIO (closeQuick ref )(\_->return())return(return(buf_empty(connBufferconn )))elsereturn(failMisc (showe )))where-- yes, this s**ks.. _may_ have to be addressed if perf-- suggests worthiness.appendNL ops b =buf_snocops b nl nl::Word8nl =fromIntegral(fromEnum'\n')onNonClosedDo::HandleStream a ->(Conn a ->IO(Result b ))->IO(Result b )onNonClosedDo h act =dox <-readMVar(getRefh )casex ofConnClosed {}->return(failWith ErrorClosed )_->act x