    --------------------------------------------------------------------------------
    -- | This provides a simple stand-alone server for 'WebSockets' applications.
    -- Note that in production you want to use a real webserver such as snap or
    -- warp.
    {-# LANGUAGE OverloadedStrings #-}
    module Network.WebSockets.Server
        ( ServerApp
        , runServer
        , ServerOptions (..)
        , defaultServerOptions
        , runServerWithOptions
        , runServerWith
        , makeListenSocket
        , makePendingConnection
        , makePendingConnectionFromStream

        , PongTimeout
        ) where

    --------------------------------------------------------------------------------
    import qualified Control.Concurrent.Async      as Async
    import           Control.Exception             (bracket,
                                                    bracketOnError, finally, mask_,
                                                    throwIO)
    import           Network.Socket                (Socket)
    import qualified Network.Socket                as S

    --------------------------------------------------------------------------------
    import           Network.WebSockets.Connection
    import           Network.WebSockets.Connection.PingPong (PongTimeout(..))
    import           Network.WebSockets.Http
    import qualified Network.WebSockets.Stream     as Stream
    import           Network.WebSockets.Types

    --------------------------------------------------------------------------------
    -- | WebSockets application that can be ran by a server. Once this 'IO' action
    -- finishes, the underlying socket is closed automatically.
    type ServerApp = PendingConnection -> IO ()

    --------------------------------------------------------------------------------
    -- | Provides a simple server. This function blocks forever.  Note that this
    -- is merely provided for quick-and-dirty or internal applications, but for real
    -- applications, you should use a real server.
    --
    -- For example:
    --
    -- * Performance is reasonable under load, but:
    -- * No protection against DoS attacks is provided.
    -- * No logging is performed.
    -- * ...
    --
    -- Glue for using this package with real servers is provided by:
    --
    -- * <https://hackage.haskell.org/package/wai-websockets>
    --
    -- * <https://hackage.haskell.org/package/websockets-snap>
    runServer :: String     -- ^ Address to bind
              -> Int        -- ^ Port to listen on
              -> ServerApp  -- ^ Application
              -> IO ()      -- ^ Never returns
    runServer :: String -> Int -> ServerApp -> IO ()
    runServer String
    host Int
    port ServerApp
    app = String -> Int -> ConnectionOptions -> ServerApp -> IO ()
    runServerWith String
    host Int
    port ConnectionOptions
    defaultConnectionOptions ServerApp
    app

    --------------------------------------------------------------------------------
    -- | A version of 'runServer' which allows you to customize some options.
    runServerWith :: String -> Int -> ConnectionOptions -> ServerApp -> IO ()
    runServerWith :: String -> Int -> ConnectionOptions -> ServerApp -> IO ()
    runServerWith String
    host Int
    port ConnectionOptions
    opts = ServerOptions -> ServerApp -> IO ()
    forall a. ServerOptions -> ServerApp -> IO a
    runServerWithOptions ServerOptions
    defaultServerOptions
        { serverHost              = host
        , serverPort              = port
        , serverConnectionOptions = opts
        }
    {-# DEPRECATED runServerWith "Use 'runServerWithOptions' instead" #-}

    --------------------------------------------------------------------------------
    data ServerOptions = ServerOptions
        { ServerOptions -> String
    serverHost              :: String
        , ServerOptions -> Int
    serverPort              :: Int
        , ServerOptions -> ConnectionOptions
    serverConnectionOptions :: ConnectionOptions
        }

    --------------------------------------------------------------------------------
    defaultServerOptions :: ServerOptions
    defaultServerOptions :: ServerOptions
    defaultServerOptions = ServerOptions
        { serverHost :: String
    serverHost              = String
    "127.0.0.1"
        , serverPort :: Int
    serverPort              = Int
    8080
        , serverConnectionOptions :: ConnectionOptions
    serverConnectionOptions = ConnectionOptions
    defaultConnectionOptions
        }

    --------------------------------------------------------------------------------
    -- | Customizable version of 'runServer'.  Never returns until killed.
    --
    -- Please use the 'defaultServerOptions' combined with record updates to set the
    -- fields you want.  This way your code is unlikely to break on future changes.
    runServerWithOptions :: ServerOptions -> ServerApp -> IO a
    runServerWithOptions :: forall a. ServerOptions -> ServerApp -> IO a
    runServerWithOptions ServerOptions
    opts ServerApp
    app = IO a -> IO a
    forall a. IO a -> IO a
    S.withSocketsDo (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $
        IO Socket -> (Socket -> IO ()) -> (Socket -> IO a) -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
        (String -> Int -> IO Socket
    makeListenSocket (ServerOptions -> String
    serverHost ServerOptions
    opts) (ServerOptions -> Int
    serverPort ServerOptions
    opts))
        Socket -> IO ()
    S.close
        (\Socket
    sock ->
            let
                mainThread :: IO b
    mainThread = do
                    (conn, _) <- Socket -> IO (Socket, SockAddr)
    S.accept Socket
    sock
                    Async.withAsyncWithUnmask
                        (\forall a. IO a -> IO a
    unmask -> IO () -> IO ()
    forall a. IO a -> IO a
    unmask (Socket -> ConnectionOptions -> ServerApp -> IO ()
    runApp Socket
    conn (ServerOptions -> ConnectionOptions
    serverConnectionOptions ServerOptions
    opts) ServerApp
    app) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO a
    `finally` Socket -> IO ()
    S.close Socket
    conn)
                        (\Async ()
    _ -> IO b
    mainThread)
            in IO a -> IO a
    forall a. IO a -> IO a
    mask_ IO a
    forall {b}. IO b
    mainThread
        )

    --------------------------------------------------------------------------------
    -- | Create a standardized socket on which you can listen for incomming
    -- connections. Should only be used for a quick and dirty solution! Should be
    -- preceded by the call 'Network.Socket.withSocketsDo'.
    makeListenSocket :: String -> Int -> IO Socket
    makeListenSocket :: String -> Int -> IO Socket
    makeListenSocket String
    host Int
    port = do
      addr:_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
    forall (t :: * -> *).
    GetAddrInfo t =>
    Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
    S.getAddrInfo (AddrInfo -> Maybe AddrInfo
    forall a. a -> Maybe a
    Just AddrInfo
    hints) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    host) (String -> Maybe String
    forall a. a -> Maybe a
    Just (Int -> String
    forall a. Show a => a -> String
    show Int
    port))
      bracketOnError
        (S.socket (S.addrFamily addr) S.Stream S.defaultProtocol)
        S.close
        (\Socket
    sock -> do
            _     <- Socket -> SocketOption -> Int -> IO ()
    S.setSocketOption Socket
    sock SocketOption
    S.ReuseAddr Int
    1
            _     <- S.setSocketOption sock S.NoDelay   1
            S.bind sock (S.addrAddress addr)
            S.listen sock 5
            return sock
            )
      where
        hints :: AddrInfo
    hints = AddrInfo
    S.defaultHints { S.addrSocketType = S.Stream }

    --------------------------------------------------------------------------------
    runApp :: Socket
           -> ConnectionOptions
           -> ServerApp
           -> IO ()
    runApp :: Socket -> ConnectionOptions -> ServerApp -> IO ()
    runApp Socket
    socket ConnectionOptions
    opts ServerApp
    app =
        IO PendingConnection -> ServerApp -> ServerApp -> IO ()
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
            (Socket -> ConnectionOptions -> IO PendingConnection
    makePendingConnection Socket
    socket ConnectionOptions
    opts)
            (Stream -> IO ()
    Stream.close (Stream -> IO ()) -> (PendingConnection -> Stream) -> ServerApp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PendingConnection -> Stream
    pendingStream)
            ServerApp
    app

    --------------------------------------------------------------------------------
    -- | Turns a socket, connected to some client, into a 'PendingConnection'. The
    -- 'PendingConnection' should be closed using 'pendingStream' and 'Stream.close' later.
    makePendingConnection
        :: Socket -> ConnectionOptions -> IO PendingConnection
    makePendingConnection :: Socket -> ConnectionOptions -> IO PendingConnection
    makePendingConnection Socket
    socket ConnectionOptions
    opts = do
        stream <- Socket -> IO Stream
    Stream.makeSocketStream Socket
    socket
        makePendingConnectionFromStream stream opts

    -- | More general version of 'makePendingConnection' for 'Stream.Stream'
    -- instead of a 'Socket'.
    makePendingConnectionFromStream
        :: Stream.Stream -> ConnectionOptions -> IO PendingConnection
    makePendingConnectionFromStream :: Stream -> ConnectionOptions -> IO PendingConnection
    makePendingConnectionFromStream Stream
    stream ConnectionOptions
    opts = do
        -- TODO: we probably want to send a 40x if the request is bad?
        mbRequest <- Stream -> Parser RequestHead -> IO (Maybe RequestHead)
    forall a. Stream -> Parser a -> IO (Maybe a)
    Stream.parse Stream
    stream (Bool -> Parser RequestHead
    decodeRequestHead Bool
    False)
        case mbRequest of
            Maybe RequestHead
    Nothing      -> ConnectionException -> IO PendingConnection
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO ConnectionException
    ConnectionClosed
            Just RequestHead
    request -> PendingConnection -> IO PendingConnection
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PendingConnection
                { pendingOptions :: ConnectionOptions
    pendingOptions  = ConnectionOptions
    opts
                , pendingRequest :: RequestHead
    pendingRequest  = RequestHead
    request
                , pendingOnAccept :: Connection -> IO ()
    pendingOnAccept = \Connection
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                , pendingStream :: Stream
    pendingStream   = Stream
    stream
                }