{-# LANGUAGE CPP #-}
#include "HsNetDef.h"
module Network.Socket.Shutdown (
ShutdownCmd(..)
, shutdown
, gracefulClose
) where
import qualified Control.Exception as E
import Foreign.Marshal.Alloc (mallocBytes, free)
import Control.Concurrent (threadDelay)
import Network.Socket.Buffer
import Network.Socket.Imports
import Network.Socket.Internal
import Network.Socket.Types
data ShutdownCmd = ShutdownReceive
| ShutdownSend
| ShutdownBoth
sdownCmdToInt :: ShutdownCmd -> CInt
sdownCmdToInt :: ShutdownCmd -> CInt
sdownCmdToInt ShutdownCmd
ShutdownReceive = CInt
0
sdownCmdToInt ShutdownCmd
ShutdownSend = CInt
1
sdownCmdToInt ShutdownCmd
ShutdownBoth = CInt
2
shutdown :: Socket -> ShutdownCmd -> IO ()
shutdown :: Socket -> ShutdownCmd -> IO ()
shutdown Socket
s ShutdownCmd
stype = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s forall a b. (a -> b) -> a -> b
$ \CInt
fd ->
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwSocketErrorIfMinus1Retry_ String
"Network.Socket.shutdown" forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> IO CInt
c_shutdown CInt
fd forall a b. (a -> b) -> a -> b
$ ShutdownCmd -> CInt
sdownCmdToInt ShutdownCmd
stype
foreign import CALLCONV unsafe "shutdown"
c_shutdown :: CInt -> CInt -> IO CInt
gracefulClose :: Socket -> Int -> IO ()
gracefulClose :: Socket -> Int -> IO ()
gracefulClose Socket
s Int
tmout = IO ()
sendRecvFIN forall a b. IO a -> IO b -> IO a
`E.finally` Socket -> IO ()
close Socket
s
where
sendRecvFIN :: IO ()
sendRecvFIN = do
Either SomeException ()
ex <- forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ Socket -> ShutdownCmd -> IO ()
shutdown Socket
s ShutdownCmd
ShutdownSend
case Either SomeException ()
ex of
Left (E.SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Right () -> do
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (forall a. Int -> IO (Ptr a)
mallocBytes Int
bufSize) forall a. Ptr a -> IO ()
free forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> do
{-# SCC "" #-} Ptr Word8 -> IO ()
recvEOFloop Ptr Word8
buf
clock :: Int
clock = Int
200
recvEOFloop :: Ptr Word8 -> IO ()
recvEOFloop Ptr Word8
buf = Int -> IO ()
loop Int
0
where
loop :: Int -> IO ()
loop Int
delay = do
Int
r <- Socket -> Ptr Word8 -> Int -> IO Int
recvBufNoWait Socket
s Ptr Word8
buf Int
bufSize
let delay' :: Int
delay' = Int
delay forall a. Num a => a -> a -> a
+ Int
clock
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
r forall a. Eq a => a -> a -> Bool
== -Int
1 Bool -> Bool -> Bool
&& Int
delay' forall a. Ord a => a -> a -> Bool
< Int
tmout) forall a b. (a -> b) -> a -> b
$ do
Int -> IO ()
threadDelay (Int
clock forall a. Num a => a -> a -> a
* Int
1000)
Int -> IO ()
loop Int
delay'
bufSize :: Int
bufSize = Int
1024