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

module Cardano.Node.Configuration.Socket
  ( SocketConfig (..)
  , 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           Generic.Data.Orphans ()
import           Network.Socket (AddrInfo (..), AddrInfoFlag (..), Family (AF_INET, AF_INET6),
                   SockAddr, Socket, SocketType (..))
import qualified Network.Socket as Socket

import           Cardano.Node.Configuration.NodeAddress

import           Ouroboros.Network.NodeToClient (LocalAddress (..), LocalSocket (..))

#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 Socket.SockAddr
                          -> IO (SocketOrSocketInfo Socket.SockAddr Socket.SockAddr)
getSocketOrSocketInfoAddr :: SocketOrSocketInfo Socket SockAddr
-> 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 SockAddr
sockAddr)  =
    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 SockAddr
sockAddr


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

data SocketConfig
  = SocketConfig
    { SocketConfig -> Last NodeHostIPv4Address
ncNodeIPv4Addr    :: !(Last NodeHostIPv4Address)
    , SocketConfig -> Last NodeHostIPv6Address
ncNodeIPv6Addr    :: !(Last NodeHostIPv6Address)
    , SocketConfig -> Last PortNumber
ncNodePortNumber  :: !(Last PortNumber)
    , SocketConfig -> Last SocketPath
ncSocketPath      :: !(Last SocketPath)
    }
    deriving (SocketConfig -> SocketConfig -> Bool
(SocketConfig -> SocketConfig -> Bool)
-> (SocketConfig -> SocketConfig -> Bool) -> Eq SocketConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SocketConfig -> SocketConfig -> Bool
$c/= :: SocketConfig -> SocketConfig -> Bool
== :: SocketConfig -> SocketConfig -> Bool
$c== :: SocketConfig -> SocketConfig -> Bool
Eq, Int -> SocketConfig -> ShowS
[SocketConfig] -> ShowS
SocketConfig -> String
(Int -> SocketConfig -> ShowS)
-> (SocketConfig -> String)
-> ([SocketConfig] -> ShowS)
-> Show SocketConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SocketConfig] -> ShowS
$cshowList :: [SocketConfig] -> ShowS
show :: SocketConfig -> String
$cshow :: SocketConfig -> String
showsPrec :: Int -> SocketConfig -> ShowS
$cshowsPrec :: Int -> SocketConfig -> ShowS
Show)

-- | 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 :: SocketConfig
                        -> ExceptT SocketConfigError IO
                                   (Maybe (SocketOrSocketInfo Socket      SockAddr),
                                    Maybe (SocketOrSocketInfo Socket      SockAddr),
                                    Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
gatherConfiguredSockets :: SocketConfig
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo Socket SockAddr),
      Maybe (SocketOrSocketInfo Socket SockAddr),
      Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
gatherConfiguredSockets SocketConfig { Last NodeHostIPv4Address
ncNodeIPv4Addr :: Last NodeHostIPv4Address
ncNodeIPv4Addr :: SocketConfig -> Last NodeHostIPv4Address
ncNodeIPv4Addr,
                                       Last NodeHostIPv6Address
ncNodeIPv6Addr :: Last NodeHostIPv6Address
ncNodeIPv6Addr :: SocketConfig -> Last NodeHostIPv6Address
ncNodeIPv6Addr,
                                       Last PortNumber
ncNodePortNumber :: Last PortNumber
ncNodePortNumber :: SocketConfig -> Last PortNumber
ncNodePortNumber,
                                       Last SocketPath
ncSocketPath :: Last SocketPath
ncSocketPath :: SocketConfig -> Last SocketPath
ncSocketPath } = do

    Maybe ([Socket], [Socket], [LocalSocket])
