{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Bcc.Node.Configuration.Socket
  ( gatherConfiguredSockets
  , SocketOrSocketInfo(..)
  , getSocketOrSocketInfoAddr
  , SocketConfigError(..)
  , renderSocketConfigError
  )
where

import           Bcc.Prelude hiding (local)
import           Prelude (String)
import qualified Prelude

import           Control.Monad.Trans.Except.Extra (handleIOExceptT)
import           Network.Socket (AddrInfo (..), AddrInfoFlag (..), Family (AF_INET, AF_INET6),
                   Socket, SocketType (..))
import qualified Network.Socket as Socket

import           Bcc.Node.Configuration.POM (NodeConfiguration (..))
import           Bcc.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
    | ClashingPublicIpv4SocketGiven
    | ClashingPublicIpv6SocketGiven
    | 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
ClashingPublicIpv4SocketGiven =
    String
"Configuration for the node's public IPv4 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
ClashingPublicIpv6SocketGiven =
    String
"Configuration for the node's public IPv6 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),
                                    Maybe (SocketOrSocketInfo Socket SocketPath))
gatherConfiguredSockets :: NodeConfiguration
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo Socket AddrInfo),
      Maybe (SocketOrSocketInfo Socket AddrInfo),
      Maybe (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
    -- TODO: add config file support
    let -- The first systemd IPv4 socket if it exists
        firstIpv4Socket :: Maybe Socket
        firstIpv4Socket :: Maybe Socket
firstIpv4Socket = Maybe (Maybe Socket) -> Maybe Socket
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Socket) -> Maybe Socket)
-> Maybe (Maybe Socket) -> Maybe Socket
forall a b. (a -> b) -> a -> b
$ [Socket] -> Maybe Socket
forall a. [a] -> Maybe a
listToMaybe ([Socket] -> Maybe Socket)
-> (([Socket], [Socket], [Socket]) -> [Socket])
-> ([Socket], [Socket], [Socket])
-> Maybe Socket
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\([Socket]
a, [Socket]
_, [Socket]
_) -> [Socket]
a) (([Socket], [Socket], [Socket]) -> Maybe Socket)
-> Maybe ([Socket], [Socket], [Socket]) -> Maybe (Maybe Socket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([Socket], [Socket], [Socket])
systemDSockets

        -- The first systemd IPv6 socket if it exists
        firstIpv6Socket :: Maybe Socket
        firstIpv6Socket :: Maybe Socket
firstIpv6Socket = Maybe (Maybe Socket) -> Maybe Socket
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Socket) -> Maybe Socket)
-> Maybe (Maybe Socket) -> Maybe Socket
forall a b. (a -> b) -> a -> b
$ [Socket] -> Maybe Socket
forall a. [a] -> Maybe a
listToMaybe ([Socket] -> Maybe Socket)
-> (([Socket], [Socket], [Socket]) -> [Socket])
-> ([Socket], [Socket], [Socket])
-> Maybe Socket
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\([Socket]
_, [Socket]
a, [Socket]
_) -> [Socket]
a) (([Socket], [Socket], [Socket]) -> Maybe Socket)
-> Maybe ([Socket], [Socket], [Socket]) -> Maybe (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
firstIpv4Socket) 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 Socket
sock)  -> 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
_, Just Socket
_)      -> SocketConfigError
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
ClashingPublicIpv4SocketGiven
      (Just NodeHostIPv4Address
addr, Maybe Socket
Nothing)  ->
            (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
firstIpv6Socket) 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 Socket
sock)  -> 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
_, Just Socket
_)      -> SocketConfigError
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket AddrInfo))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
ClashingPublicIpv6SocketGiven
      (Just NodeHostIPv6Address
addr, Maybe Socket
Nothing)  ->
              (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 firstUnixSocket :: Maybe Socket
        firstUnixSocket :: Maybe Socket
firstUnixSocket = Maybe (Maybe Socket) -> Maybe Socket
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Socket) -> Maybe Socket)
-> Maybe (Maybe Socket) -> Maybe Socket
forall a b. (a -> b) -> a -> b
$ [Socket] -> Maybe Socket
forall a. [a] -> Maybe a
listToMaybe ([Socket] -> Maybe Socket)
-> (([Socket], [Socket], [Socket]) -> [Socket])
-> ([Socket], [Socket], [Socket])
-> Maybe Socket
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\([Socket]
_, [Socket]
_, [Socket]
a) -> [Socket]
a) (([Socket], [Socket], [Socket]) -> Maybe Socket)
-> Maybe ([Socket], [Socket], [Socket]) -> Maybe (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
    Maybe (SocketOrSocketInfo Socket SocketPath)
local <- case (Maybe SocketPath
ncSocketPath, Maybe Socket
firstUnixSocket) of
      (Maybe SocketPath
Nothing, Maybe Socket
Nothing)    -> Maybe (SocketOrSocketInfo Socket SocketPath)
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SocketPath))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SocketOrSocketInfo Socket SocketPath)
forall a. Maybe a
Nothing
      (Just SocketPath
_, Just Socket
_)      -> SocketConfigError
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SocketPath))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
ClashingLocalSocketGiven
      (Maybe SocketPath
Nothing, Just Socket
sock)  -> Maybe (SocketOrSocketInfo Socket SocketPath)
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SocketPath))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SocketOrSocketInfo Socket SocketPath)
 -> ExceptT
      SocketConfigError
      IO
      (Maybe (SocketOrSocketInfo Socket SocketPath)))
-> (SocketOrSocketInfo Socket SocketPath
    -> Maybe (SocketOrSocketInfo Socket SocketPath))
-> SocketOrSocketInfo Socket SocketPath
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SocketPath))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SocketOrSocketInfo Socket SocketPath
-> Maybe (SocketOrSocketInfo Socket SocketPath)
forall a. a -> Maybe a
Just (SocketOrSocketInfo Socket SocketPath
 -> ExceptT
      SocketConfigError
      IO
      (Maybe (SocketOrSocketInfo Socket SocketPath)))
-> SocketOrSocketInfo Socket SocketPath
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SocketPath))
forall a b. (a -> b) -> a -> b
$ Socket -> SocketOrSocketInfo Socket SocketPath
forall socket info. socket -> SocketOrSocketInfo socket info
ActualSocket Socket
sock
      (Just SocketPath
path, Maybe Socket
Nothing)  -> SocketPath -> ExceptT SocketConfigError IO ()
removeStaleLocalSocket SocketPath
path ExceptT SocketConfigError IO ()
-> Maybe (SocketOrSocketInfo Socket SocketPath)
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SocketPath))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SocketOrSocketInfo Socket SocketPath
-> Maybe (SocketOrSocketInfo Socket SocketPath)
forall a. a -> Maybe a
Just (SocketPath -> SocketOrSocketInfo Socket SocketPath
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo SocketPath
path)

    (Maybe (SocketOrSocketInfo Socket AddrInfo),
 Maybe (SocketOrSocketInfo Socket AddrInfo),
 Maybe (SocketOrSocketInfo Socket SocketPath))
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo Socket AddrInfo),
      Maybe (SocketOrSocketInfo Socket AddrInfo),
      Maybe (SocketOrSocketInfo Socket SocketPath))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv4', Maybe (SocketOrSocketInfo Socket AddrInfo)
ipv6', Maybe (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