servant-client 0.8 → 0.8.1
raw patch · 4 files changed
+56/−14 lines, 4 filesdep ~aeson
Dependency ranges changed: aeson
Files
- servant-client.cabal +2/−2
- src/Servant/Client.hs +32/−0
- src/Servant/Common/Req.hs +13/−11
- test/Servant/ClientSpec.hs +9/−1
servant-client.cabal view
@@ -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
src/Servant/Client.hs view
@@ -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)
src/Servant/Common/Req.hs view
@@ -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
test/Servant/ClientSpec.hs view
@@ -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 ()