systemDSockets <- IO (Maybe ([Socket], [Socket], [LocalSocket]))
-> ExceptT
     SocketConfigError IO (Maybe ([Socket], [Socket], [LocalSocket]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe ([Socket], [Socket], [LocalSocket]))
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], [LocalSocket]) -> [Socket])
-> ([Socket], [Socket], [LocalSocket])
-> 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]
_, [LocalSocket]
_) -> [Socket]
a) (([Socket], [Socket], [LocalSocket]) -> Maybe Socket)
-> Maybe ([Socket], [Socket], [LocalSocket])
-> Maybe (Maybe Socket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([Socket], [Socket], [LocalSocket])
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], [LocalSocket]) -> [Socket])
-> ([Socket], [Socket], [LocalSocket])
-> 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, [LocalSocket]
_) -> [Socket]
a) (([Socket], [Socket], [LocalSocket]) -> Maybe Socket)
-> Maybe ([Socket], [Socket], [LocalSocket])
-> Maybe (Maybe Socket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([Socket], [Socket], [LocalSocket])
systemDSockets

    -- only when 'ncNodeIPv4Addr' is specified or an ipv4 socket is passed
    -- through socket activation
    Maybe (SocketOrSocketInfo Socket SockAddr)
ipv4 <- case (Last NodeHostIPv4Address -> Maybe NodeHostIPv4Address
forall a. Last a -> Maybe a
getLast Last NodeHostIPv4Address
ncNodeIPv4Addr, Maybe Socket
firstIpv4Socket) of
      (Maybe NodeHostIPv4Address
Nothing, Maybe Socket
Nothing)    -> Maybe (SocketOrSocketInfo Socket SockAddr)
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SockAddr))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SocketOrSocketInfo Socket SockAddr)
forall a. Maybe a
Nothing
      (Maybe NodeHostIPv4Address
Nothing, Just Socket
sock)  -> Maybe (SocketOrSocketInfo Socket SockAddr)
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SockAddr))
forall (m :: * -> *) a. Monad m => a -> m a
return (SocketOrSocketInfo Socket SockAddr
-> Maybe (SocketOrSocketInfo Socket SockAddr)
forall a. a -> Maybe a
Just (Socket -> SocketOrSocketInfo Socket SockAddr
forall socket info. socket -> SocketOrSocketInfo socket info
ActualSocket Socket
sock))
      (Just NodeHostIPv4Address
_, Just Socket
_)      -> SocketConfigError
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SockAddr))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
ClashingPublicIpv4SocketGiven
      (Just NodeHostIPv4Address
addr, Maybe Socket
Nothing)  ->
            (AddrInfo -> SocketOrSocketInfo Socket SockAddr)
-> Maybe AddrInfo -> Maybe (SocketOrSocketInfo Socket SockAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SockAddr -> SocketOrSocketInfo Socket SockAddr
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo (SockAddr -> SocketOrSocketInfo Socket SockAddr)
-> (AddrInfo -> SockAddr)
-> AddrInfo
-> SocketOrSocketInfo Socket SockAddr
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AddrInfo -> SockAddr
addrAddress) (Maybe AddrInfo -> Maybe (SocketOrSocketInfo Socket SockAddr))
-> ([AddrInfo] -> Maybe AddrInfo)
-> [AddrInfo]
-> Maybe (SocketOrSocketInfo Socket SockAddr)
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 SockAddr))
-> ExceptT SocketConfigError IO [AddrInfo]
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SockAddr))
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)
              (Last PortNumber -> Maybe PortNumber
forall a. Last a -> Maybe a
getLast Last PortNumber
ncNodePortNumber)

    -- only when 'ncNodeIPv6Addr' is specified or an ipv6 socket is passed
    -- through socket activation
    Maybe (SocketOrSocketInfo Socket SockAddr)
ipv6 <- case (Last NodeHostIPv6Address -> Maybe NodeHostIPv6Address
forall a. Last a -> Maybe a
getLast Last NodeHostIPv6Address
ncNodeIPv6Addr, Maybe Socket
firstIpv6Socket) of
      (Maybe NodeHostIPv6Address
Nothing, Maybe Socket
Nothing)    -> Maybe (SocketOrSocketInfo Socket SockAddr)
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SockAddr))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SocketOrSocketInfo Socket SockAddr)
forall a. Maybe a
Nothing
      (Maybe NodeHostIPv6Address
Nothing, Just Socket
sock)  -> Maybe (SocketOrSocketInfo Socket SockAddr)
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SockAddr))
forall (m :: * -> *) a. Monad m => a -> m a
return (SocketOrSocketInfo Socket SockAddr
-> Maybe (SocketOrSocketInfo Socket SockAddr)
forall a. a -> Maybe a
Just (Socket -> SocketOrSocketInfo Socket SockAddr
forall socket info. socket -> SocketOrSocketInfo socket info
ActualSocket Socket
sock))
      (Just NodeHostIPv6Address
_, Just Socket
_)      -> SocketConfigError
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SockAddr))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
ClashingPublicIpv6SocketGiven
      (Just NodeHostIPv6Address
addr, Maybe Socket
Nothing)  ->
              (AddrInfo -> SocketOrSocketInfo Socket SockAddr)
