{-# LANGUAGE RankNTypes #-}
module Network.HTTP.Semantics.Types (
InpObj (..),
InpBody,
OutObj (..),
OutBody (..),
TrailersMaker,
defaultTrailersMaker,
NextTrailersMaker (..),
FileOffset,
ByteCount,
FileSpec (..),
Scheme,
Authority,
Path,
) where
import Data.ByteString.Builder (Builder)
import Data.IORef
import Data.Int (Int64)
import Network.ByteOrder
import qualified Network.HTTP.Types as H
import Network.HTTP.Semantics.Header
import Network.HTTP.Semantics.Trailer
type Scheme = ByteString
type Authority = String
type Path = ByteString
type InpBody = IO ByteString
data OutBody
= OutBodyNone
|
OutBodyStreaming ((Builder -> IO ()) -> IO () -> IO ())
|
OutBodyStreamingUnmask
((forall x. IO x -> IO x) -> (Builder -> IO ()) -> IO () -> IO ())
| OutBodyBuilder Builder
| OutBodyFile FileSpec
data InpObj = InpObj
{ :: TokenHeaderTable
, InpObj -> Maybe Int
inpObjBodySize :: Maybe Int
, InpObj -> InpBody
inpObjBody :: InpBody
, InpObj -> IORef (Maybe TokenHeaderTable)
inpObjTrailers :: IORef (Maybe TokenHeaderTable)
}
instance Show InpObj where
show :: InpObj -> String
show (InpObj (TokenHeaderList
thl, ValueTable
_) Maybe Int
_ InpBody
_body IORef (Maybe TokenHeaderTable)
_tref) = TokenHeaderList -> String
forall a. Show a => a -> String
show TokenHeaderList
thl
data OutObj = OutObj
{ :: [H.Header]
, OutObj -> OutBody
outObjBody :: OutBody
, OutObj -> TrailersMaker
outObjTrailers :: TrailersMaker
}
instance Show OutObj where
show :: OutObj -> String
show (OutObj [Header]
hdr OutBody
_ TrailersMaker
_) = [Header] -> String
forall a. Show a => a -> String
show [Header]
hdr
type FileOffset = Int64
type ByteCount = Int64
data FileSpec = FileSpec FilePath FileOffset ByteCount deriving (FileSpec -> FileSpec -> Bool
(FileSpec -> FileSpec -> Bool)
-> (FileSpec -> FileSpec -> Bool) -> Eq FileSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileSpec -> FileSpec -> Bool
== :: FileSpec -> FileSpec -> Bool
$c/= :: FileSpec -> FileSpec -> Bool
/= :: FileSpec -> FileSpec -> Bool
Eq, Int -> FileSpec -> ShowS
[FileSpec] -> ShowS
FileSpec -> String
(Int -> FileSpec -> ShowS)
-> (FileSpec -> String) -> ([FileSpec] -> ShowS) -> Show FileSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileSpec -> ShowS
showsPrec :: Int -> FileSpec -> ShowS
$cshow :: FileSpec -> String
show :: FileSpec -> String
$cshowList :: [FileSpec] -> ShowS
showList :: [FileSpec] -> ShowS
Show)