{-# OPTIONS_GHC -fno-warn-orphans #-}------------------------------------------------------------------------------- |-- Module : Network.StreamSocket-- Copyright : See LICENSE file-- License : BSD---- Maintainer : Ganesh Sittampalam <ganesh@earth.li>-- Stability : experimental-- Portability : non-portable (not tested)---- Socket Stream instance. Originally part of Gray's\/Bringert's HTTP module.---- * Changes by Robin Bate Boerop <robin@bateboerop.name>:-- - Made dependencies explicit in import statements.-- - Removed false dependencies in import statements.-- - Created separate module for instance Stream Socket.---- * Changes by Simon Foster:-- - Split module up into to separate Network.[Stream,TCP,HTTP] modules-------------------------------------------------------------------------------moduleNetwork.StreamSocket(handleSocketError ,myrecv )whereimportNetwork.Stream (Stream (..),ConnError (ErrorReset ,ErrorMisc ),Result )importNetwork.Socket(Socket,getSocketOption,shutdown,ShutdownCmd(ShutdownBoth),SocketOption(SoError))importNetwork.Socket.ByteString(send,recv)importqualifiedNetwork.Socket(close)importNetwork.HTTP.Base (catchIO )importNetwork.HTTP.Utils (fromUTF8BS ,toUTF8BS )importControl.Monad(liftM)importControl.ExceptionasException(IOException)importSystem.IO.Error(isEOFError)-- | Exception handler for socket operations.handleSocketError ::Socket->IOException->IO(Result a )handleSocketError :: Socket -> IOException -> IO (Result a)
handleSocketError Socket
sk IOException
e =doInt
se <-Socket -> SocketOption -> IO Int
getSocketOptionSocket
sk SocketOption
SoErrorcaseInt
se ofInt
0->IOException -> IO (Result a)
forall a. IOException -> IO a
ioErrorIOException
e Int
10054->Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return(Result a -> IO (Result a)) -> Result a -> IO (Result a)
forall a b. (a -> b) -> a -> b
$ConnError -> Result a
forall a b. a -> Either a b
LeftConnError
ErrorReset -- resetInt
_->Result a -> IO (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return(Result a -> IO (Result a)) -> Result a -> IO (Result a)
forall a b. (a -> b) -> a -> b
$ConnError -> Result a
forall a b. a -> Either a b
Left(ConnError -> Result a) -> ConnError -> Result a
forall a b. (a -> b) -> a -> b
$String -> ConnError
ErrorMisc (String -> ConnError) -> String -> ConnError
forall a b. (a -> b) -> a -> b
$Int -> String
forall a. Show a => a -> String
showInt
se myrecv ::Socket->Int->IOStringmyrecv :: Socket -> Int -> IO String
myrecv Socket
sock Int
len =lethandler :: IOException -> IO [a]
handler IOException
e =ifIOException -> Bool
isEOFErrorIOException
e then[a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return[]elseIOException -> IO [a]
forall a. IOException -> IO a
ioErrorIOException
e inIO String -> (IOException -> IO String) -> IO String
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO ((ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapByteString -> String
fromUTF8BS (Socket -> Int -> IO ByteString
recvSocket
sock Int
len ))IOException -> IO String
forall a. IOException -> IO [a]
handler instanceStream SocketwherereadBlock :: Socket -> Int -> IO (Result String)
readBlock Socket
sk Int
n =Socket -> Int -> IO (Result String)
readBlockSocket Socket
sk Int
n readLine :: Socket -> IO (Result String)
readLine Socket
sk =Socket -> IO (Result String)
readLineSocket Socket
sk writeBlock :: Socket -> String -> IO (Result ())
writeBlock Socket
sk String
str =Socket -> String -> IO (Result ())
writeBlockSocket Socket
sk String
str close :: Socket -> IO ()
close Socket
sk =do-- This slams closed the connection (which is considered rude for TCP\/IP)Socket -> ShutdownCmd -> IO ()
shutdownSocket
sk ShutdownCmd
ShutdownBothSocket -> IO ()
Network.Socket.closeSocket
sk closeOnEnd :: Socket -> Bool -> IO ()
closeOnEnd Socket
_sk Bool
_=() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return()-- can't really deal with this, so do run the risk of leaking sockets here.readBlockSocket ::Socket->Int->IO(Result String)readBlockSocket :: Socket -> Int -> IO (Result String)
readBlockSocket Socket
sk Int
n =((String -> Result String) -> IO String -> IO (Result String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMString -> Result String
forall a b. b -> Either a b
Right(IO String -> IO (Result String))
-> IO String -> IO (Result String)
forall a b. (a -> b) -> a -> b
$Int -> IO String
fn Int
n )IO (Result String)
-> (IOException -> IO (Result String)) -> IO (Result String)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (Socket -> IOException -> IO (Result String)
forall a. Socket -> IOException -> IO (Result a)
handleSocketError Socket
sk )wherefn :: Int -> IO String
fn Int
x =do{String
str <-Socket -> Int -> IO String
myrecv Socket
sk Int
x ;letlen :: Int
len =String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
lengthString
str ;ifInt
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
x then(Int -> IO String
fn (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len )IO String -> (String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=\String
more ->String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return(String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++String
more ))elseString -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
returnString
str }-- Use of the following function is discouraged.-- The function reads in one character at a time,-- which causes many calls to the kernel recv()-- hence causes many context switches.readLineSocket ::Socket->IO(Result String)readLineSocket :: Socket -> IO (Result String)
readLineSocket Socket
sk =((String -> Result String) -> IO String -> IO (Result String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMString -> Result String
forall a b. b -> Either a b
Right(IO String -> IO (Result String))
-> IO String -> IO (Result String)
forall a b. (a -> b) -> a -> b
$String -> IO String
fn String
"")IO (Result String)
-> (IOException -> IO (Result String)) -> IO (Result String)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (Socket -> IOException -> IO (Result String)
forall a. Socket -> IOException -> IO (Result a)
handleSocketError Socket
sk )wherefn :: String -> IO String
fn String
str =doString
c <-Socket -> Int -> IO String
myrecv Socket
sk Int
1-- like eating through a straw.ifString -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
nullString
c Bool -> Bool -> Bool
||String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"\n"thenString -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return(String -> String
forall a. [a] -> [a]
reverseString
str String -> String -> String
forall a. [a] -> [a] -> [a]
++String
c )elseString -> IO String
fn (String -> Char
forall a. [a] -> a
headString
c Char -> String -> String
forall a. a -> [a] -> [a]
:String
str )writeBlockSocket ::Socket->String->IO(Result ())writeBlockSocket :: Socket -> String -> IO (Result ())
writeBlockSocket Socket
sk String
str =((() -> Result ()) -> IO () -> IO (Result ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM() -> Result ()
forall a b. b -> Either a b
Right(IO () -> IO (Result ())) -> IO () -> IO (Result ())
forall a b. (a -> b) -> a -> b
$String -> IO ()
fn String
str )IO (Result ()) -> (IOException -> IO (Result ())) -> IO (Result ())
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (Socket -> IOException -> IO (Result ())
forall a. Socket -> IOException -> IO (Result a)
handleSocketError Socket
sk )wherefn :: String -> IO ()
fn []=() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return()fn String
x =Socket -> ByteString -> IO Int
sendSocket
sk (String -> ByteString
toUTF8BS String
x )IO Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=\Int
i ->String -> IO ()
fn (Int -> String -> String
forall a. Int -> [a] -> [a]
dropInt
i String
x )