{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module Network.HTTP.Semantics.Client (
    -- * HTTP client
    Client,
    SendRequest,

    -- * Request
    Request,

    -- * Creating request
    requestNoBody,
    requestFile,
    requestStreaming,
    requestStreamingUnmask,
    requestBuilder,

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

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

    -- * Response
    Response,

    -- ** Accessing response
    responseStatus,
    responseHeaders,
    responseBodySize,
    getResponseBodyChunk,
    getResponseBodyChunk',
    getResponseTrailers,

    -- * Aux
    Aux,
    defaultAux,
    auxPossibleClientStreams,
    auxSendPing,

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

import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import Data.IORef (readIORef)
import Network.HTTP.Types (Method, RequestHeaders, Status)

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

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

-- | Send a request and receive its response.
type SendRequest = forall r. Request -> (Response -> IO r) -> IO r

-- | Client type.
type Client a = SendRequest -> Aux -> IO a

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

-- | Creating request without body.
requestNoBody :: Method -> Path -> RequestHeaders -> Request
requestNoBody :: ByteString -> ByteString -> RequestHeaders -> Request
requestNoBody ByteString
m ByteString
p RequestHeaders
hdr = OutObj -> Request
Request (OutObj -> Request) -> OutObj -> Request
forall a b. (a -> b) -> a -> b
$ RequestHeaders -> OutBody -> TrailersMaker -> OutObj
OutObj RequestHeaders
hdr' OutBody
OutBodyNone TrailersMaker
defaultTrailersMaker
  where
    hdr' :: RequestHeaders
hdr' = ByteString -> ByteString -> RequestHeaders -> RequestHeaders
addHeaders ByteString
m ByteString
p RequestHeaders
hdr

-- | Creating request with file.
requestFile :: Method -> Path -> RequestHeaders -> FileSpec -> Request
requestFile :: ByteString -> ByteString -> RequestHeaders -> FileSpec -> Request
requestFile ByteString
m ByteString
p RequestHeaders
hdr FileSpec
fileSpec = OutObj -> Request
Request (OutObj -> Request) -> OutObj -> Request
forall a b. (a -> b) -> a -> b
$ RequestHeaders -> OutBody -> TrailersMaker -> OutObj
OutObj RequestHeaders
hdr' (FileSpec -> OutBody
OutBodyFile FileSpec
fileSpec) TrailersMaker
defaultTrailersMaker
  where
    hdr' :: RequestHeaders
hdr' = ByteString -> ByteString -> RequestHeaders -> RequestHeaders
addHeaders ByteString
m ByteString
p RequestHeaders
hdr

-- | Creating request with builder.
requestBuilder :: Method -> Path -> RequestHeaders -> Builder -> Request
requestBuilder :: ByteString -> ByteString -> RequestHeaders -> Builder -> Request
requestBuilder ByteString
m ByteString
p RequestHeaders
hdr Builder
builder = OutObj -> Request
Request (OutObj -> Request) -> OutObj -> Request
forall a b. (a -> b) -> a -> b
$ RequestHeaders -> OutBody -> TrailersMaker -> OutObj
OutObj RequestHeaders
hdr' (Builder -> OutBody
OutBodyBuilder Builder
builder) TrailersMaker
defaultTrailersMaker
  where
    hdr' :: RequestHeaders
hdr' = ByteString -> ByteString -> RequestHeaders -> RequestHeaders
addHeaders ByteString
m ByteString
p RequestHeaders
hdr

-- | Creating request with streaming.
requestStreaming
    :: Method
    -> Path
    -> RequestHeaders
    -> ((Builder -> IO ()) -> IO () -> IO ())
    -> Request
requestStreaming :: ByteString
-> ByteString
-> RequestHeaders
-> ((Builder -> IO ()) -> IO () -> IO ())
-> Request
requestStreaming ByteString
m ByteString
p RequestHeaders
hdr (Builder -> IO ()) -> IO () -> IO ()
strmbdy = OutObj -> Request
Request (OutObj -> Request) -> OutObj -> Request
forall a b. (a -> b) -> a -> b
$ RequestHeaders -> OutBody -> TrailersMaker -> OutObj
OutObj RequestHeaders
hdr' (((Builder -> IO ()) -> IO () -> IO ()) -> OutBody
OutBodyStreaming (Builder -> IO ()) -> IO () -> IO ()
strmbdy) TrailersMaker
defaultTrailersMaker
  where
    hdr' :: RequestHeaders
hdr' = ByteString -> ByteString -> RequestHeaders -> RequestHeaders
addHeaders ByteString
m ByteString
p RequestHeaders
hdr

-- | Like 'requestStreaming', but run the action with exceptions masked
requestStreamingUnmask
    :: Method
    -> Path
    -> RequestHeaders
    -> ((forall x. IO x -> IO x) -> (Builder -> IO ()) -> IO () -> IO ())
    -> Request
