@@ -51,18 +51,22 @@ where
51import Control.Exception (throwIO)
51import Control.Exception (throwIO)
52import Control.Monad.Reader
52import Control.Monad.Reader
53import Data.ByteString (ByteString)
53import Data.ByteString (ByteString)
54+import Data.Maybe (isNothing, fromJust)
55+import Data.Monoid ((<>))
54import Data.Proxy
56import Data.Proxy
55import Data.Text (Text)
57import Data.Text (Text)
56import Network.HTTP.Req
58import Network.HTTP.Req
57import Test.Hspec
59import Test.Hspec
58import Test.Hspec.Core.Spec (SpecM)
60import Test.Hspec.Core.Spec (SpecM)
59import Test.QuickCheck
61import Test.QuickCheck
62+import qualified Blaze.ByteString.Builder as BB
60−import qualified Data.ByteString as B
63+import qualified Data.ByteString as B
61−import qualified Data.ByteString.Char8 as B8
64+import qualified Data.ByteString.Char8 as B8
62−import qualified Data.Text as T
65+import qualified Data.ByteString.Lazy as BL
66+import qualified Data.Text as T
63−import qualified Data.Text.Encoding as T
67+import qualified Data.Text.Encoding as T
64−import qualified Network.HTTP.Client as L
68+import qualified Network.HTTP.Client as L
65−import qualified Network.HTTP.Types as Y
69+import qualified Network.HTTP.Types as Y
67#if !MIN_VERSION_base(4,8,0)
71#if !MIN_VERSION_base(4,8,0)
68import Control.Applicative
72import Control.Applicative
@@ -71,15 +75,16 @@ import Data.Monoid (mempty)
72spec :: Spec
76spec :: Spec
74− describe "getHttpConfig" $ do
79+ describe "config" $
75− it "has effect on resulting request" $ do
80+ it "getHttpConfig has effect on resulting request" $
76 property $ \config -> do
81 property $ \config -> do
77 request <- runReaderT (req_ GET url NoReqBody mempty) config
82 request <- runReaderT (req_ GET url NoReqBody mempty) config
78 L.proxy request `shouldBe` httpConfigProxy config
83 L.proxy request `shouldBe` httpConfigProxy config
79 L.redirectCount request `shouldBe` httpConfigRedirectCount config
84 L.redirectCount request `shouldBe` httpConfigRedirectCount config
80 describe "methods" $ do
86 describe "methods" $ do
81− let -- 'mnth' = method name test helper
83 :: forall method.
88 :: forall method.
84 ( HttpMethod method
89 ( HttpMethod method
85 , HttpBodyAllowed (AllowsBody method) 'NoBody )
90 , HttpBodyAllowed (AllowsBody method) 'NoBody )
@@ -87,7 +92,7 @@ spec = do
87 -> SpecM () ()
92 -> SpecM () ()
88 mnth method = do
93 mnth method = do
89 let name = httpMethodName (Proxy :: Proxy method)
94 let name = httpMethodName (Proxy :: Proxy method)
90− describe (B8.unpack name) $ do
95+ describe (B8.unpack name) $
91 it "affects name of HTTP method" $ do
96 it "affects name of HTTP method" $ do
92 request <- req_ method url NoReqBody mempty
97 request <- req_ method url NoReqBody mempty
93 L.method request `shouldBe` name
98 L.method request `shouldBe` name
@@ -100,14 +105,73 @@ spec = do
100 mnth CONNECT
105 mnth CONNECT
101 mnth OPTIONS
106 mnth OPTIONS
102 mnth PATCH
107 mnth PATCH
103 describe "urls" $ do
109 describe "urls" $ do
104− describe "http" $ do
110+ describe "http" $
105− it "sets all the params" $ do
111+ it "sets all the params correctly" $
106 property $ \host -> do
112 property $ \host -> do
107 request <- req_ GET (http host) NoReqBody mempty
113 request <- req_ GET (http host) NoReqBody mempty
108 L.secure request `shouldBe` False
114 L.secure request `shouldBe` False
109 L.port request `shouldBe` 80
115 L.port request `shouldBe` 80
110 L.host request `shouldBe` urlEncode host
116 L.host request `shouldBe` urlEncode host
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
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
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
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
174+ -- TODO all options, OAuth1 and AWS pending
112----------------------------------------------------------------------------
176----------------------------------------------------------------------------
113-- Instances
177-- Instances
@@ -144,6 +208,9 @@ instance Arbitrary ByteString where
144instance Arbitrary Text where
208instance Arbitrary Text where
145 arbitrary = T.pack <$> arbitrary
209 arbitrary = T.pack <$> arbitrary
211+instance Show (Option scheme) where
212+ show _ = "<cannot be shown>"
147----------------------------------------------------------------------------
214----------------------------------------------------------------------------
148-- Helpers
215-- Helpers
@@ -167,5 +234,35 @@ req_ method url' body options =
167url :: Url 'Https
234url :: Url 'Https
168url = https "httpbin.org"
235url = https "httpbin.org"
237+-- | Percent encode given 'Text'.
170urlEncode :: Text -> ByteString
239urlEncode :: Text -> ByteString
171urlEncode = Y.urlEncode False . T.encodeUtf8
240urlEncode = Y.urlEncode False . T.encodeUtf8
242+-- | Build URL path from given path pieces.
244+encodePathPieces :: [Text] -> ByteString
245+encodePathPieces = BL.toStrict . BB.toLazyByteString . Y.encodePathSegments
247+-- | Assemble entire URL.
250+ :: Scheme -- ^ Scheme
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)
258+ scheme = case scheme' of
261+ host = urlEncode host'
262+ path = encodePathPieces pathPieces
263+ queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)
265+-- | Check if collection of query params is well-formed.
267+wellFormed :: [(Text, Maybe Text)] -> Bool
268+wellFormed = all (not . T.null . fst)