{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.Node.Configuration.Socket
( gatherConfiguredSockets
, SocketOrSocketInfo(..)
, getSocketOrSocketInfoAddr
, SocketConfigError(..)
, renderSocketConfigError
)
where
import Cardano.Prelude hiding (local)
import Prelude (String)
import qualified Prelude
import Control.Monad.Trans.Except.Extra (handleIOExceptT)
import Network.Socket (Family (AF_INET, AF_INET6), AddrInfo (..),
AddrInfoFlag (..), Socket, SocketType (..))
import qualified Network.Socket as Socket
import Cardano.Node.Configuration.POM (NodeConfiguration (..))
import Cardano.Node.Types
#if !defined(mingw32_HOST_OS)
import System.Directory (removeFile)
import System.IO.Error (isDoesNotExistError)
#endif
#ifdef SYSTEMD
import System.Systemd.Daemon (getActivatedSockets)
#endif
data SocketOrSocketInfo socket info =
ActualSocket socket
| SocketInfo info
deriving Int -> SocketOrSocketInfo socket info -> ShowS
[SocketOrSocketInfo socket info] -> ShowS
SocketOrSocketInfo socket info -> String
(Int -> SocketOrSocketInfo socket info -> ShowS)
-> (SocketOrSocketInfo socket info -> String)
-> ([SocketOrSocketInfo socket info] -> ShowS)
-> Show (SocketOrSocketInfo socket info)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall socket info.
(Show socket, Show info) =>
Int -> SocketOrSocketInfo socket info -> ShowS
forall socket info.
(Show socket, Show info) =>
[SocketOrSocketInfo socket info] -> ShowS
forall socket info.
(Show socket, Show info) =>
SocketOrSocketInfo socket info -> String
showList :: [SocketOrSocketInfo socket info] -> ShowS
$cshowList :: forall socket info.
(Show socket, Show info) =>
[SocketOrSocketInfo socket info] -> ShowS
show :: SocketOrSocketInfo socket info -> String
$cshow :: forall socket info.
(Show socket, Show info) =>
SocketOrSocketInfo socket info -> String
showsPrec :: Int -> SocketOrSocketInfo socket info -> ShowS
$cshowsPrec :: forall socket info.
(Show socket, Show info) =>
Int -> SocketOrSocketInfo socket info -> ShowS
Show
getSocketOrSocketInfoAddr :: SocketOrSocketInfo Socket AddrInfo
-> IO (SocketOrSocketInfo Socket.SockAddr Socket.SockAddr)
getSocketOrSocketInfoAddr :: SocketOrSocketInfo Socket AddrInfo
-> IO (SocketOrSocketInfo SockAddr SockAddr)
getSocketOrSocketInfoAddr (ActualSocket Socket
sock) =
SockAddr -> SocketOrSocketInfo SockAddr SockAddr
forall socket info. socket -> SocketOrSocketInfo socket info
ActualSocket (SockAddr -> SocketOrSocketInfo SockAddr SockAddr)
-> IO SockAddr -> IO (SocketOrSocketInfo SockAddr SockAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> IO SockAddr
Socket.getSocketName Socket
sock
getSocketOrSocketInfoAddr (SocketInfo AddrInfo
info) =
SocketOrSocketInfo SockAddr SockAddr
-> IO (SocketOrSocketInfo SockAddr SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (SocketOrSocketInfo SockAddr SockAddr
-> IO (SocketOrSocketInfo SockAddr SockAddr))
-> SocketOrSocketInfo SockAddr SockAddr
-> IO (SocketOrSocketInfo SockAddr SockAddr)
forall a b. (a -> b) -> a -> b
$ SockAddr -> SocketOrSocketInfo SockAddr SockAddr
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo (AddrInfo -> SockAddr
Socket.addrAddress AddrInfo
info)
data SocketConfigError
= NoPublicSocketGiven
| NoLocalSocketGiven
| ClashingPublicSocketGiven
| ClashingLocalSocketGiven
| LocalSocketError FilePath IOException
| GetAddrInfoError (Maybe NodeHostIPAddress) (Maybe PortNumber) IOException
deriving Int -> SocketConfigError -> ShowS
[SocketConfigError] -> ShowS
SocketConfigError -> String
(Int -> SocketConfigError -> ShowS)
-> (SocketConfigError -> String)
-> ([SocketConfigError] -> ShowS)
-> Show SocketConfigError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SocketConfigError] -> ShowS
$cshowList :: [SocketConfigError] -> ShowS
show :: SocketConfigError -> String
$cshow :: SocketConfigError -> String
showsPrec :: Int -> SocketConfigError -> ShowS
$cshowsPrec :: Int -> SocketConfigError -> ShowS
Show
instance Exception SocketConfigError where
displayException :: SocketConfigError -> String
displayException = SocketConfigError -> String
renderSocketConfigError
renderSocketConfigError :: SocketConfigError -> String
renderSocketConfigError :: SocketConfigError -> String
renderSocketConfigError SocketConfigError
NoPublicSocketGiven =
String
"No configuration for the node's public socket. Please specify a socket "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"path either in the config file, on the command line or via systemd socket "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"activation."
renderSocketConfigError SocketConfigError
NoLocalSocketGiven =
String
"No configuration for the node's local socket. Please specify a socket "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"path either in the config file, on the command line or via systemd socket "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"activation."
renderSocketConfigError SocketConfigError
ClashingPublicSocketGiven =
String
"Configuration for the node's public socket supplied both by config/cli and "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"via systemd socket activation. Please use one or the other but not both."
renderSocketConfigError SocketConfigError
ClashingLocalSocketGiven =
String
"Configuration for the node's local socket supplied both by config/cli and "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"via systemd socket activation. Please use one or the other but not both."
renderSocketConfigError (LocalSocketError String
fp IOException
ex) =
String
"Failure while attempting to remove the stale local socket: "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> IOException -> String
forall e. Exception e => e -> String
displayException IOException
ex
renderSocketConfigError (GetAddrInfoError Maybe NodeHostIPAddress
addr Maybe PortNumber
port IOException
ex) =
String
"Failure while getting address information for the public listening "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"address: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe NodeHostIPAddress -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Maybe NodeHostIPAddress
addr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe PortNumber -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Maybe PortNumber
port String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> IOException -> String
forall e. Exception e => e -> String
displayException IOException
ex
gatherConfiguredSockets :: NodeConfiguration
-> ExceptT SocketConfigError IO
(Maybe (SocketOrSocketInfo Socket AddrInfo),
Maybe (SocketOrSocketInfo Socket AddrInfo),
SocketOrSocketInfo Socket SocketPath)
gatherConfiguredSockets :: NodeConfiguration
-> ExceptT
SocketConfigError
IO
(Maybe (SocketOrSocketInfo Socket AddrInfo),
Maybe (SocketOrSocketInfo Socket AddrInfo),
SocketOrSocketInfo Socket SocketPath)
gatherConfiguredSockets NodeConfiguration { Maybe NodeHostIPv4Address
ncNodeIPv4Addr :: NodeConfiguration -> Maybe NodeHostIPv4Address
ncNodeIPv4Addr :: Maybe NodeHostIPv4Address
ncNodeIPv4Addr,
Maybe NodeHostIPv6Address
ncNodeIPv6Addr :: NodeConfiguration -> Maybe NodeHostIPv6Address
ncNodeIPv6Addr :: Maybe NodeHostIPv6Address
ncNodeIPv6Addr,
Maybe PortNumber
ncNodePortNumber :: NodeConfiguration -> Maybe PortNumber
ncNodePortNumber :: Maybe PortNumber
ncNodePortNumber,
Maybe SocketPath
ncSocketPath :: NodeConfiguration -> Maybe SocketPath
ncSocketPath :: Maybe SocketPath
ncSocketPath } = do
Maybe ([Socket], [Socket], [Socket])
systemDSockets <- IO (Maybe ([Socket], [Socket], [Socket]))
-> ExceptT
SocketConfigError IO (Maybe ([Socket], [Socket], [Socket]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe ([Socket], [Socket], [Socket]))
getSystemdSockets
let
ipv4Sockets, ipv6Sockets :: Maybe [Socket]
ipv4Sockets :: Maybe [Socket]
ipv4Sockets = (\([Socket]
a, [Socket]
_, [Socket]
_) -> [Socket]
a) (([Socket], [Socket], [Socket]) -> [Socket])
-> Maybe ([Socket], [Socket], [Socket]) -> Maybe [Socket]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([Socket], [Socket], [Socket])
systemDSockets
ipv6Sockets :: Maybe [Socket]
ipv6Sockets = (\([Socket]
_, [Socket]
a, [Socket]
_) -> [Socket]
a) (([Socket], [Socket], [Socket]) -> [Socket])
-> Maybe ([Socket], [Socket], [Socket]) -> Maybe [Socket]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([Socket], [Socket], [Socket])
systemDSockets
Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv4 <-
case (Maybe NodeHostIPv4Address
ncNodeIPv4Addr, Maybe [Socket]
ipv4Sockets) of
(Maybe NodeHostIPv4Address
Nothing, Maybe [Socket]
Nothing) -> Maybe (SocketOrSocketInfo Socket AddrInfo)
-> ExceptT
SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SocketOrSocketInfo Socket AddrInfo)
forall a. Maybe a
Nothing
(Maybe NodeHostIPv4Address
Nothing, Just []) -> Maybe (SocketOrSocketInfo Socket AddrInfo)
-> ExceptT
SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SocketOrSocketInfo Socket AddrInfo)
forall a. Maybe a
Nothing
(Just{}, Just (Socket
_:[Socket]
_)) -> SocketConfigError
-> ExceptT
SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
ClashingPublicSocketGiven
(Maybe NodeHostIPv4Address
_, Just (Socket
sock : [Socket]
_)) ->
Maybe (SocketOrSocketInfo Socket AddrInfo)
-> ExceptT
SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return (SocketOrSocketInfo Socket AddrInfo
-> Maybe (SocketOrSocketInfo Socket AddrInfo)
forall a. a -> Maybe a
Just (Socket -> SocketOrSocketInfo Socket AddrInfo
forall socket info. socket -> SocketOrSocketInfo socket info
ActualSocket Socket
sock))
(Just NodeHostIPv4Address
addr, Maybe [Socket]
_) ->
(AddrInfo -> SocketOrSocketInfo Socket AddrInfo)
-> Maybe AddrInfo -> Maybe (SocketOrSocketInfo Socket AddrInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddrInfo -> SocketOrSocketInfo Socket AddrInfo
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo (Maybe AddrInfo -> Maybe (SocketOrSocketInfo Socket AddrInfo))
-> ([AddrInfo] -> Maybe AddrInfo)
-> [AddrInfo]
-> Maybe (SocketOrSocketInfo Socket AddrInfo)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [AddrInfo] -> Maybe AddrInfo
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head
([AddrInfo] -> Maybe (SocketOrSocketInfo Socket AddrInfo))
-> ExceptT SocketConfigError IO [AddrInfo]
-> ExceptT
SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NodeHostIPAddress
-> Maybe PortNumber -> ExceptT SocketConfigError IO [AddrInfo]
nodeAddressInfo
(NodeHostIPAddress -> Maybe NodeHostIPAddress
forall a. a -> Maybe a
Just (NodeHostIPAddress -> Maybe NodeHostIPAddress)
-> NodeHostIPAddress -> Maybe NodeHostIPAddress
forall a b. (a -> b) -> a -> b
$ NodeHostIPv4Address -> NodeHostIPAddress
nodeHostIPv4AddressToIPAddress NodeHostIPv4Address
addr)
Maybe PortNumber
ncNodePortNumber
Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv6 <-
case (Maybe NodeHostIPv6Address
ncNodeIPv6Addr, Maybe [Socket]
ipv6Sockets) of
(Maybe NodeHostIPv6Address
Nothing, Maybe [Socket]
Nothing) -> Maybe (SocketOrSocketInfo Socket AddrInfo)
-> ExceptT
SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SocketOrSocketInfo Socket AddrInfo)
forall a. Maybe a
Nothing
(Maybe NodeHostIPv6Address
Nothing, Just []) -> Maybe (SocketOrSocketInfo Socket AddrInfo)
-> ExceptT
SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SocketOrSocketInfo Socket AddrInfo)
forall a. Maybe a
Nothing
(Just{}, Just (Socket
_:[Socket]
_)) -> SocketConfigError
-> ExceptT
SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
ClashingPublicSocketGiven
(Maybe NodeHostIPv6Address
_, Just (Socket
sock : [Socket]
_)) ->
Maybe (SocketOrSocketInfo Socket AddrInfo)
-> ExceptT
SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return (SocketOrSocketInfo Socket AddrInfo
-> Maybe (SocketOrSocketInfo Socket AddrInfo)
forall a. a -> Maybe a
Just (Socket -> SocketOrSocketInfo Socket AddrInfo
forall socket info. socket -> SocketOrSocketInfo socket info
ActualSocket Socket
sock))
(Just NodeHostIPv6Address
addr, Maybe [Socket]
_) ->
(AddrInfo -> SocketOrSocketInfo Socket AddrInfo)
-> Maybe AddrInfo -> Maybe (SocketOrSocketInfo Socket AddrInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddrInfo -> SocketOrSocketInfo Socket AddrInfo
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo (Maybe AddrInfo -> Maybe (SocketOrSocketInfo Socket AddrInfo))
-> ([AddrInfo] -> Maybe AddrInfo)
-> [AddrInfo]
-> Maybe (SocketOrSocketInfo Socket AddrInfo)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [AddrInfo] -> Maybe AddrInfo
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head
([AddrInfo] -> Maybe (SocketOrSocketInfo Socket AddrInfo))
-> ExceptT SocketConfigError IO [AddrInfo]
-> ExceptT
SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NodeHostIPAddress
-> Maybe PortNumber -> ExceptT SocketConfigError IO [AddrInfo]
nodeAddressInfo
(NodeHostIPAddress -> Maybe NodeHostIPAddress
forall a. a -> Maybe a
Just (NodeHostIPAddress -> Maybe NodeHostIPAddress)
-> NodeHostIPAddress -> Maybe NodeHostIPAddress
forall a b. (a -> b) -> a -> b
$ NodeHostIPv6Address -> NodeHostIPAddress
nodeHostIPv6AddressToIPAddress NodeHostIPv6Address
addr)
Maybe PortNumber
ncNodePortNumber
(Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv4', Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv6')
<- case (Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv4, Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv6) of
(Maybe (SocketOrSocketInfo Socket AddrInfo)
Nothing, Maybe (SocketOrSocketInfo Socket AddrInfo)
Nothing) -> do
[AddrInfo]
info <- Maybe NodeHostIPAddress
-> Maybe PortNumber -> ExceptT SocketConfigError IO [AddrInfo]
nodeAddressInfo Maybe NodeHostIPAddress
forall a. Maybe a
Nothing Maybe PortNumber
ncNodePortNumber
let ipv4' :: Maybe (SocketOrSocketInfo socket AddrInfo)
ipv4' = AddrInfo -> SocketOrSocketInfo socket AddrInfo
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo (AddrInfo -> SocketOrSocketInfo socket AddrInfo)
-> Maybe AddrInfo -> Maybe (SocketOrSocketInfo socket AddrInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AddrInfo -> Bool) -> [AddrInfo] -> Maybe AddrInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Family -> Family -> Bool
forall a. Eq a => a -> a -> Bool
== Family
AF_INET) (Family -> Bool) -> (AddrInfo -> Family) -> AddrInfo -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AddrInfo -> Family
addrFamily) [AddrInfo]
info
ipv6' :: Maybe (SocketOrSocketInfo socket AddrInfo)
ipv6' = AddrInfo -> SocketOrSocketInfo socket AddrInfo
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo (AddrInfo -> SocketOrSocketInfo socket AddrInfo)
-> Maybe AddrInfo -> Maybe (SocketOrSocketInfo socket AddrInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AddrInfo -> Bool) -> [AddrInfo] -> Maybe AddrInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Family -> Family -> Bool
forall a. Eq a => a -> a -> Bool
== Family
AF_INET6) (Family -> Bool) -> (AddrInfo -> Family) -> AddrInfo -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AddrInfo -> Family
addrFamily) [AddrInfo]
info
Bool
-> ExceptT SocketConfigError IO ()
-> ExceptT SocketConfigError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (SocketOrSocketInfo Any AddrInfo) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (SocketOrSocketInfo Any AddrInfo) -> Bool)
-> Maybe (SocketOrSocketInfo Any AddrInfo) -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (SocketOrSocketInfo Any AddrInfo)
forall socket. Maybe (SocketOrSocketInfo socket AddrInfo)
ipv4' Maybe (SocketOrSocketInfo Any AddrInfo)
-> Maybe (SocketOrSocketInfo Any AddrInfo)
-> Maybe (SocketOrSocketInfo Any AddrInfo)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (SocketOrSocketInfo Any AddrInfo)
forall socket. Maybe (SocketOrSocketInfo socket AddrInfo)
ipv6') (ExceptT SocketConfigError IO ()
-> ExceptT SocketConfigError IO ())
-> ExceptT SocketConfigError IO ()
-> ExceptT SocketConfigError IO ()
forall a b. (a -> b) -> a -> b
$
SocketConfigError -> ExceptT SocketConfigError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
NoPublicSocketGiven
(Maybe (SocketOrSocketInfo Socket AddrInfo),
Maybe (SocketOrSocketInfo Socket AddrInfo))
-> ExceptT
SocketConfigError
IO
(Maybe (SocketOrSocketInfo Socket AddrInfo),
Maybe (SocketOrSocketInfo Socket AddrInfo))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SocketOrSocketInfo Socket AddrInfo)
forall socket. Maybe (SocketOrSocketInfo socket AddrInfo)
ipv4', Maybe (SocketOrSocketInfo Socket AddrInfo)
forall socket. Maybe (SocketOrSocketInfo socket AddrInfo)
ipv6')
(Maybe (SocketOrSocketInfo Socket AddrInfo),
Maybe (SocketOrSocketInfo Socket AddrInfo))
_ -> (Maybe (SocketOrSocketInfo Socket AddrInfo),
Maybe (SocketOrSocketInfo Socket AddrInfo))
-> ExceptT
SocketConfigError
IO
(Maybe (SocketOrSocketInfo Socket AddrInfo),
Maybe (SocketOrSocketInfo Socket AddrInfo))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv4, Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv6)
let unixSockets :: Maybe [Socket]
unixSockets :: Maybe [Socket]
unixSockets = (\([Socket]
_, [Socket]
_, [Socket]
a) -> [Socket]
a) (([Socket], [Socket], [Socket]) -> [Socket])
-> Maybe ([Socket], [Socket], [Socket]) -> Maybe [Socket]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([Socket], [Socket], [Socket])
systemDSockets
SocketOrSocketInfo Socket SocketPath
local <-
case (Maybe SocketPath
ncSocketPath, Maybe [Socket]
unixSockets) of
(Maybe SocketPath
Nothing, Maybe [Socket]
Nothing) -> SocketConfigError
-> ExceptT
SocketConfigError IO (SocketOrSocketInfo Socket SocketPath)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
NoLocalSocketGiven
(Maybe SocketPath
Nothing, Just []) -> SocketConfigError
-> ExceptT
SocketConfigError IO (SocketOrSocketInfo Socket SocketPath)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
NoLocalSocketGiven
(Just{}, Just{}) -> SocketConfigError
-> ExceptT
SocketConfigError IO (SocketOrSocketInfo Socket SocketPath)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
ClashingLocalSocketGiven
(Maybe SocketPath
_, Just (Socket
sock : [Socket]
_)) ->
SocketOrSocketInfo Socket SocketPath
-> ExceptT
SocketConfigError IO (SocketOrSocketInfo Socket SocketPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket -> SocketOrSocketInfo Socket SocketPath
forall socket info. socket -> SocketOrSocketInfo socket info
ActualSocket Socket
sock)
(Just SocketPath
path, Maybe [Socket]
_) ->
SocketPath -> ExceptT SocketConfigError IO ()
removeStaleLocalSocket SocketPath
path ExceptT SocketConfigError IO ()
-> SocketOrSocketInfo Socket SocketPath
-> ExceptT
SocketConfigError IO (SocketOrSocketInfo Socket SocketPath)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SocketPath -> SocketOrSocketInfo Socket SocketPath
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo SocketPath
path
(Maybe (SocketOrSocketInfo Socket AddrInfo),
Maybe (SocketOrSocketInfo Socket AddrInfo),
SocketOrSocketInfo Socket SocketPath)
-> ExceptT
SocketConfigError
IO
(Maybe (SocketOrSocketInfo Socket AddrInfo),
Maybe (SocketOrSocketInfo Socket AddrInfo),
SocketOrSocketInfo Socket SocketPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv4', Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv6', SocketOrSocketInfo Socket SocketPath
local)
removeStaleLocalSocket :: SocketPath -> ExceptT SocketConfigError IO ()
#if defined(mingw32_HOST_OS)
removeStaleLocalSocket _ =
return ()
#else
removeStaleLocalSocket :: SocketPath -> ExceptT SocketConfigError IO ()
removeStaleLocalSocket (SocketPath String
path) =
(IOException -> SocketConfigError)
-> IO () -> ExceptT SocketConfigError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> SocketConfigError
LocalSocketError String
path) (IO () -> ExceptT SocketConfigError IO ())
-> IO () -> ExceptT SocketConfigError IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
removeFile String
path IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOException
e ->
if IOException -> Bool
isDoesNotExistError IOException
e then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else IOException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
e
#endif
nodeAddressInfo :: Maybe NodeHostIPAddress
-> Maybe PortNumber
-> ExceptT SocketConfigError IO [AddrInfo]
nodeAddressInfo :: Maybe NodeHostIPAddress
-> Maybe PortNumber -> ExceptT SocketConfigError IO [AddrInfo]
nodeAddressInfo Maybe NodeHostIPAddress
mbHostAddr Maybe PortNumber
mbPort =
(IOException -> SocketConfigError)
-> IO [AddrInfo] -> ExceptT SocketConfigError IO [AddrInfo]
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (Maybe NodeHostIPAddress
-> Maybe PortNumber -> IOException -> SocketConfigError
GetAddrInfoError Maybe NodeHostIPAddress
mbHostAddr Maybe PortNumber
mbPort) (IO [AddrInfo] -> ExceptT SocketConfigError IO [AddrInfo])
-> IO [AddrInfo] -> ExceptT SocketConfigError IO [AddrInfo]
forall a b. (a -> b) -> a -> b
$
Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
Socket.getAddrInfo
(AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints)
(NodeHostIPAddress -> String
forall a. Show a => a -> String
Prelude.show (NodeHostIPAddress -> String)
-> Maybe NodeHostIPAddress -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NodeHostIPAddress
mbHostAddr)
(PortNumber -> String
forall a. Show a => a -> String
Prelude.show (PortNumber -> String) -> Maybe PortNumber -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PortNumber
mbPort)
where
hints :: AddrInfo
hints = AddrInfo
Socket.defaultHints {
addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_PASSIVE, AddrInfoFlag
AI_ADDRCONFIG]
, addrSocketType :: SocketType
addrSocketType = SocketType
Stream
}
getSystemdSockets :: IO (Maybe ([Socket], [Socket], [Socket]))
#ifdef SYSTEMD
getSystemdSockets :: IO (Maybe ([Socket], [Socket], [Socket]))
getSystemdSockets = do
Maybe [Socket]
sds_m <- IO (Maybe [Socket])
getActivatedSockets
case Maybe [Socket]
sds_m of
Maybe [Socket]
Nothing -> Maybe ([Socket], [Socket], [Socket])
-> IO (Maybe ([Socket], [Socket], [Socket]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([Socket], [Socket], [Socket])
forall a. Maybe a
Nothing
Just [Socket]
socks ->
([Socket], [Socket], [Socket])
-> Maybe ([Socket], [Socket], [Socket])
forall a. a -> Maybe a
Just (([Socket], [Socket], [Socket])
-> Maybe ([Socket], [Socket], [Socket]))
-> IO ([Socket], [Socket], [Socket])
-> IO (Maybe ([Socket], [Socket], [Socket]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(([Socket], [Socket], [Socket])
-> Socket -> IO ([Socket], [Socket], [Socket]))
-> ([Socket], [Socket], [Socket])
-> [Socket]
-> IO ([Socket], [Socket], [Socket])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\([Socket]
ipv4s, [Socket]
ipv6s, [Socket]
unixs) Socket
sock -> do
SockAddr
addr <- Socket -> IO SockAddr
Socket.getSocketName Socket
sock
case SockAddr
addr of
Socket.SockAddrInet {} -> ([Socket], [Socket], [Socket]) -> IO ([Socket], [Socket], [Socket])
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock Socket -> [Socket] -> [Socket]
forall a. a -> [a] -> [a]
: [Socket]
ipv4s, [Socket]
ipv6s, [Socket]
unixs)
Socket.SockAddrInet6 {} -> ([Socket], [Socket], [Socket]) -> IO ([Socket], [Socket], [Socket])
forall (m :: * -> *) a. Monad m => a -> m a
return ( [Socket]
ipv4s, Socket
sock Socket -> [Socket] -> [Socket]
forall a. a -> [a] -> [a]
: [Socket]
ipv6s, [Socket]
unixs)
Socket.SockAddrUnix {} -> ([Socket], [Socket], [Socket]) -> IO ([Socket], [Socket], [Socket])
forall (m :: * -> *) a. Monad m => a -> m a
return ( [Socket]
ipv4s, [Socket]
ipv6s, Socket
sock Socket -> [Socket] -> [Socket]
forall a. a -> [a] -> [a]
: [Socket]
unixs))
([], [], [])
[Socket]
socks
#else
getSystemdSockets = return Nothing
#endif