module Network.HTTP2.Server.Types where

import Network.Socket (SockAddr)
import qualified System.TimeManager as T

import Imports
import Network.HTTP2.H2

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

-- | 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.
type Server = Request -> Aux -> (Response -> [PushPromise] -> IO ()) -> IO ()

-- | Request from client.
newtype Request = Request InpObj deriving (Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Request -> ShowS
showsPrec :: Int -> Request -> ShowS
$cshow :: Request -> String
show :: Request -> String
$cshowList :: [Request] -> ShowS
showList :: [Request] -> ShowS
Show)

-- | Response from server.
newtype Response = Response OutObj deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Response -> ShowS
showsPrec :: Int -> Response -> ShowS
$cshow :: Response -> String
show :: Response -> String
$cshowList :: [Response] -> ShowS
showList :: [Response] -> ShowS
Show)

-- | 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.
    }

-- | Additional information.
data Aux = Aux
    { Aux -> Handle
auxTimeHandle :: T.Handle
    -- ^ Time handle for the worker processing this request and response.
    , Aux -> SockAddr
auxMySockAddr :: SockAddr
    -- ^ Local socket address copied from 'Config'.
    , Aux -> SockAddr
auxPeerSockAddr :: SockAddr
    -- ^ Remove socket address copied from 'Config'.
    }