{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP2.Server (
run
, Config(..)
, allocSimpleConfig
, freeSimpleConfig
, Server
, Request
, requestMethod
, requestPath
, requestAuthority
, requestScheme
, requestHeaders
, requestBodySize
, getRequestBodyChunk
, getRequestTrailers
, Aux
, auxTimeHandle
, Response
, responseNoBody
, responseFile
, responseStreaming
, responseBuilder
, responseBodySize
, TrailersMaker
, NextTrailersMaker(..)
, defaultTrailersMaker
, setResponseTrailersMaker
, PushPromise
, pushPromise
, promiseRequestPath
, promiseResponse
, promiseWeight
, defaultWeight
, Path
, Authority
, Scheme
, FileSpec(..)
, FileOffset
, ByteCount
, defaultReadN
, PositionReadMaker
, PositionRead
, Sentinel(..)
, defaultPositionReadMaker
) where
import Data.ByteString.Builder (Builder)
import Data.IORef (readIORef)
import qualified Network.HTTP.Types as H
import Imports
import Network.HPACK
import Network.HPACK.Token
import Network.HTTP2.Arch
import Network.HTTP2.Frame.Types
import Network.HTTP2.Server.Run (run)
import Network.HTTP2.Server.Types
requestMethod :: Request -> Maybe H.Method
requestMethod :: Request -> Maybe Method
requestMethod (Request InpObj
req) = Token -> ValueTable -> Maybe Method
getHeaderValue Token
tokenMethod ValueTable
vt
where
(TokenHeaderList
_,ValueTable
vt) = InpObj -> (TokenHeaderList, ValueTable)
inpObjHeaders InpObj
req
requestPath :: Request -> Maybe Path
requestPath :: Request -> Maybe Method
requestPath (Request InpObj
req) = Token -> ValueTable -> Maybe Method
getHeaderValue Token
tokenPath ValueTable
vt
where
(TokenHeaderList
_,ValueTable
vt) = InpObj -> (TokenHeaderList, ValueTable)
inpObjHeaders InpObj
req
requestAuthority :: Request -> Maybe Authority
requestAuthority :: Request -> Maybe Method
requestAuthority (Request InpObj
req) = Token -> ValueTable -> Maybe Method
getHeaderValue Token
tokenAuthority ValueTable
vt
where
(TokenHeaderList
_,ValueTable
vt) = InpObj -> (TokenHeaderList, ValueTable)
inpObjHeaders InpObj
req
requestScheme :: Request -> Maybe Scheme
requestScheme :: Request -> Maybe Method
requestScheme (Request InpObj
req) = Token -> ValueTable -> Maybe Method
getHeaderValue Token
tokenScheme ValueTable
vt
where
(TokenHeaderList
_,ValueTable
vt) = InpObj -> (TokenHeaderList, ValueTable)
inpObjHeaders InpObj
req
requestHeaders :: Request -> HeaderTable
(Request InpObj
req) = InpObj -> (TokenHeaderList, ValueTable)
inpObjHeaders InpObj
req
requestBodySize :: Request -> Maybe Int
requestBodySize :: Request -> Maybe Int
requestBodySize (Request InpObj
req) = InpObj -> Maybe Int
inpObjBodySize InpObj
req
getRequestBodyChunk :: Request -> IO ByteString
getRequestBodyChunk :: Request -> IO Method
getRequestBodyChunk (Request InpObj
req) = InpObj -> IO Method
inpObjBody InpObj
req
getRequestTrailers :: Request -> IO (Maybe HeaderTable)
getRequestTrailers :: Request -> IO (Maybe (TokenHeaderList, ValueTable))
getRequestTrailers (Request InpObj
req) = IORef (Maybe (TokenHeaderList, ValueTable))
-> IO (Maybe (TokenHeaderList, ValueTable))
forall a. IORef a -> IO a
readIORef (InpObj -> IORef (Maybe (TokenHeaderList, ValueTable))
inpObjTrailers InpObj
req)
responseNoBody :: H.Status -> H.ResponseHeaders -> Response
responseNoBody :: Status -> ResponseHeaders -> Response
responseNoBody Status
st ResponseHeaders
hdr = OutObj -> Response
Response (OutObj -> Response) -> OutObj -> Response
forall a b. (a -> b) -> a -> b
$ ResponseHeaders -> OutBody -> TrailersMaker -> OutObj
OutObj ResponseHeaders
hdr' OutBody
OutBodyNone TrailersMaker
defaultTrailersMaker
where
hdr' :: ResponseHeaders
hdr' = Status -> ResponseHeaders -> ResponseHeaders
setStatus Status
st ResponseHeaders
hdr
responseFile :: H.Status -> H.ResponseHeaders -> FileSpec -> Response
responseFile :: Status -> ResponseHeaders -> FileSpec -> Response
responseFile Status
st ResponseHeaders
hdr FileSpec
fileSpec = OutObj -> Response
Response (OutObj -> Response) -> OutObj -> Response
forall a b. (a -> b) -> a -> b
$ ResponseHeaders -> OutBody -> TrailersMaker -> OutObj
OutObj ResponseHeaders
hdr' (FileSpec -> OutBody
OutBodyFile FileSpec
fileSpec) TrailersMaker
defaultTrailersMaker
where
hdr' :: ResponseHeaders
hdr' = Status -> ResponseHeaders -> ResponseHeaders
setStatus Status
st ResponseHeaders
hdr
responseBuilder :: H.Status -> H.ResponseHeaders -> Builder -> Response
responseBuilder :: Status -> ResponseHeaders -> Builder -> Response
responseBuilder Status
st ResponseHeaders
hdr Builder
builder = OutObj -> Response
Response (OutObj -> Response) -> OutObj -> Response
forall a b. (a -> b) -> a -> b
$ ResponseHeaders -> OutBody -> TrailersMaker -> OutObj
OutObj ResponseHeaders
hdr' (Builder -> OutBody
OutBodyBuilder Builder
builder) TrailersMaker
defaultTrailersMaker
where
hdr' :: ResponseHeaders
hdr' = Status -> ResponseHeaders -> ResponseHeaders
setStatus Status
st ResponseHeaders
hdr
responseStreaming :: H.Status -> H.ResponseHeaders
-> ((Builder -> IO ()) -> IO () -> IO ())
-> Response
responseStreaming :: Status
-> ResponseHeaders
-> ((Builder -> IO ()) -> IO () -> IO ())
-> Response
responseStreaming Status
st ResponseHeaders
hdr (Builder -> IO ()) -> IO () -> IO ()
strmbdy = OutObj -> Response
Response (OutObj -> Response) -> OutObj -> Response
forall a b. (a -> b) -> a -> b
$ ResponseHeaders -> OutBody -> TrailersMaker -> OutObj
OutObj ResponseHeaders
hdr' (((Builder -> IO ()) -> IO () -> IO ()) -> OutBody
OutBodyStreaming (Builder -> IO ()) -> IO () -> IO ()
strmbdy) TrailersMaker
defaultTrailersMaker
where
hdr' :: ResponseHeaders
hdr' = Status -> ResponseHeaders -> ResponseHeaders
setStatus Status
st ResponseHeaders
hdr
responseBodySize :: Response -> Maybe Int
responseBodySize :: Response -> Maybe Int
responseBodySize (Response (OutObj ResponseHeaders
_ (OutBodyFile (FileSpec FilePath
_ FileOffset
_ FileOffset
len)) TrailersMaker
_)) = Int -> Maybe Int
forall a. a -> Maybe a
Just (FileOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
len)
responseBodySize Response
_ = Maybe Int
forall a. Maybe a
Nothing
setResponseTrailersMaker :: Response -> TrailersMaker -> Response
setResponseTrailersMaker :: Response -> TrailersMaker -> Response
setResponseTrailersMaker (Response OutObj
rsp) TrailersMaker
tm = OutObj -> Response
Response OutObj
rsp { outObjTrailers :: TrailersMaker
outObjTrailers = TrailersMaker
tm }
pushPromise :: ByteString -> Response -> Weight -> PushPromise
pushPromise :: Method -> Response -> Int -> PushPromise
pushPromise Method
path Response
rsp Int
w = Method -> Response -> Int -> PushPromise
PushPromise Method
path Response
rsp Int
w