diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,15 @@ +0.11 +---- + +### Other changes + +- Path components are escaped + ([#696](https://github.com/haskell-servant/servant/pull/696)) +- `Req` `reqPath` field changed from `String` to `BS.Builder` + ([#696](https://github.com/haskell-servant/servant/pull/696)) +- Include `Req` in failure errors + ([#740](https://github.com/haskell-servant/servant/pull/740)) + 0.10 ----- diff --git a/servant-client.cabal b/servant-client.cabal --- a/servant-client.cabal +++ b/servant-client.cabal @@ -1,5 +1,5 @@ name: servant-client -version: 0.10 +version: 0.11 synopsis: automatical derivation of querying functions for servant webservices description: This library lets you derive automatically Haskell functions that @@ -38,13 +38,13 @@ build-depends: base >= 4.7 && < 4.10 , base-compat >= 0.9.1 && < 0.10 - , aeson >= 0.7 && < 1.2 + , aeson >= 0.7 && < 1.3 , attoparsec >= 0.12 && < 0.14 , base64-bytestring >= 1.0.0.1 && < 1.1 , bytestring >= 0.10 && < 0.11 , exceptions >= 0.8 && < 0.9 - , generics-sop >= 0.1.0.0 && < 0.3 - , http-api-data >= 0.3 && < 0.4 + , generics-sop >= 0.1.0.0 && < 0.4 + , http-api-data >= 0.3.6 && < 0.4 , http-client >= 0.4.18.1 && < 0.6 , http-client-tls >= 0.2.2 && < 0.4 , http-media >= 0.6.2 && < 0.7 @@ -52,8 +52,8 @@ , monad-control >= 1.0.0.4 && < 1.1 , network-uri >= 2.6 && < 2.7 , safe >= 0.3.9 && < 0.4 - , semigroupoids >= 4.3 && < 5.2 - , servant == 0.10.* + , semigroupoids >= 4.3 && < 5.3 + , servant == 0.11.* , string-conversions >= 0.3 && < 0.5 , text >= 1.2 && < 1.3 , transformers >= 0.3 && < 0.6 @@ -94,9 +94,9 @@ , mtl , network >= 2.6 , QuickCheck >= 2.7 - , servant == 0.10.* + , servant , servant-client - , servant-server == 0.10.* + , servant-server == 0.11.* , text , transformers , transformers-compat diff --git a/src/Servant/Client.hs b/src/Servant/Client.hs --- a/src/Servant/Client.hs +++ b/src/Servant/Client.hs @@ -24,6 +24,7 @@ , ClientEnv (ClientEnv) , mkAuthenticateReq , ServantError(..) + , EmptyClient(..) , module Servant.Common.BaseUrl ) where @@ -87,6 +88,23 @@ clientWithRoute Proxy req = clientWithRoute (Proxy :: Proxy a) req :<|> clientWithRoute (Proxy :: Proxy b) req + +-- | Singleton type representing a client for an empty API. +data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum) + +-- | The client for 'EmptyAPI' is simply 'EmptyClient'. +-- +-- > type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books +-- > :<|> "nothing" :> EmptyAPI +-- > +-- > myApi :: Proxy MyApi +-- > myApi = Proxy +-- > +-- > getAllBooks :: ClientM [Book] +-- > (getAllBooks :<|> EmptyClient) = client myApi +instance HasClient EmptyAPI where + type Client EmptyAPI = EmptyClient + clientWithRoute Proxy _ = EmptyClient -- | If you use a 'Capture' in one of your endpoints in your API, -- the corresponding querying function will automatically take diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs --- a/src/Servant/Common/Req.hs +++ b/src/Servant/Common/Req.hs @@ -27,6 +27,7 @@ import Control.Monad.IO.Class () import Control.Monad.Reader import Control.Monad.Trans.Control (MonadBaseControl (..)) +import qualified Data.ByteString.Builder as BS import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any) import Data.String import Data.String.Conversions (cs) @@ -48,7 +49,8 @@ data ServantError = FailureResponse - { responseStatus :: Status + { failingRequest :: UrlReq + , responseStatus :: Status , responseContentType :: MediaType , responseBody :: ByteString } @@ -71,7 +73,7 @@ deriving (Show, Typeable) instance Eq ServantError where - FailureResponse a b c == FailureResponse x y z = + FailureResponse _ a b c == FailureResponse _ x y z = (a, b, c) == (x, y, z) DecodeFailure a b c == DecodeFailure x y z = (a, b, c) == (x, y, z) @@ -85,8 +87,15 @@ instance Exception ServantError +data UrlReq = UrlReq BaseUrl Req + +instance Show UrlReq where + show (UrlReq url req) = showBaseUrl url ++ path ++ "?" ++ show (qs req) + where + path = cs (BS.toLazyByteString (reqPath req)) + data Req = Req - { reqPath :: String + { reqPath :: BS.Builder , qs :: QueryText , reqBody :: Maybe (RequestBody, MediaType) , reqAccept :: [MediaType] @@ -98,7 +107,7 @@ appendToPath :: String -> Req -> Req appendToPath p req = - req { reqPath = reqPath req ++ "/" ++ p } + req { reqPath = reqPath req <> "/" <> toEncodedUrlPiece p } appendToQueryString :: Text -- ^ param name -> Maybe Text -- ^ param value @@ -151,8 +160,9 @@ , uriRegName = reqHost , uriPort = ":" ++ show reqPort } - , uriPath = path ++ reqPath req + , uriPath = fullPath } + fullPath = path ++ cs (BS.toLazyByteString (reqPath req)) setrqb r = case reqBody req of Nothing -> r @@ -224,7 +234,7 @@ runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm -performRequest :: Method -> Req +performRequest :: Method -> Req -> ClientM ( Int, ByteString, MediaType , [HTTP.Header], Response ByteString) performRequest reqMethod req = do @@ -250,10 +260,10 @@ Nothing -> throwError $ InvalidContentTypeHeader (cs t) body Just t' -> pure t' unless (status_code >= 200 && status_code < 300) $ - throwError $ FailureResponse status ct body + throwError $ FailureResponse (UrlReq reqHost req) status ct body return (status_code, body, ct, hdrs, response) -performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req +performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req -> ClientM ([HTTP.Header], result) performRequestCT ct reqMethod req = do let acceptCTS = contentTypes ct diff --git a/test/Servant/ClientSpec.hs b/test/Servant/ClientSpec.hs --- a/test/Servant/ClientSpec.hs +++ b/test/Servant/ClientSpec.hs @@ -111,6 +111,8 @@ Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])]) :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool) :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent + :<|> "empty" :> EmptyAPI + api :: Proxy Api api = Proxy @@ -122,14 +124,15 @@ getQueryParam :: Maybe String -> SCR.ClientM Person getQueryParams :: [String] -> SCR.ClientM [Person] getQueryFlag :: Bool -> SCR.ClientM Bool -getRawSuccess :: HTTP.Method +getRawSuccess :: HTTP.Method -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString) -getRawFailure :: HTTP.Method +getRawFailure :: HTTP.Method -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString) getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])]) getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool) getDeleteContentType :: SCR.ClientM NoContent + getGet :<|> getDeleteEmpty :<|> getCapture @@ -142,7 +145,8 @@ :<|> getRawFailure :<|> getMultiple :<|> getRespHeaders - :<|> getDeleteContentType = client api + :<|> getDeleteContentType + :<|> EmptyClient = client api server :: Application server = serve api ( @@ -157,12 +161,12 @@ Nothing -> throwError $ ServantErr 400 "missing parameter" "" []) :<|> (\ names -> return (zipWith Person names [0..])) :<|> return - :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess") - :<|> (\ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure") + :<|> (Tagged $ \ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess") + :<|> (Tagged $ \ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure") :<|> (\ a b c d -> return (a, b, c, d)) :<|> (return $ addHeader 1729 $ addHeader "eg2" True) :<|> return NoContent - ) + :<|> emptyServer) type FailApi = @@ -174,9 +178,9 @@ failServer :: Application failServer = serve failApi ( - (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "") - :<|> (\ _capture _request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "") - :<|> (\_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "") + (Tagged $ \ _request respond -> respond $ responseLBS HTTP.ok200 [] "") + :<|> (\ _capture -> Tagged $ \_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "") + :<|> (Tagged $ \_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "") ) -- * basic auth stuff @@ -372,7 +376,7 @@ let (_ :<|> getDeleteEmpty :<|> _) = client api Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl) case res of - FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return () + FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return () _ -> fail $ "expected 404 response, but got " <> show res it "reports DecodeFailure" $ \(_, baseUrl) -> do