1 {-# LANGUAGE OverloadedStrings #-}
    2 
    3 -- | Types used by the Snap HTTP Server.
    4 module Snap.Http.Server.Types
    5   ( ServerConfig
    6   , PerSessionData
    7 
    8   -- * ServerConfig
    9   , emptyServerConfig
   10 
   11   -- ** getters\/setters
   12   , getDefaultTimeout
   13   , getIsSecure
   14   , getLocalHostname
   15   , getLogAccess
   16   , getLogError
   17   , getNumAcceptLoops
   18   , getOnDataFinished
   19   , getOnEscape
   20   , getOnException
   21   , getOnNewRequest
   22   , getOnParse
   23   , getOnUserHandlerFinished
   24   , setDefaultTimeout
   25   , setIsSecure
   26   , setLocalHostname
   27   , setLogAccess
   28   , setLogError
   29   , setNumAcceptLoops
   30   , setOnDataFinished
   31   , setOnEscape
   32   , setOnException
   33   , setOnNewRequest
   34   , setOnParse
   35   , setOnUserHandlerFinished
   36 
   37   -- * PerSessionData
   38   -- ** getters
   39   , getTwiddleTimeout
   40   , isNewConnection
   41   , getLocalAddress
   42   , getLocalPort
   43   , getRemoteAddress
   44   , getRemotePort
   45 
   46   -- * HTTP lifecycle
   47   -- $lifecycle
   48 
   49   -- * Hooks
   50   -- $hooks
   51 
   52   , DataFinishedHook
   53   , EscapeSnapHook
   54   , ExceptionHook
   55   , ParseHook
   56   , NewRequestHook
   57   , UserHandlerFinishedHook
   58 
   59   -- * Handlers
   60   , SendFileHandler
   61   , ServerHandler
   62   , AcceptFunc
   63 
   64   -- * Socket types
   65   , SocketConfig(..)
   66   ) where
   67 
   68 ------------------------------------------------------------------------------
   69 import           Data.ByteString                 (ByteString)
   70 import           Data.IORef                      (readIORef)
   71 import           Data.Word                       (Word64)
   72 ------------------------------------------------------------------------------
   73 import           Data.ByteString.Builder         (Builder)
   74 ------------------------------------------------------------------------------
   75 import           Snap.Core                       (Request, Response)
   76 import           Snap.Internal.Http.Server.Types (AcceptFunc, DataFinishedHook, EscapeSnapHook, ExceptionHook, NewRequestHook, ParseHook, PerSessionData (_isNewConnection, _localAddress, _localPort, _remoteAddress, _remotePort, _twiddleTimeout), SendFileHandler, ServerConfig (..), ServerHandler, SocketConfig (..), UserHandlerFinishedHook)
   77 
   78 
   79                           ---------------------------
   80                           -- snap server lifecycle --
   81                           ---------------------------
   82 
   83 ------------------------------------------------------------------------------
   84 -- $lifecycle
   85 --
   86 -- 'Request' \/ 'Response' lifecycle for \"normal\" requests (i.e. without
   87 -- errors):
   88 --
   89 -- 1. accept a new connection, set it up (e.g. with SSL)
   90 --
   91 -- 2. create a 'PerSessionData' object
   92 --
   93 -- 3. Enter the 'SessionHandler', which:
   94 --
   95 -- 4. calls the 'NewRequestHook', making a new hookState object.
   96 --
   97 -- 5. parses the HTTP request. If the session is over, we stop here.
   98 --
   99 -- 6. calls the 'ParseHook'
  100 --
  101 -- 7. enters the 'ServerHandler', which is provided by another part of the
  102 --    framework
  103 --
  104 -- 8. the server handler passes control to the user handler
  105 --
  106 -- 9. a 'Response' is produced, and the 'UserHandlerFinishedHook' is called.
  107 --
  108 -- 10. the 'Response' is written to the client
  109 --
  110 -- 11. the 'DataFinishedHook' is called.
  111 --
  112 -- 12. we go to #3.
  113 
  114 
  115                                   -----------
  116                                   -- hooks --
  117                                   -----------
  118 
  119 ------------------------------------------------------------------------------
  120 -- $hooks
  121 -- #hooks#
  122 --
  123 -- At various critical points in the HTTP lifecycle, the Snap server will call
  124 -- user-defined \"hooks\" that can be used for instrumentation or tracing of
  125 -- the process of building the HTTP response. The first hook called, the
  126 -- 'NewRequestHook', will generate a \"hookState\" object (having some
  127 -- user-defined abstract type), and this object will be passed to the rest of
  128 -- the hooks as the server handles the process of responding to the HTTP
  129 -- request.
  130 --
  131 -- For example, you could pass a set of hooks to the Snap server that measured
  132 -- timings for each URI handled by the server to produce online statistics and
  133 -- metrics using something like @statsd@ (<https://github.com/etsy/statsd>).
  134 
  135 
  136 ------------------------------------------------------------------------------
  137 emptyServerConfig :: ServerConfig a
  138 emptyServerConfig =
  139     ServerConfig (\_ _ _ -> return $! ())
  140                  (\_     -> return $! ())
  141                  (\_     -> return $ error "undefined hook state")
  142                  (\_ _   -> return $! ())
  143                  (\_ _ _ -> return $! ())
  144                  (\_ _ _ -> return $! ())
  145                  (\_ _   -> return $! ())
  146                  (\_     -> return $! ())
  147                  "localhost"
  148                  30
  149                  False
  150                  1
  151 
  152 
  153 ------------------------------------------------------------------------------
  154 getLogAccess :: ServerConfig hookState -> Request -> Response -> Word64 -> IO ()
  155 getLogAccess sc             = _logAccess sc
  156 
  157 
  158 ------------------------------------------------------------------------------
  159 getLogError :: ServerConfig hookState -> Builder -> IO ()
  160 getLogError sc              = _logError sc
  161 
  162 
  163 ------------------------------------------------------------------------------
  164 getOnNewRequest :: ServerConfig hookState -> NewRequestHook hookState
  165 getOnNewRequest sc          = _onNewRequest sc
  166 
  167 
  168 ------------------------------------------------------------------------------
  169 getOnParse :: ServerConfig hookState -> ParseHook hookState
  170 getOnParse sc               = _onParse sc
  171 
  172 
  173 ------------------------------------------------------------------------------
  174 getOnUserHandlerFinished :: ServerConfig hookState
  175                          -> UserHandlerFinishedHook hookState
  176 getOnUserHandlerFinished sc = _onUserHandlerFinished sc
  177 
  178 
  179 ------------------------------------------------------------------------------
  180 getOnDataFinished :: ServerConfig hookState -> DataFinishedHook hookState
  181 getOnDataFinished sc        = _onDataFinished sc
  182 
  183 
  184 ------------------------------------------------------------------------------
  185 getOnException :: ServerConfig hookState -> ExceptionHook hookState
  186 getOnException sc           = _onException sc
  187 
  188 
  189 ------------------------------------------------------------------------------
  190 getOnEscape :: ServerConfig hookState -> EscapeSnapHook hookState
  191 getOnEscape sc              = _onEscape sc
  192 
  193 
  194 ------------------------------------------------------------------------------
  195 getLocalHostname :: ServerConfig hookState -> ByteString
  196 getLocalHostname sc         = _localHostname sc
  197 
  198 
  199 ------------------------------------------------------------------------------
  200 getDefaultTimeout :: ServerConfig hookState -> Int
  201 getDefaultTimeout sc        = _defaultTimeout sc
  202 
  203 
  204 ------------------------------------------------------------------------------
  205 getIsSecure :: ServerConfig hookState -> Bool
  206 getIsSecure sc              = _isSecure sc
  207 
  208 
  209 ------------------------------------------------------------------------------
  210 getNumAcceptLoops :: ServerConfig hookState -> Int
  211 getNumAcceptLoops sc        = _numAcceptLoops sc
  212 
  213 
  214 ------------------------------------------------------------------------------
  215 setLogAccess :: (Request -> Response -> Word64 -> IO ())
  216              -> ServerConfig hookState
  217              -> ServerConfig hookState
  218 setLogAccess s sc             = sc { _logAccess = s }
  219 
  220 
  221 ------------------------------------------------------------------------------
  222 setLogError :: (Builder -> IO ())
  223             -> ServerConfig hookState
  224             -> ServerConfig hookState
  225 setLogError s sc              = sc { _logError = s }
  226 
  227 
  228 ------------------------------------------------------------------------------
  229 setOnNewRequest :: NewRequestHook hookState
  230                 -> ServerConfig hookState
  231                 -> ServerConfig hookState
  232 setOnNewRequest s sc          = sc { _onNewRequest = s }
  233 
  234 
  235 ------------------------------------------------------------------------------
  236 setOnParse :: ParseHook hookState
  237            -> ServerConfig hookState
  238            -> ServerConfig hookState
  239 setOnParse s sc               = sc { _onParse = s }
  240 
  241 
  242 ------------------------------------------------------------------------------
  243 setOnUserHandlerFinished :: UserHandlerFinishedHook hookState
  244                          -> ServerConfig hookState
  245                          -> ServerConfig hookState
  246 setOnUserHandlerFinished s sc = sc { _onUserHandlerFinished = s }
  247 
  248 
  249 ------------------------------------------------------------------------------
  250 setOnDataFinished :: DataFinishedHook hookState
  251                   -> ServerConfig hookState
  252                   -> ServerConfig hookState
  253 setOnDataFinished s sc        = sc { _onDataFinished = s }
  254 
  255 
  256 ------------------------------------------------------------------------------
  257 setOnException :: ExceptionHook hookState
  258                -> ServerConfig hookState
  259                -> ServerConfig hookState
  260 setOnException s sc           = sc { _onException = s }
  261 
  262 
  263 ------------------------------------------------------------------------------
  264 setOnEscape :: EscapeSnapHook hookState
  265             -> ServerConfig hookState
  266             -> ServerConfig hookState
  267 setOnEscape s sc              = sc { _onEscape = s }
  268 
  269 
  270 ------------------------------------------------------------------------------
  271 setLocalHostname :: ByteString
  272                  -> ServerConfig hookState
  273                  -> ServerConfig hookState
  274 setLocalHostname s sc         = sc { _localHostname = s }
  275 
  276 
  277 ------------------------------------------------------------------------------
  278 setDefaultTimeout :: Int -> ServerConfig hookState -> ServerConfig hookState
  279 setDefaultTimeout s sc        = sc { _defaultTimeout = s }
  280 
  281 
  282 ------------------------------------------------------------------------------
  283 setIsSecure :: Bool -> ServerConfig hookState -> ServerConfig hookState
  284 setIsSecure s sc              = sc { _isSecure = s }
  285 
  286 
  287 ------------------------------------------------------------------------------
  288 setNumAcceptLoops :: Int -> ServerConfig hookState -> ServerConfig hookState
  289 setNumAcceptLoops s sc        = sc { _numAcceptLoops = s }
  290 
  291 
  292 ------------------------------------------------------------------------------
  293 getTwiddleTimeout :: PerSessionData -> ((Int -> Int) -> IO ())
  294 getTwiddleTimeout psd = _twiddleTimeout psd
  295 
  296 
  297 ------------------------------------------------------------------------------
  298 isNewConnection :: PerSessionData -> IO Bool
  299 isNewConnection = readIORef . _isNewConnection
  300 
  301 
  302 ------------------------------------------------------------------------------
  303 getLocalAddress :: PerSessionData -> ByteString
  304 getLocalAddress psd = _localAddress psd
  305 
  306 
  307 ------------------------------------------------------------------------------
  308 getLocalPort :: PerSessionData -> Int
  309 getLocalPort psd = _localPort psd
  310 
  311 
  312 ------------------------------------------------------------------------------
  313 getRemoteAddress :: PerSessionData -> ByteString
  314 getRemoteAddress psd = _remoteAddress psd
  315 
  316 
  317 ------------------------------------------------------------------------------
  318 getRemotePort :: PerSessionData -> Int
  319 getRemotePort psd = _remotePort psd