module Network.Socket.Handle where

import qualified GHC.IO.Device (IODeviceType(Stream))
import GHC.IO.Handle.FD (fdToHandle')
import System.IO (IOMode(..), Handle, BufferMode(..), hSetBuffering)

import Network.Socket.Types

-- | Turns a Socket into an 'Handle'. By default, the new handle is
-- unbuffered. Use 'System.IO.hSetBuffering' to change the buffering.
--
-- Note that since a 'Handle' is automatically closed by a finalizer
-- when it is no longer referenced, you should avoid doing any more
-- operations on the 'Socket' after calling 'socketToHandle'.  To
-- close the 'Socket' after 'socketToHandle', call 'System.IO.hClose'
-- on the 'Handle'.
--
-- Caveat 'Handle' is not recommended for network programming in 
-- Haskell, e.g. merely performing 'hClose' on a TCP socket won't
-- cooperate with peer's 'gracefulClose', i.e. proper shutdown
-- sequence with appropriate handshakes specified by the protocol.

socketToHandle :: Socket -> IOMode -> IO Handle
socketToHandle :: Socket -> IOMode -> IO Handle
socketToHandle Socket
s IOMode
mode = Socket -> (CInt -> IO Handle) -> (CInt -> IO Handle) -> IO Handle
forall a. Socket -> (CInt -> IO a) -> (CInt -> IO a) -> IO a
invalidateSocket Socket
s CInt -> IO Handle
forall p a. p -> IO a
err ((CInt -> IO Handle) -> IO Handle)
-> (CInt -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \CInt
oldfd -> do
    Handle
h <- CInt
-> Maybe IODeviceType
-> Bool
-> FilePath
-> IOMode
-> Bool
-> IO Handle
fdToHandle' CInt
oldfd (IODeviceType -> Maybe IODeviceType
forall a. a -> Maybe a
Just IODeviceType
GHC.IO.Device.Stream) Bool
True (Socket -> FilePath
forall a. Show a => a -> FilePath
show Socket
s) IOMode
mode Bool
True{-bin-}
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
NoBuffering
    Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h
  where
    err :: p -> IO a
err p
_ = IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError (FilePath -> IOError) -> FilePath -> IOError
forall a b. (a -> b) -> a -> b
$ FilePath
"socketToHandle: socket is no longer valid"