-- Copyright 2018 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | A higher level wrapper around "Network.Socket", since "Network" is
-- deprecated.
module Util.Network (
    Addr(..)
    , listenUnix
    , withHandle, withHandle_, withConnection
    , getHostName
) where
import qualified Control.Exception as Exception
import qualified Foreign
import qualified Foreign.C as C
import qualified Network.Socket as Socket
import qualified Network.Socket.Internal as Socket.Internal
import qualified System.IO as IO
import qualified System.IO.Error as IO.Error


data Addr = Unix FilePath | TCP Socket.PortNumber | UDP Socket.PortNumber
    deriving (Addr -> Addr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Addr -> Addr -> Bool
$c/= :: Addr -> Addr -> Bool
== :: Addr -> Addr -> Bool
$c== :: Addr -> Addr -> Bool
Eq, Int -> Addr -> ShowS
[Addr] -> ShowS
Addr -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Addr] -> ShowS
$cshowList :: [Addr] -> ShowS
show :: Addr -> FilePath
$cshow :: Addr -> FilePath
showsPrec :: Int -> Addr -> ShowS
$cshowsPrec :: Int -> Addr -> ShowS
Show)

listenUnix :: FilePath -> IO Socket.Socket
listenUnix :: FilePath -> IO Socket
listenUnix FilePath
fname = do
    Socket
socket <- IO Socket
unixSocket
    -- Make sure subprocesses don't inherit this.  Otherwise a subprocess such
    -- as lilypond causes the REPL command to block until the subprocess
    -- completes.
    forall r. Socket -> (CInt -> IO r) -> IO r
Socket.withFdSocket Socket
socket CInt -> IO ()
Socket.setCloseOnExecIfNeeded
    Socket -> SockAddr -> IO ()
Socket.bind Socket
socket (FilePath -> SockAddr
Socket.SockAddrUnix FilePath
fname)
    Socket -> Int -> IO ()
Socket.listen Socket
socket Int
1
    forall (m :: * -> *) a. Monad m => a -> m a
return Socket
socket

-- | Like 'withConnection', but use a high level IO.Handle.
withHandle :: Addr -> (IO.Handle -> IO a) -> IO a
withHandle :: forall a. Addr -> (Handle -> IO a) -> IO a
withHandle Addr
addr Handle -> IO a
action = forall a. Addr -> (Socket -> IO a) -> IO a
withConnection Addr
addr forall a b. (a -> b) -> a -> b
$ \Socket
socket ->
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket (Socket -> IOMode -> IO Handle
Socket.socketToHandle Socket
socket IOMode
IO.ReadWriteMode) Handle -> IO ()
IO.hClose
        Handle -> IO a
action

-- | Like 'withHandle' except ignore a connection failure.  Other
-- exceptions pass through.
withHandle_ :: Addr -> (IO.Handle -> IO ()) -> IO ()
withHandle_ :: Addr -> (Handle -> IO ()) -> IO ()
withHandle_ Addr
addr Handle -> IO ()
action =
    forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
Exception.handleJust IOError -> Maybe ()
isConnectError (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall a b. (a -> b) -> a -> b
$
        forall a. Addr -> (Handle -> IO a) -> IO a
withHandle Addr
addr Handle -> IO ()
action

-- | Connect to the Addr and run the action with the socket.
withConnection :: Addr -> (Socket.Socket -> IO a) -> IO a
withConnection :: forall a. Addr -> (Socket -> IO a) -> IO a
withConnection Addr
addr Socket -> IO a
action = do
    Socket
socket <- case Addr
addr of
        Unix {} -> IO Socket
unixSocket
        TCP {} -> IO Socket
tcpSocket
        UDP {} -> IO Socket
udpSocket
    -- Make sure to close the socket even if Socket.connect fails.  It will
    -- get closed twice if it doesn't, but Socket.close says it ignores errors.
    forall a b c. IO a -> IO b -> IO c -> IO c
Exception.bracket_ (Socket -> SockAddr -> IO ()
Socket.connect Socket
socket SockAddr
saddr) (Socket -> IO ()
Socket.close Socket
socket) forall a b. (a -> b) -> a -> b
$
        Socket -> IO a
action Socket
socket
    where
    saddr :: SockAddr
saddr = case Addr
addr of
        TCP PortNumber
port -> PortNumber -> HostAddress -> SockAddr
Socket.SockAddrInet PortNumber
port
            ((Word8, Word8, Word8, Word8) -> HostAddress
Socket.tupleToHostAddress (Word8
127, Word8
0, Word8
0, Word8
1))
        UDP PortNumber
port -> PortNumber -> HostAddress -> SockAddr
Socket.SockAddrInet PortNumber
port
            ((Word8, Word8, Word8, Word8) -> HostAddress
Socket.tupleToHostAddress (Word8
127, Word8
0, Word8
0, Word8
1))
        Unix FilePath
fname -> FilePath -> SockAddr
Socket.SockAddrUnix FilePath
fname

-- | The network lib turns ECONNREFUSED and ENOENT into isDoesNotExistError.
-- That's ok, because 'TCP' gives ECONNREFUSED while 'Unix' gives ENOENT:
--
-- > connect: <socket: 28>: does not exist (Connection refused)
-- > connect: <socket: 28>: does not exist (No such file or directory)
isConnectError :: IO.Error.IOError -> Maybe ()
isConnectError :: IOError -> Maybe ()
isConnectError IOError
exc
    | IOError -> Bool
IO.Error.isDoesNotExistError IOError
exc = forall a. a -> Maybe a
Just ()
    | Bool
otherwise = forall a. Maybe a
Nothing

unixSocket :: IO Socket.Socket
unixSocket :: IO Socket
unixSocket = Family -> SocketType -> CInt -> IO Socket
Socket.socket Family
Socket.AF_UNIX SocketType
Socket.Stream CInt
Socket.defaultProtocol

tcpSocket :: IO Socket.Socket
tcpSocket :: IO Socket
tcpSocket = Family -> SocketType -> CInt -> IO Socket
Socket.socket Family
Socket.AF_INET SocketType
Socket.Stream CInt
Socket.defaultProtocol

udpSocket :: IO Socket.Socket
udpSocket :: IO Socket
udpSocket = Family -> SocketType -> CInt -> IO Socket
Socket.socket Family
Socket.AF_INET SocketType
Socket.Datagram CInt
Socket.defaultProtocol

-- | getHostName from Network.BSD, which is deprecated.
getHostName :: IO String
getHostName :: IO FilePath
getHostName = do
    let size :: Int
size = Int
256
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
Foreign.allocaArray0 Int
size forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cstr -> do
        forall a. (Eq a, Num a) => FilePath -> IO a -> IO ()
Socket.Internal.throwSocketErrorIfMinus1_ FilePath
"Network.getHostName" forall a b. (a -> b) -> a -> b
$
            Ptr CChar -> CSize -> IO CInt
c_gethostname Ptr CChar
cstr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
        Ptr CChar -> IO FilePath
C.peekCString Ptr CChar
cstr

foreign import ccall unsafe "gethostname"
   c_gethostname :: C.CString -> C.CSize -> IO C.CInt