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.8 +version: 0.8.1 synopsis: automatical derivation of querying functions for servant webservices description: This library lets you derive automatically Haskell functions that @@ -36,7 +36,7 @@ Servant.Common.Req build-depends: base >= 4.7 && < 4.10 - , aeson >= 0.7 && < 0.12 + , aeson >= 0.7 && < 1.1 , attoparsec >= 0.12 && < 0.14 , base64-bytestring >= 1.0.0.1 && < 1.1 , bytestring >= 0.10 && < 0.11 diff --git a/src/Servant/Client.hs b/src/Servant/Client.hs --- a/src/Servant/Client.hs +++ b/src/Servant/Client.hs @@ -118,6 +118,38 @@ where p = unpack (toUrlPiece val) +-- | If you use a 'CaptureAll' in one of your endpoints in your API, +-- the corresponding querying function will automatically take an +-- additional argument of a list of the type specified by your +-- 'CaptureAll'. That function will take care of inserting a textual +-- representation of this value at the right place in the request +-- path. +-- +-- You can control how these values are turned into text by specifying +-- a 'ToHttpApiData' instance of your type. +-- +-- Example: +-- +-- > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile +-- > +-- > myApi :: Proxy +-- > myApi = Proxy +-- +-- > getSourceFile :: [Text] -> Manager -> BaseUrl -> ClientM SourceFile +-- > getSourceFile = client myApi +-- > -- then you can use "getSourceFile" to query that endpoint +instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout) + => HasClient (CaptureAll capture a :> sublayout) where + + type Client (CaptureAll capture a :> sublayout) = + [a] -> Client sublayout + + clientWithRoute Proxy req vals = + clientWithRoute (Proxy :: Proxy sublayout) + (foldl' (flip appendToPath) req ps) + + where ps = map (unpack . toUrlPiece) vals + instance OVERLAPPABLE_ -- Note [Non-Empty Content Types] (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts) 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 @@ -103,7 +103,7 @@ reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request reqToRequest req (BaseUrl reqScheme reqHost reqPort path) = - setheaders . setAccept . setrqb . setQS <$> parseUrlThrow url + setheaders . setAccept . setrqb . setQS <$> parseRequest url where url = show $ nullURI { uriScheme = case reqScheme of Http -> "http:" @@ -129,8 +129,18 @@ | not . null . reqAccept $ req] } toProperHeader (name, val) = (fromString name, encodeUtf8 val) + #if !MIN_VERSION_http_client(0,4,30) - parseUrlThrow = parseUrl +-- 'parseRequest' is introduced in http-client-0.4.30 +-- it differs from 'parseUrl', by not throwing exceptions on non-2xx http statuses +-- +-- See for implementations: +-- http://hackage.haskell.org/package/http-client-0.4.30/docs/src/Network-HTTP-Client-Request.html#parseRequest +-- http://hackage.haskell.org/package/http-client-0.5.0/docs/src/Network-HTTP-Client-Request.html#parseRequest +parseRequest :: MonadThrow m => String -> m Request +parseRequest url = liftM disableStatusCheck (parseUrl url) + where + disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing } #endif @@ -147,8 +157,7 @@ performRequest reqMethod req manager reqHost = do partialRequest <- liftIO $ reqToRequest req reqHost - let request = disableStatusCheck $ - partialRequest { Client.method = reqMethod } + let request = partialRequest { Client.method = reqMethod } eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager case eResponse of @@ -168,13 +177,6 @@ unless (status_code >= 200 && status_code < 300) $ throwE $ FailureResponse status ct body return (status_code, body, ct, hdrs, response) - -disableStatusCheck :: Request -> Request -#if MIN_VERSION_http_client(0,5,0) -disableStatusCheck req = req { checkResponse = \ _req _res -> return () } -#else -disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing } -#endif performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req -> Manager -> BaseUrl diff --git a/test/Servant/ClientSpec.hs b/test/Servant/ClientSpec.hs --- a/test/Servant/ClientSpec.hs +++ b/test/Servant/ClientSpec.hs @@ -105,6 +105,7 @@ "get" :> Get '[JSON] Person :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person + :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person] :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person] @@ -125,6 +126,7 @@ getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person +getCaptureAll :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person] getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person] @@ -140,6 +142,7 @@ getGet :<|> getDeleteEmpty :<|> getCapture + :<|> getCaptureAll :<|> getBody :<|> getQueryParam :<|> getQueryParams @@ -155,6 +158,7 @@ return alice :<|> return NoContent :<|> (\ name -> return $ Person name 0) + :<|> (\ names -> return (zipWith Person names [0..])) :<|> return :<|> (\ name -> case name of Just "alice" -> return alice @@ -250,6 +254,10 @@ it "Servant.API.Capture" $ \(_, baseUrl) -> do (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0) + it "Servant.API.CaptureAll" $ \(_, baseUrl) -> do + let expected = [(Person "Paula" 0), (Person "Peta" 1)] + (left show <$> runExceptT (getCaptureAll ["Paula", "Peta"] manager baseUrl)) `shouldReturn` Right expected + it "Servant.API.ReqBody" $ \(_, baseUrl) -> do let p = Person "Clara" 42 (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p @@ -351,7 +359,7 @@ _ -> fail $ "expected UnsupportedContentType, but got " <> show res it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do - let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api + let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api Left res <- runExceptT (getBody alice manager baseUrl) case res of InvalidContentTypeHeader "fooooo" _ -> return ()