Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
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
- data Config = Config {}
- allocSimpleConfig :: Socket -> BufferSize -> IO Config
- freeSimpleConfig :: Config -> IO ()
- type Server = Request -> Aux -> (Response -> [PushPromise] -> IO ()) -> IO ()
- data Request
- requestMethod :: Request -> Maybe Method
- requestPath :: Request -> Maybe Path
- requestAuthority :: Request -> Maybe Authority
- requestScheme :: Request -> Maybe Scheme
- requestHeaders :: Request -> HeaderTable
- requestBodySize :: Request -> Maybe Int
- getRequestBodyChunk :: Request -> IO ByteString
- getRequestTrailers :: Request -> IO (Maybe HeaderTable)
- data Aux
- auxTimeHandle :: Aux -> Handle
- auxMySockAddr :: Aux -> SockAddr
- auxPeerSockAddr :: Aux -> SockAddr
- data Response
- responseNoBody :: Status -> ResponseHeaders -> Response
- responseFile :: Status -> ResponseHeaders -> FileSpec -> Response
- responseStreaming :: Status -> ResponseHeaders -> ((Builder -> IO ()) -> IO () -> IO ()) -> Response
- responseBuilder :: Status -> ResponseHeaders -> Builder -> Response
- responseBodySize :: Response -> Maybe Int
- type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker
- data NextTrailersMaker
- defaultTrailersMaker :: TrailersMaker
- setResponseTrailersMaker :: Response -> TrailersMaker -> Response
- data PushPromise
- pushPromise :: ByteString -> Response -> Weight -> PushPromise
- promiseRequestPath :: PushPromise -> ByteString
- promiseResponse :: PushPromise -> Response
- type Path = ByteString
- type Authority = ByteString
- type Scheme = ByteString
- data FileSpec = FileSpec FilePath FileOffset ByteCount
- type FileOffset = Int64
- type ByteCount = Int64
- defaultReadN :: Socket -> IORef (Maybe ByteString) -> Int -> IO ByteString
- type PositionReadMaker = FilePath -> IO (PositionRead, Sentinel)
- type PositionRead = FileOffset -> ByteCount -> Buffer -> IO ByteCount
- data Sentinel
- defaultPositionReadMaker :: PositionReadMaker
Runner
Server configuration
data ServerConfig Source #
Server configuration
Instances
Show ServerConfig Source # | |
Defined in Network.HTTP2.Server.Run showsPrec :: Int -> ServerConfig -> ShowS # show :: ServerConfig -> String # showList :: [ServerConfig] -> ShowS # | |
Eq ServerConfig Source # | |
Defined in Network.HTTP2.Server.Run (==) :: ServerConfig -> ServerConfig -> Bool # (/=) :: ServerConfig -> ServerConfig -> Bool # |
defaultServerConfig :: ServerConfig Source #
The default server config.
>>>
defaultServerConfig
ServerConfig {numberOfWorkers = 8, connectionWindowSize = 1048576, settings = Settings {headerTableSize = 4096, enablePush = True, maxConcurrentStreams = Just 64, initialWindowSize = 262144, maxFrameSize = 16384, maxHeaderListSize = Nothing}}
numberOfWorkers :: ServerConfig -> Int Source #
The number of workers
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}
headerTableSize :: Settings -> Int Source #
SETTINGS_HEADER_TABLE_SIZE
enablePush :: Settings -> Bool Source #
SETTINGS_ENABLE_PUSH
initialWindowSize :: Settings -> WindowSize Source #
SETTINGS_INITIAL_WINDOW_SIZE
maxFrameSize :: Settings -> Int Source #
SETTINGS_MAX_FRAME_SIZE
Common configuration
HTTP/2 configuration.
Config | |
|
allocSimpleConfig :: Socket -> BufferSize -> IO Config Source #
Making simple configuration whose IO is not efficient. A write buffer is allocated internally.
freeSimpleConfig :: Config -> IO () Source #
Deallocating the resource of the simple configuration.
HTTP/2 server
type Server = Request -> Aux -> (Response -> [PushPromise] -> IO ()) -> IO () Source #
Server type. Server takes a HTTP request, should generate a HTTP response and push promises, then should give them to the sending function. The sending function would throw exceptions so that they can be logged.
Request
Request from client.
Accessing request
requestHeaders :: Request -> HeaderTable Source #
Getting the headers from a request.
getRequestBodyChunk :: Request -> IO ByteString Source #
Reading a chunk of the request body.
An empty ByteString
returned when finished.
getRequestTrailers :: Request -> IO (Maybe HeaderTable) Source #
Reading request trailers.
This function must be called after getRequestBodyChunk
returns an empty.
Aux
auxTimeHandle :: Aux -> Handle Source #
Time handle for the worker processing this request and response.
Response
Response from server.
Creating response
responseNoBody :: Status -> ResponseHeaders -> Response Source #
Creating response without body.
responseFile :: Status -> ResponseHeaders -> FileSpec -> Response Source #
Creating response with file.
responseStreaming :: Status -> ResponseHeaders -> ((Builder -> IO ()) -> IO () -> IO ()) -> Response Source #
Creating response with streaming.
responseBuilder :: Status -> ResponseHeaders -> Builder -> Response Source #
Creating response with builder.
Accessing response
responseBodySize :: Response -> Maybe Int Source #
Getter for response body size. This value is available for file body.
Trailers maker
type TrailersMaker = Maybe ByteString -> IO NextTrailersMaker Source #
Trailers maker. A chunks of the response body is passed
with Just
. The maker should update internal state
with the ByteString
and return the next trailers maker.
When response body reaches its end,
Nothing
is passed and the maker should generate
trailers. An example:
{-# LANGUAGE BangPatterns #-} import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C8 import Crypto.Hash (Context, SHA1) -- cryptonite import qualified Crypto.Hash as CH -- Strictness is important for Context. trailersMaker :: Context SHA1 -> Maybe ByteString -> IO NextTrailersMaker trailersMaker ctx Nothing = return $ Trailers [("X-SHA1", sha1)] where !sha1 = C8.pack $ show $ CH.hashFinalize ctx trailersMaker ctx (Just bs) = return $ NextTrailersMaker $ trailersMaker ctx' where !ctx' = CH.hashUpdate ctx bs
Usage example:
let h2rsp = responseFile ... maker = trailersMaker (CH.hashInit :: Context SHA1) h2rsp' = setResponseTrailersMaker h2rsp maker
data NextTrailersMaker Source #
Either the next trailers maker or final trailers.
defaultTrailersMaker :: TrailersMaker Source #
TrailersMake to create no trailers.
setResponseTrailersMaker :: Response -> TrailersMaker -> Response Source #
Setting TrailersMaker
to Response
.
Push promise
data PushPromise Source #
HTTP/2 push promise or sever push.
Pseudo REQUEST headers in push promise is automatically generated.
Then, a server push is sent according to promiseResponse
.
pushPromise :: ByteString -> Response -> Weight -> PushPromise Source #
Creating push promise. The third argument is traditional, not used.
promiseRequestPath :: PushPromise -> ByteString Source #
Accessor for a URL path in a push promise (a virtual request from a server). E.g. "/style/default.css".
promiseResponse :: PushPromise -> Response Source #
Accessor for response actually pushed from a server.
Types
type Path = ByteString Source #
Path.
type Authority = ByteString Source #
Authority.
type Scheme = ByteString Source #
"http" or "https".
File specification.
type FileOffset = Int64 Source #
Offset for file.
RecvN
defaultReadN :: Socket -> IORef (Maybe ByteString) -> Int -> IO ByteString Source #
Naive implementation for readN.
Position read for files
type PositionReadMaker = FilePath -> IO (PositionRead, Sentinel) Source #
Making a position read and its closer.
type PositionRead = FileOffset -> ByteCount -> Buffer -> IO ByteCount Source #
Position read for files.
Manipulating a file resource.
defaultPositionReadMaker :: PositionReadMaker Source #
Position read based on Handle
.