-> Maybe AddrInfo -> Maybe (SocketOrSocketInfo Socket SockAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SockAddr -> SocketOrSocketInfo Socket SockAddr
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo (SockAddr -> SocketOrSocketInfo Socket SockAddr)
-> (AddrInfo -> SockAddr)
-> AddrInfo
-> SocketOrSocketInfo Socket SockAddr
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AddrInfo -> SockAddr
addrAddress) (Maybe AddrInfo -> Maybe (SocketOrSocketInfo Socket SockAddr))
-> ([AddrInfo] -> Maybe AddrInfo)
-> [AddrInfo]
-> Maybe (SocketOrSocketInfo Socket SockAddr)
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 SockAddr))
-> ExceptT SocketConfigError IO [AddrInfo]
-> ExceptT
     SocketConfigError IO (Maybe (SocketOrSocketInfo Socket SockAddr))
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)
                (Last PortNumber -> Maybe PortNumber
forall a. Last a -> Maybe a
getLast Last PortNumber
ncNodePortNumber)

    -- When none of the addresses was given. We try resolve address passing
    -- only 'ncNodePortNumber'.
    (Maybe (SocketOrSocketInfo Socket SockAddr)
ipv4', Maybe (SocketOrSocketInfo Socket SockAddr)
ipv6')
      <- case (Maybe (SocketOrSocketInfo Socket SockAddr)
ipv4, Maybe (SocketOrSocketInfo Socket SockAddr)
ipv6) of
            (Maybe (SocketOrSocketInfo Socket SockAddr)
Nothing, Maybe (SocketOrSocketInfo Socket SockAddr)
Nothing) -> do

              [AddrInfo]
info <- Maybe NodeHostIPAddress
-> Maybe PortNumber -> ExceptT SocketConfigError IO [AddrInfo]
nodeAddressInfo Maybe NodeHostIPAddress
forall a. Maybe a
Nothing (Maybe PortNumber -> ExceptT SocketConfigError IO [AddrInfo])
-> Maybe PortNumber -> ExceptT SocketConfigError IO [AddrInfo]
forall a b. (a -> b) -> a -> b
$ Last PortNumber -> Maybe PortNumber
forall a. Last a -> Maybe a
getLast Last PortNumber
ncNodePortNumber
              let ipv4' :: Maybe (SocketOrSocketInfo socket SockAddr)
ipv4' = SockAddr -> SocketOrSocketInfo socket SockAddr
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo (SockAddr -> SocketOrSocketInfo socket SockAddr)
-> (AddrInfo -> SockAddr)
-> AddrInfo
-> SocketOrSocketInfo socket SockAddr
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AddrInfo -> SockAddr
addrAddress
                      (AddrInfo -> SocketOrSocketInfo socket SockAddr)
-> Maybe AddrInfo -> Maybe (SocketOrSocketInfo socket SockAddr)
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 SockAddr)
ipv6' = SockAddr -> SocketOrSocketInfo socket SockAddr
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo (SockAddr -> SocketOrSocketInfo socket SockAddr)
-> (AddrInfo -> SockAddr)
-> AddrInfo
-> SocketOrSocketInfo socket SockAddr
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AddrInfo -> SockAddr
addrAddress
                      (AddrInfo -> SocketOrSocketInfo socket SockAddr)
