{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Network.TCP
( Connection
, EndPoint(..)
, openTCPPort
, isConnectedTo
, openTCPConnection
, socketConnection
, isTCPConnectedTo
, HandleStream
, HStream(..)
, StreamHooks(..)
, nullHooks
, setStreamHooks
, getStreamHooks
, hstreamToConnection
) where
import Network.Socket
( Socket, SocketOption(KeepAlive)
, SocketType(Stream), connect
, shutdown, ShutdownCmd(..)
, setSocketOption, getPeerName
, socket, Family(AF_UNSPEC), defaultProtocol, getAddrInfo
, defaultHints, addrFamily, withSocketsDo
, addrSocketType, addrAddress
)
import qualified Network.Socket
( close )
import qualified Network.Stream as Stream
( Stream(readBlock, readLine, writeBlock, close, closeOnEnd) )
import Network.Stream
( ConnError(..)
, Result
, failWith
, failMisc
)
import Network.BufferType
import Network.HTTP.Base ( catchIO )
import Network.Socket ( socketToHandle )
import Data.Char ( toLower )
import Data.Word ( Word8 )
import Control.Concurrent
import Control.Exception ( IOException, bracketOnError, try )
import Control.Monad ( liftM, when )
import System.IO ( Handle, hFlush, IOMode(..), hClose )
import System.IO.Error ( isEOFError )
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
newtype Connection = Connection (HandleStream String)
newtype HandleStream a = HandleStream {forall a. HandleStream a -> MVar (Conn a)
getRef :: MVar (Conn a)}
data EndPoint = EndPoint { EndPoint -> String
epHost :: String, EndPoint -> Int
epPort :: Int }
instance Eq EndPoint where
EndPoint String
host1 Int
port1 == :: EndPoint -> EndPoint -> Bool
== EndPoint String
host2 Int
port2 =
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
host1 forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
host2 Bool -> Bool -> Bool
&& Int
port1 forall a. Eq a => a -> a -> Bool
== Int
port2
data Conn a
= MkConn { forall a. Conn a -> Socket
connSock :: !Socket
, forall a. Conn a -> Handle
connHandle :: Handle
, forall a. Conn a -> BufferOp a
connBuffer :: BufferOp a
, forall a. Conn a -> Maybe a
connInput :: Maybe a
, forall a. Conn a -> EndPoint
connEndPoint :: EndPoint
, forall a. Conn a -> Maybe (StreamHooks a)
connHooks :: Maybe (StreamHooks a)
, forall a. Conn a -> Bool
connCloseEOF :: Bool
}
| ConnClosed
deriving(Conn a -> Conn a -> Bool
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' :: forall a. Conn a -> Maybe (StreamHooks a)
connHooks' ConnClosed{} = forall a. Maybe a
Nothing
connHooks' Conn a
x = forall a. Conn a -> Maybe (StreamHooks a)
connHooks Conn a
x
data StreamHooks ty
= StreamHooks
{ forall ty. StreamHooks ty -> (ty -> String) -> Result ty -> IO ()
hook_readLine :: (ty -> String) -> Result ty -> IO ()
, forall ty.
StreamHooks ty -> (ty -> String) -> Int -> Result ty -> IO ()
hook_readBlock :: (ty -> String) -> Int -> Result ty -> IO ()
, forall ty.
StreamHooks ty -> (ty -> String) -> ty -> Result () -> IO ()
hook_writeBlock :: (ty -> String) -> ty -> Result () -> IO ()
, forall ty. StreamHooks ty -> IO ()
hook_close :: IO ()
, forall ty. StreamHooks ty -> String
hook_name :: String
}
instance Eq ty => Eq (StreamHooks ty) where
== :: StreamHooks ty -> StreamHooks ty -> Bool
(==) StreamHooks ty
_ StreamHooks ty
_ = Bool
True
nullHooks :: StreamHooks ty
nullHooks :: forall ty. StreamHooks ty
nullHooks = StreamHooks
{ hook_readLine :: (ty -> String) -> Result ty -> IO ()
hook_readLine = \ ty -> String
_ Result ty
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
, hook_readBlock :: (ty -> String) -> Int -> Result ty -> IO ()
hook_readBlock = \ ty -> String
_ Int
_ Result ty
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
, hook_writeBlock :: (ty -> String) -> ty -> Result () -> IO ()
hook_writeBlock = \ ty -> String
_ ty
_ Result ()
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
, hook_close :: IO ()
hook_close = forall (m :: * -> *) a. Monad m => a -> m a
return ()
, hook_name :: String
hook_name = String
""
}
setStreamHooks :: HandleStream ty -> StreamHooks ty -> IO ()
setStreamHooks :: forall ty. HandleStream ty -> StreamHooks ty -> IO ()
setStreamHooks HandleStream ty
h StreamHooks ty
sh = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream ty
h) (\ Conn ty
c -> forall (m :: * -> *) a. Monad m => a -> m a
return Conn ty
c{connHooks :: Maybe (StreamHooks ty)
connHooks=forall a. a -> Maybe a
Just StreamHooks ty
sh})
getStreamHooks :: HandleStream ty -> IO (Maybe (StreamHooks ty))
getStreamHooks :: forall ty. HandleStream ty -> IO (Maybe (StreamHooks ty))
getStreamHooks HandleStream ty
h = forall a. MVar a -> IO a
readMVar (forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream ty
h) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
returnforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Conn a -> Maybe (StreamHooks a)
connHooks
class BufferType bufType => HStream bufType where
openStream :: 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 ()
instance HStream Strict.ByteString where
openStream :: String -> Int -> IO (HandleStream ByteString)
openStream = forall ty. BufferType ty => String -> Int -> IO (HandleStream ty)
openTCPConnection
openSocketStream :: String -> Int -> Socket -> IO (HandleStream ByteString)
openSocketStream = forall ty.
BufferType ty =>
String -> Int -> Socket -> IO (HandleStream ty)
socketConnection
readBlock :: HandleStream ByteString -> Int -> IO (Result ByteString)
readBlock HandleStream ByteString
c Int
n = 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 = 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 = forall a. HandleStream a -> a -> IO (Result ())
writeBlockBS HandleStream ByteString
c ByteString
str
close :: HandleStream ByteString -> IO ()
close HandleStream ByteString
c = forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream ByteString
c ByteString -> Bool
Strict.null Bool
True
closeQuick :: HandleStream ByteString -> IO ()
closeQuick HandleStream ByteString
c = forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream ByteString
c ByteString -> Bool
Strict.null Bool
False
closeOnEnd :: HandleStream ByteString -> Bool -> IO ()
closeOnEnd HandleStream ByteString
c Bool
f = forall ty. HandleStream ty -> Bool -> IO ()
closeEOF HandleStream ByteString
c Bool
f
instance HStream Lazy.ByteString where
openStream :: String -> Int -> IO (HandleStream ByteString)
openStream = \ String
a Int
b -> forall ty.
BufferType ty =>
String -> Int -> Bool -> IO (HandleStream ty)
openTCPConnection_ String
a Int
b Bool
True
openSocketStream :: String -> Int -> Socket -> IO (HandleStream ByteString)
openSocketStream = \ String
a Int
b Socket
c -> forall ty.
BufferType ty =>
String -> Int -> Socket -> Bool -> IO (HandleStream ty)
socketConnection_ String
a Int
b Socket
c Bool
True
readBlock :: HandleStream ByteString -> Int -> IO (Result ByteString)
readBlock HandleStream ByteString
c Int
n = 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 = 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 = forall a. HandleStream a -> a -> IO (Result ())
writeBlockBS HandleStream ByteString
c ByteString
str
close :: HandleStream ByteString -> IO ()
close HandleStream ByteString
c = forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream ByteString
c ByteString -> Bool
Lazy.null Bool
True
closeQuick :: HandleStream ByteString -> IO ()
closeQuick HandleStream ByteString
c = forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream ByteString
c ByteString -> Bool
Lazy.null Bool
False
closeOnEnd :: HandleStream ByteString -> Bool -> IO ()
closeOnEnd HandleStream ByteString
c Bool
f = forall ty. HandleStream ty -> Bool -> IO ()
closeEOF HandleStream ByteString
c Bool
f
instance Stream.Stream Connection where
readBlock :: Connection -> Int -> IO (Result String)
readBlock (Connection HandleStream String
c) = 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) = 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) = forall bufType.
HStream bufType =>
HandleStream bufType -> bufType -> IO (Result ())
Network.TCP.writeBlock HandleStream String
c
close :: Connection -> IO ()
close (Connection HandleStream String
c) = forall bufType. HStream bufType => HandleStream bufType -> IO ()
Network.TCP.close HandleStream String
c
closeOnEnd :: Connection -> Bool -> IO ()
closeOnEnd (Connection HandleStream String
c) Bool
f = forall ty. HandleStream ty -> Bool -> IO ()
Network.TCP.closeEOF HandleStream String
c Bool
f
instance HStream String where
openStream :: String -> Int -> IO (HandleStream String)
openStream = forall ty. BufferType ty => String -> Int -> IO (HandleStream ty)
openTCPConnection
openSocketStream :: String -> Int -> Socket -> IO (HandleStream String)
openSocketStream = forall ty.
BufferType ty =>
String -> Int -> Socket -> IO (HandleStream ty)
socketConnection
readBlock :: HandleStream String -> Int -> IO (Result String)
readBlock HandleStream String
ref Int
n = forall a. HStream a => HandleStream a -> Int -> IO (Result a)
readBlockBS HandleStream String
ref Int
n
readLine :: HandleStream String -> IO (Result String)
readLine HandleStream String
ref = forall a. HStream a => HandleStream a -> IO (Result a)
readLineBS HandleStream String
ref
writeBlock :: HandleStream String -> String -> IO (Result ())
writeBlock HandleStream String
ref String
str = forall a. HandleStream a -> a -> IO (Result ())
writeBlockBS HandleStream String
ref String
str
close :: HandleStream String -> IO ()
close HandleStream String
c = forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream String
c forall (t :: * -> *) a. Foldable t => t a -> Bool
null Bool
True
closeQuick :: HandleStream String -> IO ()
closeQuick HandleStream String
c = forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream String
c forall (t :: * -> *) a. Foldable t => t a -> Bool
null Bool
False
closeOnEnd :: HandleStream String -> Bool -> IO ()
closeOnEnd HandleStream String
c Bool
f = forall ty. HandleStream ty -> Bool -> IO ()
closeEOF HandleStream String
c Bool
f
openTCPPort :: String -> Int -> IO Connection
openTCPPort :: String -> Int -> IO Connection
openTCPPort String
uri Int
port = forall ty. BufferType ty => String -> Int -> IO (HandleStream ty)
openTCPConnection String
uri Int
port forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
returnforall b c a. (b -> c) -> (a -> b) -> a -> c
.HandleStream String -> Connection
Connection
openTCPConnection :: BufferType ty => String -> Int -> IO (HandleStream ty)
openTCPConnection :: forall ty. BufferType ty => String -> Int -> IO (HandleStream ty)
openTCPConnection String
uri Int
port = forall ty.
BufferType ty =>
String -> Int -> Bool -> IO (HandleStream ty)
openTCPConnection_ String
uri Int
port Bool
False
openTCPConnection_ :: BufferType ty => String -> Int -> Bool -> IO (HandleStream ty)
openTCPConnection_ :: forall ty.
BufferType ty =>
String -> Int -> Bool -> IO (HandleStream ty)
openTCPConnection_ String
uri Int
port Bool
stashInput = do
let fixedUri :: String
fixedUri =
case String
uri of
Char
'[':(rest :: String
rest@(Char
c:String
_)) | forall a. [a] -> a
last String
rest forall a. Eq a => a -> a -> Bool
== Char
']'
-> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'v' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'V'
then forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unsupported post-IPv6 address " forall a. [a] -> [a] -> [a]
++ String
uri
else forall a. [a] -> [a]
init String
rest
String
_ -> String
uri
[AddrInfo]
addrinfos <- forall a. IO a -> IO a
withSocketsDo forall a b. (a -> b) -> a -> b
$ Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AddrInfo
defaultHints { addrFamily :: Family
addrFamily = Family
AF_UNSPEC, addrSocketType :: SocketType
addrSocketType = SocketType
Stream }) (forall a. a -> Maybe a
Just String
fixedUri) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
port)
let
connectAddrInfo :: AddrInfo -> IO (HandleStream ty)
connectAddrInfo AddrInfo
a = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
(Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
a) SocketType
Stream ProtocolNumber
defaultProtocol)
Socket -> IO ()
Network.Socket.close
( \Socket
s -> do
Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
s SocketOption
KeepAlive Int
1
Socket -> SockAddr -> IO ()
connect Socket
s (AddrInfo -> SockAddr
addrAddress AddrInfo
a)
forall ty.
BufferType ty =>
String -> Int -> Socket -> Bool -> IO (HandleStream ty)
socketConnection_ String
fixedUri Int
port Socket
s Bool
stashInput )
tryAddrInfos :: [AddrInfo] -> IO (Maybe (HandleStream ty))
tryAddrInfos [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
tryAddrInfos (AddrInfo
h:[AddrInfo]
t) =
let next :: IOException -> IO (Maybe (HandleStream ty))
next = \(IOException
_ :: IOException) -> [AddrInfo] -> IO (Maybe (HandleStream ty))
tryAddrInfos [AddrInfo]
t
in forall e a. Exception e => IO a -> IO (Either e a)
try (forall {ty}. BufferType ty => AddrInfo -> IO (HandleStream ty)
connectAddrInfo AddrInfo
h) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOException -> IO (Maybe (HandleStream ty))
next (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
case [AddrInfo]
addrinfos of
[] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"openTCPConnection: getAddrInfo returned no address information"
[AddrInfo
ai] -> forall {ty}. BufferType ty => AddrInfo -> IO (HandleStream ty)
connectAddrInfo AddrInfo
ai forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
String
"openTCPConnection: failed to connect to "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (AddrInfo -> SockAddr
addrAddress AddrInfo
ai) forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOException
e)
[AddrInfo]
ais ->
let
err :: IO a
err = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"openTCPConnection: failed to connect; tried addresses: "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddrInfo -> SockAddr
addrAddress [AddrInfo]
ais)
in forall {ty}.
BufferType ty =>
[AddrInfo] -> IO (Maybe (HandleStream ty))
tryAddrInfos [AddrInfo]
ais forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. IO a
err forall (m :: * -> *) a. Monad m => a -> m a
return
socketConnection :: BufferType ty
=> String
-> Int
-> Socket
-> IO (HandleStream ty)
socketConnection :: forall ty.
BufferType ty =>
String -> Int -> Socket -> IO (HandleStream ty)
socketConnection String
hst Int
port Socket
sock = forall ty.
BufferType ty =>
String -> Int -> Socket -> Bool -> IO (HandleStream ty)
socketConnection_ String
hst Int
port Socket
sock Bool
False
socketConnection_ :: BufferType ty
=> String
-> Int
-> Socket
-> Bool
-> IO (HandleStream ty)
socketConnection_ :: forall ty.
BufferType ty =>
String -> Int -> Socket -> Bool -> IO (HandleStream ty)
socketConnection_ String
hst Int
port Socket
sock Bool
stashInput = do
Handle
h <- Socket -> IOMode -> IO Handle
socketToHandle Socket
sock IOMode
ReadWriteMode
Maybe ty
mb <- case Bool
stashInput of { Bool
True -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. BufferOp a -> Handle -> IO a
buf_hGetContents forall bufType. BufferType bufType => BufferOp bufType
bufferOps Handle
h; Bool
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing }
let conn :: Conn ty
conn = MkConn
{ connSock :: Socket
connSock = Socket
sock
, connHandle :: Handle
connHandle = Handle
h
, connBuffer :: BufferOp ty
connBuffer = 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 = forall a. Maybe a
Nothing
, connCloseEOF :: Bool
connCloseEOF = Bool
False
}
MVar (Conn ty)
v <- forall a. a -> IO (MVar a)
newMVar Conn ty
conn
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. MVar (Conn a) -> HandleStream a
HandleStream MVar (Conn ty)
v)
closeConnection :: HStream a => HandleStream a -> IO Bool -> IO ()
closeConnection :: forall a. HStream a => HandleStream a -> IO Bool -> IO ()
closeConnection HandleStream a
ref IO Bool
readL = do
Conn a
c <- forall a. MVar a -> IO a
readMVar (forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream a
ref)
forall {a}. Conn a -> IO ()
closeConn Conn a
c forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream a
ref) (\ Conn a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Conn a
ConnClosed)
where
closeConn :: Conn a -> IO ()
closeConn Conn a
ConnClosed = forall (m :: * -> *) a. Monad m => a -> m a
return ()
closeConn Conn a
conn = do
let sk :: Socket
sk = forall a. Conn a -> Socket
connSock Conn a
conn
Handle -> IO ()
hFlush (forall a. Conn a -> Handle
connHandle Conn a
conn)
Socket -> ShutdownCmd -> IO ()
shutdown Socket
sk ShutdownCmd
ShutdownSend
IO Bool -> IO ()
suck IO Bool
readL
Handle -> IO ()
hClose (forall a. Conn a -> Handle
connHandle Conn a
conn)
Socket -> ShutdownCmd -> IO ()
shutdown Socket
sk ShutdownCmd
ShutdownReceive
Socket -> IO ()
Network.Socket.close Socket
sk
suck :: IO Bool -> IO ()
suck :: IO Bool -> IO ()
suck IO Bool
rd = do
Bool
f <- IO Bool
rd
if Bool
f then forall (m :: * -> *) a. Monad m => a -> m a
return () else IO Bool -> IO ()
suck IO Bool
rd
isConnectedTo :: Connection -> EndPoint -> IO Bool
isConnectedTo :: Connection -> EndPoint -> IO Bool
isConnectedTo (Connection HandleStream String
conn) EndPoint
endPoint = forall ty. HandleStream ty -> EndPoint -> IO Bool
isTCPConnectedTo HandleStream String
conn EndPoint
endPoint
isTCPConnectedTo :: HandleStream ty -> EndPoint -> IO Bool
isTCPConnectedTo :: forall ty. HandleStream ty -> EndPoint -> IO Bool
isTCPConnectedTo HandleStream ty
conn EndPoint
endPoint = do
Conn ty
v <- forall a. MVar a -> IO a
readMVar (forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream ty
conn)
case Conn ty
v of
Conn ty
ConnClosed -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Conn ty
_
| forall a. Conn a -> EndPoint
connEndPoint Conn ty
v forall a. Eq a => a -> a -> Bool
== EndPoint
endPoint ->
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (Socket -> IO SockAddr
getPeerName (forall a. Conn a -> Socket
connSock Conn ty
v) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
readBlockBS :: HStream a => HandleStream a -> Int -> IO (Result a)
readBlockBS :: forall a. HStream a => HandleStream a -> Int -> IO (Result a)
readBlockBS HandleStream a
ref Int
n = forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
ref forall a b. (a -> b) -> a -> b
$ \ Conn a
conn -> do
Result a
x <- forall a. HStream a => HandleStream a -> Int -> IO (Result a)
bufferGetBlock HandleStream a
ref Int
n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ())
(\ StreamHooks a
h -> forall ty.
StreamHooks ty -> (ty -> String) -> Int -> Result ty -> IO ()
hook_readBlock StreamHooks a
h (forall a. BufferOp a -> a -> String
buf_toStr forall a b. (a -> b) -> a -> b
$ forall a. Conn a -> BufferOp a
connBuffer Conn a
conn) Int
n Result a
x)
(forall a. Conn a -> Maybe (StreamHooks a)
connHooks' Conn a
conn)
forall (m :: * -> *) a. Monad m => a -> m a
return Result a
x
readLineBS :: HStream a => HandleStream a -> IO (Result a)
readLineBS :: forall a. HStream a => HandleStream a -> IO (Result a)
readLineBS HandleStream a
ref = forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
ref forall a b. (a -> b) -> a -> b
$ \ Conn a
conn -> do
Result a
x <- forall a. HStream a => HandleStream a -> IO (Result a)
bufferReadLine HandleStream a
ref
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ())
(\ StreamHooks a
h -> forall ty. StreamHooks ty -> (ty -> String) -> Result ty -> IO ()
hook_readLine StreamHooks a
h (forall a. BufferOp a -> a -> String
buf_toStr forall a b. (a -> b) -> a -> b
$ forall a. Conn a -> BufferOp a
connBuffer Conn a
conn) Result a
x)
(forall a. Conn a -> Maybe (StreamHooks a)
connHooks' Conn a
conn)
forall (m :: * -> *) a. Monad m => a -> m a
return Result a
x
writeBlockBS :: HandleStream a -> a -> IO (Result ())
writeBlockBS :: forall a. HandleStream a -> a -> IO (Result ())
writeBlockBS HandleStream a
ref a
b = forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
ref forall a b. (a -> b) -> a -> b
$ \ Conn a
conn -> do
Result ()
x <- forall a. BufferOp a -> Handle -> a -> IO (Result ())
bufferPutBlock (forall a. Conn a -> BufferOp a
connBuffer Conn a
conn) (forall a. Conn a -> Handle
connHandle Conn a
conn) a
b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ())
(\ StreamHooks a
h -> forall ty.
StreamHooks ty -> (ty -> String) -> ty -> Result () -> IO ()
hook_writeBlock StreamHooks a
h (forall a. BufferOp a -> a -> String
buf_toStr forall a b. (a -> b) -> a -> b
$ forall a. Conn a -> BufferOp a
connBuffer Conn a
conn) a
b Result ()
x)
(forall a. Conn a -> Maybe (StreamHooks a)
connHooks' Conn a
conn)
forall (m :: * -> *) a. Monad m => a -> m a
return Result ()
x
closeIt :: HStream ty => HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt :: forall ty.
HStream ty =>
HandleStream ty -> (ty -> Bool) -> Bool -> IO ()
closeIt HandleStream ty
c ty -> Bool
p Bool
b = do
forall a. HStream a => HandleStream a -> IO Bool -> IO ()
closeConnection HandleStream ty
c (if Bool
b
then forall a. HStream a => HandleStream a -> IO (Result a)
readLineBS HandleStream ty
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Result ty
x -> case Result ty
x of { Right ty
xs -> forall (m :: * -> *) a. Monad m => a -> m a
return (ty -> Bool
p ty
xs); Result ty
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True}
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
Conn ty
conn <- forall a. MVar a -> IO a
readMVar (forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream ty
c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ())
(forall ty. StreamHooks ty -> IO ()
hook_close)
(forall a. Conn a -> Maybe (StreamHooks a)
connHooks' Conn ty
conn)
closeEOF :: HandleStream ty -> Bool -> IO ()
closeEOF :: forall ty. HandleStream ty -> Bool -> IO ()
closeEOF HandleStream ty
c Bool
flg = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream ty
c) (\ Conn ty
co -> forall (m :: * -> *) a. Monad m => a -> m a
return Conn ty
co{connCloseEOF :: Bool
connCloseEOF=Bool
flg})
bufferGetBlock :: HStream a => HandleStream a -> Int -> IO (Result a)
bufferGetBlock :: forall a. HStream a => HandleStream a -> Int -> IO (Result a)
bufferGetBlock HandleStream a
ref Int
n = forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
ref forall a b. (a -> b) -> a -> b
$ \ Conn a
conn -> do
case forall a. Conn a -> Maybe a
connInput Conn a
conn of
Just a
c -> do
let (a
a,a
b) = forall a. BufferOp a -> Int -> a -> (a, a)
buf_splitAt (forall a. Conn a -> BufferOp a
connBuffer Conn a
conn) Int
n a
c
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream a
ref) (\ Conn a
co -> forall (m :: * -> *) a. Monad m => a -> m a
return Conn a
co{connInput :: Maybe a
connInput=forall a. a -> Maybe a
Just a
b})
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return a
a)
Maybe a
_ -> do
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (forall a. BufferOp a -> Handle -> Int -> IO a
buf_hGet (forall a. Conn a -> BufferOp a
connBuffer Conn a
conn) (forall a. Conn a -> Handle
connHandle Conn a
conn) Int
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
returnforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (m :: * -> *) a. Monad m => a -> m a
return)
(\ IOException
e ->
if IOException -> Bool
isEOFError IOException
e
then do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Conn a -> Bool
connCloseEOF Conn a
conn) forall a b. (a -> b) -> a -> b
$ forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (forall bufType. HStream bufType => HandleStream bufType -> IO ()
closeQuick HandleStream a
ref) (\ IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. BufferOp a -> a
buf_empty (forall a. Conn a -> BufferOp a
connBuffer Conn a
conn)))
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. String -> Result a
failMisc (forall a. Show a => a -> String
show IOException
e)))
bufferPutBlock :: BufferOp a -> Handle -> a -> IO (Result ())
bufferPutBlock :: forall a. BufferOp a -> Handle -> a -> IO (Result ())
bufferPutBlock BufferOp a
ops Handle
h a
b =
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (forall a. BufferOp a -> Handle -> a -> IO ()
buf_hPut BufferOp a
ops Handle
h a
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
h forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return ()))
(\ IOException
e -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. String -> Result a
failMisc (forall a. Show a => a -> String
show IOException
e)))
bufferReadLine :: HStream a => HandleStream a -> IO (Result a)
bufferReadLine :: forall a. HStream a => HandleStream a -> IO (Result a)
bufferReadLine HandleStream a
ref = forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
ref forall a b. (a -> b) -> a -> b
$ \ Conn a
conn -> do
case forall a. Conn a -> Maybe a
connInput Conn a
conn of
Just a
c -> do
let (a
a,a
b0) = forall a. BufferOp a -> (Char -> Bool) -> a -> (a, a)
buf_span (forall a. Conn a -> BufferOp a
connBuffer Conn a
conn) (forall a. Eq a => a -> a -> Bool
/=Char
'\n') a
c
let (a
newl,a
b1) = forall a. BufferOp a -> Int -> a -> (a, a)
buf_splitAt (forall a. Conn a -> BufferOp a
connBuffer Conn a
conn) Int
1 a
b0
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream a
ref) (\ Conn a
co -> forall (m :: * -> *) a. Monad m => a -> m a
return Conn a
co{connInput :: Maybe a
connInput=forall a. a -> Maybe a
Just a
b1})
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. BufferOp a -> a -> a -> a
buf_append (forall a. Conn a -> BufferOp a
connBuffer Conn a
conn) a
a a
newl))
Maybe a
_ -> forall a. IO a -> (IOException -> IO a) -> IO a
catchIO
(forall a. BufferOp a -> Handle -> IO a
buf_hGetLine (forall a. Conn a -> BufferOp a
connBuffer Conn a
conn) (forall a. Conn a -> Handle
connHandle Conn a
conn) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. BufferOp a -> a -> a
appendNL (forall a. Conn a -> BufferOp a
connBuffer Conn a
conn))
(\ IOException
e ->
if IOException -> Bool
isEOFError IOException
e
then do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Conn a -> Bool
connCloseEOF Conn a
conn) forall a b. (a -> b) -> a -> b
$ forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (forall bufType. HStream bufType => HandleStream bufType -> IO ()
closeQuick HandleStream a
ref) (\ IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. BufferOp a -> a
buf_empty (forall a. Conn a -> BufferOp a
connBuffer Conn a
conn)))
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. String -> Result a
failMisc (forall a. Show a => a -> String
show IOException
e)))
where
appendNL :: BufferOp a -> a -> a
appendNL BufferOp a
ops a
b = forall a. BufferOp a -> a -> Word8 -> a
buf_snoc BufferOp a
ops a
b Word8
nl
nl :: Word8
nl :: Word8
nl = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum Char
'\n')
onNonClosedDo :: HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo :: forall a b.
HandleStream a -> (Conn a -> IO (Result b)) -> IO (Result b)
onNonClosedDo HandleStream a
h Conn a -> IO (Result b)
act = do
Conn a
x <- forall a. MVar a -> IO a
readMVar (forall a. HandleStream a -> MVar (Conn a)
getRef HandleStream a
h)
case Conn a
x of
ConnClosed{} -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ConnError -> Result a
failWith ConnError
ErrorClosed)
Conn a
_ -> Conn a -> IO (Result b)
act Conn a
x