packages feed

request 0.3.1.0 → 0.4.0.0

raw patch · 5 files changed

+126/−100 lines, 5 filesdep +text

Dependencies added: text

Files

LICENSE view
@@ -1,30 +1,26 @@-Copyright AN Long (c) 2021--All rights reserved.+Copyright (c) 2017, AN Long  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.+1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer. -    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.+2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution. -    * Neither the name of Author name here nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -4,40 +4,32 @@  HTTP client for haskell, inpired by [requests](https://requests.readthedocs.io/) and [http-dispatch](https://github.com/owainlewis/http-dispatch). +[![Ask DeepWiki](https://deepwiki.com/badge.svg)](https://deepwiki.com/aisk/request)+ ## Installation  This pacakge is published on [hackage](http://hackage.haskell.org/package/request) with the same name `request`, you can install it with cabal or stack or nix as any other hackage packages.  ## Usage -You can try this in haskell REPL once you have `request` installed:--```haskell-import Network.HTTP.Request--resp <- get "https://api.leancloud.cn/1.1/date"-print $ responseStatus resp-```--## Record Dot Syntax Support--This library supports modern Haskell record dot syntax. To use it, enable these language extensions:+This library supports modern Haskell record dot syntax. First, enable these language extensions:  ```haskell {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedRecordDot #-} ``` -### Creating Records with Dot Syntax+Then you can use the library like this:  ```haskell-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedRecordDot #-}- import Network.HTTP.Request import qualified Data.ByteString as BS --- Create request using record dot syntax+-- Using shortcuts+resp <- get "https://api.leancloud.cn/1.1/date"+print resp.status        -- 200++-- Or construct a Request manually let req = Request { method = GET, url = "https://api.leancloud.cn/1.1/date", headers = [], body = Nothing }  -- Response with ByteString body@@ -59,11 +51,11 @@ `Request` is all about the information you will send to the target URL.  ```haskell-data Request a = Request+data Request = Request   { method  :: Method   , url     :: String   , headers :: Headers-  , body    :: Maybe a+  , body    :: Maybe BS.ByteString   } deriving (Show) ``` @@ -72,7 +64,7 @@ Once you have constructed your own `Request` record, you can call the `send` function to send it to the server. The `send` function's type is:  ```haskell-send :: (IsString a) => Request a -> IO (Response a)+send :: (FromResponseBody a) => Request -> IO (Response a) ```  ### Response@@ -87,27 +79,24 @@   } deriving (Show) ``` -The response body type `a` can be any type that implements the `IsString` constraint, allowing flexible handling of response data.+The response body type `a` can be any type that implements the `FromResponseBody` constraint, allowing flexible handling of response data. -### Backward Compatibility+### Without Language Extensions -For users who prefer not to use the language extensions, you can still:+If you prefer not to use the language extensions, you can still use the library with the traditional syntax:  - Create requests using positional arguments: `Request GET "url" [] Nothing`-- Use prefixed accessor functions: `requestStatus response`, `requestHeaders response`, etc.--### Example+- Use prefixed accessor functions: `responseStatus response`, `responseHeaders response`, etc.  ```haskell-{-# LANGUAGE OverloadedStrings #-}  import Network.HTTP.Request --- Construct a Request record.+-- Construct a Request using positional arguments let req = Request GET "https://api.leancloud.cn/1.1/date" [] Nothing--- Send it.+-- Send it res <- send req--- Access the fields on Response.+-- Access the fields using prefixed accessor functions print $ responseStatus res ``` @@ -116,21 +105,25 @@ As you expected, there are some shortcuts for the most used scenarios.  ```haskell-get :: String -> IO (Response BS.ByteString)+get :: (FromResponseBody a) => String -> IO (Response a) get url =-  send $ Request { method = GET, url = url, headers = [], body = Nothing }+  send $ Request GET url [] Nothing -delete :: String -> IO (Response BS.ByteString)+delete :: (FromResponseBody a) => String -> IO (Response a) delete url =-  send $ Request { method = DELETE, url = url, headers = [], body = Nothing }+  send $ Request DELETE url [] Nothing -post :: (String, Maybe BS.ByteString) -> IO (Response BS.ByteString)-post (url, body) =-  send $ Request { method = POST, url = url, headers = [], body = body }+post :: (FromResponseBody a) => String -> Maybe BS.ByteString -> IO (Response a)+post url body =+  send $ Request POST url [] body -put :: (String, Maybe BS.ByteString) -> IO (Response BS.ByteString)-put (url, body) =-  send $ Request { method = PUT, url = url, headers = [], body = body }+put :: (FromResponseBody a) => String -> Maybe BS.ByteString -> IO (Response a)+put url body =+  send $ Request PUT url [] body++patch :: (FromResponseBody a) => String -> Maybe BS.ByteString -> IO (Response a)+patch url body =+  send $ Request PATCH url [] body ```  These shortcuts' definitions are simple and direct. You are encouraged to add your own if the built-in does not match your use cases, like add custom headers in every request.@@ -141,7 +134,7 @@  ## About the Project -Request is &copy; 2020-2021 by [aisk](https://github.com/aisk).+Request is &copy; 2020-2026 by [AN Long](https://github.com/aisk).  ### License
request.cabal view
@@ -1,5 +1,5 @@ name:                request-version:             0.3.1.0+version:             0.4.0.0 -- synopsis: description:         "HTTP client for haskell, inpired by requests and http-dispatch." homepage:            https://github.com/aisk/request#readme@@ -22,6 +22,7 @@                      , http-client        >= 0.6.4 && < 0.8                      , http-types         >= 0.12.3 && < 0.13                      , http-client-tls    >= 0.3.5 && < 0.4+                     , text               >= 1.2.4 && < 2.2   default-language:    Haskell2010  source-repository head@@ -36,4 +37,5 @@                      , request                      , hspec                      , bytestring         >= 0.10.12 && < 0.13+                     , text               >= 1.2.4 && < 2.2   default-language:    Haskell2010
src/Network/HTTP/Request.hs view
@@ -1,14 +1,17 @@ {-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-}  module Network.HTTP.Request   ( Header,     Headers,+    FromResponseBody (..),     Method (..),     Request (..),     Response (..),     get,+    delete,     patch,     post,     put,@@ -27,8 +30,8 @@ import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Lazy as LBS import qualified Data.CaseInsensitive as CI-import qualified Data.List as List-import qualified Data.String as S+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import qualified Network.HTTP.Client as LowLevelClient import qualified Network.HTTP.Client.TLS as LowLevelTLSClient import qualified Network.HTTP.Types.Status as LowLevelStatus@@ -37,6 +40,21 @@  type Headers = [Header] +class FromResponseBody a where+  fromResponseBody :: LBS.ByteString -> a++instance FromResponseBody BS.ByteString where+  fromResponseBody = LBS.toStrict++instance FromResponseBody LBS.ByteString where+  fromResponseBody = id++instance FromResponseBody T.Text where+  fromResponseBody = T.decodeUtf8Lenient . LBS.toStrict++instance FromResponseBody String where+  fromResponseBody = T.unpack . T.decodeUtf8Lenient . LBS.toStrict+ data Method   = DELETE   | GET@@ -47,17 +65,7 @@   | PUT   | TRACE   | Method String--instance Show Method where-  show DELETE = "DELETE"-  show GET = "GET"-  show HEAD = "HEAD"-  show OPTIONS = "OPTIONS"-  show PATCH = "PATCH"-  show POST = "POST"-  show PUT = "PUT"-  show TRACE = "TRACE"-  show (Method method) = method+  deriving (Show, Eq)  data Request = Request   { method :: Method,@@ -107,10 +115,10 @@ responseBody :: Response a -> a responseBody res = res.body -fromLowLevelRequest :: (S.IsString a) => LowLevelClient.Response LBS.ByteString -> Response a-fromLowLevelRequest res =+fromLowLevelResponse :: (FromResponseBody a) => LowLevelClient.Response LBS.ByteString -> Response a+fromLowLevelResponse res =   let status = LowLevelStatus.statusCode . LowLevelClient.responseStatus $ res-      body = S.fromString . C.unpack . LBS.toStrict $ LowLevelClient.responseBody res+      body = fromResponseBody $ LowLevelClient.responseBody res       headers = LowLevelClient.responseHeaders res    in Response         status@@ -123,29 +131,29 @@         )         body -send :: (S.IsString a) => Request -> IO (Response a)+send :: (FromResponseBody a) => Request -> IO (Response a) send req = do   manager <- LowLevelTLSClient.getGlobalManager   llreq <- toLowlevelRequest req   llres <- LowLevelClient.httpLbs llreq manager-  return $ fromLowLevelRequest llres+  return $ fromLowLevelResponse llres -get :: String -> IO (Response BS.ByteString)+get :: (FromResponseBody a) => String -> IO (Response a) get url =   send $ Request GET url [] Nothing -delete :: String -> IO (Response BS.ByteString)+delete :: (FromResponseBody a) => String -> IO (Response a) delete url =   send $ Request DELETE url [] Nothing -post :: (String, Maybe BS.ByteString) -> IO (Response BS.ByteString)-post (url, body) =+post :: (FromResponseBody a) => String -> Maybe BS.ByteString -> IO (Response a)+post url body =   send $ Request POST url [] body -put :: (String, Maybe BS.ByteString) -> IO (Response BS.ByteString)-put (url, body) =+put :: (FromResponseBody a) => String -> Maybe BS.ByteString -> IO (Response a)+put url body =   send $ Request PUT url [] body -patch :: (String, Maybe BS.ByteString) -> IO (Response BS.ByteString)-patch (url, body) =+patch :: (FromResponseBody a) => String -> Maybe BS.ByteString -> IO (Response a)+patch url body =   send $ Request PATCH url [] body
test/Spec.hs view
@@ -4,40 +4,43 @@  module Main where +import Data.List (isInfixOf) import Network.HTTP.Request import Test.Hspec import qualified Data.ByteString as BS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T  main :: IO () main = hspec $ do   describe "Network.HTTP.Request" $ do     it "should fetch example.com and return 200 OK" $ do-      response <- get "http://example.com"+      response <- get "http://example.com" :: IO (Response String)       responseStatus response `shouldBe` 200      it "should send a request to example.com and return 200 OK" $ do-      response <- send (Request GET "http://example.com" [] Nothing)+      response <- send (Request GET "http://example.com" [] Nothing) :: IO (Response String)       responseStatus response `shouldBe` 200 -    it "should post to httpbin.org/post and return 200 OK" $ do-      response <- post ("https://postman-echo.com/post", Just "Hello!")+    it "should post to postman-echo.com/post and return 200 OK" $ do+      response <- post "https://postman-echo.com/post" (Just "Hello!") :: IO (Response String)       responseStatus response `shouldBe` 200 -    it "should put to httpbin.org/put and return 200 OK" $ do-      response <- put ("https://postman-echo.com/put", Just "Hello!")+    it "should put to postman-echo.com/put and return 200 OK" $ do+      response <- put "https://postman-echo.com/put" (Just "Hello!") :: IO (Response String)       responseStatus response `shouldBe` 200 -    it "should patch to httpbin.org/patch and return 200 OK" $ do-      response <- patch ("https://postman-echo.com/patch", Just "Hello!")+    it "should patch to postman-echo.com/patch and return 200 OK" $ do+      response <- patch "https://postman-echo.com/patch" (Just "Hello!") :: IO (Response String)       responseStatus response `shouldBe` 200      it "should use dot record syntax to create and access request/response" $ do       let req = Request { method = GET, url = "http://example.com", headers = [("User-Agent", "Haskell-Request")], body = Nothing }-      response <- send req+      response <- send req :: IO (Response String)       response.status `shouldBe` 200       response.headers `shouldSatisfy` (not . null) -    it "should access response body with different IsString types" $ do+    it "should access response body with different types" $ do       -- Test with ByteString body       let req1 = Request { method = GET, url = "http://example.com", headers = [], body = Nothing }       response1 <- send req1 :: IO (Response BS.ByteString)@@ -47,3 +50,27 @@       let req2 = Request { method = GET, url = "http://example.com", headers = [], body = Nothing }       response2 <- send req2 :: IO (Response String)       not (null response2.body) `shouldBe` True++    it "should correctly handle UTF-8 encoded response (Chinese characters)" $ do+      let msg = "{\"message\":\"你好世界\"}"+      let req = Request+            { method = POST+            , url = "https://postman-echo.com/post"+            , headers = [("Content-Type", "application/json; charset=utf-8")]+            , body = Just (T.encodeUtf8 $ T.pack msg)+            }+      response <- send req+      responseStatus response `shouldBe` 200+      responseBody response `shouldSatisfy` isInfixOf "你好世界"++    it "should correctly handle UTF-8 encoded response (emoji)" $ do+      let msg = "{\"message\":\"Hello 🌍\"}"+      let req = Request+            { method = POST+            , url = "https://postman-echo.com/post"+            , headers = [("Content-Type", "application/json; charset=utf-8")]+            , body = Just (T.encodeUtf8 $ T.pack msg)+            }+      response <- send req+      responseStatus response `shouldBe` 200+      responseBody response `shouldSatisfy` isInfixOf "🌍"