-> Maybe AddrInfo -> Maybe (SocketOrSocketInfo socket SockAddr)
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 SockAddr) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (SocketOrSocketInfo Any SockAddr) -> Bool)
-> Maybe (SocketOrSocketInfo Any SockAddr) -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (SocketOrSocketInfo Any SockAddr)
forall socket. Maybe (SocketOrSocketInfo socket SockAddr)
ipv4' Maybe (SocketOrSocketInfo Any SockAddr)
-> Maybe (SocketOrSocketInfo Any SockAddr)
-> Maybe (SocketOrSocketInfo Any SockAddr)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (SocketOrSocketInfo Any SockAddr)
forall socket. Maybe (SocketOrSocketInfo socket SockAddr)
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 SockAddr),
 Maybe (SocketOrSocketInfo Socket SockAddr))
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo Socket SockAddr),
      Maybe (SocketOrSocketInfo Socket SockAddr))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SocketOrSocketInfo Socket SockAddr)
forall socket. Maybe (SocketOrSocketInfo socket SockAddr)
ipv4', Maybe (SocketOrSocketInfo Socket SockAddr)
forall socket. Maybe (SocketOrSocketInfo socket SockAddr)
ipv6')

            (Maybe (SocketOrSocketInfo Socket SockAddr),
 Maybe (SocketOrSocketInfo Socket SockAddr))
_ -> (Maybe (SocketOrSocketInfo Socket SockAddr),
 Maybe (SocketOrSocketInfo Socket SockAddr))
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo Socket SockAddr),
      Maybe (SocketOrSocketInfo Socket SockAddr))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SocketOrSocketInfo Socket SockAddr)
ipv4, Maybe (SocketOrSocketInfo Socket SockAddr)
ipv6)


    -- Select the socket or path for local node-to-client comms
    --
    let firstUnixSocket :: Maybe LocalSocket
        firstUnixSocket :: Maybe LocalSocket
firstUnixSocket = Maybe (Maybe LocalSocket) -> Maybe LocalSocket
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe LocalSocket) -> Maybe LocalSocket)
-> Maybe (Maybe LocalSocket) -> Maybe LocalSocket
forall a b. (a -> b) -> a -> b
$ [LocalSocket] -> Maybe LocalSocket
forall a. [a] -> Maybe a
listToMaybe ([LocalSocket] -> Maybe LocalSocket)
-> (([Socket], [Socket], [LocalSocket]) -> [LocalSocket])
-> ([Socket], [Socket], [LocalSocket])
-> Maybe LocalSocket
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\([Socket]
_, [Socket]
_, [LocalSocket]
a) -> [LocalSocket]
a) (([Socket], [Socket], [LocalSocket]) -> Maybe LocalSocket)
-> Maybe ([Socket], [Socket], [LocalSocket])
-> Maybe (Maybe LocalSocket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ([Socket], [Socket], [LocalSocket])
systemDSockets

    -- only when 'ncSocketpath' is specified or a unix socket is passed through
    -- socket activation
    Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
local <- case (Last SocketPath -> Maybe SocketPath
forall a. Last a -> Maybe a
getLast Last SocketPath
ncSocketPath, Maybe LocalSocket
firstUnixSocket) of
      (Maybe SocketPath
Nothing, Maybe LocalSocket
Nothing)    -> Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
forall a. Maybe a
Nothing
      (Just SocketPath
_, Just LocalSocket
_)      -> SocketConfigError
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SocketConfigError
ClashingLocalSocketGiven
      (Maybe SocketPath
Nothing, Just LocalSocket
sock)  -> Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
 -> ExceptT
      SocketConfigError
      IO
      (Maybe (SocketOrSocketInfo LocalSocket LocalAddress)))
