{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
module Reflex.Backend.Socket.Connect (connect) where
import Control.Concurrent (forkIO)
import Control.Exception (IOException, onException, try)
import Control.Monad.Except (ExceptT(..), runExceptT, withExceptT)
import Control.Monad.Trans (MonadIO(..))
import Data.Functor (($>), void)
import Data.List.NonEmpty (NonEmpty, fromList)
import Data.Semigroup.Foldable (asum1)
import Network.Socket (Socket, AddrInfo(..), defaultProtocol)
import qualified Network.Socket as NS
import Reflex
import Reflex.Backend.Socket.Error (SetupError(..))
connect
:: ( Reflex t
, PerformEvent t m
, TriggerEvent t m
, PostBuild t m
, MonadIO (Performable m)
, MonadIO m
)
=> Maybe NS.HostName
-> NS.ServiceName
-> m (Event t (Either SetupError Socket))
connect mHost service = do
ePostBuild <- getPostBuild
performEventAsync $ ePostBuild $> \onRes -> void . liftIO . forkIO $
let
getAddrs :: ExceptT SetupError IO (NonEmpty AddrInfo)
getAddrs = withExceptT GetAddrInfoError . ExceptT . try $
fromList <$> NS.getAddrInfo Nothing mHost (Just service)
tryConnect
:: AddrInfo
-> ExceptT (NonEmpty (AddrInfo, IOException)) IO Socket
tryConnect info = withExceptT (pure . (info,)) . ExceptT . try $ do
sock <- NS.socket (addrFamily info) NS.Stream defaultProtocol
NS.connect sock (addrAddress info) `onException` NS.close sock
pure sock
in do
res <- runExceptT $ do
addrs <- getAddrs
let attempts = tryConnect <$> addrs
withExceptT UseAddrInfoError $ asum1 attempts
onRes res