requestStreamingUnmask :: ByteString
-> ByteString
-> RequestHeaders
-> ((forall x. IO x -> IO x)
    -> (Builder -> IO ()) -> IO () -> IO ())
-> Request
requestStreamingUnmask ByteString
m ByteString
p RequestHeaders
hdr (forall x. IO x -> IO x) -> (Builder -> IO ()) -> IO () -> IO ()
strmbdy = ByteString
-> ByteString
-> RequestHeaders
-> (OutBodyIface -> IO ())
-> Request
requestStreamingIface ByteString
m ByteString
p RequestHeaders
hdr ((OutBodyIface -> IO ()) -> Request)
-> (OutBodyIface -> IO ()) -> Request
forall a b. (a -> b) -> a -> b
$ \OutBodyIface
iface ->
    (forall x. IO x -> IO x) -> (Builder -> IO ()) -> IO () -> IO ()
strmbdy (OutBodyIface -> forall x. IO x -> IO x
outBodyUnmask OutBodyIface
iface) (OutBodyIface -> Builder -> IO ()
outBodyPush OutBodyIface
iface) (OutBodyIface -> IO ()
outBodyFlush OutBodyIface
iface)

-- | Generalized version of 'requestStreaming',
requestStreamingIface
    :: Method
    -> Path
    -> RequestHeaders
    -> (OutBodyIface -> IO ())
    -> Request
requestStreamingIface :: ByteString
-> ByteString
-> RequestHeaders
-> (OutBodyIface -> IO ())
-> Request
requestStreamingIface ByteString
m ByteString
p RequestHeaders
hdr OutBodyIface -> IO ()
strmbdy = OutObj -> Request
Request (OutObj -> Request) -> OutObj -> Request
forall a b. (a -> b) -> a -> b
$ RequestHeaders -> OutBody -> TrailersMaker -> OutObj
OutObj RequestHeaders
hdr' ((OutBodyIface -> IO ()) -> OutBody
OutBodyStreamingIface OutBodyIface -> IO ()
strmbdy) TrailersMaker
defaultTrailersMaker
  where
    hdr' :: RequestHeaders
hdr' = ByteString -> ByteString -> RequestHeaders -> RequestHeaders
addHeaders ByteString
m ByteString
p RequestHeaders
hdr

addHeaders :: Method -> Path -> RequestHeaders -> RequestHeaders
addHeaders :: ByteString -> ByteString -> RequestHeaders -> RequestHeaders
addHeaders ByteString
m ByteString
p RequestHeaders
hdr = (HeaderName
":method", ByteString
m) Header -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: (HeaderName
":path", ByteString
p) Header -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: RequestHeaders
hdr

-- | Setting 'TrailersMaker' to 'Response'.
setRequestTrailersMaker :: Request -> TrailersMaker -> Request
setRequestTrailersMaker :: Request -> TrailersMaker -> Request
setRequestTrailersMaker (Request OutObj
req) TrailersMaker
tm = OutObj -> Request
Request OutObj
req{outObjTrailers = tm}

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

-- | Getting the status of a response.
responseStatus :: Response -> Maybe Status
responseStatus :: Response -> Maybe Status
responseStatus (Response InpObj
rsp) = TokenHeaderTable -> Maybe Status
getStatus (TokenHeaderTable -> Maybe Status)
-> TokenHeaderTable -> Maybe Status
forall a b. (a -> b) -> a -> b
$ InpObj -> TokenHeaderTable
inpObjHeaders InpObj
rsp

-- | Getting the headers from a response.
responseHeaders :: Response -> TokenHeaderTable
responseHeaders :: Response -> TokenHeaderTable
responseHeaders (Response InpObj
rsp) = InpObj -> TokenHeaderTable
inpObjHeaders InpObj
rsp

-- | Getting the body size from a response.
responseBodySize :: Response -> Maybe Int
responseBodySize :: Response -> Maybe Int
responseBodySize (Response InpObj
rsp) = InpObj -> Maybe Int
inpObjBodySize InpObj
rsp

-- | Reading a chunk of the response body.
--   An empty 'ByteString' returned when finished.
getResponseBodyChunk :: Response -> IO ByteString
getResponseBodyChunk :: Response -> IO ByteString
getResponseBodyChunk = ((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)
-> (Response -> IO (ByteString, Bool)) -> Response -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> IO (ByteString, Bool)
getResponseBodyChunk'

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

-- | Reading response trailers.
--   This function must be called after 'getResponseBodyChunk'
--   returns an empty.
getResponseTrailers :: Response -> IO (Maybe TokenHeaderTable)
getResponseTrailers :: Response -> IO (Maybe TokenHeaderTable)
getResponseTrailers (Response InpObj
rsp) = IORef (Maybe TokenHeaderTable) -> IO (Maybe TokenHeaderTable)
forall a. IORef a -> IO a
readIORef (InpObj -> IORef (Maybe TokenHeaderTable)
inpObjTrailers InpObj
rsp)