{-# LANGUAGE OverloadedStrings #-}

-- | Types used by the Snap HTTP Server.
module Snap.Http.Server.Types
  ( ServerConfig
  , PerSessionData

  -- * ServerConfig
  , emptyServerConfig

  -- ** getters\/setters
  , getDefaultTimeout
  , getIsSecure
  , getLocalHostname
  , getLogAccess
  , getLogError
  , getNumAcceptLoops
  , getOnDataFinished
  , getOnEscape
  , getOnException
  , getOnNewRequest
  , getOnParse
  , getOnUserHandlerFinished
  , setDefaultTimeout
  , setIsSecure
  , setLocalHostname
  , setLogAccess
  , setLogError
  , setNumAcceptLoops
  , setOnDataFinished
  , setOnEscape
  , setOnException
  , setOnNewRequest
  , setOnParse
  , setOnUserHandlerFinished

  -- * PerSessionData
  -- ** getters
  , getTwiddleTimeout
  , isNewConnection
  , getLocalAddress
  , getLocalPort
  , getRemoteAddress
  , getRemotePort

  -- * HTTP lifecycle
  -- $lifecycle

  -- * Hooks
  -- $hooks

  , DataFinishedHook
  , EscapeSnapHook
  , ExceptionHook
  , ParseHook
  , NewRequestHook
  , UserHandlerFinishedHook

  -- * Handlers
  , SendFileHandler
  , ServerHandler
  , AcceptFunc

  -- * Socket types
  , SocketConfig(..)
  ) where

------------------------------------------------------------------------------
import           Data.ByteString                 (ByteString)
import           Data.IORef                      (readIORef)
import           Data.Word                       (Word64)
------------------------------------------------------------------------------
import           Data.ByteString.Builder         (Builder)
------------------------------------------------------------------------------
import           Snap.Core                       (Request, Response)
import           Snap.Internal.Http.Server.Types (AcceptFunc, DataFinishedHook, EscapeSnapHook, ExceptionHook, NewRequestHook, ParseHook, PerSessionData (_isNewConnection, _localAddress, _localPort, _remoteAddress, _remotePort, _twiddleTimeout), SendFileHandler, ServerConfig (..), ServerHandler, SocketConfig (..), UserHandlerFinishedHook)


                          ---------------------------
                          -- snap server lifecycle --
                          ---------------------------

------------------------------------------------------------------------------
-- $lifecycle
--
-- 'Request' \/ 'Response' lifecycle for \"normal\" requests (i.e. without
-- errors):
--
-- 1. accept a new connection, set it up (e.g. with SSL)
--
-- 2. create a 'PerSessionData' object
--
-- 3. Enter the 'SessionHandler', which:
--
-- 4. calls the 'NewRequestHook', making a new hookState object.
--
-- 5. parses the HTTP request. If the session is over, we stop here.
--
-- 6. calls the 'ParseHook'
--
-- 7. enters the 'ServerHandler', which is provided by another part of the
--    framework
--
-- 8. the server handler passes control to the user handler
--
-- 9. a 'Response' is produced, and the 'UserHandlerFinishedHook' is called.
--
-- 10. the 'Response' is written to the client
--
-- 11. the 'DataFinishedHook' is called.
--
-- 12. we go to #3.


                                  -----------
                                  -- hooks --
                                  -----------

