@@ -19,14 +19,20 @@ import Control.DeepSeq
1919 (NFData (..))
2020import Control.Monad.Catch
2121 (Exception)
22−import qualified Data.ByteString as BS
23−import qualified Data.ByteString.Builder as Builder
24−import qualified Data.ByteString.Lazy as LBS
22+import Data.Bifoldable
23+ (Bifoldable (..))
24+import Data.Bifunctor
25+ (Bifunctor (..))
26+import Data.Bitraversable
27+ (Bitraversable (..), bifoldMapDefault, bimapDefault)
28+import qualified Data.ByteString as BS
29+import qualified Data.ByteString.Builder as Builder
30+import qualified Data.ByteString.Lazy as LBS
2531import Data.Int
2632 (Int64)
2733import Data.Semigroup
2834 ((<>))
29−import qualified Data.Sequence as Seq
35+import qualified Data.Sequence as Seq
3036import Data.Text
3137 (Text)
3238import Data.Text.Encoding
@@ -42,13 +48,17 @@ import Network.HTTP.Types
4248 Status (..), http11, methodGet)
4349import Servant.API
4450 (ToHttpApiData, toEncodedUrlPiece, toHeader)
51+import Servant.Client.Core.Internal.BaseUrl
52+ (BaseUrl)
4553
4654-- | A type representing possible errors in a request
4755--
4856-- Note that this type substantially changed in 0.12.
4957data ServantError =
50− -- | The server returned an error response
51− FailureResponse Response
58+ -- | The server returned an error response including the
59+ -- failing request. 'requestPath' includes the 'BaseUrl' and the
60+ -- path of the request.
61+ FailureResponse (RequestF () (BaseUrl, BS.ByteString)) Response
5262 -- | The body could not be decoded at the expected type
5363 | DecodeFailure Text Response
5464 -- | The content-type of the response is not supported
@@ -62,30 +72,53 @@ data ServantError =
6272instance Exception ServantError
6373
6474instance NFData ServantError where
65− rnf (FailureResponse res) = rnf res
75+ rnf (FailureResponse req res) = rnf req `seq` rnf res
6676 rnf (DecodeFailure err res) = rnf err `seq` rnf res
6777 rnf (UnsupportedContentType mt' res) =
6878 mediaTypeRnf mt' `seq`
6979 rnf res
70− where
71− mediaTypeRnf mt =
72− rnf (mainType mt) `seq`
73− rnf (subType mt) `seq`
74− rnf (parameters mt)
7580 rnf (InvalidContentTypeHeader res) = rnf res
7681 rnf (ConnectionError err) = rnf err
7782
78−data RequestF a = Request
79− { requestPath :: a
83+mediaTypeRnf :: MediaType -> ()
84+mediaTypeRnf mt =
85+ rnf (mainType mt) `seq`
86+ rnf (subType mt) `seq`
87+ rnf (parameters mt)
88+
89+data RequestF body path = Request
90+ { requestPath :: path
8091 , requestQueryString :: Seq.Seq QueryItem
81− , requestBody :: Maybe (RequestBody, MediaType)
92+ , requestBody :: Maybe (body, MediaType)
8293 , requestAccept :: Seq.Seq MediaType
8394 , requestHeaders :: Seq.Seq Header
8495 , requestHttpVersion :: HttpVersion
8596 , requestMethod :: Method
86− } deriving (Generic, Typeable)
97+ } deriving (Generic, Typeable, Eq, Show, Functor, Foldable, Traversable)
98+
99+instance Bifunctor RequestF where bimap = bimapDefault
100+instance Bifoldable RequestF where bifoldMap = bifoldMapDefault
101+instance Bitraversable RequestF where
102+ bitraverse f g r = mk
103+ <$> traverse (bitraverse f pure) (requestBody r)
104+ <*> g (requestPath r)
105+ where
106+ mk b p = r { requestBody = b, requestPath = p }
107+
108+instance (NFData path, NFData body) => NFData (RequestF body path) where
109+ rnf r =
110+ rnf (requestPath r)
111+ `seq` rnf (requestQueryString r)
112+ `seq` rnfB (requestBody r)
113+ `seq` rnf (fmap mediaTypeRnf (requestAccept r))
114+ `seq` rnf (requestHeaders r)
115+ `seq` requestHttpVersion r
116+ `seq` rnf (requestMethod r)
117+ where
118+ rnfB Nothing = ()
119+ rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt
87120
88−type Request = RequestF Builder.Builder
121+type Request = RequestF RequestBody Builder.Builder
89122
90123-- | The request body. A replica of the @http-client@ @RequestBody@.
91124data RequestBody