@@ -33,6 +33,7 @@
34{-# LANGUAGE CPP #-}
34{-# LANGUAGE CPP #-}
35{-# LANGUAGE DataKinds #-}
35{-# LANGUAGE DataKinds #-}
36+{-# LANGUAGE DeriveGeneric #-}
36{-# LANGUAGE FlexibleInstances #-}
37{-# LANGUAGE FlexibleInstances #-}
37{-# LANGUAGE OverloadedStrings #-}
38{-# LANGUAGE OverloadedStrings #-}
38{-# LANGUAGE RankNTypes #-}
39{-# LANGUAGE RankNTypes #-}
@@ -50,19 +51,24 @@ where
51import Control.Exception (throwIO)
52import Control.Exception (throwIO)
52import Control.Monad.Reader
53import Control.Monad.Reader
54+import Data.Aeson (ToJSON (..))
53import Data.ByteString (ByteString)
55import Data.ByteString (ByteString)
54import Data.Maybe (isNothing, fromJust)
56import Data.Maybe (isNothing, fromJust)
55import Data.Monoid ((<>))
57import Data.Monoid ((<>))
56import Data.Proxy
58import Data.Proxy
57import Data.Text (Text)
59import Data.Text (Text)
58import Network.HTTP.Req
62import Network.HTTP.Req
59import Test.Hspec
63import Test.Hspec
60import Test.Hspec.Core.Spec (SpecM)
64import Test.Hspec.Core.Spec (SpecM)
61import Test.QuickCheck
65import Test.QuickCheck
62import qualified Blaze.ByteString.Builder as BB
66import qualified Blaze.ByteString.Builder as BB
67+import qualified Data.Aeson as A
63import qualified Data.ByteString as B
68import qualified Data.ByteString as B
64import qualified Data.ByteString.Char8 as B8
69import qualified Data.ByteString.Char8 as B8
65import qualified Data.ByteString.Lazy as BL
70import qualified Data.ByteString.Lazy as BL
71+import qualified Data.CaseInsensitive as CI
66import qualified Data.Text as T
72import qualified Data.Text as T
67import qualified Data.Text.Encoding as T
73import qualified Data.Text.Encoding as T
68import qualified Network.HTTP.Client as L
74import qualified Network.HTTP.Client as L
@@ -70,6 +76,7 @@ import qualified Network.HTTP.Types as Y
71#if !MIN_VERSION_base(4,8,0)
77#if !MIN_VERSION_base(4,8,0)
72import Control.Applicative
78import Control.Applicative
79+import Data.Foldable (foldMap)
73import Data.Monoid (mempty)
80import Data.Monoid (mempty)
@@ -163,15 +170,62 @@ spec = do
163 L.queryString request `shouldBe` queryString
170 L.queryString request `shouldBe` queryString
165 describe "bodies" $ do
172 describe "bodies" $ do
166− describe "NoReqBody" $ do
173+ describe "NoReqBody" $
167 it "sets body to empty byte string" $ do
174 it "sets body to empty byte string" $ do
168− request <- req_ GET url NoReqBody mempty
175+ request <- req_ POST url NoReqBody mempty
169 case L.requestBody request of
176 case L.requestBody request of
170 L.RequestBodyBS x -> x `shouldBe` B.empty
177 L.RequestBodyBS x -> x `shouldBe` B.empty
171− _ -> expectationFailure "Something is wrong with request body."
178+ _ -> expectationFailure "Wrong request body constructor."
172− -- TODO finish with request bodies
179+ describe "ReqBodyJson" $
173−
180+ it "sets body to correct lazy byte string" $
174− -- TODO all options, OAuth1 and AWS pending
181+ property $ \thing -> do
182+ request <- req_ POST url (ReqBodyJson thing) mempty
183+ case L.requestBody request of
184+ L.RequestBodyLBS x -> x `shouldBe` A.encode (thing :: Thing)
185+ _ -> expectationFailure "Wrong request body constructor."
186+ describe "ReqBodyBs" $
187+ it "sets body to specified strict byte string" $
188+ property $ \bs -> do
189+ request <- req_ POST url (ReqBodyBs bs) mempty
190+ case L.requestBody request of
191+ L.RequestBodyBS x -> x `shouldBe` bs
192+ _ -> expectationFailure "Wrong request body constructor."
193+ describe "ReqBodyLbs" $
194+ it "sets body to specified lazy byte string" $
195+ property $ \lbs -> do
196+ request <- req_ POST url (ReqBodyLbs lbs) mempty
197+ case L.requestBody request of
198+ L.RequestBodyLBS x -> x `shouldBe` lbs
199+ _ -> expectationFailure "Wrong request body constructor."
200+ describe "ReqBodyUrlEnc" $
201+ it "sets body to correct lazy byte string" $
202+ property $ \params -> do
203+ request <- req_ POST url (ReqBodyUrlEnc (formUrlEnc params)) mempty
204+ case L.requestBody request of
205+ L.RequestBodyLBS x -> x `shouldBe` renderQuery params
206+ _ -> expectationFailure "Wrong request body constructor."
208+ describe "optional parameters" $ do
209+ describe "header" $ do
210+ it "sets specified header value" $
211+ property $ \name value -> do
212+ request <- req_ GET url NoReqBody (header name value)
213+ lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value
214+ it "left header wins" $
215+ property $ \name value0 value1 -> do
216+ request <- req_ GET url NoReqBody
217+ (header name value0 <> header name value1)
218+ lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value0
219+ it "overwrites headers set by other parts of the lib" $
220+ property $ \value -> do
221+ request <- req_ POST url (ReqBodyUrlEnc mempty)
222+ (header "Content-Type" value)
223+ lookup "Content-Type" (L.requestHeaders request) `shouldBe` pure value
224+ describe "cookieJar" $
225+ it "cookie jar is set without modifications" $
226+ property $ \cjar -> do
227+ request <- req_ GET url NoReqBody (cookieJar cjar)
228+ L.cookieJar request `shouldBe` pure cjar
176----------------------------------------------------------------------------
230----------------------------------------------------------------------------
177-- Instances
231-- Instances
@@ -205,12 +259,52 @@ instance Arbitrary L.Proxy where
205instance Arbitrary ByteString where
259instance Arbitrary ByteString where
206 arbitrary = B.pack <$> arbitrary
260 arbitrary = B.pack <$> arbitrary
262+instance Arbitrary BL.ByteString where
263+ arbitrary = BL.pack <$> arbitrary
208instance Arbitrary Text where
265instance Arbitrary Text where
209 arbitrary = T.pack <$> arbitrary
266 arbitrary = T.pack <$> arbitrary
211instance Show (Option scheme) where
268instance Show (Option scheme) where
212 show _ = "<cannot be shown>"
269 show _ = "<cannot be shown>"
272+ { _thingBool :: Bool
273+ , _thingText :: Text
274+ } deriving (Eq, Show, Generic)
276+instance ToJSON Thing
278+instance Arbitrary Thing where
279+ arbitrary = Thing <$> arbitrary <*> arbitrary
281+instance Arbitrary L.CookieJar where
282+ arbitrary = L.createCookieJar <$> arbitrary
284+instance Arbitrary L.Cookie where
286+ cookie_name <- arbitrary
287+ cookie_value <- arbitrary
288+ cookie_expiry_time <- arbitrary
289+ cookie_domain <- arbitrary
290+ cookie_path <- arbitrary
291+ cookie_creation_time <- arbitrary
292+ cookie_last_access_time <- arbitrary
293+ cookie_persistent <- arbitrary
294+ cookie_host_only <- arbitrary
295+ cookie_secure_only <- arbitrary
296+ cookie_http_only <- arbitrary
297+ return L.Cookie {..}
299+instance Arbitrary UTCTime where
300+ arbitrary = UTCTime <$> arbitrary <*> arbitrary
302+instance Arbitrary Day where
303+ arbitrary = ModifiedJulianDay <$> arbitrary
305+instance Arbitrary DiffTime where
306+ arbitrary = secondsToDiffTime <$> arbitrary
214----------------------------------------------------------------------------
308----------------------------------------------------------------------------
215-- Helpers
309-- Helpers
@@ -262,7 +356,15 @@ assembleUrl scheme' host' pathPieces queryParams =
262 path = encodePathPieces pathPieces
356 path = encodePathPieces pathPieces
263 queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)
357 queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)
359+renderQuery :: [(Text, Maybe Text)] -> BL.ByteString
360+renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery
265-- | Check if collection of query params is well-formed.
362-- | Check if collection of query params is well-formed.
267wellFormed :: [(Text, Maybe Text)] -> Bool
364wellFormed :: [(Text, Maybe Text)] -> Bool
268wellFormed = all (not . T.null . fst)
365wellFormed = all (not . T.null . fst)
367+-- | Convert collection of query parameters to 'FormUrlEncodedParam' thing.
369+formUrlEnc :: [(Text, Maybe Text)] -> FormUrlEncodedParam
370+formUrlEnc = foldMap (uncurry queryParam)