141 lines
4.7 KiB
Haskell
141 lines
4.7 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
{-# LANGUAGE DeriveFoldable #-}
|
|
{-# LANGUAGE DeriveFunctor #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DeriveTraversable #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
module Servant.Client.Core.Internal.Request where
|
|
|
|
import Prelude ()
|
|
import Prelude.Compat
|
|
|
|
import Control.Monad.Catch
|
|
(Exception)
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Builder as Builder
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
import Data.Int
|
|
(Int64)
|
|
import Data.Semigroup
|
|
((<>))
|
|
import qualified Data.Sequence as Seq
|
|
import Data.Text
|
|
(Text)
|
|
import Data.Text.Encoding
|
|
(encodeUtf8)
|
|
import Data.Typeable
|
|
(Typeable)
|
|
import GHC.Generics
|
|
(Generic)
|
|
import Network.HTTP.Media
|
|
(MediaType)
|
|
import Network.HTTP.Types
|
|
(Header, HeaderName, HttpVersion, Method, QueryItem, Status,
|
|
http11, methodGet)
|
|
import Control.Monad.Codensity
|
|
(Codensity (..))
|
|
import Web.HttpApiData
|
|
(ToHttpApiData, toEncodedUrlPiece, toHeader)
|
|
|
|
-- | A type representing possible errors in a request
|
|
--
|
|
-- Note that this type substantially changed in 0.12.
|
|
data ServantError =
|
|
-- | The server returned an error response
|
|
FailureResponse Response
|
|
-- | The body could not be decoded at the expected type
|
|
| DecodeFailure Text Response
|
|
-- | The content-type of the response is not supported
|
|
| UnsupportedContentType MediaType Response
|
|
-- | The content-type header is invalid
|
|
| InvalidContentTypeHeader Response
|
|
-- | There was a connection error, and no response was received
|
|
| ConnectionError Text
|
|
deriving (Eq, Show, Generic, Typeable)
|
|
|
|
instance Exception ServantError
|
|
|
|
data RequestF a = Request
|
|
{ requestPath :: a
|
|
, requestQueryString :: Seq.Seq QueryItem
|
|
, requestBody :: Maybe (RequestBody, MediaType)
|
|
, requestAccept :: Seq.Seq MediaType
|
|
, requestHeaders :: Seq.Seq Header
|
|
, requestHttpVersion :: HttpVersion
|
|
, requestMethod :: Method
|
|
} deriving (Generic, Typeable)
|
|
|
|
type Request = RequestF Builder.Builder
|
|
|
|
-- | The request body. A replica of the @http-client@ @RequestBody@.
|
|
data RequestBody
|
|
= RequestBodyLBS LBS.ByteString
|
|
| RequestBodyBS BS.ByteString
|
|
| RequestBodyBuilder Int64 Builder.Builder
|
|
| RequestBodyStream Int64 ((IO BS.ByteString -> IO ()) -> IO ())
|
|
| RequestBodyStreamChunked ((IO BS.ByteString -> IO ()) -> IO ())
|
|
| RequestBodyIO (IO RequestBody)
|
|
deriving (Generic, Typeable)
|
|
|
|
data GenResponse a = Response
|
|
{ responseStatusCode :: Status
|
|
, responseHeaders :: Seq.Seq Header
|
|
, responseHttpVersion :: HttpVersion
|
|
, responseBody :: a
|
|
} deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable)
|
|
|
|
type Response = GenResponse LBS.ByteString
|
|
type StreamingResponse = Codensity IO (GenResponse (IO BS.ByteString))
|
|
|
|
-- A GET request to the top-level path
|
|
defaultRequest :: Request
|
|
defaultRequest = Request
|
|
{ requestPath = ""
|
|
, requestQueryString = Seq.empty
|
|
, requestBody = Nothing
|
|
, requestAccept = Seq.empty
|
|
, requestHeaders = Seq.empty
|
|
, requestHttpVersion = http11
|
|
, requestMethod = methodGet
|
|
}
|
|
|
|
appendToPath :: Text -> Request -> Request
|
|
appendToPath p req
|
|
= req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }
|
|
|
|
appendToQueryString :: Text -- ^ param name
|
|
-> Maybe Text -- ^ param value
|
|
-> Request
|
|
-> Request
|
|
appendToQueryString pname pvalue req
|
|
= req { requestQueryString = requestQueryString req
|
|
Seq.|> (encodeUtf8 pname, encodeUtf8 <$> pvalue)}
|
|
|
|
addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
|
|
addHeader name val req
|
|
= req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}
|
|
|
|
-- | Set body and media type of the request being constructed.
|
|
--
|
|
-- The body is set to the given bytestring using the 'RequestBodyLBS'
|
|
-- constructor.
|
|
--
|
|
-- @since 0.12
|
|
--
|
|
setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request
|
|
setRequestBodyLBS b t req
|
|
= req { requestBody = Just (RequestBodyLBS b, t) }
|
|
|
|
-- | Set body and media type of the request being constructed.
|
|
--
|
|
-- @since 0.12
|
|
--
|
|
setRequestBody :: RequestBody -> MediaType -> Request -> Request
|
|
setRequestBody b t req = req { requestBody = Just (b, t) }
|