------------------------------------------------------------------------------
-- $hooks
-- #hooks#
--
-- At various critical points in the HTTP lifecycle, the Snap server will call
-- user-defined \"hooks\" that can be used for instrumentation or tracing of
-- the process of building the HTTP response. The first hook called, the
-- 'NewRequestHook', will generate a \"hookState\" object (having some
-- user-defined abstract type), and this object will be passed to the rest of
-- the hooks as the server handles the process of responding to the HTTP
-- request.
--
-- For example, you could pass a set of hooks to the Snap server that measured
-- timings for each URI handled by the server to produce online statistics and
-- metrics using something like @statsd@ (<https://github.com/etsy/statsd>).


------------------------------------------------------------------------------
emptyServerConfig :: ServerConfig a
emptyServerConfig :: ServerConfig a
emptyServerConfig =
    (Request -> Response -> Word64 -> IO ())
-> (Builder -> IO ())
-> NewRequestHook a
-> ParseHook a
-> UserHandlerFinishedHook a
-> UserHandlerFinishedHook a
-> ExceptionHook a
-> EscapeSnapHook a
-> ByteString
-> Int
-> Bool
-> Int
-> ServerConfig a
forall hookState.
(Request -> Response -> Word64 -> IO ())
-> (Builder -> IO ())
-> NewRequestHook hookState
-> ParseHook hookState
-> UserHandlerFinishedHook hookState
-> UserHandlerFinishedHook hookState
-> ExceptionHook hookState
-> EscapeSnapHook hookState
-> ByteString
-> Int
-> Bool
-> Int
-> ServerConfig hookState
ServerConfig (\Request
_ Response
_ Word64
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
                 (\Builder
_     -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
                 (\PerSessionData
_     -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"undefined hook state")
                 (\IORef a
_ Request
_   -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
                 (\IORef a
_ Request
_ Response
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
                 (\IORef a
_ Request
_ Response
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
                 (\IORef a
_ SomeException
_   -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
                 (\IORef a
_     -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
                 ByteString
"localhost"
                 Int
30
                 Bool
False
                 Int
1


------------------------------------------------------------------------------
getLogAccess :: ServerConfig hookState -> Request -> Response -> Word64 -> IO ()
getLogAccess :: ServerConfig hookState -> Request -> Response -> Word64 -> IO ()
getLogAccess ServerConfig hookState
sc             = ServerConfig hookState -> Request -> Response -> Word64 -> IO ()
forall hookState.
ServerConfig hookState -> Request -> Response -> Word64 -> IO ()
_logAccess ServerConfig hookState
sc


------------------------------------------------------------------------------
getLogError :: ServerConfig hookState -> Builder -> IO ()
getLogError :: ServerConfig hookState -> Builder -> IO ()
getLogError ServerConfig hookState
sc              = ServerConfig hookState -> Builder -> IO ()
forall hookState. ServerConfig hookState -> Builder -> IO ()
_logError ServerConfig hookState
sc


------------------------------------------------------------------------------
getOnNewRequest :: ServerConfig hookState -> NewRequestHook hookState
getOnNewRequest :: ServerConfig hookState -> NewRequestHook hookState
getOnNewRequest ServerConfig hookState
sc          = ServerConfig hookState -> NewRequestHook hookState
forall hookState.
ServerConfig hookState -> NewRequestHook hookState
_onNewRequest ServerConfig hookState
sc


------------------------------------------------------------------------------
getOnParse :: ServerConfig hookState -> ParseHook hookState
getOnParse :: ServerConfig hookState -> ParseHook hookState
getOnParse ServerConfig hookState
sc               = ServerConfig hookState -> ParseHook hookState
forall hookState. ServerConfig hookState -> ParseHook hookState
_onParse ServerConfig hookState
sc


------------------------------------------------------------------------------
getOnUserHandlerFinished :: ServerConfig hookState
                         -> UserHandlerFinishedHook hookState
getOnUserHandlerFinished :: ServerConfig hookState -> UserHandlerFinishedHook hookState
getOnUserHandlerFinished ServerConfig hookState
sc = ServerConfig hookState -> UserHandlerFinishedHook hookState
forall hookState.
ServerConfig hookState -> UserHandlerFinishedHook hookState
_onUserHandlerFinished ServerConfig hookState
sc


------------------------------------------------------------------------------
getOnDataFinished :: ServerConfig hookState -> DataFinishedHook hookState
getOnDataFinished :: ServerConfig hookState -> DataFinishedHook hookState
getOnDataFinished ServerConfig hookState
sc        = ServerConfig hookState -> DataFinishedHook hookState
forall hookState.
ServerConfig hookState -> UserHandlerFinishedHook hookState
_onDataFinished ServerConfig hookState
sc


------------------------------------------------------------------------------
getOnException :: ServerConfig hookState -> ExceptionHook hookState
getOnException :: ServerConfig hookState -> ExceptionHook hookState
getOnException ServerConfig hookState
sc           = ServerConfig hookState -> ExceptionHook hookState
forall hookState. ServerConfig hookState -> ExceptionHook hookState
_onException ServerConfig hookState
sc


------------------------------------------------------------------------------
getOnEscape :: ServerConfig hookState -> EscapeSnapHook hookState
getOnEscape :: ServerConfig hookState -> EscapeSnapHook hookState
getOnEscape ServerConfig hookState
sc              = ServerConfig hookState -> EscapeSnapHook hookState
forall hookState.
ServerConfig hookState -> EscapeSnapHook hookState
_onEscape ServerConfig hookState
sc


------------------------------------------------------------------------------
getLocalHostname :: ServerConfig hookState -> ByteString
getLocalHostname :: ServerConfig hookState -> ByteString
getLocalHostname ServerConfig hookState
sc         = ServerConfig hookState -> ByteString
forall hookState. ServerConfig hookState -> ByteString
_localHostname ServerConfig hookState
sc


------------------------------------------------------------------------------
getDefaultTimeout :: ServerConfig hookState -> Int
getDefaultTimeout :: ServerConfig hookState -> Int
getDefaultTimeout ServerConfig hookState
sc        = ServerConfig hookState -> Int
forall hookState. ServerConfig hookState -> Int
_defaultTimeout ServerConfig hookState
sc


------------------------------------------------------------------------------
getIsSecure :: ServerConfig hookState -> Bool
getIsSecure :: ServerConfig hookState -> Bool
getIsSecure ServerConfig hookState
sc              = ServerConfig hookState -> Bool
forall hookState. ServerConfig hookState -> Bool
_isSecure ServerConfig hookState
sc


------------------------------------------------------------------------------
getNumAcceptLoops :: ServerConfig hookState -> Int
getNumAcceptLoops :: ServerConfig hookState -> Int
getNumAcceptLoops ServerConfig hookState
sc        = ServerConfig hookState -> Int
forall hookState. ServerConfig hookState -> Int
_numAcceptLoops ServerConfig hookState
sc


------------------------------------------------------------------------------
setLogAccess :: (Request -> Response -> Word64 -> IO ())
             -> ServerConfig hookState
             -> ServerConfig hookState
setLogAccess :: (Request -> Response -> Word64 -> IO ())
-> ServerConfig hookState -> ServerConfig hookState
setLogAccess Request -> Response -> Word64 -> IO ()
s ServerConfig hookState
sc             = ServerConfig hookState
sc { _logAccess :: Request -> Response -> Word64 -> IO ()
_logAccess = Request -> Response -> Word64 -> IO ()
s }


------------------------------------------------------------------------------
setLogError :: (Builder -> IO ())
            -> ServerConfig hookState
            -> ServerConfig hookState
setLogError :: (Builder -> IO ())
-> ServerConfig hookState -> ServerConfig hookState
setLogError Builder -> IO ()
s ServerConfig hookState
sc              = ServerConfig hookState
sc { _logError :: Builder -> IO ()
_logError = Builder -> IO ()
s }


------------------------------------------------------------------------------
setOnNewRequest :: NewRequestHook hookState
                -> ServerConfig hookState
                -> ServerConfig hookState
setOnNewRequest :: NewRequestHook hookState
-> ServerConfig hookState -> ServerConfig hookState
setOnNewRequest NewRequestHook hookState
s ServerConfig hookState
sc          = ServerConfig hookState
sc { _onNewRequest :: NewRequestHook hookState
_onNewRequest = NewRequestHook hookState
s }


------------------------------------------------------------------------------
setOnParse :: ParseHook hookState
           -> ServerConfig hookState
           -> ServerConfig hookState
setOnParse :: ParseHook hookState
-> ServerConfig hookState -> ServerConfig hookState
setOnParse ParseHook hookState
s ServerConfig hookState
sc               = ServerConfig hookState
sc { _onParse :: ParseHook hookState
_onParse = ParseHook hookState
s }


------------------------------------------------------------------------------
setOnUserHandlerFinished :: UserHandlerFinishedHook hookState
                         -> ServerConfig hookState
                         -> ServerConfig hookState
setOnUserHandlerFinished :: UserHandlerFinishedHook hookState
-> ServerConfig hookState -> ServerConfig hookState
setOnUserHandlerFinished UserHandlerFinishedHook hookState
s ServerConfig hookState
sc = ServerConfig hookState
sc { _onUserHandlerFinished :: UserHandlerFinishedHook hookState
_onUserHandlerFinished = UserHandlerFinishedHook hookState
s }


------------------------------------------------------------------------------
setOnDataFinished :: DataFinishedHook hookState
                  -> ServerConfig hookState
                  -> ServerConfig hookState
setOnDataFinished :: DataFinishedHook hookState
-> ServerConfig hookState -> ServerConfig hookState
setOnDataFinished DataFinishedHook hookState
s ServerConfig hookState
sc        = ServerConfig hookState
sc { _onDataFinished :: DataFinishedHook hookState
_onDataFinished = DataFinishedHook hookState
s }


------------------------------------------------------------------------------
setOnException :: ExceptionHook hookState
               -> ServerConfig hookState
               -> ServerConfig hookState
setOnException :: ExceptionHook hookState
-> ServerConfig hookState -> ServerConfig hookState
setOnException ExceptionHook hookState
s ServerConfig hookState
sc           = ServerConfig hookState
sc { _onException :: ExceptionHook hookState
_onException = ExceptionHook hookState
s }


------------------------------------------------------------------------------
setOnEscape :: EscapeSnapHook hookState
            -> ServerConfig hookState
            -> ServerConfig hookState
setOnEscape :: EscapeSnapHook hookState
-> ServerConfig hookState -> ServerConfig hookState
setOnEscape EscapeSnapHook hookState
s ServerConfig hookState
sc              = ServerConfig hookState
sc { _onEscape :: EscapeSnapHook hookState
_onEscape = EscapeSnapHook hookState
s }


------------------------------------------------------------------------------
setLocalHostname :: ByteString
                 -> ServerConfig hookState
                 -> ServerConfig hookState
setLocalHostname :: ByteString -> ServerConfig hookState -> ServerConfig hookState
setLocalHostname ByteString
s ServerConfig hookState
sc         = ServerConfig hookState
sc { _localHostname :: ByteString
_localHostname = ByteString
s }


------------------------------------------------------------------------------
setDefaultTimeout :: Int -> ServerConfig hookState -> ServerConfig hookState
setDefaultTimeout :: Int -> ServerConfig hookState -> ServerConfig hookState
setDefaultTimeout Int
s ServerConfig hookState
sc        = ServerConfig hookState
sc { _defaultTimeout :: Int
_defaultTimeout = Int
s }


------------------------------------------------------------------------------
setIsSecure :: Bool -> ServerConfig hookState -> ServerConfig hookState
setIsSecure :: Bool -> ServerConfig hookState -> ServerConfig hookState
setIsSecure Bool
s ServerConfig hookState
sc              = ServerConfig hookState
sc { _isSecure :: Bool
_isSecure = Bool
s }


------------------------------------------------------------------------------
setNumAcceptLoops :: Int -> ServerConfig hookState -> ServerConfig hookState
setNumAcceptLoops :: Int -> ServerConfig hookState -> ServerConfig hookState
setNumAcceptLoops Int
s ServerConfig hookState
sc        = ServerConfig hookState
sc { _numAcceptLoops :: Int
_numAcceptLoops = Int
s }


------------------------------------------------------------------------------
getTwiddleTimeout :: PerSessionData -> ((Int -> Int) -> IO ())
getTwiddleTimeout :: PerSessionData -> (Int -> Int) -> IO ()
getTwiddleTimeout PerSessionData
psd = PerSessionData -> (Int -> Int) -> IO ()
_twiddleTimeout PerSessionData
psd


------------------------------------------------------------------------------
isNewConnection :: PerSessionData -> IO Bool
isNewConnection :: PerSessionData -> IO Bool
isNewConnection = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool)
-> (PerSessionData -> IORef Bool) -> PerSessionData -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerSessionData -> IORef Bool
_isNewConnection


------------------------------------------------------------------------------
getLocalAddress :: PerSessionData -> ByteString
getLocalAddress :: PerSessionData -> ByteString
getLocalAddress PerSessionData
psd = PerSessionData -> ByteString
_localAddress PerSessionData
psd


------------------------------------------------------------------------------
getLocalPort :: PerSessionData -> Int
getLocalPort :: PerSessionData -> Int
getLocalPort PerSessionData
psd = PerSessionData -> Int
_localPort PerSessionData
psd


------------------------------------------------------------------------------
getRemoteAddress :: PerSessionData -> ByteString
getRemoteAddress :: PerSessionData -> ByteString
getRemoteAddress PerSessionData
psd = PerSessionData -> ByteString
_remoteAddress PerSessionData
psd


------------------------------------------------------------------------------
getRemotePort :: PerSessionData -> Int
getRemotePort :: PerSessionData -> Int
getRemotePort PerSessionData
psd = PerSessionData -> Int
_remotePort PerSessionData
psd