@@ -51,18 +51,22 @@ where
5151import Control.Exception (throwIO)
5252import Control.Monad.Reader
5353import Data.ByteString (ByteString)
54+import Data.Maybe (isNothing, fromJust)
55+import Data.Monoid ((<>))
5456import Data.Proxy
5557import Data.Text (Text)
5658import Network.HTTP.Req
5759import Test.Hspec
5860import Test.Hspec.Core.Spec (SpecM)
5961import Test.QuickCheck
60−import qualified Data.ByteString as B
61−import qualified Data.ByteString.Char8 as B8
62−import qualified Data.Text as T
63−import qualified Data.Text.Encoding as T
64−import qualified Network.HTTP.Client as L
65−import qualified Network.HTTP.Types as Y
62+import qualified Blaze.ByteString.Builder as BB
63+import qualified Data.ByteString as B
64+import qualified Data.ByteString.Char8 as B8
65+import qualified Data.ByteString.Lazy as BL
66+import qualified Data.Text as T
67+import qualified Data.Text.Encoding as T
68+import qualified Network.HTTP.Client as L
69+import qualified Network.HTTP.Types as Y
6670
6771#if !MIN_VERSION_base(4,8,0)
6872import Control.Applicative
@@ -71,15 +75,16 @@ import Data.Monoid (mempty)
7175
7276spec :: Spec
7377spec = do
74− describe "getHttpConfig" $ do
75− it "has effect on resulting request" $ do
78+
79+ describe "config" $
80+ it "getHttpConfig has effect on resulting request" $
7681 property $ \config -> do
7782 request <- runReaderT (req_ GET url NoReqBody mempty) config
7883 L.proxy request `shouldBe` httpConfigProxy config
7984 L.redirectCount request `shouldBe` httpConfigRedirectCount config
85+
8086 describe "methods" $ do
81− let -- 'mnth' = method name test helper
82− mnth
87+ let mnth
8388 :: forall method.
8489 ( HttpMethod method
8590 , HttpBodyAllowed (AllowsBody method) 'NoBody )
@@ -87,7 +92,7 @@ spec = do
8792 -> SpecM () ()
8893 mnth method = do
8994 let name = httpMethodName (Proxy :: Proxy method)
90− describe (B8.unpack name) $ do
95+ describe (B8.unpack name) $
9196 it "affects name of HTTP method" $ do
9297 request <- req_ method url NoReqBody mempty
9398 L.method request `shouldBe` name
@@ -100,14 +105,73 @@ spec = do
100105 mnth CONNECT
101106 mnth OPTIONS
102107 mnth PATCH
108+
103109 describe "urls" $ do
104− describe "http" $ do
105− it "sets all the params" $ do
110+ describe "http" $
111+ it "sets all the params correctly" $
106112 property $ \host -> do
107113 request <- req_ GET (http host) NoReqBody mempty
108114 L.secure request `shouldBe` False
109115 L.port request `shouldBe` 80
110116 L.host request `shouldBe` urlEncode host
117+ describe "https" $
118+ it "sets all the params correctly" $
119+ property $ \host -> do
120+ request <- req_ GET (https host) NoReqBody mempty
121+ L.secure request `shouldBe` True
122+ L.port request `shouldBe` 443
123+ L.host request `shouldBe` urlEncode host
124+ describe "(/~)" $
125+ it "attaches a path piece that is URL-encoded" $
126+ property $ \host pieces -> do
127+ let url' = foldl (/~) (https host) pieces
128+ request <- req_ GET url' NoReqBody mempty
129+ L.host request `shouldBe` urlEncode host
130+ L.path request `shouldBe` encodePathPieces pieces
131+ describe "(/:)" $
132+ it "attaches a path piece that is URL-encoded" $
133+ property $ \host pieces -> do
134+ let url' = foldl (/:) (https host) pieces
135+ request <- req_ GET url' NoReqBody mempty
136+ L.host request `shouldBe` urlEncode host
137+ L.path request `shouldBe` encodePathPieces pieces
138+ describe "parseUrlHttp" $ do
139+ it "does not recognize non-http schemes" $
140+ parseUrlHttp "https://httpbin.org" `shouldSatisfy` isNothing
141+ it "parses correct URLs" $
142+ property $ \host pieces queryParams ->
143+ not (T.null host) && wellFormed queryParams ==> do
144+ let (url', path, queryString) =
145+ assembleUrl Http host pieces queryParams
146+ (url'', options) = fromJust (parseUrlHttp url')
147+ request <- req_ GET url'' NoReqBody options
148+ L.host request `shouldBe` urlEncode host
149+ L.path request `shouldBe` path
150+ L.queryString request `shouldBe` queryString
151+ describe "parseUrlHttps" $ do
152+ it "does not recognize non-https schemes" $
153+ parseUrlHttps "http://httpbin.org" `shouldSatisfy` isNothing
154+ it "parses correct URLs" $
155+ property $ \host pieces queryParams ->
156+ not (T.null host) && wellFormed queryParams ==> do
157+ let (url', path, queryString) =
158+ assembleUrl Https host pieces queryParams
159+ (url'', options) = fromJust (parseUrlHttps url')
160+ request <- req_ GET url'' NoReqBody options
161+ L.host request `shouldBe` urlEncode host
162+ L.path request `shouldBe` path
163+ L.queryString request `shouldBe` queryString
164+
165+ describe "bodies" $ do
166+ describe "NoReqBody" $ do
167+ it "sets body to empty byte string" $ do
168+ request <- req_ GET url NoReqBody mempty
169+ case L.requestBody request of
170+ 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
111175
112176----------------------------------------------------------------------------
113177-- Instances
@@ -144,6 +208,9 @@ instance Arbitrary ByteString where
144208instance Arbitrary Text where
145209 arbitrary = T.pack <$> arbitrary
146210
211+instance Show (Option scheme) where
212+ show _ = "<cannot be shown>"
213+
147214----------------------------------------------------------------------------
148215-- Helpers
149216
@@ -167,5 +234,35 @@ req_ method url' body options =
167234url :: Url 'Https
168235url = https "httpbin.org"
169236
237+-- | Percent encode given 'Text'.
238+
170239urlEncode :: Text -> ByteString
171240urlEncode = Y.urlEncode False . T.encodeUtf8
241+
242+-- | Build URL path from given path pieces.
243+
244+encodePathPieces :: [Text] -> ByteString
245+encodePathPieces = BL.toStrict . BB.toLazyByteString . Y.encodePathSegments
246+
247+-- | Assemble entire URL.
248+
249+assembleUrl
250+ :: Scheme -- ^ Scheme
251+ -> Text -- ^ Host
252+ -> [Text] -- ^ Path pieces
253+ -> [(Text, Maybe Text)] -- ^ Query parameters
254+ -> (ByteString, ByteString, ByteString) -- ^ URL, path, query string
255+assembleUrl scheme' host' pathPieces queryParams =
256+ (scheme <> host <> path <> queryString, path, queryString)
257+ where
258+ scheme = case scheme' of
259+ Http -> "http://"
260+ Https -> "https://"
261+ host = urlEncode host'
262+ path = encodePathPieces pathPieces
263+ queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)
264+
265+-- | Check if collection of query params is well-formed.
266+
267+wellFormed :: [(Text, Maybe Text)] -> Bool
268+wellFormed = all (not . T.null . fst)