req 3.13.0 → 3.13.1
raw patch · 12 files changed
+773/−819 lines, 12 filesdep +crypton-connectiondep −connectiondep ~QuickCheckdep ~basedep ~bytestring
Dependencies added: crypton-connection
Dependencies removed: connection
Dependency ranges changed: QuickCheck, base, bytestring, hspec, hspec-core, http-api-data, mtl, template-haskell, text
Files
- CHANGELOG.md +10/−0
- Network/HTTP/Req.hs +58/−74
- httpbin-data/robots.txt +0/−2
- httpbin-data/utf8.html +0/−220
- httpbin-tests/Network/HTTP/ReqSpec.hs +0/−480
- httpbin-tests/Spec.hs +0/−1
- httpbun-data/robots.txt +2/−0
- httpbun-data/utf8.html +220/−0
- httpbun-tests/Network/HTTP/ReqSpec.hs +446/−0
- httpbun-tests/Spec.hs +1/−0
- pure-tests/Network/HTTP/ReqSpec.hs +18/−18
- req.cabal +18/−24
CHANGELOG.md view
@@ -1,3 +1,13 @@+## Req 3.13.1++* Switched the non-pure test suite to use https://httpbun.org instead of+ https://httpbin.org since the latter proved to be highly unreliable+ lately.++* Switched from `connection` to `crypton-connection`.++* Builds with GHC 9.6.1.+ ## Req 3.13.0 * Add `headerRedacted` function to add header fields, which will be with
Network/HTTP/Req.hs view
@@ -1,20 +1,9 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveLift #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RoleAnnotations #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}@@ -214,7 +203,7 @@ ) where -import qualified Blaze.ByteString.Builder as BB+import Blaze.ByteString.Builder qualified as BB import Control.Applicative import Control.Arrow (first, second) import Control.Exception hiding (Handler (..), TypeError)@@ -230,55 +219,55 @@ import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Identity (IdentityT) import Control.Monad.Trans.Maybe (MaybeT)-import qualified Control.Monad.Trans.RWS.CPS as RWS.CPS-import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy-import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict+import Control.Monad.Trans.RWS.CPS qualified as RWS.CPS+import Control.Monad.Trans.RWS.Lazy qualified as RWS.Lazy+import Control.Monad.Trans.RWS.Strict qualified as RWS.Strict import Control.Monad.Trans.Select (SelectT)-import qualified Control.Monad.Trans.State.Lazy as State.Lazy-import qualified Control.Monad.Trans.State.Strict as State.Strict-import qualified Control.Monad.Trans.Writer.CPS as Writer.CPS-import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy-import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict+import Control.Monad.Trans.State.Lazy qualified as State.Lazy+import Control.Monad.Trans.State.Strict qualified as State.Strict+import Control.Monad.Trans.Writer.CPS qualified as Writer.CPS+import Control.Monad.Trans.Writer.Lazy qualified as Writer.Lazy+import Control.Monad.Trans.Writer.Strict qualified as Writer.Strict import Control.Retry import Data.Aeson (FromJSON (..), ToJSON (..))-import qualified Data.Aeson as A+import Data.Aeson qualified as A import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.CaseInsensitive as CI+import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as BL+import Data.CaseInsensitive qualified as CI import Data.Data (Data) import Data.Function (on) import Data.IORef import Data.Kind (Constraint, Type) import Data.List (foldl', nubBy) import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe) import Data.Proxy import Data.Semigroup (Endo (..))-import qualified Data.Set as S+import Data.Set qualified as S import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import Data.Text qualified as T+import Data.Text.Encoding qualified as T import Data.Typeable (Typeable, cast) import GHC.Generics import GHC.TypeLits-import qualified Language.Haskell.TH as TH-import qualified Language.Haskell.TH.Quote as TH-import qualified Language.Haskell.TH.Syntax as TH-import qualified Network.Connection as NC-import qualified Network.HTTP.Client as L-import qualified Network.HTTP.Client.Internal as LI-import qualified Network.HTTP.Client.MultipartFormData as LM-import qualified Network.HTTP.Client.TLS as L-import qualified Network.HTTP.Types as Y+import Language.Haskell.TH qualified as TH+import Language.Haskell.TH.Quote qualified as TH+import Language.Haskell.TH.Syntax qualified as TH+import Network.Connection qualified as NC+import Network.HTTP.Client qualified as L+import Network.HTTP.Client.Internal qualified as LI+import Network.HTTP.Client.MultipartFormData qualified as LM+import Network.HTTP.Client.TLS qualified as L+import Network.HTTP.Types qualified as Y import System.IO.Unsafe (unsafePerformIO) import Text.URI (URI)-import qualified Text.URI as URI-import qualified Text.URI.QQ as QQ-import qualified Web.Authenticate.OAuth as OAuth+import Text.URI qualified as URI+import Text.URI.QQ qualified as QQ+import Web.Authenticate.OAuth qualified as OAuth import Web.FormUrlEncoded (FromForm (..), ToForm (..))-import qualified Web.FormUrlEncoded as Form+import Web.FormUrlEncoded qualified as Form import Web.HttpApiData (ToHttpApiData (..)) ----------------------------------------------------------------------------@@ -499,7 +488,7 @@ -- -- @since 3.7.0 reqHandler ::- MonadHttp m =>+ (MonadHttp m) => -- | How to get final result from a 'L.Response' (L.Response L.BodyReader -> IO b) -> -- | 'L.Request' to perform@@ -597,7 +586,7 @@ -- | Perform an action using the global implicit 'L.Manager' that the rest -- of the library uses. This allows to reuse connections that the -- 'L.Manager' controls.-withReqManager :: MonadIO m => (L.Manager -> m a) -> m a+withReqManager :: (MonadIO m) => (L.Manager -> m a) -> m a withReqManager m = liftIO (readIORef globalManager) >>= m -- | The global 'L.Manager' that 'req' uses. Here we just go with the@@ -640,7 +629,7 @@ -- | A type class for monads that support performing HTTP requests. -- Typically, you only need to define the 'handleHttpException' method -- unless you want to tweak 'HttpConfig'.-class MonadIO m => MonadHttp m where+class (MonadIO m) => MonadHttp m where -- | This method describes how to deal with 'HttpException' that was -- caught by the library. One option is to re-throw it if you are OK with -- exceptions, but if you prefer working with something like@@ -724,7 +713,7 @@ -- | Max length of preview fragment of response body. -- -- @since 3.6.0- httpConfigBodyPreviewLength :: forall a. Num a => a+ httpConfigBodyPreviewLength :: forall a. (Num a) => a } deriving (Typeable) @@ -814,27 +803,27 @@ getHttpConfig = lift getHttpConfig -- | @since 3.10.0-instance MonadHttp m => MonadHttp (ContT r m) where+instance (MonadHttp m) => MonadHttp (ContT r m) where handleHttpException = lift . handleHttpException getHttpConfig = lift getHttpConfig -- | @since 3.10.0-instance MonadHttp m => MonadHttp (ExceptT e m) where+instance (MonadHttp m) => MonadHttp (ExceptT e m) where handleHttpException = lift . handleHttpException getHttpConfig = lift getHttpConfig -- | @since 3.10.0-instance MonadHttp m => MonadHttp (IdentityT m) where+instance (MonadHttp m) => MonadHttp (IdentityT m) where handleHttpException = lift . handleHttpException getHttpConfig = lift getHttpConfig -- | @since 3.10.0-instance MonadHttp m => MonadHttp (MaybeT m) where+instance (MonadHttp m) => MonadHttp (MaybeT m) where handleHttpException = lift . handleHttpException getHttpConfig = lift getHttpConfig -- | @since 3.10.0-instance MonadHttp m => MonadHttp (ReaderT r m) where+instance (MonadHttp m) => MonadHttp (ReaderT r m) where handleHttpException = lift . handleHttpException getHttpConfig = lift getHttpConfig @@ -854,17 +843,17 @@ getHttpConfig = lift getHttpConfig -- | @since 3.10.0-instance MonadHttp m => MonadHttp (SelectT r m) where+instance (MonadHttp m) => MonadHttp (SelectT r m) where handleHttpException = lift . handleHttpException getHttpConfig = lift getHttpConfig -- | @since 3.10.0-instance MonadHttp m => MonadHttp (State.Lazy.StateT s m) where+instance (MonadHttp m) => MonadHttp (State.Lazy.StateT s m) where handleHttpException = lift . handleHttpException getHttpConfig = lift getHttpConfig -- | @since 3.10.0-instance MonadHttp m => MonadHttp (State.Strict.StateT s m) where+instance (MonadHttp m) => MonadHttp (State.Strict.StateT s m) where handleHttpException = lift . handleHttpException getHttpConfig = lift getHttpConfig @@ -888,7 +877,7 @@ -- -- @since 0.4.0 runReq ::- MonadIO m =>+ (MonadIO m) => -- | 'HttpConfig' to use HttpConfig -> -- | Computation to run@@ -993,7 +982,7 @@ -- | Return name of the method as a 'ByteString'. httpMethodName :: Proxy a -> ByteString -instance HttpMethod method => RequestComponent (Tagged "method" method) where+instance (HttpMethod method) => RequestComponent (Tagged "method" method) where getRequestMod _ = Endo $ \x -> x {L.method = httpMethodName (Proxy :: Proxy method)} @@ -1041,19 +1030,14 @@ -- With template-haskell >=2.15 and text >=1.2.4 Lift can be derived, however -- the derived lift forgets the type of the scheme.-instance Typeable scheme => TH.Lift (Url scheme) where+instance (Typeable scheme) => TH.Lift (Url scheme) where lift url = TH.dataToExpQ (fmap liftText . cast) url `TH.sigE` case url of Url Http _ -> [t|Url 'Http|] Url Https _ -> [t|Url 'Https|] where liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)--#if MIN_VERSION_template_haskell(2,17,0) liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift-#elif MIN_VERSION_template_haskell(2,16,0)- liftTyped = TH.unsafeTExpCoerce . TH.lift-#endif -- | Given host name, produce a 'Url' which has “http” as its scheme and -- empty path. This also sets port to @80@.@@ -1069,7 +1053,7 @@ -- path segment can be of any type that is an instance of 'ToHttpApiData'. infixl 5 /~ -(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme+(/~) :: (ToHttpApiData a) => Url scheme -> a -> Url scheme Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path) -- | A type-constrained version of @('/~')@ to remove ambiguity in the cases@@ -1257,7 +1241,7 @@ -- charset=utf-8\"@ value. newtype ReqBodyJson a = ReqBodyJson a -instance ToJSON a => HttpBody (ReqBodyJson a) where+instance (ToJSON a) => HttpBody (ReqBodyJson a) where getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a) getRequestContentType _ = pure "application/json; charset=utf-8" @@ -1356,7 +1340,7 @@ -- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's. -- -- @since 0.2.0-reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart+reqBodyMultipart :: (MonadIO m) => [LM.Part] -> m ReqBodyMultipart reqBodyMultipart parts = liftIO $ do boundary <- LM.webkitBoundary body <- LM.renderParts boundary parts@@ -1396,7 +1380,7 @@ TypeError ('Text "This HTTP method does not allow attaching a request body.") -instance HttpBody body => RequestComponent (Tagged "body" body) where+instance (HttpBody body) => RequestComponent (Tagged "body" body) where getRequestMod (Tagged body) = Endo $ \x -> x { L.requestBody = getRequestBody body,@@ -1466,7 +1450,7 @@ -- | Finalize given 'L.Request' by applying a finalizer from the given -- 'Option' (if it has any).-finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request+finalizeRequest :: (MonadIO m) => Option scheme -> L.Request -> m L.Request finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer ----------------------------------------------------------------------------@@ -1499,7 +1483,7 @@ -- This operator is defined in terms of 'queryParam': -- -- > queryFlag name = queryParam name (Nothing :: Maybe ())-queryFlag :: QueryParam param => Text -> param+queryFlag :: (QueryParam param) => Text -> param queryFlag name = queryParam name (Nothing :: Maybe ()) -- | Construct query parameters from a 'ToForm' instance. This function@@ -1529,7 +1513,7 @@ -- 'Nothing', it won't be included at all (i.e. you create a flag this -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this -- method, because they are easier to read.- queryParam :: ToHttpApiData a => Text -> Maybe a -> param+ queryParam :: (ToHttpApiData a) => Text -> Maybe a -> param -- | Get the query parameter names and values set by 'queryParam'. --@@ -1778,7 +1762,7 @@ newtype JsonResponse a = JsonResponse (L.Response a) deriving (Show) -instance FromJSON a => HttpResponse (JsonResponse a) where+instance (FromJSON a) => HttpResponse (JsonResponse a) where type HttpResponseBody (JsonResponse a) = a toVanillaResponse (JsonResponse r) = r getHttpResponse r = do@@ -1894,14 +1878,14 @@ -- | Get the response body. responseBody ::- HttpResponse response =>+ (HttpResponse response) => response -> HttpResponseBody response responseBody = L.responseBody . toVanillaResponse -- | Get the response status code. responseStatusCode ::- HttpResponse response =>+ (HttpResponse response) => response -> Int responseStatusCode =@@ -1909,7 +1893,7 @@ -- | Get the response status message. responseStatusMessage ::- HttpResponse response =>+ (HttpResponse response) => response -> ByteString responseStatusMessage =@@ -1917,7 +1901,7 @@ -- | Lookup a particular header from a response. responseHeader ::- HttpResponse response =>+ (HttpResponse response) => -- | Response interpretation response -> -- | Header to lookup@@ -1929,7 +1913,7 @@ -- | Get the response 'L.CookieJar'. responseCookieJar ::- HttpResponse response =>+ (HttpResponse response) => response -> L.CookieJar responseCookieJar = L.responseCookieJar . toVanillaResponse
− httpbin-data/robots.txt
@@ -1,2 +0,0 @@-User-agent: *-Disallow: /deny
− httpbin-data/utf8.html
@@ -1,220 +0,0 @@-<h1>Unicode Demo</h1>--<p>Taken from <a-href="http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-demo.txt">http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-demo.txt</a></p>--<pre>--UTF-8 encoded sample plain-text file-‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾--Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25---The ASCII compatible UTF-8 encoding used in this plain-text file-is defined in Unicode, ISO 10646-1, and RFC 2279.---Using Unicode/UTF-8, you can write in emails and source code things such as--Mathematics and sciences:-- ∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫- ⎪⎢⎜│a²+b³ ⎟⎥⎪- ∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪- ⎪⎢⎜⎷ c₈ ⎟⎥⎪- ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬- ⎪⎢⎜ ∞ ⎟⎥⎪- ⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪- ⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪- 2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭--Linguistics and dictionaries:-- ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn- Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]--APL:-- ((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈--Nicer typography in plain text files:-- ╔══════════════════════════════════════════╗- ║ ║- ║ • ‘single’ and “double” quotes ║- ║ ║- ║ • Curly apostrophes: “We’ve been here” ║- ║ ║- ║ • Latin-1 apostrophe and accents: '´` ║- ║ ║- ║ • ‚deutsche‘ „Anführungszeichen“ ║- ║ ║- ║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║- ║ ║- ║ • ASCII safety test: 1lI|, 0OD, 8B ║- ║ ╭─────────╮ ║- ║ • the euro symbol: │ 14.95 € │ ║- ║ ╰─────────╯ ║- ╚══════════════════════════════════════════╝--Combining characters:-- STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑--Greek (in Polytonic):-- The Greek anthem:-- Σὲ γνωρίζω ἀπὸ τὴν κόψη- τοῦ σπαθιοῦ τὴν τρομερή,- σὲ γνωρίζω ἀπὸ τὴν ὄψη- ποὺ μὲ βία μετράει τὴ γῆ.-- ᾿Απ᾿ τὰ κόκκαλα βγαλμένη- τῶν ῾Ελλήνων τὰ ἱερά- καὶ σὰν πρῶτα ἀνδρειωμένη- χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά!-- From a speech of Demosthenes in the 4th century BC:-- Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι,- ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς- λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ- τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿- εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ- πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν- οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι,- οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν- ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον- τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι- γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν- προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους- σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ- τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ- τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς- τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον.-- Δημοσθένους, Γ´ ᾿Ολυνθιακὸς--Georgian:-- From a Unicode conference invitation:-- გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო- კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს,- ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს- ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი,- ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება- ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში,- ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.--Russian:-- From a Unicode conference invitation:-- Зарегистрируйтесь сейчас на Десятую Международную Конференцию по- Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.- Конференция соберет широкий круг экспертов по вопросам глобального- Интернета и Unicode, локализации и интернационализации, воплощению и- применению Unicode в различных операционных системах и программных- приложениях, шрифтах, верстке и многоязычных компьютерных системах.--Thai (UCS Level 2):-- Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese- classic 'San Gua'):-- [----------------------------|------------------------]- ๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่- สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา- ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา- โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ- เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ- ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ- พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้- ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ-- (The above is a two-column text. If combining characters are handled- correctly, the lines of the second column should be aligned with the- | character above.)--Ethiopian:-- Proverbs in the Amharic language:-- ሰማይ አይታረስ ንጉሥ አይከሰስ።- ብላ ካለኝ እንደአባቴ በቆመጠኝ።- ጌጥ ያለቤቱ ቁምጥና ነው።- ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው።- የአፍ ወለምታ በቅቤ አይታሽም።- አይጥ በበላ ዳዋ ተመታ።- ሲተረጉሙ ይደረግሙ።- ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል።- ድር ቢያብር አንበሳ ያስር።- ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም።- እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም።- የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ።- ሥራ ከመፍታት ልጄን ላፋታት።- ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል።- የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ።- ተንጋሎ ቢተፉ ተመልሶ ባፉ።- ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው።- እግርህን በፍራሽህ ልክ ዘርጋ።--Runes:-- ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ-- (Old English, which transcribed into Latin reads 'He cwaeth that he- bude thaem lande northweardum with tha Westsae.' and means 'He said- that he lived in the northern land near the Western Sea.')--Braille:-- ⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌-- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞- ⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎- ⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂- ⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙- ⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑- ⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲-- ⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲-- ⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹- ⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞- ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕- ⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹- ⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎- ⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎- ⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳- ⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞- ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲-- (The first couple of paragraphs of "A Christmas Carol" by Dickens)--Compact font selection example text:-- ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789- abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ- –—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд- ∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi�⑀₂ἠḂӥẄɐː⍎אԱა--Greetings in various languages:-- Hello world, Καλημέρα κόσμε, コンニチハ--Box drawing alignment tests: █- ▉- ╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳- ║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳- ║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳- ╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳- ║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎- ║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏- ╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█- ▝▀▘▙▄▟--</pre>
− httpbin-tests/Network/HTTP/ReqSpec.hs
@@ -1,480 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Network.HTTP.ReqSpec (spec) where--import Control.Exception-import Control.Monad (forM_)-import Control.Monad.Trans.Control-import Data.Aeson (ToJSON (..), Value (..), object, (.=))-import qualified Data.Aeson as A-import qualified Data.Aeson.KeyMap as Aeson.KeyMap-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import Data.Functor.Identity (runIdentity)-import Data.Maybe (fromJust)-import Data.Proxy-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as TIO-import qualified Network.HTTP.Client as L-import qualified Network.HTTP.Client.MultipartFormData as LM-import Network.HTTP.Req-import qualified Network.HTTP.Types as Y-import Test.Hspec-import Test.QuickCheck--spec :: Spec-spec = do- describe "exception throwing on non-2xx status codes" $- it "throws indeed for non-2xx" $- req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty- `shouldThrow` selector404-- describe "exception throwing on non-2xx status codes (Req monad)" $- it "throws indeed for non-2xx" $- asIO . runReq defaultHttpConfig $- liftBaseWith $ \run ->- run (req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty)- `shouldThrow` selector404-- describe "response check via httpConfigCheckResponse" $- context "if it's set to always throw" $- it "throws indeed" $- blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)- `shouldThrow` anyException-- describe "isStatusCodeException" $- it "extracts non-2xx response" $- req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty- `shouldThrow` selector404ByStatusCodeException-- describe "receiving user-agent header back" $- it "works" $ do- r <-- req- GET- (httpbin /: "user-agent")- NoReqBody- jsonResponse- (header "user-agent" "Req")- responseBody r- `shouldBe` object- ["user-agent" .= ("Req" :: Text)]- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- describe "receiving request headers back" $- it "works" $ do- r <-- req- GET- (httpbin /: "headers")- NoReqBody- jsonResponse- (header "Foo" "bar" <> header "Baz" "quux")- stripFunnyHeaders (responseBody r)- `shouldBe` object- [ "headers"- .= object- [ "Accept-Encoding" .= ("gzip" :: Text),- "Foo" .= ("bar" :: Text),- "Baz" .= ("quux" :: Text),- "Host" .= ("httpbin.org" :: Text)- ]- ]- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- describe "receiving GET data back" $- it "works" $ do- r <- req GET (httpbin /: "get") NoReqBody jsonResponse mempty- (stripFunnyHeaders . stripOrigin) (responseBody r)- `shouldBe` object- [ "args" .= emptyObject,- "url" .= ("https://httpbin.org/get" :: Text),- "headers"- .= object- [ "Accept-Encoding" .= ("gzip" :: Text),- "Host" .= ("httpbin.org" :: Text)- ]- ]- responseHeader r "Content-Type" `shouldBe` return "application/json"- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- describe "receiving POST JSON data back" $- it "works" $ do- let text = "foo" :: Text- reflected = reflectJSON text- r <- req POST (httpbin /: "post") (ReqBodyJson text) jsonResponse mempty- (stripFunnyHeaders . stripOrigin) (responseBody r)- `shouldBe` object- [ "args" .= emptyObject,- "json" .= text,- "data" .= reflected,- "url" .= ("https://httpbin.org/post" :: Text),- "headers"- .= object- [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),- "Accept-Encoding" .= ("gzip" :: Text),- "Host" .= ("httpbin.org" :: Text),- "Content-Length" .= show (T.length reflected)- ],- "files" .= emptyObject,- "form" .= emptyObject- ]- responseHeader r "Content-Type" `shouldBe` return "application/json"- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- describe "receiving POST data back (multipart form data)" $- it "works" $ do- body <-- reqBodyMultipart- [ LM.partBS "foo" "foo data!",- LM.partBS "bar" "bar data!"- ]- r <- req POST (httpbin /: "post") body jsonResponse mempty- let contentType = fromJust (getRequestContentType body)- (stripFunnyHeaders . stripOrigin) (responseBody r)- `shouldBe` object- [ "args" .= emptyObject,- "json" .= Null,- "data" .= ("" :: Text),- "url" .= ("https://httpbin.org/post" :: Text),- "headers"- .= object- [ "Content-Type" .= T.decodeUtf8 contentType,- "Accept-Encoding" .= ("gzip" :: Text),- "Host" .= ("httpbin.org" :: Text),- "Content-Length" .= ("242" :: Text)- ],- "files" .= emptyObject,- "form"- .= object- [ "foo" .= ("foo data!" :: Text),- "bar" .= ("bar data!" :: Text)- ]- ]- responseHeader r "Content-Type" `shouldBe` return "application/json"- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- describe "receiving PATCHed file back" $- it "works" $ do- let file :: FilePath- file = "httpbin-data/robots.txt"- contents <- TIO.readFile file- r <- req PATCH (httpbin /: "patch") (ReqBodyFile file) jsonResponse mempty- (stripFunnyHeaders . stripOrigin) (responseBody r)- `shouldBe` object- [ "args" .= emptyObject,- "json" .= Null,- "data" .= contents,- "url" .= ("https://httpbin.org/patch" :: Text),- "headers"- .= object- [ "Accept-Encoding" .= ("gzip" :: Text),- "Host" .= ("httpbin.org" :: Text),- "Content-Length" .= show (T.length contents)- ],- "files" .= emptyObject,- "form" .= emptyObject- ]- responseHeader r "Content-Type" `shouldBe` return "application/json"- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- describe "receiving PUT form URL-encoded data back" $- it "works" $ do- let params =- "foo" =: ("bar" :: Text)- <> "baz" =: (5 :: Int)- <> queryFlag "quux"- r <- req PUT (httpbin /: "put") (ReqBodyUrlEnc params) jsonResponse mempty- (stripFunnyHeaders . stripOrigin) (responseBody r)- `shouldBe` object- [ "args" .= emptyObject,- "json" .= Null,- "data" .= ("" :: Text),- "url" .= ("https://httpbin.org/put" :: Text),- "headers"- .= object- [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),- "Accept-Encoding" .= ("gzip" :: Text),- "Host" .= ("httpbin.org" :: Text),- "Content-Length" .= ("18" :: Text)- ],- "files" .= emptyObject,- "form"- .= object- [ "foo" .= ("bar" :: Text),- "baz" .= ("5" :: Text),- "quux" .= ("" :: Text)- ]- ]- responseHeader r "Content-Type" `shouldBe` return "application/json"- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- -- TODO /delete-- describe "receiving UTF-8 encoded Unicode data" $- it "works" $ do- r <-- req- GET- (httpbin /: "encoding" /: "utf8")- NoReqBody- bsResponse- mempty- utf8data <- B.readFile "httpbin-data/utf8.html"- responseBody r `shouldBe` utf8data- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- -- TODO /gzip- -- TODO /deflate-- describe "retrying" $- it "retries as many times as specified" $ do- -- FIXME We no longer can count retries because all the functions- -- responsible for controlling retrying are pure now.- let status = 408 :: Int- r <-- prepareForShit $- req- GET- (httpbin /: "status" /~ status)- NoReqBody- ignoreResponse- mempty- responseStatusCode r `shouldBe` status-- -- forM_ [101..102] checkStatusCode- forM_ [200 .. 208] checkStatusCode- -- forM_ [300..308] checkStatusCode- forM_ [400 .. 431] checkStatusCode- forM_ [500 .. 511] checkStatusCode-- -- TODO /response-headers- -- TODO /redirect-- describe "redirects" $- it "follows redirects" $ do- r <-- req- GET- (httpbin /: "redirect-to")- NoReqBody- ignoreResponse- ("url" =: ("https://httpbin.org" :: Text))- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- -- TODO /relative-redicet- -- TODO /absolute-redirect- -- TODO /cookies-- describe "basicAuth" $ do- let user, password :: Text- user = "Scooby"- password = "Doo"- context "when we do not send appropriate basic auth data" $- it "fails with 401" $ do- r <-- prepareForShit $- req- GET- (httpbin /: "basic-auth" /~ user /~ password)- NoReqBody- ignoreResponse- mempty- responseStatusCode r `shouldBe` 401- responseStatusMessage r `shouldBe` "UNAUTHORIZED"- context "when we provide appropriate basic auth data" $- it "succeeds" $ do- r <-- req- GET- (httpbin /: "basic-auth" /~ user /~ password)- NoReqBody- ignoreResponse- (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- -- TODO /hidden-basic-auth- -- TODO /digest-auth- -- TODO /stream- -- TODO /delay- -- TODO /drip- -- TODO /range- -- TODO /html-- describe "robots.txt" $- it "works" $ do- r <- req GET (httpbin /: "robots.txt") NoReqBody bsResponse mempty- robots <- B.readFile "httpbin-data/robots.txt"- responseBody r `shouldBe` robots- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"-- -- TODO /deny- -- TODO /cache-- describe "getting random bytes" $ do- it "works" $- property $ \n' -> do- let n :: Word- n = getSmall n'- r <-- req- GET- (httpbin /: "bytes" /~ n)- NoReqBody- lbsResponse- mempty- responseBody r `shouldSatisfy` ((== n) . fromIntegral . BL.length)- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"- context "when we try to interpret 1000 random bytes as JSON" $- it "throws correct exception" $ do- let selector :: HttpException -> Bool- selector (JsonHttpException _) = True- selector _ = False- n :: Int- n = 1000- req- GET- (httpbin /: "bytes" /~ n)- NoReqBody- (Proxy :: Proxy (JsonResponse Value))- mempty- `shouldThrow` selector-- describe "streaming random bytes" $- it "works" $- property $ \n' -> do- let n :: Word- n = getSmall n'- r <-- req- GET- (httpbin /: "stream-bytes" /~ n)- NoReqBody- bsResponse- mempty- responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)- responseStatusCode r `shouldBe` 200- responseStatusMessage r `shouldBe` "OK"---- TODO /links--- TODO /image--- TODO /image/png--- TODO /image/jpeg--- TODO /image/webp--- TODO /image/svg--- TODO /forms/post--- TODO /xml--------------------------------------------------------------------------------- Instances--instance MonadHttp IO where- handleHttpException = throwIO--------------------------------------------------------------------------------- Helpers---- | Run a request with such settings that it does not signal errors.-prepareForShit :: Req a -> IO a-prepareForShit = runReq defaultHttpConfig {httpConfigCheckResponse = noNoise}- where- noNoise _ _ _ = Nothing---- | Run a request with such settings that it throws on any response.-blindlyThrowing :: Req a -> IO a-blindlyThrowing = runReq defaultHttpConfig {httpConfigCheckResponse = doit}- where- doit _ _ = error "Oops!"---- | 'Url' representing <https://httpbin.org>.-httpbin :: Url 'Https-httpbin = https "httpbin.org"---- | Remove “origin” field from JSON value. Origin may change, we don't want--- to depend on that.-stripOrigin :: Value -> Value-stripOrigin (Object m) = Object (Aeson.KeyMap.delete "origin" m)-stripOrigin value = value---- | Remove funny headers that might break the tests.-stripFunnyHeaders :: Value -> Value-stripFunnyHeaders (Object m) =- let f (Object p) = Object $ Aeson.KeyMap.filterWithKey (\k _ -> k `elem` hs) p- f value = value- hs =- [ "Content-Type",- "Accept-Encoding",- "Host",- "Content-Length",- "Foo",- "Baz"- ]- in Object (runIdentity (Aeson.KeyMap.alterF (pure . fmap f) "headers" m))-stripFunnyHeaders value = value---- | This is a complete test case that makes use of <https://httpbin.org> to--- get various response status codes.-checkStatusCode :: Int -> SpecWith ()-checkStatusCode code =- describe ("receiving status code " ++ show code) $- it "works" $ do- r <-- prepareForShit $- req- GET- (httpbin /: "status" /~ code)- NoReqBody- ignoreResponse- mempty- responseStatusCode r `shouldBe` code---- | Exception selector that selects only 404 “Not found” exceptions.-selector404 :: HttpException -> Bool-selector404- ( VanillaHttpException- ( L.HttpExceptionRequest- _- (L.StatusCodeException response chunk)- )- ) =- L.responseStatus response == Y.status404 && not (B.null chunk)-selector404 _ = False---- | Same as 'selector404' except that it uses 'isStatusCodeException'.-selector404ByStatusCodeException :: HttpException -> Bool-selector404ByStatusCodeException e =- case isStatusCodeException e of- Nothing -> False- Just r -> responseStatusCode r == 404---- | The empty JSON 'Object'.-emptyObject :: Value-emptyObject = Object Aeson.KeyMap.empty---- | Get a rendered JSON value as 'Text'.-reflectJSON :: ToJSON a => a -> Text-reflectJSON = T.decodeUtf8 . BL.toStrict . A.encode---- | Clarify to the type checker that the inner computation is in the 'IO'--- monad.-asIO :: IO a -> IO a-asIO = id
− httpbin-tests/Spec.hs
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ httpbun-data/robots.txt view
@@ -0,0 +1,2 @@+User-agent: *+Disallow: /deny
+ httpbun-data/utf8.html view
@@ -0,0 +1,220 @@+<h1>Unicode Demo</h1>++<p>Taken from <a+href="http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-demo.txt">http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-demo.txt</a></p>++<pre>++UTF-8 encoded sample plain-text file+‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾++Markus Kuhn [ˈmaʳkʊs kuːn] <http://www.cl.cam.ac.uk/~mgk25/> — 2002-07-25+++The ASCII compatible UTF-8 encoding used in this plain-text file+is defined in Unicode, ISO 10646-1, and RFC 2279.+++Using Unicode/UTF-8, you can write in emails and source code things such as++Mathematics and sciences:++ ∮ E⋅da = Q, n → ∞, ∑ f(i) = ∏ g(i), ⎧⎡⎛┌─────┐⎞⎤⎫+ ⎪⎢⎜│a²+b³ ⎟⎥⎪+ ∀x∈ℝ: ⌈x⌉ = −⌊−x⌋, α ∧ ¬β = ¬(¬α ∨ β), ⎪⎢⎜│───── ⎟⎥⎪+ ⎪⎢⎜⎷ c₈ ⎟⎥⎪+ ℕ ⊆ ℕ₀ ⊂ ℤ ⊂ ℚ ⊂ ℝ ⊂ ℂ, ⎨⎢⎜ ⎟⎥⎬+ ⎪⎢⎜ ∞ ⎟⎥⎪+ ⊥ < a ≠ b ≡ c ≤ d ≪ ⊤ ⇒ (⟦A⟧ ⇔ ⟪B⟫), ⎪⎢⎜ ⎲ ⎟⎥⎪+ ⎪⎢⎜ ⎳aⁱ-bⁱ⎟⎥⎪+ 2H₂ + O₂ ⇌ 2H₂O, R = 4.7 kΩ, ⌀ 200 mm ⎩⎣⎝i=1 ⎠⎦⎭++Linguistics and dictionaries:++ ði ıntəˈnæʃənəl fəˈnɛtık əsoʊsiˈeıʃn+ Y [ˈʏpsilɔn], Yen [jɛn], Yoga [ˈjoːgɑ]++APL:++ ((V⍳V)=⍳⍴V)/V←,V ⌷←⍳→⍴∆∇⊃‾⍎⍕⌈++Nicer typography in plain text files:++ ╔══════════════════════════════════════════╗+ ║ ║+ ║ • ‘single’ and “double” quotes ║+ ║ ║+ ║ • Curly apostrophes: “We’ve been here” ║+ ║ ║+ ║ • Latin-1 apostrophe and accents: '´` ║+ ║ ║+ ║ • ‚deutsche‘ „Anführungszeichen“ ║+ ║ ║+ ║ • †, ‡, ‰, •, 3–4, —, −5/+5, ™, … ║+ ║ ║+ ║ • ASCII safety test: 1lI|, 0OD, 8B ║+ ║ ╭─────────╮ ║+ ║ • the euro symbol: │ 14.95 € │ ║+ ║ ╰─────────╯ ║+ ╚══════════════════════════════════════════╝++Combining characters:++ STARGΛ̊TE SG-1, a = v̇ = r̈, a⃑ ⊥ b⃑++Greek (in Polytonic):++ The Greek anthem:++ Σὲ γνωρίζω ἀπὸ τὴν κόψη+ τοῦ σπαθιοῦ τὴν τρομερή,+ σὲ γνωρίζω ἀπὸ τὴν ὄψη+ ποὺ μὲ βία μετράει τὴ γῆ.++ ᾿Απ᾿ τὰ κόκκαλα βγαλμένη+ τῶν ῾Ελλήνων τὰ ἱερά+ καὶ σὰν πρῶτα ἀνδρειωμένη+ χαῖρε, ὦ χαῖρε, ᾿Ελευθεριά!++ From a speech of Demosthenes in the 4th century BC:++ Οὐχὶ ταὐτὰ παρίσταταί μοι γιγνώσκειν, ὦ ἄνδρες ᾿Αθηναῖοι,+ ὅταν τ᾿ εἰς τὰ πράγματα ἀποβλέψω καὶ ὅταν πρὸς τοὺς+ λόγους οὓς ἀκούω· τοὺς μὲν γὰρ λόγους περὶ τοῦ+ τιμωρήσασθαι Φίλιππον ὁρῶ γιγνομένους, τὰ δὲ πράγματ᾿+ εἰς τοῦτο προήκοντα, ὥσθ᾿ ὅπως μὴ πεισόμεθ᾿ αὐτοὶ+ πρότερον κακῶς σκέψασθαι δέον. οὐδέν οὖν ἄλλο μοι δοκοῦσιν+ οἱ τὰ τοιαῦτα λέγοντες ἢ τὴν ὑπόθεσιν, περὶ ἧς βουλεύεσθαι,+ οὐχὶ τὴν οὖσαν παριστάντες ὑμῖν ἁμαρτάνειν. ἐγὼ δέ, ὅτι μέν+ ποτ᾿ ἐξῆν τῇ πόλει καὶ τὰ αὑτῆς ἔχειν ἀσφαλῶς καὶ Φίλιππον+ τιμωρήσασθαι, καὶ μάλ᾿ ἀκριβῶς οἶδα· ἐπ᾿ ἐμοῦ γάρ, οὐ πάλαι+ γέγονεν ταῦτ᾿ ἀμφότερα· νῦν μέντοι πέπεισμαι τοῦθ᾿ ἱκανὸν+ προλαβεῖν ἡμῖν εἶναι τὴν πρώτην, ὅπως τοὺς συμμάχους+ σώσομεν. ἐὰν γὰρ τοῦτο βεβαίως ὑπάρξῃ, τότε καὶ περὶ τοῦ+ τίνα τιμωρήσεταί τις καὶ ὃν τρόπον ἐξέσται σκοπεῖν· πρὶν δὲ+ τὴν ἀρχὴν ὀρθῶς ὑποθέσθαι, μάταιον ἡγοῦμαι περὶ τῆς+ τελευτῆς ὁντινοῦν ποιεῖσθαι λόγον.++ Δημοσθένους, Γ´ ᾿Ολυνθιακὸς++Georgian:++ From a Unicode conference invitation:++ გთხოვთ ახლავე გაიაროთ რეგისტრაცია Unicode-ის მეათე საერთაშორისო+ კონფერენციაზე დასასწრებად, რომელიც გაიმართება 10-12 მარტს,+ ქ. მაინცში, გერმანიაში. კონფერენცია შეჰკრებს ერთად მსოფლიოს+ ექსპერტებს ისეთ დარგებში როგორიცაა ინტერნეტი და Unicode-ი,+ ინტერნაციონალიზაცია და ლოკალიზაცია, Unicode-ის გამოყენება+ ოპერაციულ სისტემებსა, და გამოყენებით პროგრამებში, შრიფტებში,+ ტექსტების დამუშავებასა და მრავალენოვან კომპიუტერულ სისტემებში.++Russian:++ From a Unicode conference invitation:++ Зарегистрируйтесь сейчас на Десятую Международную Конференцию по+ Unicode, которая состоится 10-12 марта 1997 года в Майнце в Германии.+ Конференция соберет широкий круг экспертов по вопросам глобального+ Интернета и Unicode, локализации и интернационализации, воплощению и+ применению Unicode в различных операционных системах и программных+ приложениях, шрифтах, верстке и многоязычных компьютерных системах.++Thai (UCS Level 2):++ Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese+ classic 'San Gua'):++ [----------------------------|------------------------]+ ๏ แผ่นดินฮั่นเสื่อมโทรมแสนสังเวช พระปกเกศกองบู๊กู้ขึ้นใหม่+ สิบสองกษัตริย์ก่อนหน้าแลถัดไป สององค์ไซร้โง่เขลาเบาปัญญา+ ทรงนับถือขันทีเป็นที่พึ่ง บ้านเมืองจึงวิปริตเป็นนักหนา+ โฮจิ๋นเรียกทัพทั่วหัวเมืองมา หมายจะฆ่ามดชั่วตัวสำคัญ+ เหมือนขับไสไล่เสือจากเคหา รับหมาป่าเข้ามาเลยอาสัญ+ ฝ่ายอ้องอุ้นยุแยกให้แตกกัน ใช้สาวนั้นเป็นชนวนชื่นชวนใจ+ พลันลิฉุยกุยกีกลับก่อเหตุ ช่างอาเพศจริงหนาฟ้าร้องไห้+ ต้องรบราฆ่าฟันจนบรรลัย ฤๅหาใครค้ำชูกู้บรรลังก์ ฯ++ (The above is a two-column text. If combining characters are handled+ correctly, the lines of the second column should be aligned with the+ | character above.)++Ethiopian:++ Proverbs in the Amharic language:++ ሰማይ አይታረስ ንጉሥ አይከሰስ።+ ብላ ካለኝ እንደአባቴ በቆመጠኝ።+ ጌጥ ያለቤቱ ቁምጥና ነው።+ ደሀ በሕልሙ ቅቤ ባይጠጣ ንጣት በገደለው።+ የአፍ ወለምታ በቅቤ አይታሽም።+ አይጥ በበላ ዳዋ ተመታ።+ ሲተረጉሙ ይደረግሙ።+ ቀስ በቀስ፥ ዕንቁላል በእግሩ ይሄዳል።+ ድር ቢያብር አንበሳ ያስር።+ ሰው እንደቤቱ እንጅ እንደ ጉረቤቱ አይተዳደርም።+ እግዜር የከፈተውን ጉሮሮ ሳይዘጋው አይድርም።+ የጎረቤት ሌባ፥ ቢያዩት ይስቅ ባያዩት ያጠልቅ።+ ሥራ ከመፍታት ልጄን ላፋታት።+ ዓባይ ማደሪያ የለው፥ ግንድ ይዞ ይዞራል።+ የእስላም አገሩ መካ የአሞራ አገሩ ዋርካ።+ ተንጋሎ ቢተፉ ተመልሶ ባፉ።+ ወዳጅህ ማር ቢሆን ጨርስህ አትላሰው።+ እግርህን በፍራሽህ ልክ ዘርጋ።++Runes:++ ᚻᛖ ᚳᚹᚫᚦ ᚦᚫᛏ ᚻᛖ ᛒᚢᛞᛖ ᚩᚾ ᚦᚫᛗ ᛚᚪᚾᛞᛖ ᚾᚩᚱᚦᚹᛖᚪᚱᛞᚢᛗ ᚹᛁᚦ ᚦᚪ ᚹᛖᛥᚫ++ (Old English, which transcribed into Latin reads 'He cwaeth that he+ bude thaem lande northweardum with tha Westsae.' and means 'He said+ that he lived in the northern land near the Western Sea.')++Braille:++ ⡌⠁⠧⠑ ⠼⠁⠒ ⡍⠜⠇⠑⠹⠰⠎ ⡣⠕⠌++ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠙⠑⠁⠙⠒ ⠞⠕ ⠃⠑⠛⠔ ⠺⠊⠹⠲ ⡹⠻⠑ ⠊⠎ ⠝⠕ ⠙⠳⠃⠞+ ⠱⠁⠞⠑⠧⠻ ⠁⠃⠳⠞ ⠹⠁⠞⠲ ⡹⠑ ⠗⠑⠛⠊⠌⠻ ⠕⠋ ⠙⠊⠎ ⠃⠥⠗⠊⠁⠇ ⠺⠁⠎+ ⠎⠊⠛⠝⠫ ⠃⠹ ⠹⠑ ⠊⠇⠻⠛⠹⠍⠁⠝⠂ ⠹⠑ ⠊⠇⠻⠅⠂ ⠹⠑ ⠥⠝⠙⠻⠞⠁⠅⠻⠂+ ⠁⠝⠙ ⠹⠑ ⠡⠊⠑⠋ ⠍⠳⠗⠝⠻⠲ ⡎⠊⠗⠕⠕⠛⠑ ⠎⠊⠛⠝⠫ ⠊⠞⠲ ⡁⠝⠙+ ⡎⠊⠗⠕⠕⠛⠑⠰⠎ ⠝⠁⠍⠑ ⠺⠁⠎ ⠛⠕⠕⠙ ⠥⠏⠕⠝ ⠰⡡⠁⠝⠛⠑⠂ ⠋⠕⠗ ⠁⠝⠹⠹⠔⠛ ⠙⠑+ ⠡⠕⠎⠑ ⠞⠕ ⠏⠥⠞ ⠙⠊⠎ ⠙⠁⠝⠙ ⠞⠕⠲++ ⡕⠇⠙ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲++ ⡍⠔⠙⠖ ⡊ ⠙⠕⠝⠰⠞ ⠍⠑⠁⠝ ⠞⠕ ⠎⠁⠹ ⠹⠁⠞ ⡊ ⠅⠝⠪⠂ ⠕⠋ ⠍⠹+ ⠪⠝ ⠅⠝⠪⠇⠫⠛⠑⠂ ⠱⠁⠞ ⠹⠻⠑ ⠊⠎ ⠏⠜⠞⠊⠊⠥⠇⠜⠇⠹ ⠙⠑⠁⠙ ⠁⠃⠳⠞+ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲ ⡊ ⠍⠊⠣⠞ ⠙⠁⠧⠑ ⠃⠑⠲ ⠔⠊⠇⠔⠫⠂ ⠍⠹⠎⠑⠇⠋⠂ ⠞⠕+ ⠗⠑⠛⠜⠙ ⠁ ⠊⠕⠋⠋⠔⠤⠝⠁⠊⠇ ⠁⠎ ⠹⠑ ⠙⠑⠁⠙⠑⠌ ⠏⠊⠑⠊⠑ ⠕⠋ ⠊⠗⠕⠝⠍⠕⠝⠛⠻⠹+ ⠔ ⠹⠑ ⠞⠗⠁⠙⠑⠲ ⡃⠥⠞ ⠹⠑ ⠺⠊⠎⠙⠕⠍ ⠕⠋ ⠳⠗ ⠁⠝⠊⠑⠌⠕⠗⠎+ ⠊⠎ ⠔ ⠹⠑ ⠎⠊⠍⠊⠇⠑⠆ ⠁⠝⠙ ⠍⠹ ⠥⠝⠙⠁⠇⠇⠪⠫ ⠙⠁⠝⠙⠎+ ⠩⠁⠇⠇ ⠝⠕⠞ ⠙⠊⠌⠥⠗⠃ ⠊⠞⠂ ⠕⠗ ⠹⠑ ⡊⠳⠝⠞⠗⠹⠰⠎ ⠙⠕⠝⠑ ⠋⠕⠗⠲ ⡹⠳+ ⠺⠊⠇⠇ ⠹⠻⠑⠋⠕⠗⠑ ⠏⠻⠍⠊⠞ ⠍⠑ ⠞⠕ ⠗⠑⠏⠑⠁⠞⠂ ⠑⠍⠏⠙⠁⠞⠊⠊⠁⠇⠇⠹⠂ ⠹⠁⠞+ ⡍⠜⠇⠑⠹ ⠺⠁⠎ ⠁⠎ ⠙⠑⠁⠙ ⠁⠎ ⠁ ⠙⠕⠕⠗⠤⠝⠁⠊⠇⠲++ (The first couple of paragraphs of "A Christmas Carol" by Dickens)++Compact font selection example text:++ ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789+ abcdefghijklmnopqrstuvwxyz £©µÀÆÖÞßéöÿ+ –—‘“”„†•…‰™œŠŸž€ ΑΒΓΔΩαβγδω АБВГДабвгд+ ∀∂∈ℝ∧∪≡∞ ↑↗↨↻⇣ ┐┼╔╘░►☺♀ fi�⑀₂ἠḂӥẄɐː⍎אԱა++Greetings in various languages:++ Hello world, Καλημέρα κόσμε, コンニチハ++Box drawing alignment tests: █+ ▉+ ╔══╦══╗ ┌──┬──┐ ╭──┬──╮ ╭──┬──╮ ┏━━┳━━┓ ┎┒┏┑ ╷ ╻ ┏┯┓ ┌┰┐ ▊ ╱╲╱╲╳╳╳+ ║┌─╨─┐║ │╔═╧═╗│ │╒═╪═╕│ │╓─╁─╖│ ┃┌─╂─┐┃ ┗╃╄┙ ╶┼╴╺╋╸┠┼┨ ┝╋┥ ▋ ╲╱╲╱╳╳╳+ ║│╲ ╱│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╿ │┃ ┍╅╆┓ ╵ ╹ ┗┷┛ └┸┘ ▌ ╱╲╱╲╳╳╳+ ╠╡ ╳ ╞╣ ├╢ ╟┤ ├┼─┼─┼┤ ├╫─╂─╫┤ ┣┿╾┼╼┿┫ ┕┛┖┚ ┌┄┄┐ ╎ ┏┅┅┓ ┋ ▍ ╲╱╲╱╳╳╳+ ║│╱ ╲│║ │║ ║│ ││ │ ││ │║ ┃ ║│ ┃│ ╽ │┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▎+ ║└─╥─┘║ │╚═╤═╝│ │╘═╪═╛│ │╙─╀─╜│ ┃└─╂─┘┃ ░░▒▒▓▓██ ┊ ┆ ╎ ╏ ┇ ┋ ▏+ ╚══╩══╝ └──┴──┘ ╰──┴──╯ ╰──┴──╯ ┗━━┻━━┛ ▗▄▖▛▀▜ └╌╌┘ ╎ ┗╍╍┛ ┋ ▁▂▃▄▅▆▇█+ ▝▀▘▙▄▟++</pre>
+ httpbun-tests/Network/HTTP/ReqSpec.hs view
@@ -0,0 +1,446 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Network.HTTP.ReqSpec (spec) where++import Control.Exception+import Control.Monad (forM_)+import Control.Monad.Trans.Control+import Data.Aeson (ToJSON (..), Value (..), object, (.=))+import Data.Aeson qualified as A+import Data.Aeson.KeyMap qualified as Aeson.KeyMap+import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as BL+import Data.Functor.Identity (runIdentity)+import Data.Maybe (fromJust)+import Data.Proxy+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Text.IO qualified as TIO+import Network.HTTP.Client qualified as L+import Network.HTTP.Client.MultipartFormData qualified as LM+import Network.HTTP.Req+import Network.HTTP.Types qualified as Y+import Test.Hspec+import Test.QuickCheck++spec :: Spec+spec = do+ describe "exception throwing on non-2xx status codes" $+ it "throws indeed for non-2xx" $+ req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty+ `shouldThrow` selector404++ describe "exception throwing on non-2xx status codes (Req monad)" $+ it "throws indeed for non-2xx" $+ asIO . runReq defaultHttpConfig $+ liftBaseWith $ \run ->+ run (req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty)+ `shouldThrow` selector404++ describe "response check via httpConfigCheckResponse" $+ context "if it's set to always throw" $+ it "throws indeed" $+ blindlyThrowing (req GET httpbun NoReqBody ignoreResponse mempty)+ `shouldThrow` anyException++ describe "isStatusCodeException" $+ it "extracts non-2xx response" $+ req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty+ `shouldThrow` selector404ByStatusCodeException++ describe "receiving user-agent header back" $+ it "works" $ do+ r <-+ req+ GET+ (httpbun /: "user-agent")+ NoReqBody+ jsonResponse+ (header "user-agent" "Req")+ responseBody r+ `shouldBe` object+ ["user-agent" .= ("Req" :: Text)]+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ describe "receiving request headers back" $+ it "works" $ do+ r <-+ req+ GET+ (httpbun /: "headers")+ NoReqBody+ jsonResponse+ (header "Foo" "bar" <> header "Baz" "quux")+ stripFunnyHeaders (responseBody r)+ `shouldBe` object+ [ "headers"+ .= object+ [ "Accept-Encoding" .= ("gzip" :: Text),+ "Foo" .= ("bar" :: Text),+ "Baz" .= ("quux" :: Text)+ ]+ ]+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ describe "receiving GET data back" $+ it "works" $ do+ r <- req GET (httpbun /: "get") NoReqBody jsonResponse mempty+ (stripFunnyHeaders . stripOrigin) (responseBody r)+ `shouldBe` object+ [ "args" .= emptyObject,+ "url" .= ("https://httpbun.org/get" :: Text),+ "method" .= ("GET" :: Text),+ "headers"+ .= object+ [ "Accept-Encoding" .= ("gzip" :: Text)+ ]+ ]+ responseHeader r "Content-Type" `shouldBe` return "application/json"+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ describe "receiving POST JSON data back" $+ it "works" $ do+ let text = "foo" :: Text+ reflected = reflectJSON text+ r <- req POST (httpbun /: "post") (ReqBodyJson text) jsonResponse mempty+ (stripFunnyHeaders . stripOrigin) (responseBody r)+ `shouldBe` object+ [ "args" .= emptyObject,+ "json" .= text,+ "data" .= reflected,+ "url" .= ("https://httpbun.org/post" :: Text),+ "method" .= ("POST" :: Text),+ "headers"+ .= object+ [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),+ "Accept-Encoding" .= ("gzip" :: Text),+ "Content-Length" .= show (T.length reflected)+ ],+ "files" .= emptyObject,+ "form" .= emptyObject+ ]+ responseHeader r "Content-Type" `shouldBe` return "application/json"+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ describe "receiving POST data back (multipart form data)" $+ it "works" $ do+ body <-+ reqBodyMultipart+ [ LM.partBS "foo" "foo data!",+ LM.partBS "bar" "bar data!"+ ]+ r <- req POST (httpbun /: "post") body jsonResponse mempty+ let contentType = fromJust (getRequestContentType body)+ (stripFunnyHeaders . stripOrigin) (responseBody r)+ `shouldBe` object+ [ "args" .= emptyObject,+ "json" .= Null,+ "data" .= ("" :: Text),+ "url" .= ("https://httpbun.org/post" :: Text),+ "method" .= ("POST" :: Text),+ "headers"+ .= object+ [ "Content-Type" .= T.decodeUtf8 contentType,+ "Accept-Encoding" .= ("gzip" :: Text),+ "Content-Length" .= ("242" :: Text)+ ],+ "files" .= emptyObject,+ "form"+ .= object+ [ "foo" .= ("foo data!" :: Text),+ "bar" .= ("bar data!" :: Text)+ ]+ ]+ responseHeader r "Content-Type" `shouldBe` return "application/json"+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ describe "receiving PATCHed file back" $+ it "works" $ do+ let file :: FilePath+ file = "httpbun-data/robots.txt"+ contents <- TIO.readFile file+ r <- req PATCH (httpbun /: "patch") (ReqBodyFile file) jsonResponse mempty+ (stripFunnyHeaders . stripOrigin) (responseBody r)+ `shouldBe` object+ [ "args" .= emptyObject,+ "json" .= Null,+ "data" .= contents,+ "url" .= ("https://httpbun.org/patch" :: Text),+ "method" .= ("PATCH" :: Text),+ "headers"+ .= object+ [ "Accept-Encoding" .= ("gzip" :: Text),+ "Content-Length" .= show (T.length contents)+ ],+ "files" .= emptyObject,+ "form" .= emptyObject+ ]+ responseHeader r "Content-Type" `shouldBe` return "application/json"+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ describe "receiving PUT form URL-encoded data back" $+ it "works" $ do+ let params =+ "foo" =: ("bar" :: Text)+ <> "baz" =: (5 :: Int)+ <> queryFlag "quux"+ r <- req PUT (httpbun /: "put") (ReqBodyUrlEnc params) jsonResponse mempty+ (stripFunnyHeaders . stripOrigin) (responseBody r)+ `shouldBe` object+ [ "args" .= emptyObject,+ "json" .= Null,+ "data" .= ("" :: Text),+ "url" .= ("https://httpbun.org/put" :: Text),+ "method" .= ("PUT" :: Text),+ "headers"+ .= object+ [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),+ "Accept-Encoding" .= ("gzip" :: Text),+ "Content-Length" .= ("18" :: Text)+ ],+ "files" .= emptyObject,+ "form"+ .= object+ [ "foo" .= ("bar" :: Text),+ "baz" .= ("5" :: Text),+ "quux" .= ("" :: Text)+ ]+ ]+ responseHeader r "Content-Type" `shouldBe` return "application/json"+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ -- describe "receiving UTF-8 encoded Unicode data" $+ -- it "works" $ do+ -- r <-+ -- req+ -- GET+ -- (httpbun /: "encoding" /: "utf8")+ -- NoReqBody+ -- bsResponse+ -- mempty+ -- utf8data <- B.readFile "httpbun-data/utf8.html"+ -- responseBody r `shouldBe` utf8data+ -- responseStatusCode r `shouldBe` 200+ -- responseStatusMessage r `shouldBe` "OK"++ describe "retrying" $+ it "retries as many times as specified" $ do+ -- FIXME We no longer can count retries because all the functions+ -- responsible for controlling retrying are pure now.+ let status = 408 :: Int+ r <-+ prepareForShit $+ req+ GET+ (httpbun /: "status" /~ status)+ NoReqBody+ ignoreResponse+ mempty+ responseStatusCode r `shouldBe` status++ -- forM_ [101..102] checkStatusCode+ forM_ [200 .. 208] checkStatusCode+ -- forM_ [300..308] checkStatusCode+ forM_ [400 .. 431] checkStatusCode+ forM_ [500 .. 511] checkStatusCode++ describe "redirects" $+ it "follows redirects" $ do+ r <-+ req+ GET+ (httpbun /: "redirect-to")+ NoReqBody+ ignoreResponse+ ("url" =: ("https://httpbun.org" :: Text))+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ describe "basicAuth" $ do+ let user, password :: Text+ user = "Scooby"+ password = "Doo"+ context "when we do not send appropriate basic auth data" $+ it "fails with 401" $ do+ r <-+ prepareForShit $+ req+ GET+ (httpbun /: "basic-auth" /~ user /~ password)+ NoReqBody+ ignoreResponse+ mempty+ responseStatusCode r `shouldBe` 401+ responseStatusMessage r `shouldBe` "Unauthorized"+ context "when we provide appropriate basic auth data" $+ it "succeeds" $ do+ r <-+ req+ GET+ (httpbun /: "basic-auth" /~ user /~ password)+ NoReqBody+ ignoreResponse+ (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ describe "robots.txt" $+ it "works" $ do+ r <- req GET (httpbun /: "robots.txt") NoReqBody bsResponse mempty+ robots <- B.readFile "httpbun-data/robots.txt"+ responseBody r `shouldBe` robots+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ describe "getting random bytes" $ do+ it "works" $+ property $ \n' -> do+ let n :: Word+ n = getSmall n'+ r <-+ req+ GET+ (httpbun /: "bytes" /~ n)+ NoReqBody+ lbsResponse+ mempty+ responseBody r `shouldSatisfy` ((== n) . fromIntegral . BL.length)+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"+ context "when we try to interpret 1000 random bytes as JSON" $+ it "throws correct exception" $ do+ let selector :: HttpException -> Bool+ selector (JsonHttpException _) = True+ selector _ = False+ n :: Int+ n = 1000+ req+ GET+ (httpbun /: "bytes" /~ n)+ NoReqBody+ (Proxy :: Proxy (JsonResponse Value))+ mempty+ `shouldThrow` selector++-- describe "streaming random bytes" $+-- it "works" $+-- property $ \n' -> do+-- let n :: Word+-- n = getSmall n'+-- r <-+-- req+-- GET+-- (httpbun /: "stream-bytes" /~ n)+-- NoReqBody+-- bsResponse+-- mempty+-- responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)+-- responseStatusCode r `shouldBe` 200+-- responseStatusMessage r `shouldBe` "OK"++----------------------------------------------------------------------------+-- Instances++instance MonadHttp IO where+ handleHttpException = throwIO++----------------------------------------------------------------------------+-- Helpers++-- | Run a request with such settings that it does not signal errors.+prepareForShit :: Req a -> IO a+prepareForShit = runReq defaultHttpConfig {httpConfigCheckResponse = noNoise}+ where+ noNoise _ _ _ = Nothing++-- | Run a request with such settings that it throws on any response.+blindlyThrowing :: Req a -> IO a+blindlyThrowing = runReq defaultHttpConfig {httpConfigCheckResponse = doit}+ where+ doit _ _ = error "Oops!"++-- | 'Url' representing <https://httpbun.org>.+httpbun :: Url 'Https+httpbun = https "httpbun.org"++-- | Remove “origin” field from JSON value. Origin may change, we don't want+-- to depend on that.+stripOrigin :: Value -> Value+stripOrigin (Object m) = Object (Aeson.KeyMap.delete "origin" m)+stripOrigin value = value++-- | Remove funny headers that might break the tests.+stripFunnyHeaders :: Value -> Value+stripFunnyHeaders (Object m) =+ let f (Object p) = Object $ Aeson.KeyMap.filterWithKey (\k _ -> k `elem` hs) p+ f value = value+ hs =+ [ "Content-Type",+ "Accept-Encoding",+ "Host",+ "Content-Length",+ "Foo",+ "Baz"+ ]+ in Object (runIdentity (Aeson.KeyMap.alterF (pure . fmap f) "headers" m))+stripFunnyHeaders value = value++-- | This is a complete test case that makes use of <https://httpbun.org> to+-- get various response status codes.+checkStatusCode :: Int -> SpecWith ()+checkStatusCode code =+ describe ("receiving status code " ++ show code) $+ it "works" $ do+ r <-+ prepareForShit $+ req+ GET+ (httpbun /: "status" /~ code)+ NoReqBody+ ignoreResponse+ mempty+ responseStatusCode r `shouldBe` code++-- | Exception selector that selects only 404 “Not found” exceptions.+selector404 :: HttpException -> Bool+selector404+ ( VanillaHttpException+ ( L.HttpExceptionRequest+ _+ (L.StatusCodeException response chunk)+ )+ ) =+ L.responseStatus response == Y.status404 && not (B.null chunk)+selector404 _ = False++-- | Same as 'selector404' except that it uses 'isStatusCodeException'.+selector404ByStatusCodeException :: HttpException -> Bool+selector404ByStatusCodeException e =+ case isStatusCodeException e of+ Nothing -> False+ Just r -> responseStatusCode r == 404++-- | The empty JSON 'Object'.+emptyObject :: Value+emptyObject = Object Aeson.KeyMap.empty++-- | Get a rendered JSON value as 'Text'.+reflectJSON :: (ToJSON a) => a -> Text+reflectJSON = T.decodeUtf8 . BL.toStrict . A.encode++-- | Clarify to the type checker that the inner computation is in the 'IO'+-- monad.+asIO :: IO a -> IO a+asIO = id
+ httpbun-tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
pure-tests/Network/HTTP/ReqSpec.hs view
@@ -13,41 +13,41 @@ module Network.HTTP.ReqSpec (spec) where -import qualified Blaze.ByteString.Builder as BB+import Blaze.ByteString.Builder qualified as BB import Control.Exception (throwIO) import Control.Monad import Control.Retry import Data.Aeson (ToJSON (..))-import qualified Data.Aeson as A+import Data.Aeson qualified as A import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Lazy as BL-import qualified Data.CaseInsensitive as CI+import Data.ByteString qualified as B+import Data.ByteString.Char8 qualified as B8+import Data.ByteString.Lazy qualified as BL+import Data.CaseInsensitive qualified as CI import Data.Either (isRight)-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Maybe (fromJust, fromMaybe, isJust, isNothing) import Data.Proxy import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import Data.Text qualified as T+import Data.Text.Encoding qualified as T import Data.Time import Data.Typeable (Typeable, eqT) import GHC.Exts (IsList (..)) import GHC.Generics-import qualified Language.Haskell.TH as TH-import qualified Language.Haskell.TH.Quote as TH-import qualified Network.HTTP.Client as L+import Language.Haskell.TH qualified as TH+import Language.Haskell.TH.Quote qualified as TH+import Network.HTTP.Client qualified as L import Network.HTTP.Req-import qualified Network.HTTP.Types as Y-import qualified Network.HTTP.Types.Header as Y+import Network.HTTP.Types qualified as Y+import Network.HTTP.Types.Header qualified as Y import Test.Hspec import Test.Hspec.Core.Spec (SpecM) import Test.QuickCheck import Text.URI (URI)-import qualified Text.URI as URI-import qualified Text.URI.QQ as QQ-import qualified Web.FormUrlEncoded as F+import Text.URI qualified as URI+import Text.URI.QQ qualified as QQ+import Web.FormUrlEncoded qualified as F spec :: Spec spec = do@@ -413,7 +413,7 @@ -- 'Https, Option _) type checks, so we can catch if the type of scheme -- is unspecified. let testTypeOfQuoterResult ::- forall a s. Typeable a => (a, Option s) -> Bool+ forall a s. (Typeable a) => (a, Option s) -> Bool testTypeOfQuoterResult _ = isJust $ eqT @a @(Url 'Https) in property $ testTypeOfQuoterResult [urlQ|https://example.org/|] it "doesn't work for invalid urls" $
req.cabal view
@@ -1,11 +1,11 @@ cabal-version: 2.4 name: req-version: 3.13.0+version: 3.13.1 license: BSD-3-Clause license-file: LICENSE.md maintainer: Mark Karpov <markkarpov92@gmail.com> author: Mark Karpov <markkarpov92@gmail.com>-tested-with: ghc ==8.10.7 ghc ==9.0.2 ghc ==9.2.1+tested-with: ghc ==9.2.7 ghc ==9.4.4 ghc ==9.6.1 homepage: https://github.com/mrkkrp/req bug-reports: https://github.com/mrkkrp/req/issues synopsis: HTTP client library@@ -13,8 +13,8 @@ category: Network, Web build-type: Simple data-files:- httpbin-data/utf8.html- httpbin-data/robots.txt+ httpbun-data/utf8.html+ httpbun-data/robots.txt extra-doc-files: CHANGELOG.md@@ -31,16 +31,16 @@ library exposed-modules: Network.HTTP.Req- default-language: Haskell2010+ default-language: GHC2021 build-depends: aeson >=0.9 && <3, authenticate-oauth >=1.5 && <1.8,- base >=4.13 && <5.0,+ base >=4.15 && <5.0, blaze-builder >=0.3 && <0.5, bytestring >=0.10.8 && <0.12, case-insensitive >=0.2 && <1.3,- connection >=0.2.2 && <0.4, containers >=0.5 && <0.7,+ crypton-connection >=0.2.2 && <0.4, exceptions >=0.6 && <0.11, http-api-data >=0.2 && <0.6, http-client >=0.7.13.1 && <0.8,@@ -50,35 +50,29 @@ monad-control >=1.0 && <1.1, mtl >=2.0 && <3.0, retry >=0.8 && <0.10,- template-haskell >=2.14 && <2.19,+ template-haskell >=2.14 && <2.21, text >=0.2 && <2.1,- time >=1.2 && <1.13, transformers >=0.5.3.0 && <0.7, transformers-base, unliftio-core >=0.1.1 && <0.3 if flag(dev)- ghc-options: -O0 -Wall -Werror+ ghc-options: -Wall -Werror -Wpartial-fields -Wunused-packages else ghc-options: -O2 -Wall - if flag(dev)- ghc-options:- -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns- -Wnoncanonical-monad-instances- test-suite pure-tests type: exitcode-stdio-1.0 main-is: Spec.hs build-tool-depends: hspec-discover:hspec-discover >=2.0 && <3.0 hs-source-dirs: pure-tests other-modules: Network.HTTP.ReqSpec- default-language: Haskell2010+ default-language: GHC2021 build-depends: QuickCheck >=2.7 && <3.0, aeson >=0.9 && <3,- base >=4.13 && <5.0,+ base >=4.15 && <5.0, blaze-builder >=0.3 && <0.5, bytestring >=0.10.8 && <0.12, case-insensitive >=0.2 && <1.3,@@ -91,27 +85,27 @@ mtl >=2.0 && <3.0, req, retry >=0.8 && <0.10,- template-haskell >=2.14 && <2.19,+ template-haskell >=2.14 && <2.21, text >=0.2 && <2.1, time >=1.2 && <1.13 if flag(dev)- ghc-options: -O0 -Wall -Werror+ ghc-options: -Wall -Werror else ghc-options: -O2 -Wall -test-suite httpbin-tests+test-suite httpbun-tests type: exitcode-stdio-1.0 main-is: Spec.hs build-tool-depends: hspec-discover:hspec-discover >=2.0 && <3.0- hs-source-dirs: httpbin-tests+ hs-source-dirs: httpbun-tests other-modules: Network.HTTP.ReqSpec- default-language: Haskell2010+ default-language: GHC2021 build-depends: QuickCheck >=2.7 && <3.0, aeson >=2 && <3,- base >=4.13 && <5.0,+ base >=4.15 && <5.0, bytestring >=0.10.8 && <0.12, hspec >=2.0 && <3.0, http-client >=0.7 && <0.8,@@ -122,7 +116,7 @@ text >=0.2 && <2.1 if flag(dev)- ghc-options: -O0 -Wall -Werror+ ghc-options: -Wall -Werror else ghc-options: -O2 -Wall