{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | HTTP\/2 server library.
--
--  Example:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > module Main (main) where
-- >
-- > import Control.Concurrent (forkFinally)
-- > import Control.Exception (SomeException(..))
-- > import qualified Control.Exception as E
-- > import Control.Monad (forever, void)
-- > import Data.ByteString.Builder (byteString)
-- > import Network.HTTP.Types (ok200)
-- > import Network.HTTP2.Server
-- > import Network.Socket
-- >
-- > main :: IO ()
-- > main = runTCPServer "80" $ \s _peer -> runHTTP2Server s
-- >   where
-- >     runHTTP2Server s = E.bracket (allocSimpleConfig s 4096)
-- >                                  (\config -> run config server)
-- >                                  freeSimpleConfig
-- >     server _req _aux sendResponse = sendResponse response []
-- >       where
-- >         response = responseBuilder ok200 header body
-- >         header = [("Content-Type", "text/plain")]
-- >         body = byteString "Hello, world!\n"
-- >
-- > runTCPServer :: String -> (Socket -> SockAddr -> IO a) -> IO a
-- > runTCPServer port server = withSocketsDo $ do
-- >     addr <- resolve
-- >     E.bracket (open addr) close loop
-- >   where
-- >     resolve = do
-- >         let hints = defaultHints {
-- >                 addrFlags = [AI_PASSIVE]
-- >               , addrSocketType = Stream
-- >               }
-- >         head <$> getAddrInfo (Just hints) Nothing (Just port)
-- >     open addr = do
-- >         sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
-- >         setSocketOption sock ReuseAddr 1
-- >         withFdSocket sock $ setCloseOnExecIfNeeded
-- >         bind sock $ addrAddress addr
-- >         listen sock 1024
-- >         return sock
-- >     loop sock = forever $ do
-- >         (conn, peer) <- accept sock
-- >         void $ forkFinally (server conn peer) (clear conn)
-- >     clear conn _ = shutdown conn ShutdownSend `E.catch` ignore
-- >       where
-- >         ignore (SomeException _) = return ()

module Network.HTTP2.Server (
  -- * Runner
    run
  -- * Runner arguments
  , Config(..)
  , allocSimpleConfig
  , freeSimpleConfig
  , makeSimpleConfig
  -- * HTTP/2 server
  , Server
  -- * Request
  , Request
  , requestHeaders
  , requestBodySize
  , getRequestBodyChunk
  , getRequestTrailers
  -- * Aux
  , Aux
  , auxTimeHandle
  -- * Response
  , Response
  -- ** Creating response
  , responseNoBody
  , responseFile
  , responseStreaming
  , responseBuilder
  -- ** Accessing response
  , responseStatus
  , responseBodySize
  -- ** Trailers maker
  , TrailersMaker
  , NextTrailersMaker(..)
  , defaultTrailersMaker
  , setResponseTrailersMaker
  -- * Push promise
  , PushPromise
  , pushPromise
  , promiseRequestPath
  , promiseResponse
  , promiseWeight
  -- * Types
  , FileSpec(..)
  , FileOffset
  , ByteCount
  -- * RecvN
  , defaultReadN
  -- * Position read for files
  , PositionReadMaker
  , PositionRead
  , Sentinel(..)
  , defaultPositionReadMaker
  ) where

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

import Imports
import Network.HPACK
import Network.HTTP2.Server.API
import Network.HTTP2.Server.Config
import Network.HTTP2.Server.File (defaultPositionReadMaker)
import Network.HTTP2.Server.ReadN (defaultReadN)
import Network.HTTP2.Server.Run (run)
import Network.HTTP2.Types

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

-- | Reading a chunk of the request body.
--   An empty 'ByteString' returned when finished.
getRequestBodyChunk :: Request -> IO ByteString
getRequestBodyChunk :: Request -> IO ByteString
getRequestBodyChunk = Request -> IO ByteString
requestBody

-- | Reading request trailers.
--   This function must be called after 'getRequestBodyChunk'
--   returns an empty.
getRequestTrailers :: Request -> IO (Maybe HeaderTable)
getRequestTrailers :: Request -> IO (Maybe HeaderTable)
getRequestTrailers = IORef (Maybe HeaderTable) -> IO (Maybe HeaderTable)
forall a. IORef a -> IO a
readIORef (IORef (Maybe HeaderTable) -> IO (Maybe HeaderTable))
-> (Request -> IORef (Maybe HeaderTable))
-> Request
-> IO (Maybe HeaderTable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> IORef (Maybe HeaderTable)
requestTrailers_

-- |Creating response without body.
responseNoBody :: H.Status -> H.ResponseHeaders -> Response
responseNoBody :: Status -> ResponseHeaders -> Response
responseNoBody Status
st ResponseHeaders
hdr = Status
-> ResponseHeaders -> ResponseBody -> TrailersMaker -> Response
Response Status
st ResponseHeaders
hdr ResponseBody
RspNoBody TrailersMaker
defaultTrailersMaker

-- |Creating response with file.
responseFile :: H.Status -> H.ResponseHeaders -> FileSpec -> Response
responseFile :: Status -> ResponseHeaders -> FileSpec -> Response
responseFile Status
st ResponseHeaders
hdr FileSpec
fileSpec = Status
-> ResponseHeaders -> ResponseBody -> TrailersMaker -> Response
Response Status
st ResponseHeaders
hdr (FileSpec -> ResponseBody
RspFile FileSpec
fileSpec) TrailersMaker
defaultTrailersMaker

-- |Creating response with builder.
responseBuilder :: H.Status -> H.ResponseHeaders -> Builder -> Response
responseBuilder :: Status -> ResponseHeaders -> Builder -> Response
responseBuilder Status
st ResponseHeaders
hdr Builder
builder = Status
-> ResponseHeaders -> ResponseBody -> TrailersMaker -> Response
Response Status
st ResponseHeaders
hdr (Builder -> ResponseBody
RspBuilder Builder
builder) TrailersMaker
defaultTrailersMaker
-- |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 = Status
-> ResponseHeaders -> ResponseBody -> TrailersMaker -> Response
Response Status
st ResponseHeaders
hdr (((Builder -> IO ()) -> IO () -> IO ()) -> ResponseBody
RspStreaming (Builder -> IO ()) -> IO () -> IO ()
strmbdy) TrailersMaker
defaultTrailersMaker

-- | Getter for response body size. This value is available for file body.
responseBodySize :: Response -> Maybe Int
responseBodySize :: Response -> Maybe Int
responseBodySize (Response Status
_ ResponseHeaders
_ (RspFile (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

-- | Setting 'TrailersMaker' to 'Response'.
setResponseTrailersMaker :: Response -> TrailersMaker -> Response
setResponseTrailersMaker :: Response -> TrailersMaker -> Response
setResponseTrailersMaker Response
rsp TrailersMaker
tm = Response
rsp { responseTrailers :: TrailersMaker
responseTrailers = TrailersMaker
tm }

-- | TrailersMake to create no trailers.
defaultTrailersMaker :: TrailersMaker
defaultTrailersMaker :: TrailersMaker
defaultTrailersMaker Maybe ByteString
Nothing = NextTrailersMaker -> IO NextTrailersMaker
forall (m :: * -> *) a. Monad m => a -> m a
return (NextTrailersMaker -> IO NextTrailersMaker)
-> NextTrailersMaker -> IO NextTrailersMaker
forall a b. (a -> b) -> a -> b
$ ResponseHeaders -> NextTrailersMaker
Trailers []
defaultTrailersMaker Maybe ByteString
_       = NextTrailersMaker -> IO NextTrailersMaker
forall (m :: * -> *) a. Monad m => a -> m a
return (NextTrailersMaker -> IO NextTrailersMaker)
-> NextTrailersMaker -> IO NextTrailersMaker
forall a b. (a -> b) -> a -> b
$ TrailersMaker -> NextTrailersMaker
NextTrailersMaker TrailersMaker
defaultTrailersMaker

-- | Creating push promise.
pushPromise :: ByteString -> Response -> Weight -> PushPromise
pushPromise :: ByteString -> Response -> Int -> PushPromise
pushPromise ByteString
path Response
rsp Int
w = ByteString -> Response -> Int -> PushPromise
PushPromise ByteString
path Response
rsp Int
w