--------------------------------------------------------------------
-- |
-- Module      : Network.Connection
-- Description : Networking, at a higher-level.
-- Copyright   : (c) Sigbjorn Finne, 2009
-- License     : BSD3
--
-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>
-- Stability   : provisional
-- Portability : portable
--
-- Taking care of the details of creating & tearing down network connections,
-- both client and server connections.
--
--------------------------------------------------------------------
module Network.Connection
       ( ClientOptions(..)
       , clientOpts
       
       , Connection(..)
       , ConnectionOptions(..)
       , defaultConnectionOptions

       , clientConnection

       , Server
       , ServerOptions(..)
       , serverOpts

       , newServer

       , acceptConnection
       , closeConnection
       , closeSession
       
       ) where

import Network.Socket as S hiding ( connect )
import qualified Network.Socket as S ( connect )
import Network.BSD as BSD ( HostEntry, getHostByName, hostAddresses )
import Control.Concurrent
import System.IO

import Data.Maybe

data Connection
 = Connection
     { coHandle  :: Handle
     , coSocket  :: Socket
     , coServer  :: Maybe Server
     }
     
data ConnectionOptions
 = ConnectionOptions
     { connMode :: Bool -- False => connectionless.
     , ioMode   :: IOMode
     , bufMode  :: BufferMode
     }

defaultConnectionOptions :: ConnectionOptions
defaultConnectionOptions = ConnectionOptions
     { connMode = True
     , ioMode   = ReadWriteMode
     , bufMode  = LineBuffering
     }

data ClientOptions
 = ClientOptions
     { host     :: String
     , port     :: Maybe PortNumber
     , cliProto :: Maybe ProtocolNumber
     , localEnd :: Maybe PortNumber
     , cliOpts  :: ConnectionOptions
     }

clientOpts :: ClientOptions
clientOpts = ClientOptions
     { host     = ""
     , port     = Nothing
     , cliProto = Nothing
     , localEnd = Nothing
     , cliOpts  = defaultConnectionOptions
     }

-- | @clientConnection opts@ tries to open up a connection
-- as requested by the 'ClientOptions' @opts@. If successful, returns
-- a @Handle@ and its underlying @Socket@. The latter is only meant
-- to be used when doing orderly & draining shutdowns. All I/O is
-- expected to happen over the @Handle@.
clientConnection :: ClientOptions -> IO Connection
clientConnection opts = catch (do
  s <- socket AF_INET (if connMode $ cliOpts opts then Stream else Datagram) 
                      (fromMaybe S.defaultProtocol (cliProto opts))
  setSocketOption s KeepAlive 1{-on..-}
  hst <- getHostAddr (host opts)
  let srcAddr = SockAddrInet (fromMaybe S.aNY_PORT (localEnd opts))
                             S.iNADDR_ANY
  catch (S.bindSocket s srcAddr) (\ e -> sClose s >> ioError e)
  resetSocketStatus s
  let tgtAddr = SockAddrInet (fromMaybe S.aNY_PORT (port opts)) hst
  catch (S.connect s tgtAddr) (\ e -> sClose s >> ioError e)
  h <- socketToHandle s (ioMode $ cliOpts opts)
  hSetBuffering h (bufMode $ cliOpts opts)
  return (Connection{coHandle=h,coSocket=s,coServer=Nothing})) (errHandler opts)
 where
  errHandler o e = do
     mapM_ (hPutStrLn stderr)
           [ "clientConnection failed for: "
	   , show o
	   , "Details: "
	   , show e
	   ]
     ioError e

-- what a hack!
resetSocketStatus :: Socket -> IO ()
resetSocketStatus (MkSocket _ _ _ _ s) = do
  modifyMVar_ s $ \ status -> do
    case status of
      Bound -> return NotConnected
      _ -> return status


data ServerOptions
 = ServerOptions
     { servInterface :: Maybe String
     , servPort      :: Maybe PortNumber
     , servProto     :: Maybe ProtocolNumber
     , servOpts      :: ConnectionOptions
     }

serverOpts :: ServerOptions
serverOpts = ServerOptions
     { servInterface = Nothing
     , servPort      = Nothing
     , servProto     = Nothing
     , servOpts      = defaultConnectionOptions
     }