-> (SocketOrSocketInfo LocalSocket LocalAddress
    -> Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
-> SocketOrSocketInfo LocalSocket LocalAddress
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SocketOrSocketInfo LocalSocket LocalAddress
-> Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
forall a. a -> Maybe a
Just (SocketOrSocketInfo LocalSocket LocalAddress
 -> ExceptT
      SocketConfigError
      IO
      (Maybe (SocketOrSocketInfo LocalSocket LocalAddress)))
-> SocketOrSocketInfo LocalSocket LocalAddress
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
forall a b. (a -> b) -> a -> b
$ LocalSocket -> SocketOrSocketInfo LocalSocket LocalAddress
forall socket info. socket -> SocketOrSocketInfo socket info
ActualSocket LocalSocket
sock
      (Just (SocketPath String
path), Maybe LocalSocket
Nothing)
                            -> String -> ExceptT SocketConfigError IO ()
removeStaleLocalSocket String
path
                            ExceptT SocketConfigError IO ()
-> Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SocketOrSocketInfo LocalSocket LocalAddress
-> Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
forall a. a -> Maybe a
Just (LocalAddress -> SocketOrSocketInfo LocalSocket LocalAddress
forall socket info. info -> SocketOrSocketInfo socket info
SocketInfo (String -> LocalAddress
LocalAddress String
path))

    (Maybe (SocketOrSocketInfo Socket SockAddr),
 Maybe (SocketOrSocketInfo Socket SockAddr),
 Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
-> ExceptT
     SocketConfigError
     IO
     (Maybe (SocketOrSocketInfo Socket SockAddr),
      Maybe (SocketOrSocketInfo Socket SockAddr),
      Maybe (SocketOrSocketInfo LocalSocket LocalAddress))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SocketOrSocketInfo Socket SockAddr)
ipv4', Maybe (SocketOrSocketInfo Socket SockAddr)
ipv6', Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
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 :: FilePath -> ExceptT SocketConfigError IO ()
#if defined(mingw32_HOST_OS)
removeStaleLocalSocket _ =
    return ()
#else
removeStaleLocalSocket :: String -> ExceptT SocketConfigError IO ()
removeStaleLocalSocket 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], [LocalSocket]))
#ifdef SYSTEMD
getSystemdSockets :: IO (Maybe ([Socket], [Socket], [LocalSocket]))
getSystemdSockets = do
  Maybe [Socket]
sds_m <- IO (Maybe [Socket])
getActivatedSockets
  case Maybe [Socket]
sds_m of
       Maybe [Socket]
Nothing    -> Maybe ([Socket], [Socket], [LocalSocket])
-> IO (Maybe ([Socket], [Socket], [LocalSocket]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([Socket], [Socket], [LocalSocket])
forall a. Maybe a
Nothing
       Just [Socket]
socks ->
         ([Socket], [Socket], [LocalSocket])
-> Maybe ([Socket], [Socket], [LocalSocket])
forall a. a -> Maybe a
Just (([Socket], [Socket], [LocalSocket])
 -> Maybe ([Socket], [Socket], [LocalSocket]))
-> IO ([Socket], [Socket], [LocalSocket])
-> IO (Maybe ([Socket], [Socket], [LocalSocket]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          (([Socket], [Socket], [LocalSocket])
 -> Socket -> IO ([Socket], [Socket], [LocalSocket]))
-> ([Socket], [Socket], [LocalSocket])
-> [Socket]
-> IO ([Socket], [Socket], [LocalSocket])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\([Socket]
ipv4s, [Socket]
ipv6s, [LocalSocket]
unixs) Socket
sock -> do
                  SockAddr
addr <- Socket -> IO SockAddr
Socket.getSocketName Socket
sock
                  ([Socket], [Socket], [LocalSocket])
-> IO ([Socket], [Socket], [LocalSocket])
forall (m :: * -> *) a. Monad m => a -> m a
return (([Socket], [Socket], [LocalSocket])
 -> IO ([Socket], [Socket], [LocalSocket]))
-> ([Socket], [Socket], [LocalSocket])
-> IO ([Socket], [Socket], [LocalSocket])
forall a b. (a -> b) -> a -> b
$ case SockAddr
addr of
                    Socket.SockAddrInet {}  ->
                      (Socket
sock Socket -> [Socket] -> [Socket]
forall a. a -> [a] -> [a]
: [Socket]
ipv4s,        [Socket]
ipv6s,                    [LocalSocket]
unixs)
                    Socket.SockAddrInet6 {} ->
                      (       [Socket]
ipv4s, Socket
sock Socket -> [Socket] -> [Socket]
forall a. a -> [a] -> [a]
: [Socket]
ipv6s,                    [LocalSocket]
unixs)
                    Socket.SockAddrUnix {}  ->
                      (       [Socket]
ipv4s,        [Socket]
ipv6s, Socket -> LocalSocket
LocalSocket Socket
sock LocalSocket -> [LocalSocket] -> [LocalSocket]
forall a. a -> [a] -> [a]
: [LocalSocket]
unixs))
                ([], [], [])
                [Socket]
socks
#else
getSystemdSockets = return Nothing
#endif