on master help sign in
Add ‘parseUrlHttp’ and ‘parseUrlHttps’
commit2febecdd565b33a5cade4739974944b3e08d8706 authormrkkrp <markkarpov@opmbx.org> dateFri 28 Oct 2016, 20:48 (10 years ago) parentb49c999
1 file changed+52−12
Network/HTTP/Req.hs+52−12
Network/HTTP/Req.hs+52−12
@@ -113,6 +113,8 @@ module Network.HTTP.Req
113113 , http
114114 , https
115115 , (/:)
116+ , parseUrlHttp
117+ , parseUrlHttps
116118 -- ** Body
117119 , HttpBody (..) -- TODO more stuff here
118120 -- ** Optional parameters
@@ -148,13 +150,13 @@ import Control.Arrow (first, second)
148150import Control.Exception (try)
149151import Control.Monad.IO.Class
150152import Data.Aeson
151−import Data.ByteString
153+import Data.ByteString (ByteString)
152154import Data.Data (Data)
153155import Data.Default.Class
154156import Data.IORef
155157import Data.List.NonEmpty (NonEmpty (..))
156158import Data.Proxy
157−import Data.Semigroup hiding (Option)
159+import Data.Semigroup hiding (Option, option)
158160import Data.Text (Text)
159161import Data.Typeable (Typeable)
160162import GHC.Generics
@@ -433,23 +435,21 @@ instance HttpMethod method => RequestComponent (Womb "method" method) where
433435-- > https "юникод.рф"
434436-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
435437
436−data Url (scheme :: Scheme) = Url Bool (NonEmpty Text)
437− -- NOTE The first 'Bool' value specifies if the 'Url' has “https” as its
438− -- scheme (otherwise “http” is assumed). The second value is path segments
439− -- in reversed order.
440− deriving (Eq, Ord, Data, Typeable, Generic)
438+data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
439+ -- NOTE The second value is path segments in reversed order.
440+ deriving (Eq, Ord, Show, Data, Typeable, Generic)
441441
442442-- | Given host name, produce a 'Url' which have “http” as its scheme and
443443-- empty path. This also sets port to @80@.
444444
445445http :: Text -> Url 'Http
446−http = Url False . pure
446+http = Url Http . pure
447447
448448-- | Given host name, produce a 'Url' which have “https” as its scheme and
449449-- empty path. This also sets port to @443@.
450450
451451https :: Text -> Url 'Https
452−https = Url True . pure
452+https = Url Https . pure
453453
454454-- | Grow given 'Url' appending a single path segment to it.
455455
@@ -457,11 +457,50 @@ infixl 5 /:
457457(/:) :: Url scheme -> Text -> Url scheme
458458Url secure path /: segment = Url secure (NE.cons segment path)
459459
460+-- | The 'parseUrlHttp' function provides an alternative method to get 'Url'
461+-- (possibly with some 'Option's) from a 'ByteString'. This is useful when
462+-- you are given an URL to query dynamically and don't know it beforehand.
463+-- The function parses 'ByteString' because it's a correct type to hold an
464+-- URL, as 'Url' cannot contain characters outside of ASCII range, thus we
465+-- can consider every character a 'Data.Word.Word8' value.
466+--
467+-- This function only parses 'Url' (scheme, host, path) and optional query
468+-- parameters that are returned as 'Option'. It does not parse method name
469+-- or authentication info from given 'ByteString'.
470+
471+parseUrlHttp :: ByteString -> Maybe (Url 'Http, Option scheme)
472+parseUrlHttp url' = do
473+ url <- B.stripPrefix "http://" url'
474+ (host :| path, option) <- parseUrlHelper url
475+ return (foldl (/:) (http host) path, option)
476+
477+-- | Just like 'parseUrlHttp', but expects “https” scheme.
478+
479+parseUrlHttps :: ByteString -> Maybe (Url 'Https, Option scheme)
480+parseUrlHttps url' = do
481+ url <- B.stripPrefix "https://" url'
482+ (host :| path, option) <- parseUrlHelper url
483+ return (foldl (/:) (https host) path, option)
484+
485+-- | Get host\/collection of path pieces and possibly query parameters
486+-- already converted to 'Option'. This function is not public.
487+
488+parseUrlHelper :: ByteString -> Maybe (NonEmpty Text, Option scheme)
489+parseUrlHelper url = do
490+ let (path', query') = B.break (== 0x3f) url
491+ query = mconcat (uncurry queryParam <$> Y.parseQueryText query')
492+ path <- NE.nonEmpty (Y.decodePathSegments path')
493+ return (path, query)
494+
460495instance RequestComponent (Url scheme) where
461− getRequestMod (Url secure segments) = Endo $ \x ->
496+ getRequestMod (Url scheme segments) = Endo $ \x ->
462497 let (host :| path) = NE.reverse segments in
463− x { L.secure = secure
464− , L.port = if secure then 443 else 80
498+ x { L.secure = case scheme of
499+ Http -> False
500+ Https -> True
501+ , L.port = case scheme of
502+ Http -> 80
503+ Https -> 443
465504 , L.host = Y.urlEncode False (T.encodeUtf8 host)
466505 , L.path =
467506 (BL.toStrict . R.toLazyByteString . Y.encodePathSegments) path }
@@ -747,3 +786,4 @@ data CanHaveBody
747786data Scheme
748787 = Http -- ^ HTTP, no TLS
749788 | Https -- ^ HTTPS
789+ deriving (Eq, Ord, Show, Data, Typeable, Generic)