    {-# 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
    --
    -----------------------------------------------------------------------------
    module Network.StreamSocket
       ( handleSocketError
       , myrecv
       ) where

    import Network.Stream
       ( Stream(..), ConnError(ErrorReset, ErrorMisc), Result
       )
    import Network.Socket
       ( Socket, getSocketOption, shutdown
       , ShutdownCmd(ShutdownBoth), SocketOption(SoError)
       )
    import Network.Socket.ByteString (send, recv)
    import qualified Network.Socket
       ( close )

    import Network.HTTP.Base ( catchIO )
    import Network.HTTP.Utils ( fromUTF8BS, toUTF8BS )
    import Control.Monad (liftM)
    import Control.Exception as Exception (IOException)
    import System.IO.Error (isEOFError)

    -- | Exception handler for socket operations.
    handleSocketError :: Socket -> IOException -> IO (Result a)
    handleSocketError :: forall a. Socket -> IOException -> IO (Result a)
    handleSocketError Socket
    sk IOException
    e =
        do se <- Socket -> SocketOption -> IO Int
    getSocketOption Socket
    sk SocketOption
    SoError
           case se of
              Int
    0     -> IOException -> IO (Result a)
    forall a. IOException -> IO a
    ioError IOException
    e
              Int
    10054 -> Result a -> IO (Result a)
    forall a. a -> IO 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
    ErrorReset  -- reset
              Int
    _     -> Result a -> IO (Result a)
    forall a. a -> IO 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
    show Int
    se

    myrecv :: Socket -> Int -> IO String
    myrecv :: Socket -> Int -> IO String
    myrecv Socket
    sock Int
    len =
        let handler :: IOException -> IO [a]
    handler IOException
    e = if IOException -> Bool
    isEOFError IOException
    e then [a] -> IO [a]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [] else IOException -> IO [a]
    forall a. IOException -> IO a
    ioError IOException
    e
            in IO String -> (IOException -> IO String) -> IO String
    forall a. IO a -> (IOException -> IO a) -> IO a
    catchIO ((ByteString -> String) -> IO ByteString -> IO String
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ByteString -> String
    fromUTF8BS (Socket -> Int -> IO ByteString
    recv Socket
    sock Int
    len)) IOException -> IO String
    forall {a}. IOException -> IO [a]
    handler

    instance Stream Socket where
        readBlock :: 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 ()
    shutdown Socket
    sk ShutdownCmd
    ShutdownBoth
             Socket -> IO ()
    Network.Socket.close Socket
    sk
        closeOnEnd :: Socket -> Bool -> IO ()
    closeOnEnd Socket
    _sk Bool
    _  = () -> IO ()
    forall a. a -> IO a
    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
    liftM String -> 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)
      where
       fn :: Int -> IO String
    fn Int
    x = do { str <- Socket -> Int -> IO String
    myrecv Socket
    sk Int
    x
                 ; let len = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    str
                 ; if len < x
                    then ( fn (x-len) >>= \String
    more -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    strString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    more) )
                    else return 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
    liftM String -> 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)
      where
       fn :: String -> IO String
    fn String
    str = do
         c <- Socket -> Int -> IO String
    myrecv Socket
    sk Int
    1 -- like eating through a straw.
         if null c || c == "\n"
          then return (reverse str++c)
          else fn (head c: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)
      where
       fn :: String -> IO ()
    fn [] = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
       fn String
    x  = Socket -> ByteString -> IO Int
    send Socket
    sk (String -> ByteString
    toUTF8BS String
    x) IO Int -> (Int -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    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]
    drop Int
    i String
    x)