module Servant.Client.Core.Internal.Request where
import Prelude ()
import Prelude.Compat
import Control.Monad.Catch (Exception)
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as LBS
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 Web.HttpApiData (ToHttpApiData, toEncodedUrlPiece,
toHeader)
data ServantError =
FailureResponse Response
| DecodeFailure Text Response
| UnsupportedContentType MediaType Response
| InvalidContentTypeHeader Response
| 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 (Eq, Show, Functor, Generic, Typeable)
type Request = RequestF Builder.Builder
newtype RequestBody = RequestBodyLBS LBS.ByteString
deriving (Eq, Ord, Read, Show, Typeable)
data Response = Response
{ responseStatusCode :: Status
, responseBody :: LBS.ByteString
, responseHeaders :: Seq.Seq Header
, responseHttpVersion :: HttpVersion
} deriving (Eq, Show, Generic, Typeable)
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
-> Maybe Text
-> 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)}
setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request
setRequestBodyLBS b t req
= req { requestBody = Just (RequestBodyLBS b, t) }
setRequestBody :: RequestBody -> MediaType -> Request -> Request
setRequestBody b t req = req { requestBody = Just (b, t) }