git.iko.soy/typeable/req
on master help sign in
Add `parseUrl` for URLs with unknown schemes (#49)

References #48

commit4c8859866f1bb9b886d8a6c360a44c24681fddc8 authorMarc Busqué <marc@lamarciana.com> dateThu 2 Aug 2018, 05:26 (8 years ago) parent9476507
2 files changed+36−1
compare with master
unifiedsplit
Network/HTTP/Req.hs+9−1 pure-tests/Network/HTTP/ReqSpec.hs+27
Network/HTTP/Req.hs+9−1
@@ -146,6 +146,7 @@ module Network.HTTP.Req
146146 , (/:)
147147 , parseUrlHttp
148148 , parseUrlHttps
149+ , parseUrl
149150 -- ** Body
150151 -- $body
151152 , NoReqBody (..)
@@ -798,7 +799,8 @@ instance HttpMethod method => RequestComponent (Womb "method" method) where
798799-- $url
799800--
800801-- We use 'Url's which are correct by construction, see 'Url'. To build a
801−-- 'Url' from a 'ByteString', use 'parseUrlHttp' or 'parseUrlHttps'.
802+-- 'Url' from a 'ByteString', use 'parseUrlHttp', 'parseUrlHttps' or
803+-- generic 'parseUrl'.
802804
803805-- | Request's 'Url'. Start constructing your 'Url' with 'http' or 'https'
804806-- specifying the scheme and host at the same time. Then use the @('/~')@
@@ -884,6 +886,12 @@ parseUrlHttps url' = do
884886 (host :| path, option) <- parseUrlHelper url
885887 return (foldl (/:) (https host) path, option)
886888
889+-- | 'parseUrlHttp' and 'parseUrlHttps' companion that can be used
890+-- when scheme is not known beforehand.
891+
892+parseUrl :: ByteString -> Maybe (Either (Url 'Http, Option scheme) (Url 'Https, Option scheme))
893+parseUrl url' = Left <$> parseUrlHttp url' <|> Right <$> parseUrlHttps url'
894+
887895-- | Get host\/collection of path pieces and possibly query parameters
888896-- already converted to 'Option'. This function is not public.
889897
pure-tests/Network/HTTP/ReqSpec.hs+27
@@ -135,6 +135,33 @@ spec = do
135135 parseUrlHttp "https://my-site.com:bob/far" `shouldSatisfy` isNothing
136136 parseUrlHttp "https://my-site.com:7001uh/api" `shouldSatisfy` isNothing
137137 parseUrlHttp "https://my-site.com:/bar" `shouldSatisfy` isNothing
138+ describe "parseUrl" $ do
139+ it "does not recognize non-http and non-https schemes" $
140+ parseUrl "ftp://httpbin.org" `shouldSatisfy` isNothing
141+ it "parses correct http URLs" $
142+ property $ \host mport' pieces queryParams -> do
143+ let (url', path, queryString) =
144+ assembleUrl Http host mport' pieces queryParams
145+ Left (url'', options) = fromJust (parseUrl url')
146+ request <- req_ GET url'' NoReqBody options
147+ L.host request `shouldBe` urlEncode (unHost host)
148+ L.port request `shouldBe` maybe 80 getNonNegative mport'
149+ L.path request `shouldBe` path
150+ L.queryString request `shouldBe` queryString
151+ it "parses correct https URLs" $
152+ property $ \host mport' pieces queryParams -> do
153+ let (url', path, queryString) =
154+ assembleUrl Https host mport' pieces queryParams
155+ Right (url'', options) = fromJust (parseUrl url')
156+ request <- req_ GET url'' NoReqBody options
157+ L.host request `shouldBe` urlEncode (unHost host)
158+ L.port request `shouldBe` maybe 443 getNonNegative mport'
159+ L.path request `shouldBe` path
160+ L.queryString request `shouldBe` queryString
161+ it "rejects gibberish in port component" $ do
162+ parseUrl "http://my-site.com:bob/far" `shouldSatisfy` isNothing
163+ parseUrl "https://my-site.com:7001uh/api" `shouldSatisfy` isNothing
164+ parseUrl "http://my-site.com:/bar" `shouldSatisfy` isNothing
138165
139166 describe "bodies" $ do
140167 describe "NoReqBody" $