{-# LANGUAGE ViewPatterns, ForeignFunctionInterface, CPP #-}
module Network.Hermes.Net(connectStream,streamServer,Address(..),resolve,reverseLookup) where

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Maybe

import System.IO
import Network.Socket

import Foreign
import Foreign.C

import Network.Hermes.Protocol
import Network.Hermes.Misc

connectStream :: Address -> IO Handle
connectStream address = do
  ip <- resolve address
  s <- case ip of
    SockAddrInet _ _ -> socket AF_INET Stream defaultProtocol
    SockAddrInet6 _ _ _ _ -> socket AF_INET6 Stream defaultProtocol
    SockAddrUnix _ -> socket AF_UNIX Stream defaultProtocol
  connect s ip
  socketToHandle s ReadWriteMode

-- | Returns the /best/ fit only, or a DNSFailure exception
resolve :: Address -> IO SockAddr
resolve (Unix path) = return $ SockAddrUnix path
resolve address = do
  fits <- getAddrInfo (Just defaultHints{addrFlags=[AI_ADDRCONFIG,AI_NUMERICSERV]})
          (Just $ ghead address)
          (Just $ show (ghead address :: Int))
  let fits' = flip filter (map addrAddress fits) $ \fit ->
        case (fit,address) of
          (_,IP _ _) -> True
          (SockAddrInet _ _, IPv4 _ _) -> True
          (SockAddrInet6 _ _ _ _, IPv6 _ _) -> True
          _ -> False
  when (null fits') $ throwIO $ DNSFailure address
  return $ head fits'

-- | Creates a TCP server that will hand off incoming connections to
-- new threads.
--
-- Killing the server does not kill these forked threads.
--
-- The handle passed to your action will be automatically closed when
-- that action returns.
streamServer :: Address -- ^ Address we should bind to. Use "" for hostname to use all interfaces.
               -> (Handle -> Address -> IO ()) -- ^ Function called to handle connections
               -> IO (IO ()) -- ^ Returns an action you may use to kill the server
streamServer address act = block $ do
  socks <- listenAt address
  threads <- forM socks $ \server -> forkIO $ flip finally (sClose server) $ unblock $ forever $ do
    (sock,sockAddr) <- accept server
    address <- reverseLookup sockAddr
    handle <- socketToHandle sock ReadWriteMode
    trapForkIO "hermes.net.streamServer" $ act handle address `finally` hClose handle
  return $ mapM_ killThread threads

reverseLookup :: SockAddr -> IO Address
reverseLookup (SockAddrUnix path) = return $ Unix path
reverseLookup sockAddr = do
  (Just host, Just (read -> port)) <- getNameInfo [NI_NUMERICSERV] True True sockAddr
  return $ case sockAddr of
    SockAddrInet _ _ -> IPv4 host port
    SockAddrInet6 _ _ _ _ -> IPv6 host port

-- On linux, binding an IPv6 port by default also binds the corresponding IPv4 port. Disable that.
#ifdef __linux
#include <sys/socket.h>
#include <netinet/in.h>

type SockLen = #type socklen_t
iPPROTO_IPV6 :: CInt
iPPROTO_IPV6 = #const IPPROTO_IPV6
iPV6_V6ONLY :: CInt
iPV6_V6ONLY  = #const IPV6_V6ONLY
foreign import ccall unsafe "setsockopt" _setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> SockLen -> IO ()

#endif

tryListenAt :: Family -> HostName -> Int -> IO (Maybe Socket)
tryListenAt family host port = do
  addr <- getAddrInfo (Just defaultHints{addrFamily=family,addrFlags=[AI_PASSIVE,AI_ADDRCONFIG]})
                     (if null host then Nothing else Just host)
                     (Just (show port))
  case addr of
    [] -> return Nothing
    ((addrAddress -> address):_) -> do
      s <- socket family Stream defaultProtocol
      setSocketOption s ReuseAddr 1
#ifdef __linux
      when (family == AF_INET6) $ do
        alloca $ \intptr -> do
          poke intptr 1
          _setsockopt (fdSocket s) iPPROTO_IPV6 iPV6_V6ONLY intptr (#size int)
#endif
      bindSocket s address
      listen s 3
      return $ Just s
  
listenAt :: Address -> IO [Socket]  
listenAt (IP host port) = do
  v4 <- tryListenAt AF_INET host port
  v6 <- tryListenAt AF_INET6 host port
  when (isNothing v4 && isNothing v6) (error "listenAt: No good exception, FIXME")
  return $ concat $ [maybeToList v4,maybeToList v6]
listenAt (IPv4 host port) = do
  Just s <- tryListenAt AF_INET host port -- FIXME
  return [s]
listenAt (IPv6 host port) = do
  Just s <- tryListenAt AF_INET6 host port -- FIXME
  return [s]