Safe Haskell | None |
---|---|
Language | Haskell2010 |
Network.HTTP2.Server
Description
HTTP/2 server library.
Example:
{-# LANGUAGE OverloadedStrings #-} module Main (main) where import qualified Control.Exception as E import Data.ByteString.Builder (byteString) import Network.HTTP.Types (ok200) import Network.Run.TCP (runTCPServer) -- network-run import Network.HTTP2.Server main :: IO () main = runTCPServer Nothing "80" runHTTP2Server where runHTTP2Server s = E.bracket (allocSimpleConfig s 4096) freeSimpleConfig (\config -> run defaultServerConfig config server) server _req _aux sendResponse = sendResponse response [] where response = responseBuilder ok200 header body header = [("Content-Type", "text/plain")] body = byteString "Hello, world!\n"
Synopsis
- run :: ServerConfig -> Config -> Server -> IO ()
- data ServerConfig
- defaultServerConfig :: ServerConfig
- numberOfWorkers :: ServerConfig -> Int
- connectionWindowSize :: ServerConfig -> WindowSize
- settings :: ServerConfig -> Settings
- data Settings
- defaultSettings :: Settings
- headerTableSize :: Settings -> Int
- enablePush :: Settings -> Bool
- maxConcurrentStreams :: Settings -> Maybe Int
- initialWindowSize :: Settings -> WindowSize
- maxFrameSize :: Settings -> Int
- maxHeaderListSize :: Settings -> Maybe Int
- pingRateLimit :: Settings -> Int
- settingsRateLimit :: Settings -> Int
- emptyFrameRateLimit :: Settings -> Int
- rstRateLimit :: Settings -> Int
- data Config = Config {
- confWriteBuffer :: Buffer
- confBufferSize :: BufferSize
- confSendAll :: ByteString -> IO ()
- confReadN :: Int -> IO ByteString
- confPositionReadMaker :: PositionReadMaker
- confTimeoutManager :: Manager
- confMySockAddr :: SockAddr
- confPeerSockAddr :: SockAddr
- allocSimpleConfig :: Socket -> BufferSize -> IO Config
- allocSimpleConfig' :: Socket -> BufferSize -> Int -> IO Config
- freeSimpleConfig :: Config -> IO ()
- data Request
- data Response
- data Aux
- type Server = Request -> Aux -> (Response -> [PushPromise] -> IO ()) -> IO ()
- data NextTrailersMaker
- type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker
- defaultTrailersMaker :: TrailersMaker
- type Authority = String
- type ByteCount = Int64
- type FileOffset = Int64
- data FileSpec = FileSpec FilePath FileOffset ByteCount
- data OutBodyIface = OutBodyIface {
- outBodyUnmask :: forall x. IO x -> IO x
- outBodyPush :: Builder -> IO ()
- outBodyPushFinal :: Builder -> IO ()
- outBodyCancel :: Maybe SomeException -> IO ()
- outBodyFlush :: IO ()
- type Path = ByteString
- type Scheme = ByteString
- type PositionReadMaker = FilePath -> IO (PositionRead, Sentinel)
- data Sentinel
- type PositionRead = FileOffset -> ByteCount -> Buffer -> IO ByteCount
- defaultPositionReadMaker :: PositionReadMaker
- type ReadN = Int -> IO ByteString
- defaultReadN :: Socket -> IORef (Maybe ByteString) -> ReadN
- responseBodySize :: Response -> Maybe Int
- pushPromise :: ByteString -> Response -> Int -> PushPromise
- data PushPromise = PushPromise {
- promiseRequestPath :: ByteString
- promiseResponse :: Response
- getRequestBodyChunk :: Request -> IO ByteString
- getRequestBodyChunk' :: Request -> IO (ByteString, Bool)
- getRequestTrailers :: Request -> IO (Maybe TokenHeaderTable)
- requestAuthority :: Request -> Maybe Authority
- requestBodySize :: Request -> Maybe Int
- requestHeaders :: Request -> TokenHeaderTable
- requestMethod :: Request -> Maybe Method
- requestPath :: Request -> Maybe Path
- requestScheme :: Request -> Maybe Scheme
- responseBuilder :: Status -> ResponseHeaders -> Builder -> Response
- responseFile :: Status -> ResponseHeaders -> FileSpec -> Response
- responseNoBody :: Status -> ResponseHeaders -> Response
- responseStreaming :: Status -> ResponseHeaders -> ((Builder -> IO ()) -> IO () -> IO ()) -> Response
- responseStreamingIface :: Status -> ResponseHeaders -> (OutBodyIface -> IO ()) -> Response
- setResponseTrailersMaker :: Response -> TrailersMaker -> Response
Runner
Server configuration
data ServerConfig Source #
Server configuration
Instances
Show ServerConfig Source # | |
Defined in Network.HTTP2.Server.Run Methods showsPrec :: Int -> ServerConfig -> ShowS show :: ServerConfig -> String showList :: [ServerConfig] -> ShowS | |
Eq ServerConfig Source # | |
Defined in Network.HTTP2.Server.Run |
defaultServerConfig :: ServerConfig Source #
The default server config.
>>>
defaultServerConfig
ServerConfig {numberOfWorkers = 8, connectionWindowSize = 16777216, settings = Settings {headerTableSize = 4096, enablePush = True, maxConcurrentStreams = Just 64, initialWindowSize = 262144, maxFrameSize = 16384, maxHeaderListSize = Nothing, pingRateLimit = 10, emptyFrameRateLimit = 4, settingsRateLimit = 4, rstRateLimit = 4}}
numberOfWorkers :: ServerConfig -> Int Source #
Deprecated: No effect anymore
Deprecated field.
connectionWindowSize :: ServerConfig -> WindowSize Source #
The window size of incoming streams
settings :: ServerConfig -> Settings Source #
Settings
HTTP/2 setting
HTTP/2 settings. See https://datatracker.ietf.org/doc/html/rfc9113#name-defined-settings.
Instances
defaultSettings :: Settings Source #
The default settings.
>>>
defaultSettings
Settings {headerTableSize = 4096, enablePush = True, maxConcurrentStreams = Just 64, initialWindowSize = 262144, maxFrameSize = 16384, maxHeaderListSize = Nothing, pingRateLimit = 10, emptyFrameRateLimit = 4, settingsRateLimit = 4, rstRateLimit = 4}
headerTableSize :: Settings -> Int Source #
SETTINGS_HEADER_TABLE_SIZE
enablePush :: Settings -> Bool Source #
SETTINGS_ENABLE_PUSH
maxConcurrentStreams :: Settings -> Maybe Int Source #
SETTINGS_MAX_CONCURRENT_STREAMS
initialWindowSize :: Settings -> WindowSize Source #
SETTINGS_INITIAL_WINDOW_SIZE
maxFrameSize :: Settings -> Int Source #
SETTINGS_MAX_FRAME_SIZE
maxHeaderListSize :: Settings -> Maybe Int Source #
SETTINGS_MAX_HEADER_LIST_SIZE
Rate limits
pingRateLimit :: Settings -> Int Source #
Maximum number of pings allowed per second (CVE-2019-9512)
settingsRateLimit :: Settings -> Int Source #
Maximum number of settings frames allowed per second (CVE-2019-9515)
emptyFrameRateLimit :: Settings -> Int Source #
Maximum number of empty data frames allowed per second (CVE-2019-9518)
rstRateLimit :: Settings -> Int Source #
Maximum number of reset frames allowed per second (CVE-2023-44487)
Common configuration
HTTP/2 configuration.
Constructors
Config | |
Fields
|
allocSimpleConfig :: Socket -> BufferSize -> IO Config Source #
Making simple configuration whose IO is not efficient. A write buffer is allocated internally. WAI timeout manger is initialized with 30_000_000 microseconds.
allocSimpleConfig' :: Socket -> BufferSize -> Int -> IO Config Source #
Making simple configuration whose IO is not efficient. A write buffer is allocated internally. The third argument is microseconds to initialize WAI timeout manager.
freeSimpleConfig :: Config -> IO () Source #
Deallocating the resource of the simple configuration.
data NextTrailersMaker #
Constructors
NextTrailersMaker TrailersMaker | |
Trailers [Header] |
type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker #
type FileOffset = Int64 #
Constructors
FileSpec FilePath FileOffset ByteCount |
data OutBodyIface #
Constructors
OutBodyIface | |
Fields
|
type PositionReadMaker = FilePath -> IO (PositionRead, Sentinel) #
type PositionRead = FileOffset -> ByteCount -> Buffer -> IO ByteCount #
defaultReadN :: Socket -> IORef (Maybe ByteString) -> ReadN #
responseBodySize :: Response -> Maybe Int #
pushPromise :: ByteString -> Response -> Int -> PushPromise #
data PushPromise #
Constructors
PushPromise | |
Fields
|
getRequestBodyChunk :: Request -> IO ByteString #
getRequestBodyChunk' :: Request -> IO (ByteString, Bool) #
getRequestTrailers :: Request -> IO (Maybe TokenHeaderTable) #
requestAuthority :: Request -> Maybe Authority #
requestBodySize :: Request -> Maybe Int #
requestMethod :: Request -> Maybe Method #
requestPath :: Request -> Maybe Path #
requestScheme :: Request -> Maybe Scheme #
responseBuilder :: Status -> ResponseHeaders -> Builder -> Response #
responseFile :: Status -> ResponseHeaders -> FileSpec -> Response #
responseNoBody :: Status -> ResponseHeaders -> Response #
responseStreaming :: Status -> ResponseHeaders -> ((Builder -> IO ()) -> IO () -> IO ()) -> Response #
responseStreamingIface :: Status -> ResponseHeaders -> (OutBodyIface -> IO ()) -> Response #