    {-# LANGUAGE Trustworthy #-}

    {- arch-tag: Generic Server Support
    Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

    All rights reserved.

    For license and copyright information, see the file LICENSE
    -}

    {- |
       Module     : Network.SocketServer
       Copyright  : Copyright (C) 2004-2011 John Goerzen
       SPDX-License-Identifier: BSD-3-Clause

       Stability  : experimental
       Portability: systems with networking

    This module provides an infrastructure to simplify server design.

    Written by John Goerzen, jgoerzen\@complete.org

    Please note: this module is designed to work with TCP, UDP, and Unix domain
    sockets, but only TCP sockets have been tested to date.

    This module is presently under-documented.  For an example of usage, please
    see the description of "Network.FTP.Server".
    -}

    module Network.SocketServer(-- * Generic Options and Types
                                         InetServerOptions(..),
                                         simpleTCPOptions,
                                         SocketServer(..),
                                         HandlerT,
                                         -- * TCP server convenient setup
                                         serveTCPforever,
                                         -- * Lower-Level Processing
                                         setupSocketServer,
                                         handleOne,
                                         serveForever,
                                         closeSocketServer,
                                         -- * Combinators
                                         loggingHandler,
                                         threadedHandler,
                                         handleHandler
                                        )
    where
    import           Control.Concurrent
    import           Network.BSD
    import           Network.Socket
    import           Network.Utils
    import           System.IO
    import qualified System.Log.Logger

    {- | Options for your server. -}
    data InetServerOptions  = InetServerOptions {InetServerOptions -> Int
    listenQueueSize :: Int,
                                                 InetServerOptions -> PortNumber
    portNumber      :: PortNumber,
                                                 InetServerOptions -> HostAddress
    interface       :: HostAddress,
                                                 InetServerOptions -> Bool
    reuse           :: Bool,
                                                 InetServerOptions -> Family
    family          :: Family,
                                                 InetServerOptions -> SocketType
    sockType        :: SocketType,
                                                 InetServerOptions -> String
    protoStr        :: String
                                                }
        deriving (InetServerOptions -> InetServerOptions -> Bool
    (InetServerOptions -> InetServerOptions -> Bool)
    -> (InetServerOptions -> InetServerOptions -> Bool)
    -> Eq InetServerOptions
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: InetServerOptions -> InetServerOptions -> Bool
    $c/= :: InetServerOptions -> InetServerOptions -> Bool
    == :: InetServerOptions -> InetServerOptions -> Bool
    $c== :: InetServerOptions -> InetServerOptions -> Bool
    Eq, Int -> InetServerOptions -> ShowS
    [InetServerOptions] -> ShowS
    InetServerOptions -> String
    (Int -> InetServerOptions -> ShowS)
    -> (InetServerOptions -> String)
    -> ([InetServerOptions] -> ShowS)
    -> Show InetServerOptions
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [InetServerOptions] -> ShowS
    $cshowList :: [InetServerOptions] -> ShowS
    show :: InetServerOptions -> String
    $cshow :: InetServerOptions -> String
    showsPrec :: Int -> InetServerOptions -> ShowS
    $cshowsPrec :: Int -> InetServerOptions -> ShowS
    Show)

    {- | The main handler type.

    The first parameter is the socket itself.

    The second is the address of the remote endpoint.

    The third is the address of the local endpoint.
    -}
    type HandlerT = Socket -> SockAddr -> SockAddr -> IO ()

    {- | Get Default options.  You can always modify it later. -}
    simpleTCPOptions :: Int                -- ^ Port Number
                     -> InetServerOptions
    simpleTCPOptions :: Int -> InetServerOptions
    simpleTCPOptions p :: Int
    p = InetServerOptions :: Int
    -> PortNumber
    -> HostAddress
    -> Bool
    -> Family
    -> SocketType
    -> String
    -> InetServerOptions
    InetServerOptions {listenQueueSize :: Int
    listenQueueSize = 5,
                                            portNumber :: PortNumber
    portNumber = (Int -> PortNumber
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    p),
                                            interface :: HostAddress
    interface = 0,
                                            reuse :: Bool
    reuse = Bool
    False,
                                            family :: Family
    family = Family
    AF_INET,
                                            sockType :: SocketType
    sockType = SocketType
    Stream,
                                            protoStr :: String
    protoStr = "tcp"
                                           }

    data SocketServer = SocketServer {SocketServer -> InetServerOptions
    optionsSS :: InetServerOptions,
                                      SocketServer -> Socket
    sockSS    :: Socket}
                      deriving (SocketServer -> SocketServer -> Bool
    (SocketServer -> SocketServer -> Bool)
    -> (SocketServer -> SocketServer -> Bool) -> Eq SocketServer
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: SocketServer -> SocketServer -> Bool
    $c/= :: SocketServer -> SocketServer -> Bool
    == :: SocketServer -> SocketServer -> Bool
    $c== :: SocketServer -> SocketServer -> Bool
    Eq, Int -> SocketServer -> ShowS
    [SocketServer] -> ShowS
    SocketServer -> String
    (Int -> SocketServer -> ShowS)
    -> (SocketServer -> String)
    -> ([SocketServer] -> ShowS)
    -> Show SocketServer
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [SocketServer] -> ShowS
    $cshowList :: [SocketServer] -> ShowS
    show :: SocketServer -> String
    $cshow :: SocketServer -> String
    showsPrec :: Int -> SocketServer -> ShowS
    $cshowsPrec :: Int -> SocketServer -> ShowS
    Show)

    {- | Takes some options and sets up the 'SocketServer'.  I will bind
    and begin listening, but will not accept any connections itself. -}
    setupSocketServer :: InetServerOptions -> IO SocketServer
    setupSocketServer :: InetServerOptions -> IO SocketServer
    setupSocketServer opts :: InetServerOptions
    opts =
        do ProtocolNumber
    proto <- String -> IO ProtocolNumber
    getProtocolNumber (InetServerOptions -> String
    protoStr InetServerOptions
    opts)
           Socket
    s <- Family -> SocketType -> ProtocolNumber -> IO Socket
    socket (InetServerOptions -> Family
    family InetServerOptions
    opts) (InetServerOptions -> SocketType
    sockType InetServerOptions
    opts) ProtocolNumber
    proto
           Socket -> SocketOption -> Int -> IO ()
    setSocketOption Socket
    s SocketOption
    ReuseAddr (case (InetServerOptions -> Bool
    reuse InetServerOptions
    opts) of
                                        True  -> 1
                                        False -> 0)
           Socket -> SockAddr -> IO ()
    bind Socket
    s (PortNumber -> HostAddress -> SockAddr
    SockAddrInet (InetServerOptions -> PortNumber
    portNumber InetServerOptions
    opts)
                         (InetServerOptions -> HostAddress
    interface InetServerOptions
    opts))
           Socket -> Int -> IO ()
    listen Socket
    s (InetServerOptions -> Int
    listenQueueSize InetServerOptions
    opts)
           SocketServer -> IO SocketServer
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SocketServer -> IO SocketServer)
    -> SocketServer -> IO SocketServer
    forall a b. (a -> b) -> a -> b
    $ SocketServer :: InetServerOptions -> Socket -> SocketServer
    SocketServer {optionsSS :: InetServerOptions
    optionsSS = InetServerOptions
    opts, sockSS :: Socket
    sockSS = Socket
    s}

    {- | Close the socket server.  Does not terminate active
    handlers, if any. -}
    closeSocketServer :: SocketServer -> IO ()
    closeSocketServer :: SocketServer -> IO ()
    closeSocketServer ss :: SocketServer
    ss =
        Socket -> IO ()
    close (SocketServer -> Socket
    sockSS SocketServer
    ss)

    {- | Handle one incoming request from the given 'SocketServer'. -}
    handleOne :: SocketServer -> HandlerT -> IO ()
    handleOne :: SocketServer -> HandlerT -> IO ()
    handleOne ss :: SocketServer
    ss func :: HandlerT
    func =
        let opts :: InetServerOptions
    opts = (SocketServer -> InetServerOptions
    optionsSS SocketServer
    ss)
            in    do (Socket, SockAddr)
    a <- Socket -> IO (Socket, SockAddr)
    accept (SocketServer -> Socket
    sockSS SocketServer
    ss)
                     SockAddr
    localaddr <- Socket -> IO SockAddr
    getSocketName ((Socket, SockAddr) -> Socket
    forall a b. (a, b) -> a
    fst (Socket, SockAddr)
    a)
                     HandlerT
    func ((Socket, SockAddr) -> Socket
    forall a b. (a, b) -> a
    fst (Socket, SockAddr)
    a) ((Socket, SockAddr) -> SockAddr
    forall a b. (a, b) -> b
    snd (Socket, SockAddr)
    a) SockAddr
    localaddr

    {- | Handle all incoming requests from the given 'SocketServer'. -}
    serveForever :: SocketServer -> HandlerT -> IO ()
    serveForever :: SocketServer -> HandlerT -> IO ()
    serveForever ss :: SocketServer
    ss func :: HandlerT
    func =
        [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ (IO () -> [IO ()]
    forall a. a -> [a]
    repeat (SocketServer -> HandlerT -> IO ()
    handleOne SocketServer
    ss HandlerT
    func))

    {- | Convenience function to completely set up a TCP
    'SocketServer' and handle all incoming requests.

    This function is literally this:

    >serveTCPforever options func =
    >    do sockserv <- setupSocketServer options
    >       serveForever sockserv func
     -}
    serveTCPforever :: InetServerOptions     -- ^ Server options
                    -> HandlerT              -- ^ Handler function
                    -> IO ()
    serveTCPforever :: InetServerOptions -> HandlerT -> IO ()
    serveTCPforever options :: InetServerOptions
    options func :: HandlerT
    func =
        do SocketServer
    sockserv <- InetServerOptions -> IO SocketServer
    setupSocketServer InetServerOptions
    options
           SocketServer -> HandlerT -> IO ()
    serveForever SocketServer
    sockserv HandlerT
    func

    ----------------------------------------------------------------------
    -- Combinators
    ----------------------------------------------------------------------

    {- | Log each incoming connection using the interface in
    "System.Log.Logger".

    Log when the incoming connection disconnects.

    Also, log any failures that may occur in the child handler. -}

    loggingHandler :: String                -- ^ Name of logger to use
                   -> System.Log.Logger.Priority -- ^ Priority of logged messages
                   -> HandlerT              -- ^ Handler to call after logging
                   -> HandlerT              -- ^ Resulting handler
    loggingHandler :: String -> Priority -> HandlerT -> HandlerT
    loggingHandler hname :: String
    hname prio :: Priority
    prio nexth :: HandlerT
    nexth socket :: Socket
    socket r_sockaddr :: SockAddr
    r_sockaddr l_sockaddr :: SockAddr
    l_sockaddr =
        do String
    sockStr <- SockAddr -> IO String
    showSockAddr SockAddr
    r_sockaddr
           String -> Priority -> String -> IO ()
    System.Log.Logger.logM String
    hname Priority
    prio
                       ("Received connection from " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    sockStr)
           String -> Priority -> String -> IO () -> IO ()
    forall a. String -> Priority -> String -> IO a -> IO a
    System.Log.Logger.traplogging String
    hname
                   Priority
    System.Log.Logger.WARNING "" (HandlerT
    nexth Socket
    socket SockAddr
    r_sockaddr
                                                       SockAddr
    l_sockaddr)
           String -> Priority -> String -> IO ()
    System.Log.Logger.logM String
    hname Priority
    prio
                       ("Connection " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    sockStr String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " disconnected")

    -- | Handle each incoming connection in its own thread to
    -- make the server multi-tasking.
    threadedHandler :: HandlerT             -- ^ Handler to call in the new thread
                    -> HandlerT             -- ^ Resulting handler
    threadedHandler :: HandlerT -> HandlerT
    threadedHandler nexth :: HandlerT
    nexth socket :: Socket
    socket r_sockaddr :: SockAddr
    r_sockaddr l_sockaddr :: SockAddr
    l_sockaddr=
        do IO () -> IO ThreadId
    forkIO (HandlerT
    nexth Socket
    socket SockAddr
    r_sockaddr SockAddr
    l_sockaddr)
           () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    {- | Give your handler function a Handle instead of a Socket.

    The Handle will be opened with ReadWriteMode (you use one handle for both
    directions of the Socket).  Also, it will be initialized with LineBuffering.

    Unlike other handlers, the handle will be closed when the function returns.
    Therefore, if you are doing threading, you should to it before you call this
    handler.
    -}
    handleHandler :: (Handle -> SockAddr -> SockAddr -> IO ())      -- ^ Handler to call
                  -> HandlerT
    handleHandler :: (Handle -> SockAddr -> SockAddr -> IO ()) -> HandlerT
    handleHandler func :: Handle -> SockAddr -> SockAddr -> IO ()
    func socket :: Socket
    socket r_sockaddr :: SockAddr
    r_sockaddr l_sockaddr :: SockAddr
    l_sockaddr =
        do Handle
    h <- Socket -> IOMode -> IO Handle
    socketToHandle Socket
    socket IOMode
    ReadWriteMode
           Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    h BufferMode
    LineBuffering
           Handle -> SockAddr -> SockAddr -> IO ()
    func Handle
    h SockAddr
    r_sockaddr SockAddr
    l_sockaddr
           Handle -> IO ()
    hClose Handle
    h