Blame Network/StreamSocket.hs

Packit acf257
{-# OPTIONS_GHC -fno-warn-orphans #-}
Packit acf257
-----------------------------------------------------------------------------
Packit acf257
-- |
Packit acf257
-- Module      :  Network.StreamSocket
Packit acf257
-- Copyright   :  See LICENSE file
Packit acf257
-- License     :  BSD
Packit acf257
--
Packit acf257
-- Maintainer  :  Ganesh Sittampalam <ganesh@earth.li>
Packit acf257
-- Stability   :  experimental
Packit acf257
-- Portability :  non-portable (not tested)
Packit acf257
--
Packit acf257
-- Socket Stream instance. Originally part of Gray's\/Bringert's HTTP module.
Packit acf257
--
Packit acf257
-- * Changes by Robin Bate Boerop <robin@bateboerop.name>:
Packit acf257
--      - Made dependencies explicit in import statements.
Packit acf257
--      - Removed false dependencies in import statements.
Packit acf257
--      - Created separate module for instance Stream Socket.
Packit acf257
--
Packit acf257
-- * Changes by Simon Foster:
Packit acf257
--      - Split module up into to sepearate Network.[Stream,TCP,HTTP] modules
Packit acf257
--      
Packit acf257
-----------------------------------------------------------------------------
Packit acf257
module Network.StreamSocket
Packit acf257
   ( handleSocketError
Packit acf257
   , myrecv
Packit acf257
   ) where
Packit acf257
Packit acf257
import Network.Stream
Packit acf257
   ( Stream(..), ConnError(ErrorReset, ErrorMisc), Result
Packit acf257
   )
Packit acf257
import Network.Socket
Packit acf257
   ( Socket, getSocketOption, shutdown, send, recv, sClose
Packit acf257
   , ShutdownCmd(ShutdownBoth), SocketOption(SoError)
Packit acf257
   )
Packit acf257
Packit acf257
import Network.HTTP.Base ( catchIO )
Packit acf257
import Control.Monad (liftM)
Packit acf257
import Control.Exception as Exception (IOException)
Packit acf257
import System.IO.Error (isEOFError)
Packit acf257
Packit acf257
-- | Exception handler for socket operations.
Packit acf257
handleSocketError :: Socket -> IOException -> IO (Result a)
Packit acf257
handleSocketError sk e =
Packit acf257
    do se <- getSocketOption sk SoError
Packit acf257
       case se of
Packit acf257
          0     -> ioError e
Packit acf257
          10054 -> return $ Left ErrorReset  -- reset
Packit acf257
          _     -> return $ Left $ ErrorMisc $ show se
Packit acf257
Packit acf257
myrecv :: Socket -> Int -> IO String
Packit acf257
myrecv sock len =
Packit acf257
    let handler e = if isEOFError e then return [] else ioError e
Packit acf257
        in catchIO (recv sock len) handler
Packit acf257
Packit acf257
instance Stream Socket where
Packit acf257
    readBlock sk n    = readBlockSocket sk n
Packit acf257
    readLine sk       = readLineSocket sk
Packit acf257
    writeBlock sk str = writeBlockSocket sk str
Packit acf257
    close sk          = do
Packit acf257
        -- This slams closed the connection (which is considered rude for TCP\/IP)
Packit acf257
         shutdown sk ShutdownBoth
Packit acf257
         sClose sk
Packit acf257
    closeOnEnd _sk _  = return () -- can't really deal with this, so do run the risk of leaking sockets here.
Packit acf257
Packit acf257
readBlockSocket :: Socket -> Int -> IO (Result String)
Packit acf257
readBlockSocket sk n = (liftM Right $ fn n) `catchIO` (handleSocketError sk)
Packit acf257
  where
Packit acf257
   fn x = do { str <- myrecv sk x
Packit acf257
             ; let len = length str
Packit acf257
             ; if len < x
Packit acf257
                then ( fn (x-len) >>= \more -> return (str++more) )
Packit acf257
                else return str
Packit acf257
             }
Packit acf257
Packit acf257
-- Use of the following function is discouraged.
Packit acf257
-- The function reads in one character at a time, 
Packit acf257
-- which causes many calls to the kernel recv()
Packit acf257
-- hence causes many context switches.
Packit acf257
readLineSocket :: Socket -> IO (Result String)
Packit acf257
readLineSocket sk = (liftM Right $ fn "") `catchIO` (handleSocketError sk)
Packit acf257
  where
Packit acf257
   fn str = do
Packit acf257
     c <- myrecv sk 1 -- like eating through a straw.
Packit acf257
     if null c || c == "\n"
Packit acf257
      then return (reverse str++c)
Packit acf257
      else fn (head c:str)
Packit acf257
    
Packit acf257
writeBlockSocket :: Socket -> String -> IO (Result ())
Packit acf257
writeBlockSocket sk str = (liftM Right $ fn str) `catchIO` (handleSocketError sk)
Packit acf257
  where
Packit acf257
   fn [] = return ()
Packit acf257
   fn x  = send sk x >>= \i -> fn (drop i x)
Packit acf257