module Network.TCP (
Conn(..),
Connection(..),
openTCP,
openTCPPort,
isConnectedTo
) where
import Control.Exception as Exception
import Network (withSocketsDo)
import Network.BSD
import Network.URI
import Network.Socket
import Network.Stream
import Data.List (isPrefixOf,partition,elemIndex)
import Data.Char
import Data.IORef
import Control.Monad (when,liftM,guard)
import System.IO
newtype Connection = ConnRef {getRef :: IORef Conn}
data Conn = MkConn { connSock :: ! Socket
, connAddr :: ! SockAddr
, connBffr :: ! String
, connHost :: String
}
| ConnClosed
deriving(Eq)
openTCP :: String -> IO Connection
openTCP host = openTCPPort host 80
openTCPPort :: String -> Int -> IO Connection
openTCPPort uri port =
do { s <- socket AF_INET Stream 6
; setSocketOption s KeepAlive 1
; host <- Exception.catch (inet_addr uri)
(\_ -> getHostByName uri >>= \host ->
case hostAddresses host of
[] -> return (error "no addresses in host entry")
(h:_) -> return h)
; let a = SockAddrInet (toEnum port) host
; Exception.catch (connect s a) (\e -> sClose s >> throw e)
; v <- newIORef (MkConn s a [] uri)
; return (ConnRef v)
}
instance Stream Connection where
readBlock ref n =
readIORef (getRef ref) >>= \conn -> case conn of
ConnClosed -> return (Left ErrorClosed)
(MkConn sk addr bfr hst)
| length bfr >= n ->
do { modifyIORef (getRef ref) (\c -> c { connBffr=(drop n bfr) })
; return (Right $ take n bfr)
}
| otherwise ->
do { modifyIORef (getRef ref) (\c -> c { connBffr=[] })
; more <- readBlock sk (n length bfr)
; return $ case more of
Left _ -> more
Right s -> (Right $ bfr ++ s)
}
readLine ref =
readIORef (getRef ref) >>= \conn -> case conn of
ConnClosed -> return (Left ErrorClosed)
(MkConn sk addr bfr _)
| null bfr ->
do { str <- myrecv sk 1000
; let len = length str
; if len == 0
then return (Right "")
else modifyIORef (getRef ref) (\c -> c { connBffr=str })
>> readLine ref
}
| otherwise ->
case elemIndex '\n' bfr of
Nothing ->
do { modifyIORef (getRef ref) (\c -> c { connBffr=[] })
; more <- readLine ref
; return $ more `bindE` \str -> Right (bfr++str)
}
Just i ->
let (bgn,end) = splitAt i bfr in
do { modifyIORef (getRef ref) (\c -> c { connBffr=(drop 1 end) })
; return (Right (bgn++['\n']))
}
writeBlock ref str =
readIORef (getRef ref) >>= \conn -> case conn of
ConnClosed -> return (Left ErrorClosed)
(MkConn sk addr _ _) -> fn sk addr str `Exception.catch` (handleSocketError sk)
where
fn sk addr s
| null s = return (Right ())
| otherwise =
getSocketOption sk SoError >>= \se ->
if se == 0
then sendTo sk s addr >>= \i -> fn sk addr (drop i s)
else writeIORef (getRef ref) ConnClosed >>
if se == 10054
then return (Left ErrorReset)
else return (Left $ ErrorMisc $ show se)
close ref =
do { c <- readIORef (getRef ref)
; closeConn c `Exception.catch` (\_ -> return ())
; writeIORef (getRef ref) ConnClosed
}
where
closeConn (ConnClosed) = return ()
closeConn (MkConn sk addr [] _) =
do { shutdown sk ShutdownSend
; suck ref
; shutdown sk ShutdownReceive
; sClose sk
}
suck :: Connection -> IO ()
suck cn = readLine cn >>=
either (\_ -> return ())
(\x -> if null x then return () else suck cn)
isConnectedTo :: Connection -> String -> IO Bool
isConnectedTo conn name =
do { v <- readIORef (getRef conn)
; case v of
ConnClosed -> return False
(MkConn sk _ _ h) ->
if (map toLower h == map toLower name)
then sIsConnected sk
else return False
}