data Server
 = Server 
     { servSocket   :: Socket
     , servOptions  :: ConnectionOptions
     , servSessions :: MVar [Connection]
--     , serv
     }

newServer :: ServerOptions -> IO Server
newServer opts = do
  s <- socket AF_INET (if connMode $ servOpts opts then Stream else Datagram) 
                      (fromMaybe S.defaultProtocol (servProto opts))
  setSocketOption s KeepAlive 1{-on..-}
  setSocketOption s ReuseAddr 1{-on..-}
  hst <- maybe (return iNADDR_ANY) getHostAddr (servInterface opts)
  let srcAddr = SockAddrInet (fromMaybe S.aNY_PORT (servPort opts)) hst
  catch (S.bindSocket s srcAddr) (\ e -> sClose s >> ioError e)
  S.listen s 1024{-backlog-}
  sessVar <- newMVar []
  return Server{ servSocket   = s
               , servOptions  = servOpts opts
	       , servSessions = sessVar
	       }

acceptConnection :: Server -> IO (Connection, SockAddr)
acceptConnection s = catch (do
   (sc,sa) <- S.accept (servSocket s)
   let opts = servOptions s
   h <- socketToHandle sc (ioMode opts)
   hSetBuffering h (bufMode opts)
   let conn = 
        Connection{ coHandle=h
                  , coSocket=sc
		  , coServer=Just s
		  }
   modifyMVar_ (servSessions s) (\ ls -> return (conn:ls))
   return (conn, sa))
     (errHandler (servOptions s))
 where
  errHandler o e = do
     mapM_ (hPutStrLn stderr)
           [ "acceptConnection failed for: "
	   , show o
	   , "Details: "
	   , show e
	   ]
     ioError e

closeSession :: Connection -> Server -> IO ()
closeSession co s = modifyMVar_ (servSessions s) $ \ ls ->
  case break (\ c -> coSocket c == coSocket co) ls of
    (_,[]) -> return ls
    (as,_:bs) -> return (as++bs)

closeServer :: Server -> IO ()
closeServer s = do
   ls <- readMVar (servSessions s)
   mapM_ closeConnection ls
     -- by this point the connections will have removed themselves...but just in case, stub out connections list.
   _ls <- modifyMVar (servSessions s) (\ s -> return ([],s))
   let sock = servSocket s
   shutdown sock ShutdownSend
   shutdown sock ShutdownReceive
   sClose sock
   return ()

closeConnection :: Connection -> IO ()
closeConnection co = do
    let h = coHandle co
    let s = coSocket co
    hFlush h
    shutdown s ShutdownSend
    catch (hClose h) (\ _ -> return ())
    shutdown s ShutdownReceive
    sClose s
    maybe (return ()) (closeSession co) (coServer co)
    return ()

getHostAddr :: String -> IO HostAddress
getHostAddr h = do
    catch (inet_addr h)    -- handles ascii IP numbers
          (\ _ -> do
	        hst <- getHostByName_safe h
                case hostAddresses hst of
                  []     -> fail ("getHostAddr: no addresses in host entry for " ++ show h)
                  (ha:_) -> return ha)

getHostByName_safe :: HostName -> IO BSD.HostEntry
getHostByName_safe h = 
    catch (getHostByName h)
          (\ _ -> fail ("Redis.connect: host lookup failure for " ++ show h))



-- Instances:

instance Show ClientOptions where
  show x = 
    unlines [ "ClientOptions: "
            , " hostName   = " ++ host x
	    , " portNumber = " ++ show (port x)
	    , " connection-oriented = " ++ show (connMode $ cliOpts x)
	    , " direction  = " ++ show (ioMode $ cliOpts x)
	    , " buffering  = " ++ show (bufMode $ cliOpts x)
	    ]

instance Show ConnectionOptions where
  show x = 
    unlines [ "ConnectionOptions: "
            , " connection-oriented = " ++ show (connMode x)
	    , " direction  = " ++ show (ioMode x)
	    , " buffering  = " ++ show (bufMode x)
	    ]