http-semantics-0.0.0: HTTP senmatics libarry
Safe HaskellSafe-Inferred
LanguageHaskell2010

Network.HTTP.Semantics

Description

Library for HTTP Semantics (RFC9110), version-independent common parts. For low-level headers, Token is used. For upper-level headers, HeaderName should be used.

Synopsis

Request/response as input

data InpObj Source #

Input object

Constructors

InpObj 

Fields

Instances

Instances details
Show InpObj Source # 
Instance details

Defined in Network.HTTP.Semantics.Types

Request/response as output

data OutObj Source #

Output object

Constructors

OutObj 

Fields

Instances

Instances details
Show OutObj Source # 
Instance details

Defined in Network.HTTP.Semantics.Types

data OutBody Source #

Constructors

OutBodyNone 
OutBodyStreaming ((Builder -> IO ()) -> IO () -> IO ())

Streaming body takes a write action and a flush action.

OutBodyStreamingUnmask ((forall x. IO x -> IO x) -> (Builder -> IO ()) -> IO () -> IO ())

Like OutBodyStreaming, but with a callback to unmask expections

This is used in the client: we spawn the new thread for the request body with exceptions masked, and provide the body of OutBodyStreamingUnmask with a callback to unmask them again (typically after installing an exception handler).

We do NOT support this in the server, as here the scope of the thread that is spawned for the server is the entire handler, not just the response streaming body.

TODO: The analogous change for the server-side would be to provide a similar unmask callback as the first argument in the Server type alias.

OutBodyBuilder Builder 
OutBodyFile FileSpec 

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

defaultTrailersMaker :: TrailersMaker Source #

TrailersMake to create no trailers.

data NextTrailersMaker Source #

Either the next trailers maker or final trailers.

File spec

type FileOffset = Int64 Source #

Offset for file.

type ByteCount = Int64 Source #

How many bytes to read

data FileSpec Source #

File specification.

Instances

Instances details
Show FileSpec Source # 
Instance details

Defined in Network.HTTP.Semantics.Types

Eq FileSpec Source # 
Instance details

Defined in Network.HTTP.Semantics.Types

Types

type Scheme = ByteString Source #

"http" or "https".

type Authority = String Source #

Authority.

type Path = ByteString Source #

Path.

Low-level headers.

type FieldName = ByteString Source #

Field name. Internal usage only.

type FieldValue = ByteString Source #

Field value.

type TokenHeader = (Token, FieldValue) Source #

TokenBased header.

type TokenHeaderList = [TokenHeader] Source #

TokenBased header list.

type TokenHeaderTable = (TokenHeaderList, ValueTable) Source #

A pair of token list and value table.

Value table

type ValueTable = Array Int (Maybe FieldValue) Source #

An array to get FieldValue quickly. getHeaderValue should be used. Internally, the key is tokenIx.

Deprecated

type HeaderTable = (TokenHeaderList, ValueTable) Source #

Deprecated: use TokenHeaderTable instead

A pair of token list and value table.

type HeaderValue = ByteString Source #

Deprecated: use FieldValue instead

Header value.

getHeaderValue :: Token -> ValueTable -> Maybe FieldValue Source #

Deprecated: use geFieldValue instead

Accessing FieldValue with Token.

Data type

data Token Source #

Internal representation for header keys.

Constructors

Token 

Fields

Instances

Instances details
Show Token Source # 
Instance details

Defined in Network.HTTP.Semantics.Token

Methods

showsPrec :: Int -> Token -> ShowS #

show :: Token -> String #

showList :: [Token] -> ShowS #

Eq Token Source # 
Instance details

Defined in Network.HTTP.Semantics.Token

Methods

(==) :: Token -> Token -> Bool #

(/=) :: Token -> Token -> Bool #

tokenCIKey :: Token -> ByteString Source #

Extracting a case insensitive header key from a token.

tokenFoldedKey :: Token -> ByteString Source #

Extracting a folded header key from a token.

toToken :: ByteString -> Token Source #

Making a token from a header key.

>>> toToken ":authority" == tokenAuthority
True
>>> toToken "foo"
Token {tokenIx = 73, shouldBeIndexed = True, isPseudo = False, tokenKey = "foo"}
>>> toToken ":bar"
Token {tokenIx = 73, shouldBeIndexed = True, isPseudo = True, tokenKey = ":bar"}

Ix

minTokenIx :: Int Source #

Minimum token index.

maxStaticTokenIx :: Int Source #

Maximun token index defined in the static table.

maxTokenIx :: Int Source #

Maximum token index.

cookieTokenIx :: Int Source #

Token index for tokenCookie.

Utilities

isMaxTokenIx :: Int -> Bool Source #

Is this token ix to be held in the place holder?

isCookieTokenIx :: Int -> Bool Source #

Is this token ix for Cookie?

isStaticTokenIx :: Int -> Bool Source #

Is this token ix for a header not defined in the static table?

isStaticToken :: Token -> Bool Source #

Is this token for a header not defined in the static table?

Defined tokens

tokenConnection :: Token Source #

A place holder to hold header keys not defined in the static table. | For Warp