@@ -33,6 +33,7 @@
3333
3434{-# LANGUAGE CPP #-}
3535{-# LANGUAGE DataKinds #-}
36+{-# LANGUAGE DeriveGeneric #-}
3637{-# LANGUAGE FlexibleInstances #-}
3738{-# LANGUAGE OverloadedStrings #-}
3839{-# LANGUAGE RankNTypes #-}
@@ -50,19 +51,24 @@ where
5051
5152import Control.Exception (throwIO)
5253import Control.Monad.Reader
54+import Data.Aeson (ToJSON (..))
5355import Data.ByteString (ByteString)
5456import Data.Maybe (isNothing, fromJust)
5557import Data.Monoid ((<>))
5658import Data.Proxy
5759import Data.Text (Text)
60+import Data.Time
61+import GHC.Generics
5862import Network.HTTP.Req
5963import Test.Hspec
6064import Test.Hspec.Core.Spec (SpecM)
6165import Test.QuickCheck
6266import qualified Blaze.ByteString.Builder as BB
67+import qualified Data.Aeson as A
6368import qualified Data.ByteString as B
6469import qualified Data.ByteString.Char8 as B8
6570import qualified Data.ByteString.Lazy as BL
71+import qualified Data.CaseInsensitive as CI
6672import qualified Data.Text as T
6773import qualified Data.Text.Encoding as T
6874import qualified Network.HTTP.Client as L
@@ -70,6 +76,7 @@ import qualified Network.HTTP.Types as Y
7076
7177#if !MIN_VERSION_base(4,8,0)
7278import Control.Applicative
79+import Data.Foldable (foldMap)
7380import Data.Monoid (mempty)
7481#endif
7582
@@ -163,15 +170,62 @@ spec = do
163170 L.queryString request `shouldBe` queryString
164171
165172 describe "bodies" $ do
166− describe "NoReqBody" $ do
173+ describe "NoReqBody" $
167174 it "sets body to empty byte string" $ do
168− request <- req_ GET url NoReqBody mempty
175+ request <- req_ POST url NoReqBody mempty
169176 case L.requestBody request of
170177 L.RequestBodyBS x -> x `shouldBe` B.empty
171− _ -> expectationFailure "Something is wrong with request body."
172− -- TODO finish with request bodies
173−
174− -- TODO all options, OAuth1 and AWS pending
178+ _ -> expectationFailure "Wrong request body constructor."
179+ describe "ReqBodyJson" $
180+ it "sets body to correct lazy byte string" $
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."
207+
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
175229
176230----------------------------------------------------------------------------
177231-- Instances
@@ -205,12 +259,52 @@ instance Arbitrary L.Proxy where
205259instance Arbitrary ByteString where
206260 arbitrary = B.pack <$> arbitrary
207261
262+instance Arbitrary BL.ByteString where
263+ arbitrary = BL.pack <$> arbitrary
264+
208265instance Arbitrary Text where
209266 arbitrary = T.pack <$> arbitrary
210267
211268instance Show (Option scheme) where
212269 show _ = "<cannot be shown>"
213270
271+data Thing = Thing
272+ { _thingBool :: Bool
273+ , _thingText :: Text
274+ } deriving (Eq, Show, Generic)
275+
276+instance ToJSON Thing
277+
278+instance Arbitrary Thing where
279+ arbitrary = Thing <$> arbitrary <*> arbitrary
280+
281+instance Arbitrary L.CookieJar where
282+ arbitrary = L.createCookieJar <$> arbitrary
283+
284+instance Arbitrary L.Cookie where
285+ arbitrary = do
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 {..}
298+
299+instance Arbitrary UTCTime where
300+ arbitrary = UTCTime <$> arbitrary <*> arbitrary
301+
302+instance Arbitrary Day where
303+ arbitrary = ModifiedJulianDay <$> arbitrary
304+
305+instance Arbitrary DiffTime where
306+ arbitrary = secondsToDiffTime <$> arbitrary
307+
214308----------------------------------------------------------------------------
215309-- Helpers
216310
@@ -262,7 +356,15 @@ assembleUrl scheme' host' pathPieces queryParams =
262356 path = encodePathPieces pathPieces
263357 queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)
264358
359+renderQuery :: [(Text, Maybe Text)] -> BL.ByteString
360+renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery
361+
265362-- | Check if collection of query params is well-formed.
266363
267364wellFormed :: [(Text, Maybe Text)] -> Bool
268365wellFormed = all (not . T.null . fst)
366+
367+-- | Convert collection of query parameters to 'FormUrlEncodedParam' thing.
368+
369+formUrlEnc :: [(Text, Maybe Text)] -> FormUrlEncodedParam
370+formUrlEnc = foldMap (uncurry queryParam)