    {-# LANGUAGE OverloadedStrings #-}

    module Network.HTTP.Semantics.Server (
        -- * HTTP server
        Server,

        -- * Request
        Request,

        -- ** Accessing request
        requestMethod,
        requestPath,
        requestAuthority,
        requestScheme,
        requestHeaders,
        requestBodySize,
        getRequestBodyChunk,
        getRequestBodyChunk',
        getRequestTrailers,

        -- * Aux
        Aux,
        auxTimeHandle,
        auxMySockAddr,
        auxPeerSockAddr,

        -- * Response
        Response,

        -- ** Creating response
        responseNoBody,
        responseFile,
        responseStreaming,
        responseBuilder,

        -- ** Generalized streaming interface
        OutBodyIface (..),
        responseStreamingIface,

        -- ** Accessing response
        responseBodySize,

        -- ** Trailers maker
        TrailersMaker,
        NextTrailersMaker (..),
        defaultTrailersMaker,
        setResponseTrailersMaker,

        -- * Push promise
        PushPromise (..),
        pushPromise,

        -- * Types
        Path,
        Authority,
        Scheme,
        FileSpec (..),
        FileOffset,
        ByteCount,
        module Network.HTTP.Semantics.ReadN,
        module Network.HTTP.Semantics.File,
    ) where

    import Data.ByteString (ByteString)
    import Data.ByteString.Builder (Builder)
    import qualified Data.ByteString.UTF8 as UTF8
    import Data.IORef
    import qualified Network.HTTP.Types as H

    import Network.HTTP.Semantics
    import Network.HTTP.Semantics.File
    import Network.HTTP.Semantics.ReadN
    import Network.HTTP.Semantics.Server.Internal
    import Network.HTTP.Semantics.Status

    ----------------------------------------------------------------

    -- | 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.
    --
    --   The sending function must only be called once.
    type Server = Request -> Aux -> (Response -> [PushPromise] -> IO ()) -> IO ()

    -- | 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'.
    data PushPromise = PushPromise
        { PushPromise -> ByteString
    promiseRequestPath :: ByteString
        -- ^ Accessor for a URL path in a push promise (a virtual request from a server).
        --   E.g. \"\/style\/default.css\".
        , PushPromise -> Response
    promiseResponse :: Response
        -- ^ Accessor for response actually pushed from a server.
        }

    ----------------------------------------------------------------

    -- | Getting the method from a request.
    requestMethod :: Request -> Maybe H.Method
    requestMethod :: Request -> Maybe ByteString
    requestMethod (Request InpObj
    req) = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenMethod ValueTable
    vt
      where
        (TokenHeaderList
    _, ValueTable
    vt) = InpObj -> (TokenHeaderList, ValueTable)
    inpObjHeaders InpObj
    req

    -- | Getting the path from a request.
    requestPath :: Request -> Maybe Path
    requestPath :: Request -> Maybe ByteString
    requestPath (Request InpObj
    req) = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenPath ValueTable
    vt
      where
        (TokenHeaderList
    _, ValueTable
    vt) = InpObj -> (TokenHeaderList, ValueTable)
    inpObjHeaders InpObj
    req

    -- | Getting the authority from a request.
    requestAuthority :: Request -> Maybe Authority
    requestAuthority :: Request -> Maybe Authority
    requestAuthority (Request InpObj
    req) = ByteString -> Authority
    UTF8.toString (ByteString -> Authority) -> Maybe ByteString -> Maybe Authority
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenAuthority ValueTable
    vt
      where
        (TokenHeaderList
    _, ValueTable
    vt) = InpObj -> (TokenHeaderList, ValueTable)
    inpObjHeaders InpObj
    req

    -- | Getting the scheme from a request.
    requestScheme :: Request -> Maybe Scheme
    requestScheme :: Request -> Maybe ByteString
    requestScheme (Request InpObj
    req) = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenScheme ValueTable
    vt
      where
        (TokenHeaderList
    _, ValueTable
    vt) = InpObj -> (TokenHeaderList, ValueTable)
    inpObjHeaders InpObj
    req

    -- | Getting the headers from a request.
    requestHeaders :: Request -> TokenHeaderTable
    requestHeaders :: Request -> (TokenHeaderList, ValueTable)
    requestHeaders (Request InpObj
    req) = InpObj -> (TokenHeaderList, ValueTable)
    inpObjHeaders InpObj
    req

    -- | Getting the body size from a request.
    requestBodySize :: Request -> Maybe Int
    requestBodySize :: Request -> Maybe Int
    requestBodySize (Request InpObj
    req) = InpObj -> Maybe Int
    inpObjBodySize InpObj
    req

    -- | Reading a chunk of the request body.
    --   An empty 'ByteString' returned when finished.
    getRequestBodyChunk :: Request -> IO ByteString
    getRequestBodyChunk :: Request -> IO ByteString
    getRequestBodyChunk = ((ByteString, Bool) -> ByteString)
    -> IO (ByteString, Bool) -> IO ByteString
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ByteString, Bool) -> ByteString
    forall a b. (a, b) -> a
    fst (IO (ByteString, Bool) -> IO ByteString)
    -> (Request -> IO (ByteString, Bool)) -> Request -> IO ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Request -> IO (ByteString, Bool)
    getRequestBodyChunk'

    -- | Generalization of 'getRequestBodyChunk' which also returns if the 'ByteString' is the final one
    getRequestBodyChunk' :: Request -> IO (ByteString, Bool)
    getRequestBodyChunk' :: Request -> IO (ByteString, Bool)
    getRequestBodyChunk' (Request InpObj
    req) = InpObj -> IO (ByteString, Bool)
    inpObjBody InpObj
    req

    -- | Reading request trailers.
    --   This function must be called after 'getRequestBodyChunk'
    --   returns an empty.
    getRequestTrailers :: Request -> IO (Maybe TokenHeaderTable)
    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)

    ----------------------------------------------------------------

    -- | Creating response without body.
    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

    -- | Creating response with file.
    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

    -- | Creating response with builder.
    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

    -- | Creating response with streaming.
    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

    -- | Generalization of 'responseStreaming'.
    responseStreamingIface
        :: H.Status
        -> H.ResponseHeaders
        -> (OutBodyIface -> IO ())
        -> Response
    responseStreamingIface :: Status -> ResponseHeaders -> (OutBodyIface -> IO ()) -> Response
    responseStreamingIface Status
    st ResponseHeaders
    hdr OutBodyIface -> IO ()
    strmbdy = OutObj -> Response
    Response (OutObj -> Response) -> OutObj -> Response
    forall a b. (a -> b) -> a -> b
    $ ResponseHeaders -> OutBody -> TrailersMaker -> OutObj
    OutObj ResponseHeaders
    hdr' ((OutBodyIface -> IO ()) -> OutBody
    OutBodyStreamingIface OutBodyIface -> IO ()
    strmbdy) TrailersMaker
    defaultTrailersMaker
      where
        hdr' :: ResponseHeaders
    hdr' = Status -> ResponseHeaders -> ResponseHeaders
    setStatus Status
    st ResponseHeaders
    hdr

    ----------------------------------------------------------------

    -- | Getter for response body size. This value is available for file body.
    responseBodySize :: Response -> Maybe Int
    responseBodySize :: Response -> Maybe Int
    responseBodySize (Response (OutObj ResponseHeaders
    _ (OutBodyFile (FileSpec Authority
    _ ByteCount
    _ ByteCount
    len)) TrailersMaker
    _)) = Int -> Maybe Int
    forall a. a -> Maybe a
    Just (ByteCount -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ByteCount
    len)
    responseBodySize Response
    _ = Maybe Int
    forall a. Maybe a
    Nothing

    -- | Setting 'TrailersMaker' to 'Response'.
    setResponseTrailersMaker :: Response -> TrailersMaker -> Response
    setResponseTrailersMaker :: Response -> TrailersMaker -> Response
    setResponseTrailersMaker (Response OutObj
    rsp) TrailersMaker
    tm = OutObj -> Response
    Response OutObj
    rsp{outObjTrailers = tm}

    ----------------------------------------------------------------

    -- | Creating push promise.
    --   The third argument is traditional, not used.
    pushPromise :: ByteString -> Response -> Int -> PushPromise
    pushPromise :: ByteString -> Response -> Int -> PushPromise
    pushPromise ByteString
    path Response
    rsp Int
    _ = ByteString -> Response -> PushPromise
    PushPromise ByteString
    path Response
    rsp