1 {-# LANGUAGE RankNTypes #-}
    2 ------------------------------------------------------------------------------
    3 -- | Types internal to the implementation of the Snap HTTP server.
    4 module Snap.Internal.Http.Server.Types
    5   ( ServerConfig(..)
    6   , PerSessionData(..)
    7   , DataFinishedHook
    8   , EscapeSnapHook
    9   , ExceptionHook
   10   , ParseHook
   11   , NewRequestHook
   12   , UserHandlerFinishedHook
   13 
   14   -- * Handlers
   15   , SendFileHandler
   16   , ServerHandler
   17   , AcceptFunc(..)
   18 
   19   -- * Socket types
   20   , SocketConfig(..)
   21   ) where
   22 
   23 ------------------------------------------------------------------------------
   24 import           Control.Exception                (SomeException)
   25 import           Data.ByteString                  (ByteString)
   26 import           Data.IORef                       (IORef)
   27 import           Data.Word                        (Word64)
   28 import           Network.Socket                   (Socket)
   29 ------------------------------------------------------------------------------
   30 import           Data.ByteString.Builder          (Builder)
   31 import           Data.ByteString.Builder.Internal (Buffer)
   32 import           System.IO.Streams                (InputStream, OutputStream)
   33 ------------------------------------------------------------------------------
   34 import           Snap.Core                        (Request, Response)
   35 
   36 
   37 ------------------------------------------------------------------------------
   38 -- | The 'NewRequestHook' is called once processing for an HTTP request begins,
   39 -- i.e. after the connection has been accepted and we know that there's data
   40 -- available to read from the socket. The IORef passed to the hook initially
   41 -- contains a bottom value that will throw an exception if evaluated.
   42 type NewRequestHook hookState = PerSessionData -> IO hookState
   43 
   44 -- | The 'ParseHook' is called after the HTTP Request has been parsed by the
   45 -- server, but before the user handler starts running.
   46 type ParseHook hookState = IORef hookState -> Request -> IO ()
   47 
   48 -- | The 'UserHandlerFinishedHook' is called once the user handler has finished
   49 -- running, but before the data for the HTTP response starts being sent to the
   50 -- client.
   51 type UserHandlerFinishedHook hookState =
   52     IORef hookState -> Request -> Response -> IO ()
   53 
   54 -- | The 'DataFinishedHook' is called once the server has finished sending the
   55 -- HTTP response to the client.
   56 type DataFinishedHook hookState =
   57     IORef hookState -> Request -> Response -> IO ()
   58 
   59 -- | The 'ExceptionHook' is called if an exception reaches the toplevel of the
   60 -- server, i.e. if an exception leaks out of the user handler or if an
   61 -- exception is raised during the sending of the HTTP response data.
   62 type ExceptionHook hookState = IORef hookState -> SomeException -> IO ()
   63 
   64 -- | The 'EscapeSnapHook' is called if the user handler escapes the HTTP
   65 -- session, e.g. for websockets.
   66 type EscapeSnapHook hookState = IORef hookState -> IO ()
   67 
   68 
   69                              ---------------------
   70                              -- data structures --
   71                              ---------------------
   72 ------------------------------------------------------------------------------
   73 -- | Data and services that all HTTP response handlers share.
   74 --
   75 data ServerConfig hookState = ServerConfig
   76     { _logAccess             :: !(Request -> Response -> Word64 -> IO ())
   77     , _logError              :: !(Builder -> IO ())
   78     , _onNewRequest          :: !(NewRequestHook hookState)
   79     , _onParse               :: !(ParseHook hookState)
   80     , _onUserHandlerFinished :: !(UserHandlerFinishedHook hookState)
   81     , _onDataFinished        :: !(DataFinishedHook hookState)
   82     , _onException           :: !(ExceptionHook hookState)
   83     , _onEscape              :: !(EscapeSnapHook hookState)
   84 
   85       -- | will be overridden by a @Host@ header if it appears.
   86     , _localHostname         :: !ByteString
   87     , _defaultTimeout        :: {-# UNPACK #-} !Int
   88     , _isSecure              :: !Bool
   89 
   90       -- | Number of accept loops to spawn.
   91     , _numAcceptLoops        :: {-# UNPACK #-} !Int
   92     }
   93 
   94 
   95 ------------------------------------------------------------------------------
   96 -- | All of the things a session needs to service a single HTTP request.
   97 data PerSessionData = PerSessionData
   98     { -- | If the bool stored in this IORef becomes true, the server will close
   99       -- the connection after the current request is processed.
  100       _forceConnectionClose :: {-# UNPACK #-} !(IORef Bool)
  101 
  102       -- | An IO action to modify the current request timeout.
  103     , _twiddleTimeout       :: !((Int -> Int) -> IO ())
  104 
  105       -- | The value stored in this IORef is True if this request is the first
  106       -- on a new connection, and False if it is a subsequent keep-alive
  107       -- request.
  108     , _isNewConnection      :: !(IORef Bool)
  109 
  110       -- | The function called when we want to use @sendfile().@
  111     , _sendfileHandler      :: !SendFileHandler
  112 
  113       -- | The server's idea of its local address.
  114     , _localAddress         :: !ByteString
  115 
  116       -- | The listening port number.
  117     , _localPort            :: {-# UNPACK #-} !Int
  118 
  119       -- | The address of the remote user.
  120     , _remoteAddress        :: !ByteString
  121 
  122       -- | The remote user's port.
  123     , _remotePort           :: {-# UNPACK #-} !Int
  124 
  125       -- | The read end of the socket connection.
  126     , _readEnd              :: !(InputStream ByteString)
  127 
  128       -- | The write end of the socket connection.
  129     , _writeEnd             :: !(OutputStream ByteString)
  130     }
  131 
  132 
  133 ------------------------------------------------------------------------------
  134 newtype AcceptFunc = AcceptFunc {
  135   runAcceptFunc :: (forall a . IO a -> IO a)         -- exception restore function
  136                     -> IO ( SendFileHandler          -- what to do on sendfile
  137                           , ByteString               -- local address
  138                           , Int                      -- local port
  139                           , ByteString               -- remote address
  140                           , Int                      -- remote port
  141                           , InputStream ByteString   -- socket read end
  142                           , OutputStream ByteString  -- socket write end
  143                           , IO ()                    -- cleanup action
  144                           )
  145   }
  146 
  147                              --------------------
  148                              -- function types --
  149                              --------------------
  150 ------------------------------------------------------------------------------
  151 -- | This function, provided to the web server internals from the outside, is
  152 -- responsible for producing a 'Response' once the server has parsed the
  153 -- 'Request'.
  154 --
  155 type ServerHandler hookState =
  156         ServerConfig hookState     -- ^ global server config
  157      -> PerSessionData             -- ^ per-connection data
  158      -> Request                    -- ^ HTTP request object
  159      -> IO (Request, Response)
  160 
  161 
  162 ------------------------------------------------------------------------------
  163 -- | A 'SendFileHandler' is called if the user handler requests that a file be
  164 -- sent using @sendfile()@ on systems that support it (Linux, Mac OSX, and
  165 -- FreeBSD).
  166 type SendFileHandler =
  167        Buffer                   -- ^ builder buffer
  168     -> Builder                  -- ^ status line and headers
  169     -> FilePath                 -- ^ file to send
  170     -> Word64                   -- ^ start offset
  171     -> Word64                   -- ^ number of bytes
  172     -> IO ()
  173 
  174 
  175 
  176                         -------------------------------
  177                         -- types for server backends --
  178                         -------------------------------
  179 
  180 ------------------------------------------------------------------------------
  181 -- | Either the server should start listening on the given interface \/ port
  182 -- combination, or the server should start up with a 'Socket' that has already
  183 -- had @bind()@ and @listen()@ called on it.
  184 data SocketConfig = StartListening ByteString Int
  185                   | PreBound Socket