module Data.Conduit.Network.Retry where
import Prelude hiding (catch)
import Data.Conduit
import Data.Conduit.Network
import Network.Socket (Socket, close)
import Network.Socket.ByteString (sendAll)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Exception
import Data.ByteString (ByteString)
import Control.Concurrent (threadDelay)
import Control.Concurrent.MVar
import Control.Monad ((>=>))
import Control.Monad.Trans.Class (lift)
sinkSocketRetry :: MonadResource m => IO Socket -> Int -> IO () -> Consumer ByteString m ()
sinkSocketRetry mkSocket delay exeptionCallback =
let
safeMkSocket :: IO Socket
safeMkSocket = catch mkSocket (\SomeException{} -> exeptionCallback >> threadDelay delay >> safeMkSocket)
safeSend :: MVar Socket -> ByteString -> IO ()
safeSend s o = do
sock <- takeMVar s
catch (sendAll sock o >> putMVar s sock) $ \SomeException{} -> do
close sock
safeMkSocket >>= putMVar s
threadDelay delay
safeSend s o
push :: MonadResource m => MVar Socket -> Consumer ByteString m ()
push s = await >>= maybe (return ()) (\bs -> lift (liftIO $ safeSend s bs) >> push s)
in bracketP (safeMkSocket >>= newMVar) (takeMVar >=> close) push
tcpSinkRetry :: MonadResource m => ByteString -> Int -> Int -> IO () -> Consumer ByteString m ()
tcpSinkRetry host port = sinkSocketRetry (fmap fst (getSocket host port))