{-# LANGUAGE ScopedTypeVariables #-}{-# 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(IOException,bracketOnError,try)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 {HandleStream a -> MVar (Conn a)
getRef ::MVar(Conn a )}dataEndPoint =EndPoint {EndPoint -> String
epHost ::String,EndPoint -> Int
epPort ::Int}instanceEqEndPoint whereEndPoint String
host1 Int
port1 == :: EndPoint -> EndPoint -> Bool
==EndPoint String
host2 Int
port2 =(Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
mapChar -> Char
toLowerString
host1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==(Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
mapChar -> Char
toLowerString
host2 Bool -> Bool -> Bool
&&Int
port1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
port2 dataConn a =MkConn {Conn a -> Socket
connSock ::!Socket,Conn a -> Handle
connHandle ::Handle,Conn a -> BufferOp a
connBuffer ::BufferOp a ,Conn a -> Maybe a
connInput ::Maybea ,Conn a -> EndPoint
connEndPoint ::EndPoint ,Conn a -> Maybe (StreamHooks a)
connHooks ::Maybe(StreamHooks a ),Conn a -> Bool
connCloseEOF ::Bool-- True => close socket upon reaching end-of-stream.}|ConnClosed deriving(Conn a -> Conn a -> Bool
(Conn a -> Conn a -> Bool)
-> (Conn a -> Conn a -> Bool) -> Eq (Conn a)
forall a. Eq a => Conn a -> Conn a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Conn a -> Conn a -> Bool
$c/= :: forall a. Eq a => Conn a -> Conn a -> Bool
== :: Conn a -> Conn a -> Bool
$c== :: forall a. Eq a => Conn a -> Conn a -> Bool
Eq)hstreamToConnection ::HandleStream String->Connection hstreamToConnection :: HandleStream String -> Connection
hstreamToConnection HandleStream String
h =HandleStream String -> Connection
Connection HandleStream String
h connHooks' ::Conn a ->Maybe(StreamHooks a )connHooks' :: Conn a -> Maybe (StreamHooks a)
connHooks' ConnClosed {}=Maybe (StreamHooks a)
forall a. Maybe a
NothingconnHooks' Conn a
x =Conn a -> Maybe (StreamHooks a)
forall a. Conn a -> Maybe (StreamHooks a)
connHooks Conn a
x -- all of these are post-op hooksdataStreamHooks ty =StreamHooks {StreamHooks ty -> (ty -> String) -> Result ty -> IO ()
hook_readLine ::(ty ->String)->Result ty ->IO(),StreamHooks ty -> (ty -> String) -> Int -> Result ty -> IO ()
hook_readBlock ::(ty ->String)->Int->Result ty ->IO(),StreamHooks ty -> (ty -> String) -> ty -> Result () -> IO ()
hook_writeBlock ::(ty ->String)->ty ->Result ()->IO(),StreamHooks ty -> IO ()
hook_close ::IO(),StreamHooks ty -> String
hook_name ::String-- hack alert: name of the hook itself.}instanceEqty =>Eq(StreamHooks ty )where== :: StreamHooks ty -> StreamHooks ty -> Bool
(==)StreamHooks ty
_StreamHooks ty
_=Bool
TruenullHooks ::StreamHooks ty nullHooks :: StreamHooks ty
nullHooks =StreamHooks :: forall ty.
((ty -> String) -> Result ty -> IO ())
-> ((ty -> String) -> Int -> Result ty -> IO ())
-> ((ty -> String) -> ty -> Result () -> IO ())
-> IO ()
-> String
-> StreamHooks ty
StreamHooks {hook_readLine :: (ty -> String) -> Result ty -> IO ()
hook_readLine =\ty -> String
_Result ty
_->() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return(),hook_readBlock :: (ty -> String) -> Int -> Result ty -> IO ()
hook_readBlock =\ty -> String
_Int
_Result ty
_->() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return(),hook_writeBlock :: (ty -> String) -> ty -> Result () -> IO ()
hook_writeBlock =\ty -> String
_ty
_Result ()
_->() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return(),hook_close :: IO ()
hook_close =() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return(),hook_name :: String
hook_name =String
""}setStreamHooks ::HandleStream ty ->StreamHooks ty ->IO()setStreamHooks :: HandleStream ty -> StreamHooks ty -> IO ()
setStreamHooks HandleStream ty
h StreamHooks ty
sh =MVar (Conn ty) -> (Conn ty -> IO (Conn ty)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_(HandleStream ty -> MVar (Conn ty)
forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream ty
h )(\Conn ty
c ->Conn ty -> IO (Conn ty)
forall (m :: * -> *) a. Monad m => a -> m a
returnConn ty
c {connHooks :: Maybe (StreamHooks ty)
connHooks =StreamHooks ty -> Maybe (StreamHooks ty)
forall a. a -> Maybe a
JustStreamHooks ty
sh })getStreamHooks ::HandleStream ty ->IO(Maybe(StreamHooks ty ))getStreamHooks :: HandleStream ty -> IO (Maybe (StreamHooks ty))
getStreamHooks HandleStream ty
h =MVar (Conn ty) -> IO (Conn ty)
forall a. MVar a -> IO a
readMVar(HandleStream ty -> MVar (Conn ty)
forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream ty
h )IO (Conn ty)
-> (Conn ty -> IO (Maybe (StreamHooks ty)))
-> IO (Maybe (StreamHooks ty))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=Maybe (StreamHooks ty) -> IO (Maybe (StreamHooks ty))
forall (m :: * -> *) a. Monad m => a -> m a
return(Maybe (StreamHooks ty) -> IO (Maybe (StreamHooks ty)))
-> (Conn ty -> Maybe (StreamHooks ty))
-> Conn ty
-> IO (Maybe (StreamHooks ty))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Conn ty -> Maybe (StreamHooks ty)
forall a. Conn a -> Maybe (StreamHooks a)
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 :: String -> Int -> IO (HandleStream ByteString)
openStream =String -> Int -> IO (HandleStream ByteString)
forall ty. BufferType ty => String -> Int -> IO (HandleStream ty)
openTCPConnection openSocketStream :: String -> Int -> Socket -> IO (HandleStream ByteString)
openSocketStream =String -> Int -> Socket -> IO (HandleStream ByteString)
forall ty.
BufferType ty =>
String -> Int -> Socket -> IO (HandleStream ty)
socketConnection readBlock :: HandleStream ByteString -> Int -> IO (Result ByteString)
readBlock HandleStream ByteString
c Int
n =HandleStream ByteString -> Int -> IO (Result ByteString)
forall a. HStream a => HandleStream a -> Int -> IO (Result a)
readBlockBS HandleStream ByteString
c Int
n readLine :: HandleStream ByteString -> IO (Result ByteString)
readLine HandleStream ByteString
c =HandleStream ByteString -> IO (Result ByteString)
forall a. HStream a => HandleStream a -> IO (Result a)
readLineBS HandleStream ByteString
c writeBlock :: HandleStream ByteString -> ByteString -> IO (Result ())
writeBlock HandleStream ByteString
c ByteString
str =HandleStream ByteString -> ByteString -> IO (Result ())
forall a. HandleStream a -> a -> IO (Result ())
writeBlockBS HandleStream ByteString
c ByteString
str close :: HandleStream ByteString -> IO ()
close HandleStream ByteString
c =HandleStream ByteString -> (ByteString -> Bool) -> Bool -> IO ()
forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream ByteString
c ByteString -> Bool
Strict.nullBool
TruecloseQuick :: HandleStream ByteString -> IO ()
closeQuick HandleStream ByteString
c =HandleStream ByteString -> (ByteString -> Bool) -> Bool -> IO ()
forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream ByteString
c ByteString -> Bool
Strict.nullBool
FalsecloseOnEnd :: HandleStream ByteString -> Bool -> IO ()
closeOnEnd HandleStream ByteString
c Bool
f =HandleStream ByteString -> Bool -> IO ()
forall ty. HandleStream ty -> Bool -> IO ()
closeEOF HandleStream ByteString
c Bool
f instanceHStream Lazy.ByteStringwhereopenStream :: String -> Int -> IO (HandleStream ByteString)
openStream =\String
a Int
b ->String -> Int -> Bool -> IO (HandleStream ByteString)
forall ty.
BufferType ty =>
String -> Int -> Bool -> IO (HandleStream ty)
openTCPConnection_ String
a Int
b Bool
TrueopenSocketStream :: String -> Int -> Socket -> IO (HandleStream ByteString)
openSocketStream =\String
a Int
b Socket
c ->String -> Int -> Socket -> Bool -> IO (HandleStream ByteString)
forall ty.
BufferType ty =>
String -> Int -> Socket -> Bool -> IO (HandleStream ty)
socketConnection_ String
a Int
b Socket
c Bool
TruereadBlock :: HandleStream ByteString -> Int -> IO (Result ByteString)
readBlock HandleStream ByteString
c Int
n =HandleStream ByteString -> Int -> IO (Result ByteString)
forall a. HStream a => HandleStream a -> Int -> IO (Result a)
readBlockBS HandleStream ByteString
c Int
n readLine :: HandleStream ByteString -> IO (Result ByteString)
readLine HandleStream ByteString
c =HandleStream ByteString -> IO (Result ByteString)
forall a. HStream a => HandleStream a -> IO (Result a)
readLineBS HandleStream ByteString
c writeBlock :: HandleStream ByteString -> ByteString -> IO (Result ())
writeBlock HandleStream ByteString
c ByteString
str =HandleStream ByteString -> ByteString -> IO (Result ())
forall a. HandleStream a -> a -> IO (Result ())
writeBlockBS HandleStream ByteString
c ByteString
str close :: HandleStream ByteString -> IO ()
close HandleStream ByteString
c =HandleStream ByteString -> (ByteString -> Bool) -> Bool -> IO ()
forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream ByteString
c ByteString -> Bool
Lazy.nullBool
TruecloseQuick :: HandleStream ByteString -> IO ()
closeQuick HandleStream ByteString
c =HandleStream ByteString -> (ByteString -> Bool) -> Bool -> IO ()
forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream ByteString
c ByteString -> Bool
Lazy.nullBool
FalsecloseOnEnd :: HandleStream ByteString -> Bool -> IO ()
closeOnEnd HandleStream ByteString
c Bool
f =HandleStream ByteString -> Bool -> IO ()
forall ty. HandleStream ty -> Bool -> IO ()
closeEOF HandleStream ByteString
c Bool
f instanceStream.Stream Connection wherereadBlock :: Connection -> Int -> IO (Result String)
readBlock (Connection HandleStream String
c )=HandleStream String -> Int -> IO (Result String)
forall a. HStream a => HandleStream a -> Int -> IO (Result a)
Network.TCP.readBlock HandleStream String
c readLine :: Connection -> IO (Result String)
readLine (Connection HandleStream String
c )=HandleStream String -> IO (Result String)
forall a. HStream a => HandleStream a -> IO (Result a)
Network.TCP.readLine HandleStream String
c writeBlock :: Connection -> String -> IO (Result ())
writeBlock (Connection HandleStream String
c )=HandleStream String -> String -> IO (Result ())
forall bufType.
HStream bufType =>
HandleStream bufType -> bufType -> IO (Result ())
Network.TCP.writeBlock HandleStream String
c close :: Connection -> IO ()
close (Connection HandleStream String
c )=HandleStream String -> IO ()
forall bufType. HStream bufType => HandleStream bufType -> IO ()
Network.TCP.close HandleStream String
c closeOnEnd :: Connection -> Bool -> IO ()
closeOnEnd (Connection HandleStream String
c )Bool
f =HandleStream String -> Bool -> IO ()
forall ty. HandleStream ty -> Bool -> IO ()
Network.TCP.closeEOF HandleStream String
c Bool
f instanceHStream StringwhereopenStream :: String -> Int -> IO (HandleStream String)
openStream =String -> Int -> IO (HandleStream String)
forall ty. BufferType ty => String -> Int -> IO (HandleStream ty)
openTCPConnection openSocketStream :: String -> Int -> Socket -> IO (HandleStream String)
openSocketStream =String -> Int -> Socket -> IO (HandleStream String)
forall ty.
BufferType ty =>
String -> Int -> Socket -> IO (HandleStream ty)
socketConnection readBlock :: HandleStream String -> Int -> IO (Result String)
readBlock HandleStream String
ref Int
n =HandleStream String -> Int -> IO (Result String)
forall a. HStream a => HandleStream a -> Int -> IO (Result a)
readBlockBS HandleStream String
ref Int
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 :: HandleStream String -> IO (Result String)
readLine HandleStream String
ref =HandleStream String -> IO (Result String)
forall a. HStream a => HandleStream a -> IO (Result a)
readLineBS HandleStream String
ref -- The 'Connection' object allows no outward buffering,-- since in general messages are serialised in their entirety.writeBlock :: HandleStream String -> String -> IO (Result ())
writeBlock HandleStream String
ref String
str =HandleStream String -> String -> IO (Result ())
forall a. HandleStream a -> a -> IO (Result ())
writeBlockBS HandleStream String
ref String
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 :: HandleStream String -> IO ()
close HandleStream String
c =HandleStream String -> (String -> Bool) -> Bool -> IO ()
forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream String
c String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
nullBool
True-- Closes a Connection without munching the rest of the stream.closeQuick :: HandleStream String -> IO ()
closeQuick HandleStream String
c =HandleStream String -> (String -> Bool) -> Bool -> IO ()
forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream String
c String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
nullBool
FalsecloseOnEnd :: HandleStream String -> Bool -> IO ()
closeOnEnd HandleStream String
c Bool
f =HandleStream String -> Bool -> IO ()
forall ty. HandleStream ty -> Bool -> IO ()
closeEOF HandleStream String
c Bool
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 :: String -> Int -> IO Connection
openTCPPort String
uri Int
port =String -> Int -> IO (HandleStream String)
forall ty. BufferType ty => String -> Int -> IO (HandleStream ty)
openTCPConnection String
uri Int
port IO (HandleStream String)
-> (HandleStream String -> IO Connection) -> IO Connection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return(Connection -> IO Connection)
-> (HandleStream String -> Connection)
-> HandleStream String
-> IO Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
.HandleStream String -> Connection
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 :: String -> Int -> IO (HandleStream ty)
openTCPConnection String
uri Int
port =String -> Int -> Bool -> IO (HandleStream ty)
forall ty.
BufferType ty =>
String -> Int -> Bool -> IO (HandleStream ty)
openTCPConnection_ String
uri Int
port Bool
FalseopenTCPConnection_ ::BufferType ty =>String->Int->Bool->IO(HandleStream ty )openTCPConnection_ :: String -> Int -> Bool -> IO (HandleStream ty)
openTCPConnection_ String
uri Int
port Bool
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 :: String
fixedUri =caseString
uri ofChar
'[':(rest :: String
rest @(Char
c :String
_))|String -> Char
forall a. [a] -> a
lastString
rest Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
']'->ifChar
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'v'Bool -> Bool -> Bool
||Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'V'thenString -> String
forall a. HasCallStack => String -> a
error(String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$String
"Unsupported post-IPv6 address "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
uri elseString -> String
forall a. [a] -> [a]
initString
rest String
_->String
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 action[AddrInfo]
addrinfos <-IO [AddrInfo] -> IO [AddrInfo]
forall a. IO a -> IO a
withSocketsDo(IO [AddrInfo] -> IO [AddrInfo]) -> IO [AddrInfo] -> IO [AddrInfo]
forall a b. (a -> b) -> a -> b
$Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo(AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just(AddrInfo -> Maybe AddrInfo) -> AddrInfo -> Maybe AddrInfo
forall a b. (a -> b) -> a -> b
$AddrInfo
defaultHints{addrFamily :: Family
addrFamily=Family
AF_UNSPEC,addrSocketType :: SocketType
addrSocketType=SocketType
Stream})(String -> Maybe String
forall a. a -> Maybe a
JustString
fixedUri )(String -> Maybe String
forall a. a -> Maybe a
Just(String -> Maybe String) -> (Int -> String) -> Int -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> String
forall a. Show a => a -> String
show(Int -> Maybe String) -> Int -> Maybe String
forall a b. (a -> b) -> a -> b
$Int
port )letconnectAddrInfo :: AddrInfo -> IO (HandleStream ty)
connectAddrInfo AddrInfo
a =IO Socket
-> (Socket -> IO ())
-> (Socket -> IO (HandleStream ty))
-> IO (HandleStream ty)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError(Family -> SocketType -> ProtocolNumber -> IO Socket
socket(AddrInfo -> Family
addrFamilyAddrInfo
a )SocketType
StreamProtocolNumber
defaultProtocol)-- acquireSocket -> IO ()
Network.Socket.close-- release(\Socket
s ->doSocket -> SocketOption -> Int -> IO ()
setSocketOptionSocket
s SocketOption
KeepAliveInt
1Socket -> SockAddr -> IO ()
connectSocket
s (AddrInfo -> SockAddr
addrAddressAddrInfo
a )String -> Int -> Socket -> Bool -> IO (HandleStream ty)
forall ty.
BufferType ty =>
String -> Int -> Socket -> Bool -> IO (HandleStream ty)
socketConnection_ String
fixedUri Int
port Socket
s Bool
stashInput )-- try multiple addresses; return Just connected socket or NothingtryAddrInfos :: [AddrInfo] -> IO (Maybe (HandleStream ty))
tryAddrInfos []=Maybe (HandleStream ty) -> IO (Maybe (HandleStream ty))
forall (m :: * -> *) a. Monad m => a -> m a
returnMaybe (HandleStream ty)
forall a. Maybe a
NothingtryAddrInfos (AddrInfo
h :[AddrInfo]
t )=letnext :: IOException -> IO (Maybe (HandleStream ty))
next =\(IOException
_::IOException)->[AddrInfo] -> IO (Maybe (HandleStream ty))
tryAddrInfos [AddrInfo]
t inIO (HandleStream ty) -> IO (Either IOException (HandleStream ty))
forall e a. Exception e => IO a -> IO (Either e a)
try(AddrInfo -> IO (HandleStream ty)
forall ty. BufferType ty => AddrInfo -> IO (HandleStream ty)
connectAddrInfo AddrInfo
h )IO (Either IOException (HandleStream ty))
-> (Either IOException (HandleStream ty)
 -> IO (Maybe (HandleStream ty)))
-> IO (Maybe (HandleStream ty))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=(IOException -> IO (Maybe (HandleStream ty)))
-> (HandleStream ty -> IO (Maybe (HandleStream ty)))
-> Either IOException (HandleStream ty)
-> IO (Maybe (HandleStream ty))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
eitherIOException -> IO (Maybe (HandleStream ty))
next (Maybe (HandleStream ty) -> IO (Maybe (HandleStream ty))
forall (m :: * -> *) a. Monad m => a -> m a
return(Maybe (HandleStream ty) -> IO (Maybe (HandleStream ty)))
-> (HandleStream ty -> Maybe (HandleStream ty))
-> HandleStream ty
-> IO (Maybe (HandleStream ty))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.HandleStream ty -> Maybe (HandleStream ty)
forall a. a -> Maybe a
Just)case[AddrInfo]
addrinfos of[]->String -> IO (HandleStream ty)
forall (m :: * -> *) a. MonadFail m => String -> m a
failString
"openTCPConnection: getAddrInfo returned no address information"-- single AddrInfo; call connectAddrInfo directly so that specific-- exception is thrown in event of failure[AddrInfo
ai ]->AddrInfo -> IO (HandleStream ty)
forall ty. BufferType ty => AddrInfo -> IO (HandleStream ty)
connectAddrInfo AddrInfo
ai IO (HandleStream ty)
-> (IOException -> IO (HandleStream ty)) -> IO (HandleStream ty)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
e ->String -> IO (HandleStream ty)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail(String -> IO (HandleStream ty)) -> String -> IO (HandleStream ty)
forall a b. (a -> b) -> a -> b
$String
"openTCPConnection: failed to connect to "String -> String -> String
forall a. [a] -> [a] -> [a]
++SockAddr -> String
forall a. Show a => a -> String
show(AddrInfo -> SockAddr
addrAddressAddrInfo
ai )String -> String -> String
forall a. [a] -> [a] -> [a]
++String
": "String -> String -> String
forall a. [a] -> [a] -> [a]
++IOException -> String
forall a. Show a => a -> String
showIOException
e )-- multiple AddrInfos; try each until we get a connection, or run out[AddrInfo]
ais ->leterr :: IO a
err =String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail(String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$String
"openTCPConnection: failed to connect; tried addresses: "String -> String -> String
forall a. [a] -> [a] -> [a]
++[SockAddr] -> String
forall a. Show a => a -> String
show((AddrInfo -> SockAddr) -> [AddrInfo] -> [SockAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapAddrInfo -> SockAddr
addrAddress[AddrInfo]
ais )in[AddrInfo] -> IO (Maybe (HandleStream ty))
forall ty.
BufferType ty =>
[AddrInfo] -> IO (Maybe (HandleStream ty))
tryAddrInfos [AddrInfo]
ais IO (Maybe (HandleStream ty))
-> (Maybe (HandleStream ty) -> IO (HandleStream ty))
-> IO (HandleStream ty)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=IO (HandleStream ty)
-> (HandleStream ty -> IO (HandleStream ty))
-> Maybe (HandleStream ty)
-> IO (HandleStream ty)
forall b a. b -> (a -> b) -> Maybe a -> b
maybeIO (HandleStream ty)
forall a. IO a
err HandleStream ty -> IO (HandleStream ty)
forall (m :: * -> *) a. Monad m => a -> m a
return-- | @socketConnection@, like @openConnection@ but using a pre-existing 'Socket'.socketConnection ::BufferType ty =>String->Int->Socket->IO(HandleStream ty )socketConnection :: String -> Int -> Socket -> IO (HandleStream ty)
socketConnection String
hst Int
port Socket
sock =String -> Int -> Socket -> Bool -> IO (HandleStream ty)
forall ty.
BufferType ty =>
String -> Int -> Socket -> Bool -> IO (HandleStream ty)
socketConnection_ String
hst Int
port Socket
sock Bool
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_ :: String -> Int -> Socket -> Bool -> IO (HandleStream ty)
socketConnection_ String
hst Int
port Socket
sock Bool
stashInput =doHandle
h <-Socket -> IOMode -> IO Handle
socketToHandleSocket
sock IOMode
ReadWriteModeMaybe ty
mb <-caseBool
stashInput of{Bool
True->(ty -> Maybe ty) -> IO ty -> IO (Maybe ty)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMty -> Maybe ty
forall a. a -> Maybe a
Just(IO ty -> IO (Maybe ty)) -> IO ty -> IO (Maybe ty)
forall a b. (a -> b) -> a -> b
$BufferOp ty -> Handle -> IO ty
forall a. BufferOp a -> Handle -> IO a
buf_hGetContents BufferOp ty
forall bufType. BufferType bufType => BufferOp bufType
bufferOps Handle
h ;Bool
_->Maybe ty -> IO (Maybe ty)
forall (m :: * -> *) a. Monad m => a -> m a
returnMaybe ty
forall a. Maybe a
Nothing}letconn :: Conn ty
conn =MkConn :: forall a.
Socket
-> Handle
-> BufferOp a
-> Maybe a
-> EndPoint
-> Maybe (StreamHooks a)
-> Bool
-> Conn a
MkConn {connSock :: Socket
connSock =Socket
sock ,connHandle :: Handle
connHandle =Handle
h ,connBuffer :: BufferOp ty
connBuffer =BufferOp ty
forall bufType. BufferType bufType => BufferOp bufType
bufferOps ,connInput :: Maybe ty
connInput =Maybe ty
mb ,connEndPoint :: EndPoint
connEndPoint =String -> Int -> EndPoint
EndPoint String
hst Int
port ,connHooks :: Maybe (StreamHooks ty)
connHooks =Maybe (StreamHooks ty)
forall a. Maybe a
Nothing,connCloseEOF :: Bool
connCloseEOF =Bool
False}MVar (Conn ty)
v <-Conn ty -> IO (MVar (Conn ty))
forall a. a -> IO (MVar a)
newMVarConn ty
conn HandleStream ty -> IO (HandleStream ty)
forall (m :: * -> *) a. Monad m => a -> m a
return(MVar (Conn ty) -> HandleStream ty
forall a. MVar (Conn a) -> HandleStream a
HandleStream MVar (Conn ty)
v )closeConnection ::HStream a =>HandleStream a ->IOBool->IO()closeConnection :: HandleStream a -> IO Bool -> IO ()
closeConnection HandleStream a
ref IO Bool
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.Conn a
c <-MVar (Conn a) -> IO (Conn a)
forall a. MVar a -> IO a
readMVar(HandleStream a -> MVar (Conn a)
forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream a
ref )Conn a -> IO ()
forall a. Conn a -> IO ()
closeConn Conn a
c IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_->() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return())MVar (Conn a) -> (Conn a -> IO (Conn a)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_(HandleStream a -> MVar (Conn a)
forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream a
ref )(\Conn a
_->Conn a -> IO (Conn a)
forall (m :: * -> *) a. Monad m => a -> m a
returnConn a
forall a. Conn a
ConnClosed )where-- Be kind to peer & close gracefully.closeConn :: Conn a -> IO ()
closeConn Conn a
ConnClosed =() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return()closeConn Conn a
conn =doletsk :: Socket
sk =Conn a -> Socket
forall a. Conn a -> Socket
connSock Conn a
conn Handle -> IO ()
hFlush(Conn a -> Handle
forall a. Conn a -> Handle
connHandle Conn a
conn )Socket -> ShutdownCmd -> IO ()
shutdownSocket
sk ShutdownCmd
ShutdownSendIO Bool -> IO ()
suck IO Bool
readL Handle -> IO ()
hClose(Conn a -> Handle
forall a. Conn a -> Handle
connHandle Conn a
conn )Socket -> ShutdownCmd -> IO ()
shutdownSocket
sk ShutdownCmd
ShutdownReceiveSocket -> IO ()
Network.Socket.closeSocket
sk suck ::IOBool->IO()suck :: IO Bool -> IO ()
suck IO Bool
rd =doBool
f <-IO Bool
rd ifBool
f then() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return()elseIO Bool -> IO ()
suck IO Bool
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 -> EndPoint -> IO Bool
isConnectedTo (Connection HandleStream String
conn )EndPoint
endPoint =HandleStream String -> EndPoint -> IO Bool
forall ty. HandleStream ty -> EndPoint -> IO Bool
isTCPConnectedTo HandleStream String
conn EndPoint
endPoint isTCPConnectedTo ::HandleStream ty ->EndPoint ->IOBoolisTCPConnectedTo :: HandleStream ty -> EndPoint -> IO Bool
isTCPConnectedTo HandleStream ty
conn EndPoint
endPoint =doConn ty
v <-MVar (Conn ty) -> IO (Conn ty)
forall a. MVar a -> IO a
readMVar(HandleStream ty -> MVar (Conn ty)
forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream ty
conn )caseConn ty
v ofConn ty
ConnClosed ->Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
returnBool
FalseConn ty
_|Conn ty -> EndPoint
forall a. Conn a -> EndPoint
connEndPoint Conn ty
v EndPoint -> EndPoint -> Bool
forall a. Eq a => a -> a -> Bool
==EndPoint
endPoint ->IO Bool -> (IOException -> IO Bool) -> IO Bool
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (Socket -> IO SockAddr
getPeerName(Conn ty -> Socket
forall a. Conn a -> Socket
connSock Conn ty
v )IO SockAddr -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
returnBool
True)(IO Bool -> IOException -> IO Bool
forall a b. a -> b -> a
const(IO Bool -> IOException -> IO Bool)
-> IO Bool -> IOException -> IO Bool
forall a b. (a -> b) -> a -> b
$Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
returnBool
False)|Bool
otherwise->Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
returnBool
FalsereadBlockBS ::HStream a =>HandleStream a ->Int->IO(Result a )readBlockBS :: HandleStream a -> Int -> IO (Result a)
readBlockBS HandleStream a
ref Int
n =HandleStream a -> (Conn a -> IO (Result a)) -> IO (Result a)
forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
ref ((Conn a -> IO (Result a)) -> IO (Result a))
-> (Conn a -> IO (Result a)) -> IO (Result a)
forall a b. (a -> b) -> a -> b
$\Conn a
conn ->doResult a
x <-HandleStream a -> Int -> IO (Result a)
forall a. HStream a => HandleStream a -> Int -> IO (Result a)
bufferGetBlock HandleStream a
ref Int
n IO () -> (StreamHooks a -> IO ()) -> Maybe (StreamHooks a) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return())(\StreamHooks a
h ->StreamHooks a -> (a -> String) -> Int -> Result a -> IO ()
forall ty.
StreamHooks ty -> (ty -> String) -> Int -> Result ty -> IO ()
hook_readBlock StreamHooks a
h (BufferOp a -> a -> String
forall a. BufferOp a -> a -> String
buf_toStr (BufferOp a -> a -> String) -> BufferOp a -> a -> String
forall a b. (a -> b) -> a -> b
$Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )Int
n Result a
x )(Conn a -> Maybe (StreamHooks a)
forall a. Conn a -> Maybe (StreamHooks a)
connHooks' Conn a
conn )Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
returnResult a
x -- 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 :: HandleStream a -> IO (Result a)
readLineBS HandleStream a
ref =HandleStream a -> (Conn a -> IO (Result a)) -> IO (Result a)
forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
ref ((Conn a -> IO (Result a)) -> IO (Result a))
-> (Conn a -> IO (Result a)) -> IO (Result a)
forall a b. (a -> b) -> a -> b
$\Conn a
conn ->doResult a
x <-HandleStream a -> IO (Result a)
forall a. HStream a => HandleStream a -> IO (Result a)
bufferReadLine HandleStream a
ref IO () -> (StreamHooks a -> IO ()) -> Maybe (StreamHooks a) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return())(\StreamHooks a
h ->StreamHooks a -> (a -> String) -> Result a -> IO ()
forall ty. StreamHooks ty -> (ty -> String) -> Result ty -> IO ()
hook_readLine StreamHooks a
h (BufferOp a -> a -> String
forall a. BufferOp a -> a -> String
buf_toStr (BufferOp a -> a -> String) -> BufferOp a -> a -> String
forall a b. (a -> b) -> a -> b
$Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )Result a
x )(Conn a -> Maybe (StreamHooks a)
forall a. Conn a -> Maybe (StreamHooks a)
connHooks' Conn a
conn )Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
returnResult a
x -- The 'Connection' object allows no outward buffering,-- since in general messages are serialised in their entirety.writeBlockBS ::HandleStream a ->a ->IO(Result ())writeBlockBS :: HandleStream a -> a -> IO (Result ())
writeBlockBS HandleStream a
ref a
b =HandleStream a -> (Conn a -> IO (Result ())) -> IO (Result ())
forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
ref ((Conn a -> IO (Result ())) -> IO (Result ()))
-> (Conn a -> IO (Result ())) -> IO (Result ())
forall a b. (a -> b) -> a -> b
$\Conn a
conn ->doResult ()
x <-BufferOp a -> Handle -> a -> IO (Result ())
forall a. BufferOp a -> Handle -> a -> IO (Result ())
bufferPutBlock (Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )(Conn a -> Handle
forall a. Conn a -> Handle
connHandle Conn a
conn )a
b IO () -> (StreamHooks a -> IO ()) -> Maybe (StreamHooks a) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return())(\StreamHooks a
h ->StreamHooks a -> (a -> String) -> a -> Result () -> IO ()
forall ty.
StreamHooks ty -> (ty -> String) -> ty -> Result () -> IO ()
hook_writeBlock StreamHooks a
h (BufferOp a -> a -> String
forall a. BufferOp a -> a -> String
buf_toStr (BufferOp a -> a -> String) -> BufferOp a -> a -> String
forall a b. (a -> b) -> a -> b
$Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )a
b Result ()
x )(Conn a -> Maybe (StreamHooks a)
forall a. Conn a -> Maybe (StreamHooks a)
connHooks' Conn a
conn )Result () -> IO (Result ())
forall (m :: * -> *) a. Monad m => a -> m a
returnResult ()
x closeIt ::HStream ty =>HandleStream ty ->(ty ->Bool)->Bool->IO()closeIt :: HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream ty
c ty -> Bool
p Bool
b =doHandleStream ty -> IO Bool -> IO ()
forall a. HStream a => HandleStream a -> IO Bool -> IO ()
closeConnection HandleStream ty
c (ifBool
b thenHandleStream ty -> IO (Result ty)
forall a. HStream a => HandleStream a -> IO (Result a)
readLineBS HandleStream ty
c IO (Result ty) -> (Result ty -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=\Result ty
x ->caseResult ty
x of{Rightty
xs ->Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return(ty -> Bool
p ty
xs );Result ty
_->Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
returnBool
True}elseBool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
returnBool
True)Conn ty
conn <-MVar (Conn ty) -> IO (Conn ty)
forall a. MVar a -> IO a
readMVar(HandleStream ty -> MVar (Conn ty)
forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream ty
c )IO ()
-> (StreamHooks ty -> IO ()) -> Maybe (StreamHooks ty) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return())(StreamHooks ty -> IO ()
forall ty. StreamHooks ty -> IO ()
hook_close )(Conn ty -> Maybe (StreamHooks ty)
forall a. Conn a -> Maybe (StreamHooks a)
connHooks' Conn ty
conn )closeEOF ::HandleStream ty ->Bool->IO()closeEOF :: HandleStream ty -> Bool -> IO ()
closeEOF HandleStream ty
c Bool
flg =MVar (Conn ty) -> (Conn ty -> IO (Conn ty)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_(HandleStream ty -> MVar (Conn ty)
forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream ty
c )(\Conn ty
co ->Conn ty -> IO (Conn ty)
forall (m :: * -> *) a. Monad m => a -> m a
returnConn ty
co {connCloseEOF :: Bool
connCloseEOF =Bool
flg })bufferGetBlock ::HStream a =>HandleStream a ->Int->IO(Result a )bufferGetBlock :: HandleStream a -> Int -> IO (Result a)
bufferGetBlock HandleStream a
ref Int
n =HandleStream a -> (Conn a -> IO (Result a)) -> IO (Result a)
forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
ref ((Conn a -> IO (Result a)) -> IO (Result a))
-> (Conn a -> IO (Result a)) -> IO (Result a)
forall a b. (a -> b) -> a -> b
$\Conn a
conn ->docaseConn a -> Maybe a
forall a. Conn a -> Maybe a
connInput Conn a
conn ofJusta
c ->dolet(a
a ,a
b )=BufferOp a -> Int -> a -> (a, a)
forall a. BufferOp a -> Int -> a -> (a, a)
buf_splitAt (Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )Int
n a
c MVar (Conn a) -> (Conn a -> IO (Conn a)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_(HandleStream a -> MVar (Conn a)
forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream a
ref )(\Conn a
co ->Conn a -> IO (Conn a)
forall (m :: * -> *) a. Monad m => a -> m a
returnConn a
co {connInput :: Maybe a
connInput =a -> Maybe a
forall a. a -> Maybe a
Justa
b })Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return(a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
returna
a )Maybe a
_->doIO (Result a) -> (IOException -> IO (Result a)) -> IO (Result a)
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (BufferOp a -> Handle -> Int -> IO a
forall a. BufferOp a -> Handle -> Int -> IO a
buf_hGet (Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )(Conn a -> Handle
forall a. Conn a -> Handle
connHandle Conn a
conn )Int
n IO a -> (a -> IO (Result a)) -> IO (Result a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return(Result a -> IO (Result a))
-> (a -> Result a) -> a -> IO (Result a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return)(\IOException
e ->ifIOException -> Bool
isEOFErrorIOException
e thendoBool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when(Conn a -> Bool
forall a. Conn a -> Bool
connCloseEOF Conn a
conn )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (HandleStream a -> IO ()
forall bufType. HStream bufType => HandleStream bufType -> IO ()
closeQuick HandleStream a
ref )(\IOException
_->() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return())Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return(a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return(BufferOp a -> a
forall a. BufferOp a -> a
buf_empty (Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )))elseResult a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> Result a
forall a. String -> Result a
failMisc (IOException -> String
forall a. Show a => a -> String
showIOException
e )))bufferPutBlock ::BufferOp a ->Handle->a ->IO(Result ())bufferPutBlock :: BufferOp a -> Handle -> a -> IO (Result ())
bufferPutBlock BufferOp a
ops Handle
h a
b =IO (Result ()) -> (IOException -> IO (Result ())) -> IO (Result ())
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (BufferOp a -> Handle -> a -> IO ()
forall a. BufferOp a -> Handle -> a -> IO ()
buf_hPut BufferOp a
ops Handle
h a
b IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>Handle -> IO ()
hFlushHandle
h IO () -> IO (Result ()) -> IO (Result ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>Result () -> IO (Result ())
forall (m :: * -> *) a. Monad m => a -> m a
return(() -> Result ()
forall (m :: * -> *) a. Monad m => a -> m a
return()))(\IOException
e ->Result () -> IO (Result ())
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> Result ()
forall a. String -> Result a
failMisc (IOException -> String
forall a. Show a => a -> String
showIOException
e )))bufferReadLine ::HStream a =>HandleStream a ->IO(Result a )bufferReadLine :: HandleStream a -> IO (Result a)
bufferReadLine HandleStream a
ref =HandleStream a -> (Conn a -> IO (Result a)) -> IO (Result a)
forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
ref ((Conn a -> IO (Result a)) -> IO (Result a))
-> (Conn a -> IO (Result a)) -> IO (Result a)
forall a b. (a -> b) -> a -> b
$\Conn a
conn ->docaseConn a -> Maybe a
forall a. Conn a -> Maybe a
connInput Conn a
conn ofJusta
c ->dolet(a
a ,a
b0 )=BufferOp a -> (Char -> Bool) -> a -> (a, a)
forall a. BufferOp a -> (Char -> Bool) -> a -> (a, a)
buf_span (Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n')a
c let(a
newl ,a
b1 )=BufferOp a -> Int -> a -> (a, a)
forall a. BufferOp a -> Int -> a -> (a, a)
buf_splitAt (Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )Int
1a
b0 MVar (Conn a) -> (Conn a -> IO (Conn a)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_(HandleStream a -> MVar (Conn a)
forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream a
ref )(\Conn a
co ->Conn a -> IO (Conn a)
forall (m :: * -> *) a. Monad m => a -> m a
returnConn a
co {connInput :: Maybe a
connInput =a -> Maybe a
forall a. a -> Maybe a
Justa
b1 })Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return(a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return(BufferOp a -> a -> a -> a
forall a. BufferOp a -> a -> a -> a
buf_append (Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )a
a a
newl ))Maybe a
_->IO (Result a) -> (IOException -> IO (Result a)) -> IO (Result a)
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (BufferOp a -> Handle -> IO a
forall a. BufferOp a -> Handle -> IO a
buf_hGetLine (Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )(Conn a -> Handle
forall a. Conn a -> Handle
connHandle Conn a
conn )IO a -> (a -> IO (Result a)) -> IO (Result a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return(Result a -> IO (Result a))
-> (a -> Result a) -> a -> IO (Result a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return(a -> Result a) -> (a -> a) -> a -> Result a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BufferOp a -> a -> a
forall a. BufferOp a -> a -> a
appendNL (Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn ))(\IOException
e ->ifIOException -> Bool
isEOFErrorIOException
e thendoBool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when(Conn a -> Bool
forall a. Conn a -> Bool
connCloseEOF Conn a
conn )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (HandleStream a -> IO ()
forall bufType. HStream bufType => HandleStream bufType -> IO ()
closeQuick HandleStream a
ref )(\IOException
_->() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return())Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return(a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return(BufferOp a -> a
forall a. BufferOp a -> a
buf_empty (Conn a -> BufferOp a
forall a. Conn a -> BufferOp a
connBuffer Conn a
conn )))elseResult a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> Result a
forall a. String -> Result a
failMisc (IOException -> String
forall a. Show a => a -> String
showIOException
e )))where-- yes, this s**ks.. _may_ have to be addressed if perf-- suggests worthiness.appendNL :: BufferOp a -> a -> a
appendNL BufferOp a
ops a
b =BufferOp a -> a -> Word8 -> a
forall a. BufferOp a -> a -> Word8 -> a
buf_snoc BufferOp a
ops a
b Word8
nl nl ::Word8nl :: Word8
nl =Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Char -> Int
forall a. Enum a => a -> Int
fromEnumChar
'\n')onNonClosedDo ::HandleStream a ->(Conn a ->IO(Result b ))->IO(Result b )onNonClosedDo :: HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
h Conn a -> IO (Result b)
act =doConn a
x <-MVar (Conn a) -> IO (Conn a)
forall a. MVar a -> IO a
readMVar(HandleStream a -> MVar (Conn a)
forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream a
h )caseConn a
x ofConnClosed {}->Result b -> IO (Result b)
forall (m :: * -> *) a. Monad m => a -> m a
return(ConnError -> Result b
forall a. ConnError -> Result a
failWith ConnError
ErrorClosed )Conn a
_->Conn a -> IO (Result b)
act Conn a
x