{-# LANGUAGE RankNTypes #-}

module Network.HTTP.Semantics.Types (
    -- * Request/response as input
    InpObj (..),
    InpBody,

    -- * Request/response as output
    OutObj (..),
    OutBody (..),

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

    -- * File spec
    FileOffset,
    ByteCount,
    FileSpec (..),

    -- * Types
    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

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

-- | "http" or "https".
type Scheme = ByteString

-- | Authority.
type Authority = String

-- | Path.
type Path = ByteString

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

type InpBody = IO ByteString

data OutBody
    = OutBodyNone
    | -- | Streaming body takes a write action and a flush action.
      OutBodyStreaming ((Builder -> IO ()) -> IO () -> IO ())
    | -- | Like 'OutBodyStreaming', but with a callback to unmask expections
      --
      -- This is used in the client: we spawn the new thread for the request body
      -- with exceptions masked, and provide the body of 'OutBodyStreamingUnmask'
      -- with a callback to unmask them again (typically after installing an exception
      -- handler).
      --
      -- We do /NOT/ support this in the server, as here the scope of the thread
      -- that is spawned for the server is the entire handler, not just the response
      -- streaming body.
      --
      -- TODO: The analogous change for the server-side would be to provide a similar
      -- @unmask@ callback as the first argument in the 'Server' type alias.
      OutBodyStreamingUnmask
        ((forall x. IO x -> IO x) -> (Builder -> IO ()) -> IO () -> IO ())
    | OutBodyBuilder Builder
    | OutBodyFile FileSpec

-- | Input object
data InpObj = InpObj
    { InpObj -> TokenHeaderTable
inpObjHeaders :: TokenHeaderTable
    -- ^ Accessor for headers.
    , InpObj -> Maybe Int
inpObjBodySize :: Maybe Int
    -- ^ Accessor for body length specified in content-length:.
    , InpObj -> InpBody
inpObjBody :: InpBody
    -- ^ Accessor for body.
    , InpObj -> IORef (Maybe TokenHeaderTable)
inpObjTrailers :: IORef (Maybe TokenHeaderTable)
    -- ^ Accessor for trailers.
    }

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

-- | Output object
data OutObj = OutObj
    { OutObj -> [Header]
outObjHeaders :: [H.Header]
    -- ^ Accessor for header.
    , OutObj -> OutBody
outObjBody :: OutBody
    -- ^ Accessor for outObj body.
    , OutObj -> TrailersMaker
outObjTrailers :: TrailersMaker
    -- ^ Accessor for trailers maker.
    }

instance Show OutObj where
    show :: OutObj -> String
show (OutObj [Header]
hdr OutBody
_ TrailersMaker
_) = [Header] -> String
forall a. Show a => a -> String
show [Header]
hdr

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

-- | Offset for file.
type FileOffset = Int64

-- | How many bytes to read
type ByteCount = Int64

-- | File specification.
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)