{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}

{- arch-tag: Network utilities main file
Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}
{- |
   Module     : Network.Utils
   Copyright  : Copyright (C) 2004-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: systems with networking

This module provides various helpful utilities for dealing with networking

Written by John Goerzen, jgoerzen\@complete.org

-}

module Network.Utils (niceSocketsDo, connectTCP, connectTCPAddr,
                        listenTCPAddr, showSockAddr)
    where

import Network.BSD
    ( getHostByName,
      getProtocolNumber,
      hostAddress,
      HostName,
      Family(AF_INET),
      PortNumber )
import Network.Socket
    ( getNameInfo,
      withSocketsDo,
      bind,
      connect,
      listen,
      socket,
      close,
      NameInfoFlag(NI_NUMERICHOST),
      SockAddr(..),
      Socket,
      SocketType(Stream) )
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
import qualified System.Posix.Signals
#endif
import           Control.Exception (bracketOnError)

{- | Sets up the system for networking.  Similar to the built-in
withSocketsDo (and actually, calls it), but also sets the SIGPIPE
handler so that signal is ignored.

Example:

> main = niceSocketsDo $ do { ... }
-}

-- FIXME integrate with WebCont.Util.UDP

niceSocketsDo :: IO a -> IO a
niceSocketsDo :: forall a. IO a -> IO a
niceSocketsDo IO a
func = do
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
                -- No signals on Windows anyway
                Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
System.Posix.Signals.installHandler
                      Signal
System.Posix.Signals.sigPIPE
                      Handler
System.Posix.Signals.Ignore
                      Maybe SignalSet
forall a. Maybe a
Nothing
#endif
                IO a -> IO a
forall a. IO a -> IO a
withSocketsDo IO a
func

connectTCP :: HostName -> PortNumber -> IO Socket
connectTCP :: HostName -> PortNumber -> IO Socket
connectTCP HostName
host PortNumber
port = do
                       HostEntry
he <- HostName -> IO HostEntry
getHostByName HostName
host
                       SockAddr -> IO Socket
connectTCPAddr (PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
port (HostEntry -> HostAddress
hostAddress HostEntry
he))

connectTCPAddr :: SockAddr -> IO Socket
connectTCPAddr :: SockAddr -> IO Socket
connectTCPAddr SockAddr
addr = do
                      Signal
proto <- HostName -> IO Signal
getProtocolNumber HostName
"tcp"
                      IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (Family -> SocketType -> Signal -> IO Socket
socket Family
AF_INET SocketType
Stream Signal
proto) Socket -> IO ()
close
                        (\Socket
s -> Socket -> SockAddr -> IO ()
connect Socket
s SockAddr
addr IO () -> IO Socket -> IO Socket
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
s)

listenTCPAddr :: SockAddr -> Int -> IO Socket
listenTCPAddr :: SockAddr -> Int -> IO Socket
listenTCPAddr SockAddr
addr Int
queuelen = do
                     Signal
proto <- HostName -> IO Signal
getProtocolNumber HostName
"tcp"
                     Socket
s <- Family -> SocketType -> Signal -> IO Socket
socket Family
AF_INET SocketType
Stream Signal
proto
                     Socket -> SockAddr -> IO ()
bind Socket
s SockAddr
addr
                     Socket -> Int -> IO ()
listen Socket
s Int
queuelen
                     Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
s

showSockAddr :: SockAddr -> IO String
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
showSockAddr :: SockAddr -> IO HostName
showSockAddr (SockAddrUnix HostName
x) = HostName -> IO HostName
forall (m :: * -> *) a. Monad m => a -> m a
return (HostName -> IO HostName) -> HostName -> IO HostName
forall a b. (a -> b) -> a -> b
$ HostName
"UNIX socket at " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
x
#endif
showSockAddr sa :: SockAddr
sa@(SockAddrInet PortNumber
port HostAddress
_host) =
    do (Just HostName
h,Maybe HostName
_) <- [NameInfoFlag]
-> Bool -> Bool -> SockAddr -> IO (Maybe HostName, Maybe HostName)
getNameInfo [NameInfoFlag
NI_NUMERICHOST] Bool
True Bool
False SockAddr
sa
       HostName -> IO HostName
forall (m :: * -> *) a. Monad m => a -> m a
return (HostName -> IO HostName) -> HostName -> IO HostName
forall a b. (a -> b) -> a -> b
$ HostName
"IPv4 host " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
h HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
", port " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ (PortNumber -> HostName
forall a. Show a => a -> HostName
show PortNumber
port)