1 module Snap.Internal.Http.Server.Backend where
    2 
    3 {-
    4 
    5 The server backend is made up of two APIs.
    6 
    7 + The ListenSocket class abstracts the reading and writing from the network.
    8   We have seperate implementations of ListenSocket for http and https.
    9 
   10 + The EventLoop function is the interface to accept on the socket.
   11   The EventLoop function will listen on the ports, and for each accepted
   12   connection it wil call the SessionHandler.
   13 
   14 -}
   15 
   16 import Data.ByteString (ByteString)
   17 import Foreign
   18 import Foreign.C
   19 import Network.Socket (Socket)
   20 import Snap.Iteratee (Iteratee, Enumerator)
   21 
   22 
   23 ------------------------------------------------------------------------------
   24 data SessionInfo = SessionInfo
   25     { localAddress  :: ByteString
   26     , localPort     :: Int
   27     , remoteAddress :: ByteString
   28     , remotePort    :: Int
   29     , isSecure      :: Bool
   30     }
   31 
   32 
   33 ------------------------------------------------------------------------------
   34 type SessionHandler =
   35        SessionInfo                           -- ^ session port information
   36     -> Enumerator ByteString IO ()           -- ^ read end of socket
   37     -> Iteratee ByteString IO ()             -- ^ write end of socket
   38     -> (FilePath -> Int64 -> Int64 -> IO ()) -- ^ sendfile end
   39     -> (Int -> IO ())                        -- ^ timeout tickler
   40     -> IO ()
   41 
   42 
   43 ------------------------------------------------------------------------------
   44 type EventLoop = Int                       -- ^ default timeout
   45               -> [ListenSocket]            -- ^ list of ports
   46               -> Int                       -- ^ number of capabilities
   47               -> (ByteString -> IO ())     -- ^ error log
   48               -> SessionHandler            -- ^ session handler
   49               -> IO ()
   50 
   51 
   52 {- For performance reasons, we do not implement this as a class
   53 class ListenSocket a where
   54     data ListenSocketSession a :: *
   55 
   56     listenSocket  :: a -> Socket
   57     isSecure      :: a -> Bool
   58 
   59     closePort     :: a -> IO ()
   60 
   61     createSession :: a
   62                   -> Int   -- ^ recv buffer size
   63                   -> CInt  -- ^ network socket
   64                   -> IO () -- ^ action to block waiting for handshake
   65                   -> IO (ListenSocketSession a)
   66 
   67     endSession    :: a -> ListenSocketSession a -> IO ()
   68 
   69     recv :: a
   70          -> IO ()                 -- ^ action to block waiting for data
   71          -> ListenSocketSession a  -- ^ session
   72          -> IO (Maybe ByteString)
   73 
   74     send :: a
   75          -> IO ()                 -- ^ action to tickle the timeout
   76          -> IO ()                 -- ^ action to block waiting for data
   77          -> ListenSocketSession a  -- ^ session
   78          -> ByteString            -- ^ data to send
   79          -> IO ()
   80 -}
   81 
   82 
   83 ------------------------------------------------------------------------------
   84 data ListenSocket = ListenHttp  Socket
   85                   | ListenHttps Socket (Ptr Word) (Ptr Word)
   86 
   87 instance Show ListenSocket where
   88     show (ListenHttp s) = "ListenHttp (" ++ show s ++ ")"
   89     show (ListenHttps s _ _) = "ListenHttps (" ++ show s ++ ")"
   90 
   91 
   92 ------------------------------------------------------------------------------
   93 data NetworkSession = NetworkSession
   94   { _socket     :: CInt
   95   , _session    :: Ptr Word
   96   , _recvLen    :: Int
   97   }