{-# 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




-- | Since we support systemd socket activation, we have to handle being
-- given actual already-constructed sockets, or the info needed to make new
-- sockets later.
--
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)


-- | Errors for the current module.
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


-- | Gather from the various sources of configuration which sockets we will use
-- for the public node-to-node and the local node-to-client IPC.  It returns
-- 'SocketOrSocketInfo' for @ipv4@, @ipv6@ and local socket.
--
-- We get such configuration from:
--
-- * node config file
-- * node cli
-- * systemd socket activation
--
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

    -- Select the sockets or address for public node-to-node comms
    --
    let --TODO: add config file support
        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

    -- only when 'ncNodeIPv4Addr' is specified or an ipv4 socket is passed
    -- through socket activation
    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

    -- only when 'ncNodeIPv6Addr' is specified or an ipv6 socket is passed
    -- through socket activation
    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

    -- When none of the addresses was given. We try resolve address passing
    -- only '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)


    -- Select the socket or path for local node-to-client comms
    --
    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

    -- only when 'ncSocketpath' is specified or a unix socket is passed through
    -- socket activation
    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)


-- | Binding a local unix domain socket always expects to create it, and fails
-- if it exists already. So we delete it first if it exists. But only on unix.
--
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
              }


-- | Possibly return systemd-activated sockets.  Splits the sockets into three
-- groups:'AF_INET' and 'AF_INET6', 'AF_UNIX'.
--
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