{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Query strings generally have the following form: @"key1=value1&key2=value2"@
--
-- >>> renderQuery False [("key1", Just "value1"), ("key2", Just "value2")]
-- "key1=value1&key2=value2"
--
-- But if the value of @key1@ is 'Nothing', it becomes: @key1&key2=value2@
--
-- >>> renderQuery False [("key1", Nothing), ("key2", Just "value2")]
-- "key1&key2=value2"
--
-- This module also provides type synonyms and functions to handle queries
-- that do not allow/expect keys without values ('SimpleQuery'), handle
-- queries which have partially escaped characters
module Network.HTTP.Types.URI (
    -- * Query strings

    -- ** Query
    Query,
    QueryItem,
    renderQuery,
    renderQueryBuilder,
    parseQuery,
    parseQueryReplacePlus,

    -- *** Query (Text)
    QueryText,
    queryTextToQuery,
    queryToQueryText,
    renderQueryText,
    parseQueryText,

    -- ** SimpleQuery

    -- | If values are guaranteed, it might be easier working with 'SimpleQuery'.
    --
    -- This way, you don't have to worry about any 'Maybe's, though when parsing
    -- a query string and there's no @\'=\'@ after the key in the query item, the
    -- value will just be an empty 'B.ByteString'.
    SimpleQuery,
    SimpleQueryItem,
    simpleQueryToQuery,
    renderSimpleQuery,
    parseSimpleQuery,

    -- ** PartialEscapeQuery

    -- | For some values in query items, certain characters must not be percent-encoded,
    -- for example @\'+\'@ or @\':\'@ in
    --
    -- @q=a+language:haskell+created:2009-01-01..2009-02-01&sort=stars@
    --
    -- Using specific 'EscapeItem's provides a way to decide which parts of a query string value
    -- will be URL encoded and which won't.
    --
    -- This is mandatory when searching for @\'+\'@ (@%2B@ being a percent-encoded @\'+\'@):
    --
    -- @q=%2B+language:haskell@
    PartialEscapeQuery,
    PartialEscapeQueryItem,
    EscapeItem (..),
    renderQueryPartialEscape,
    renderQueryBuilderPartialEscape,

    -- * Path

    -- ** Segments + Query String
    extractPath,
    encodePath,
    decodePath,

    -- ** Path Segments
    encodePathSegments,
    encodePathSegmentsRelative,
    decodePathSegments,

    -- * URL encoding / decoding
    urlEncode,
    urlEncodeBuilder,
    urlDecode,
)
where

import Control.Arrow (second, (***))
import Data.Bits (shiftL, (.|.))
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as BL
import Data.Char (ord)
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Word (Word8)

-- | An item from the query string, split up into two parts.
--
-- The second part should be 'Nothing' if there was no key-value
-- separator after the query item name.
--
-- @since 0.2.0
type QueryItem = (B.ByteString, Maybe B.ByteString)

-- | A sequence of 'QueryItem's.
type Query = [QueryItem]

-- | Like Query, but with 'Text' instead of 'B.ByteString' (UTF8-encoded).
--
-- @since 0.5.2
type QueryText = [(Text, Maybe Text)]

-- | Convert 'QueryText' to 'Query'.
--
-- @since 0.5.2
queryTextToQuery :: QueryText -> Query
queryTextToQuery :: QueryText -> Query
queryTextToQuery = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8

-- | Convert 'QueryText' to a 'B.Builder'.
--
-- If you want a question mark (@?@) added to the front of the result, use 'True'.
--
-- @since 0.5.2
renderQueryText :: Bool -> QueryText -> B.Builder
renderQueryText :: Bool -> QueryText -> Builder
renderQueryText Bool
b = Bool -> Query -> Builder
renderQueryBuilder Bool
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryText -> Query
queryTextToQuery

-- | Convert 'Query' to 'QueryText' (leniently decoding the UTF-8).
--
-- @since 0.5.2
queryToQueryText :: Query -> QueryText
queryToQueryText :: Query -> QueryText
queryToQueryText =
    forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ ByteString -> Text
go forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
go
  where
    go :: ByteString -> Text
go = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode

-- | Parse a 'QueryText' from a 'B.ByteString'. See 'parseQuery' for details.
--
-- @'queryToQueryText' . 'parseQuery'@
--
-- @since 0.5.2
parseQueryText :: B.ByteString -> QueryText
parseQueryText :: ByteString -> QueryText
parseQueryText = Query -> QueryText
queryToQueryText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Query
parseQuery

-- | Simplified query item type without support for parameter-less items.
--
-- @since 0.2.0
type SimpleQueryItem = (B.ByteString, B.ByteString)

-- | A sequence of 'SimpleQueryItem's.
type SimpleQuery = [SimpleQueryItem]

-- | Convert 'SimpleQuery' to 'Query'.
--
-- @since 0.5
simpleQueryToQuery :: SimpleQuery -> Query
simpleQueryToQuery :: SimpleQuery -> Query
simpleQueryToQuery = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. a -> Maybe a
Just)

-- | Renders the given 'Query' into a 'Builder'.
--
-- If you want a question mark (@?@) added to the front of the result, use 'True'.
--
-- @since 0.5
renderQueryBuilder :: Bool -> Query -> B.Builder
renderQueryBuilder :: Bool -> Query -> Builder
renderQueryBuilder Bool
_ [] = forall a. Monoid a => a
mempty
renderQueryBuilder Bool
qmark' ((ByteString, Maybe ByteString)
p : Query
ps) =
    -- FIXME: replace mconcat + map with foldr
    forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
        Builder -> (ByteString, Maybe ByteString) -> Builder
go (if Bool
qmark' then Builder
qmark else forall a. Monoid a => a
mempty) (ByteString, Maybe ByteString)
p
            forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Builder -> (ByteString, Maybe ByteString) -> Builder
go Builder
amp) Query
ps
  where
    qmark :: Builder
qmark = ByteString -> Builder
B.byteString ByteString
"?"
    amp :: Builder
amp = ByteString -> Builder
B.byteString ByteString
"&"
    equal :: Builder
equal = ByteString -> Builder
B.byteString ByteString
"="
    go :: Builder -> (ByteString, Maybe ByteString) -> Builder
go Builder
sep (ByteString
k, Maybe ByteString
mv) =
        forall a. Monoid a => [a] -> a
mconcat
            [ Builder
sep
            , Bool -> ByteString -> Builder
urlEncodeBuilder Bool
True ByteString
k
            , case Maybe ByteString
mv of
                Maybe ByteString
Nothing -> forall a. Monoid a => a
mempty
                Just ByteString
v -> Builder
equal forall a. Monoid a => a -> a -> a
`mappend` Bool -> ByteString -> Builder
urlEncodeBuilder Bool
True ByteString
v
            ]

-- | Renders the given 'Query' into a 'B.ByteString'.
--
-- If you want a question mark (@?@) added to the front of the result, use 'True'.
--
-- @since 0.2.0
renderQuery :: Bool -> Query -> B.ByteString
renderQuery :: Bool -> Query -> ByteString
renderQuery Bool
qm = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Query -> Builder
renderQueryBuilder Bool
qm

-- | Render the given 'SimpleQuery' into a 'ByteString'.
--
-- If you want a question mark (@?@) added to the front of the result, use 'True'.
--
-- @since 0.2.0
renderSimpleQuery :: Bool -> SimpleQuery -> B.ByteString
renderSimpleQuery :: Bool -> SimpleQuery -> ByteString
renderSimpleQuery Bool
useQuestionMark = Bool -> Query -> ByteString
renderQuery Bool
useQuestionMark forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleQuery -> Query
simpleQueryToQuery

-- | Split out the query string into a list of keys and values. A few
-- importants points:
--
-- * The result returned is still bytestrings, since we perform no character
-- decoding here. Most likely, you will want to use UTF-8 decoding, but this is
-- left to the user of the library.
--
-- * Percent decoding errors are ignored. In particular, @"%Q"@ will be output as
-- @"%Q"@.
--
-- * It decodes @\'+\'@ characters to @\' \'@
--
-- @since 0.2.0
parseQuery :: B.ByteString -> Query
parseQuery :: ByteString -> Query
parseQuery = Bool -> ByteString -> Query
parseQueryReplacePlus Bool
True

-- | Same functionality as 'parseQuery', but with the option to decode @\'+\'@ characters to @\' \'@
-- or to preserve any @\'+\'@ encountered.
--
-- If you want to replace any @\'+\'@ with a space, use 'True'.
--
-- @since 0.12.2
parseQueryReplacePlus :: Bool -> B.ByteString -> Query
parseQueryReplacePlus :: Bool -> ByteString -> Query
parseQueryReplacePlus Bool
replacePlus ByteString
bs = ByteString -> Query
parseQueryString' forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dropQuestion ByteString
bs
  where
    dropQuestion :: ByteString -> ByteString
dropQuestion ByteString
q =
        case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
q of
            Just (Word8
63, ByteString
q') -> ByteString
q'
            Maybe (Word8, ByteString)
_ -> ByteString
q
    parseQueryString' :: ByteString -> Query
parseQueryString' ByteString
q | ByteString -> Bool
B.null ByteString
q = []
    parseQueryString' ByteString
q =
        let (ByteString
x, ByteString
xs) = ByteString -> ByteString -> (ByteString, ByteString)
breakDiscard ByteString
queryStringSeparators ByteString
q
         in ByteString -> (ByteString, Maybe ByteString)
parsePair ByteString
x forall a. a -> [a] -> [a]
: ByteString -> Query
parseQueryString' ByteString
xs
      where
        parsePair :: ByteString -> (ByteString, Maybe ByteString)
parsePair ByteString
x =
            let (ByteString
k, ByteString
v) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (forall a. Eq a => a -> a -> Bool
== Word8
61) ByteString
x -- equal sign
                v'' :: Maybe ByteString
v'' =
                    case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
v of
                        Just (Word8
_, ByteString
v') -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> ByteString -> ByteString
urlDecode Bool
replacePlus ByteString
v'
                        Maybe (Word8, ByteString)
_ -> forall a. Maybe a
Nothing
             in (Bool -> ByteString -> ByteString
urlDecode Bool
replacePlus ByteString
k, Maybe ByteString
v'')

queryStringSeparators :: B.ByteString
queryStringSeparators :: ByteString
queryStringSeparators = [Word8] -> ByteString
B.pack [Word8
38, Word8
59] -- ampersand, semicolon

-- | Break the second bytestring at the first occurrence of any bytes from
-- the first bytestring, discarding that byte.
breakDiscard :: B.ByteString -> B.ByteString -> (B.ByteString, B.ByteString)
breakDiscard :: ByteString -> ByteString -> (ByteString, ByteString)
breakDiscard ByteString
seps ByteString
s =
    let (ByteString
x, ByteString
y) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (Word8 -> ByteString -> Bool
`B.elem` ByteString
seps) ByteString
s
     in (ByteString
x, Int -> ByteString -> ByteString
B.drop Int
1 ByteString
y)

-- | Parse 'SimpleQuery' from a 'ByteString'.
--
-- This uses 'parseQuery' under the hood, and will transform
-- any 'Nothing' values into an empty 'B.ByteString'.
--
-- @since 0.2.0
parseSimpleQuery :: B.ByteString -> SimpleQuery
parseSimpleQuery :: ByteString -> SimpleQuery
parseSimpleQuery = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe ByteString
B.empty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Query
parseQuery

ord8 :: Char -> Word8
ord8 :: Char -> Word8
ord8 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

unreservedQS, unreservedPI :: [Word8]
unreservedQS :: [Word8]
unreservedQS = forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ord8 [Char]
"-_.~"
-- FIXME: According to RFC 3986, the following are also allowed in path segments:
-- "!'()*;"
--
-- https://www.rfc-editor.org/rfc/rfc3986#section-3.3
unreservedPI :: [Word8]
unreservedPI = forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ord8 [Char]
"-_.~:@&=+$,"

-- | Percent-encoding for URLs.
--
-- This will substitute every byte with its percent-encoded equivalent unless:
--
-- * The byte is alphanumeric. (i.e. one of @/[A-Za-z0-9]/@)
--
-- * The byte is one of the 'Word8' listed in the first argument.
urlEncodeBuilder' :: [Word8] -> B.ByteString -> B.Builder
urlEncodeBuilder' :: [Word8] -> ByteString -> Builder
urlEncodeBuilder' [Word8]
extraUnreserved =
    forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Builder
encodeChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack
  where
    encodeChar :: Word8 -> Builder
encodeChar Word8
ch
        | Word8 -> Bool
unreserved Word8
ch = Word8 -> Builder
B.word8 Word8
ch
        | Bool
otherwise = Word8 -> Builder
h2 Word8
ch

    unreserved :: Word8 -> Bool
unreserved Word8
ch
        | Word8
ch forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
ch forall a. Ord a => a -> a -> Bool
<= Word8
90 = Bool
True -- A-Z
        | Word8
ch forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
ch forall a. Ord a => a -> a -> Bool
<= Word8
122 = Bool
True -- a-z
        | Word8
ch forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
ch forall a. Ord a => a -> a -> Bool
<= Word8
57 = Bool
True -- 0-9
    unreserved Word8
c = Word8
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8]
extraUnreserved

    -- must be upper-case
    h2 :: Word8 -> Builder
h2 Word8
v = Word8 -> Builder
B.word8 Word8
37 forall a. Monoid a => a -> a -> a
`mappend` Word8 -> Builder
B.word8 (forall {a}. (Ord a, Num a) => a -> a
h Word8
a) forall a. Monoid a => a -> a -> a
`mappend` Word8 -> Builder
B.word8 (forall {a}. (Ord a, Num a) => a -> a
h Word8
b) -- 37 = %
      where
        (Word8
a, Word8
b) = Word8
v forall a. Integral a => a -> a -> (a, a)
`divMod` Word8
16
    h :: a -> a
h a
i
        | a
i forall a. Ord a => a -> a -> Bool
< a
10 = a
48 forall a. Num a => a -> a -> a
+ a
i -- zero (0)
        | Bool
otherwise = a
65 forall a. Num a => a -> a -> a
+ a
i forall a. Num a => a -> a -> a
- a
10 -- 65: A

-- | Percent-encoding for URLs.
--
-- Like 'urlEncode', but only makes the 'B.Builder'.
--
-- @since 0.5
urlEncodeBuilder :: Bool -> B.ByteString -> B.Builder
urlEncodeBuilder :: Bool -> ByteString -> Builder
urlEncodeBuilder Bool
True = [Word8] -> ByteString -> Builder
urlEncodeBuilder' [Word8]
unreservedQS
urlEncodeBuilder Bool
False = [Word8] -> ByteString -> Builder
urlEncodeBuilder' [Word8]
unreservedPI

-- | Percent-encoding for URLs.
--
-- In short:
--
-- * if you're encoding (parts of) a path element, use 'False'.
--
-- * if you're encoding (parts of) a query string, use 'True'.
--
-- === __In-depth explanation__
--
-- This will substitute every byte with its percent-encoded equivalent unless:
--
-- * The byte is alphanumeric. (i.e. @A-Z@, @a-z@, or @0-9@)
--
-- * The byte is either a dash @\'-\'@, an underscore @\'_\'@, a dot @\'.\'@, or a tilde @\'~\'@
--
-- * If 'False' is used, the following will also /not/ be percent-encoded:
--
--     * colon @\':\'@, at sign @\'\@\'@, ampersand @\'&\'@, equals sign @\'=\'@, plus sign @\'+\'@, dollar sign @\'$\'@ or a comma @\',\'@
--
-- @since 0.2.0
urlEncode :: Bool -> B.ByteString -> B.ByteString
urlEncode :: Bool -> ByteString -> ByteString
urlEncode Bool
q = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> Builder
urlEncodeBuilder Bool
q

-- | Percent-decoding.
--
-- If you want to replace any @\'+\'@ with a space, use 'True'.
--
-- @since 0.2.0
urlDecode :: Bool -> B.ByteString -> B.ByteString
urlDecode :: Bool -> ByteString -> ByteString
urlDecode Bool
replacePlus ByteString
z = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
B.unfoldrN (ByteString -> Int
B.length ByteString
z) ByteString -> Maybe (Word8, ByteString)
go ByteString
z
  where
    go :: ByteString -> Maybe (Word8, ByteString)
go ByteString
bs =
        case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs of
            Maybe (Word8, ByteString)
Nothing -> forall a. Maybe a
Nothing
            -- plus to space
            Just (Word8
43, ByteString
ws) | Bool
replacePlus -> forall a. a -> Maybe a
Just (Word8
32, ByteString
ws)
            -- percent
            Just (Word8
37, ByteString
ws) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (Word8
37, ByteString
ws) forall a b. (a -> b) -> a -> b
$ do
                (Word8
x, ByteString
xs) <- ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
ws
                Word8
x' <- forall {a}. (Ord a, Num a) => a -> Maybe a
hexVal Word8
x
                (Word8
y, ByteString
ys) <- ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
xs
                Word8
y' <- forall {a}. (Ord a, Num a) => a -> Maybe a
hexVal Word8
y
                forall a. a -> Maybe a
Just (Word8 -> Word8 -> Word8
combine Word8
x' Word8
y', ByteString
ys)
            Just (Word8
w, ByteString
ws) -> forall a. a -> Maybe a
Just (Word8
w, ByteString
ws)
    hexVal :: a -> Maybe a
hexVal a
w
        | a
48 forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
57 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
w forall a. Num a => a -> a -> a
- a
48 -- 0 - 9
        | a
65 forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
70 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
w forall a. Num a => a -> a -> a
- a
55 -- A - F
        | a
97 forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
102 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
w forall a. Num a => a -> a -> a
- a
87 -- a - f
        | Bool
otherwise = forall a. Maybe a
Nothing
    combine :: Word8 -> Word8 -> Word8
    combine :: Word8 -> Word8 -> Word8
combine Word8
a Word8
b = forall a. Bits a => a -> Int -> a
shiftL Word8
a Int
4 forall a. Bits a => a -> a -> a
.|. Word8
b

-- | Encodes a list of path segments into a valid URL fragment.
--
-- This function takes the following three steps:
--
-- * UTF-8 encodes the characters.
--
-- * Prepends each segment with a slash.
--
-- * Performs percent-encoding on all characters that are __not__:
--
--     * alphanumeric (i.e. @A-Z@ and @a-z@)
--
--     * digits (i.e. @0-9@)
--
--     * a dash @\'-\'@, an underscore @\'_\'@, a dot @\'.\'@, or a tilde @\'~\'@
--
-- For example:
--
-- >>> encodePathSegments ["foo", "bar1", "~baz"]
-- "/foo/bar1/~baz"
--
-- >>> encodePathSegments ["foo bar", "baz/bin"]
-- "/foo%20bar/baz%2Fbin"
--
-- >>> encodePathSegments ["שלום"]
-- "/%D7%A9%D7%9C%D7%95%D7%9D"
--
-- Huge thanks to /Jeremy Shaw/ who created the original implementation of this
-- function in web-routes and did such thorough research to determine all
-- correct escaping procedures.
--
-- @since 0.5
encodePathSegments :: [Text] -> B.Builder
encodePathSegments :: [Text] -> Builder
encodePathSegments = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Text
x -> forall a. Monoid a => a -> a -> a
mappend (ByteString -> Builder
B.byteString ByteString
"/" forall a. Monoid a => a -> a -> a
`mappend` Text -> Builder
encodePathSegment Text
x)) forall a. Monoid a => a
mempty

-- | Like 'encodePathSegments', but without the initial slash.
--
-- @since 0.6.10
encodePathSegmentsRelative :: [Text] -> B.Builder
encodePathSegmentsRelative :: [Text] -> Builder
encodePathSegmentsRelative [Text]
xs = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (ByteString -> Builder
B.byteString ByteString
"/") (forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
encodePathSegment [Text]
xs)

encodePathSegment :: Text -> B.Builder
encodePathSegment :: Text -> Builder
encodePathSegment = Bool -> ByteString -> Builder
urlEncodeBuilder Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Parse a list of path segments from a valid URL fragment.
--
-- Will also decode any percent-encoded characters.
--
-- @since 0.5
decodePathSegments :: B.ByteString -> [Text]
decodePathSegments :: ByteString -> [Text]
decodePathSegments ByteString
"" = []
decodePathSegments ByteString
"/" = []
decodePathSegments ByteString
a =
    ByteString -> [Text]
go forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
drop1Slash ByteString
a
  where
    drop1Slash :: ByteString -> ByteString
drop1Slash ByteString
bs =
        case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs of
            Just (Word8
47, ByteString
bs') -> ByteString
bs' -- 47 == /
            Maybe (Word8, ByteString)
_ -> ByteString
bs
    go :: ByteString -> [Text]
go ByteString
bs =
        let (ByteString
x, ByteString
y) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (forall a. Eq a => a -> a -> Bool
== Word8
47) ByteString
bs
         in ByteString -> Text
decodePathSegment ByteString
x
                forall a. a -> [a] -> [a]
: if ByteString -> Bool
B.null ByteString
y
                    then []
                    else ByteString -> [Text]
go forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop Int
1 ByteString
y

decodePathSegment :: B.ByteString -> Text
decodePathSegment :: ByteString -> Text
decodePathSegment = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlDecode Bool
False

-- | Extract whole path (path segments + query) from a
-- [RFC 2616 Request-URI](http://tools.ietf.org/html/rfc2616#section-5.1.2).
--
-- Though a more accurate description of this function's behaviour is that
-- it removes the domain/origin if the string starts with an HTTP protocol.
-- (i.e. @http://@ or @https://@)
--
-- This function will not change anything when given any other 'B.ByteString'.
-- (except return a root path @\"\/\"@ if given an empty string)
--
-- >>> extractPath "/path"
-- "/path"
--
-- >>> extractPath "http://example.com:8080/path"
-- "/path"
--
-- >>> extractPath "http://example.com"
-- "/"
--
-- >>> extractPath ""
-- "/"
--
-- >>> extractPath "www.google.com/some/path"
-- "www.google.com/some/path"
--
-- @since 0.8.5
extractPath :: B.ByteString -> B.ByteString
extractPath :: ByteString -> ByteString
extractPath = forall {a}. (Eq a, IsString a) => a -> a
ensureNonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
extract
  where
    extract :: ByteString -> ByteString
extract ByteString
path
        | ByteString
"http://" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
path = (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
breakOnSlash forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop Int
7) ByteString
path
        | ByteString
"https://" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
path = (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
breakOnSlash forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop Int
8) ByteString
path
        | Bool
otherwise = ByteString
path
    breakOnSlash :: ByteString -> (ByteString, ByteString)
breakOnSlash = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (forall a. Eq a => a -> a -> Bool
== Word8
47)
    ensureNonEmpty :: a -> a
ensureNonEmpty a
"" = a
"/"
    ensureNonEmpty a
p = a
p

-- | Encode a whole path (path segments + query).
--
-- @since 0.5
encodePath :: [Text] -> Query -> B.Builder
encodePath :: [Text] -> Query -> Builder
encodePath [Text]
x [] = [Text] -> Builder
encodePathSegments [Text]
x
encodePath [Text]
x Query
y = [Text] -> Builder
encodePathSegments [Text]
x forall a. Monoid a => a -> a -> a
`mappend` Bool -> Query -> Builder
renderQueryBuilder Bool
True Query
y

-- | Decode a whole path (path segments + query).
--
-- @since 0.5
decodePath :: B.ByteString -> ([Text], Query)
decodePath :: ByteString -> ([Text], Query)
decodePath ByteString
b =
    let (ByteString
x, ByteString
y) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (forall a. Eq a => a -> a -> Bool
== Word8
63) ByteString
b -- question mark
     in (ByteString -> [Text]
decodePathSegments ByteString
x, ByteString -> Query
parseQuery ByteString
y)

-----------------------------------------------------------------------------------------

-- | Section of a query item value that decides whether to use
-- regular URL encoding (using @'urlEncode True'@) with 'QE',
-- or to not encode /anything/ with 'QN'.
--
-- @since 0.12.1
data EscapeItem
    = -- | will be URL encoded
      QE B.ByteString
    | -- | will NOT /at all/ be URL encoded
      QN B.ByteString
    deriving (Int -> EscapeItem -> ShowS
[EscapeItem] -> ShowS
EscapeItem -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EscapeItem] -> ShowS
$cshowList :: [EscapeItem] -> ShowS
show :: EscapeItem -> [Char]
$cshow :: EscapeItem -> [Char]
showsPrec :: Int -> EscapeItem -> ShowS
$cshowsPrec :: Int -> EscapeItem -> ShowS
Show, EscapeItem -> EscapeItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EscapeItem -> EscapeItem -> Bool
$c/= :: EscapeItem -> EscapeItem -> Bool
== :: EscapeItem -> EscapeItem -> Bool
$c== :: EscapeItem -> EscapeItem -> Bool
Eq, Eq EscapeItem
EscapeItem -> EscapeItem -> Bool
EscapeItem -> EscapeItem -> Ordering
EscapeItem -> EscapeItem -> EscapeItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EscapeItem -> EscapeItem -> EscapeItem
$cmin :: EscapeItem -> EscapeItem -> EscapeItem
max :: EscapeItem -> EscapeItem -> EscapeItem
$cmax :: EscapeItem -> EscapeItem -> EscapeItem
>= :: EscapeItem -> EscapeItem -> Bool
$c>= :: EscapeItem -> EscapeItem -> Bool
> :: EscapeItem -> EscapeItem -> Bool
$c> :: EscapeItem -> EscapeItem -> Bool
<= :: EscapeItem -> EscapeItem -> Bool
$c<= :: EscapeItem -> EscapeItem -> Bool
< :: EscapeItem -> EscapeItem -> Bool
$c< :: EscapeItem -> EscapeItem -> Bool
compare :: EscapeItem -> EscapeItem -> Ordering
$ccompare :: EscapeItem -> EscapeItem -> Ordering
Ord)

-- | Partially escaped query item.
--
-- The key will always be encoded using @'urlEncode True'@,
-- but the value will be encoded depending on which 'EscapeItem's are used.
--
-- @since 0.12.1
type PartialEscapeQueryItem = (B.ByteString, [EscapeItem])

-- | Query with some characters that should not be escaped.
--
-- General form: @a=b&c=d:e+f&g=h@
--
-- @since 0.12.1
type PartialEscapeQuery = [PartialEscapeQueryItem]

-- | Convert 'PartialEscapeQuery' to 'ByteString'.
--
-- If you want a question mark (@?@) added to the front of the result, use 'True'.
--
-- >>> renderQueryPartialEscape True [("a", [QN "x:z + ", QE (encodeUtf8 "They said: \"שלום\"")])]
-- "?a=x:z + They%20said%3A%20%22%D7%A9%D7%9C%D7%95%D7%9D%22"
--
-- @since 0.12.1
renderQueryPartialEscape :: Bool -> PartialEscapeQuery -> B.ByteString
renderQueryPartialEscape :: Bool -> PartialEscapeQuery -> ByteString
renderQueryPartialEscape Bool
qm =
    ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> PartialEscapeQuery -> Builder
renderQueryBuilderPartialEscape Bool
qm

-- | Convert a 'PartialEscapeQuery' to a 'B.Builder'.
--
-- If you want a question mark (@?@) added to the front of the result, use 'True'.
--
-- @since 0.12.1
renderQueryBuilderPartialEscape :: Bool -> PartialEscapeQuery -> B.Builder
renderQueryBuilderPartialEscape :: Bool -> PartialEscapeQuery -> Builder
renderQueryBuilderPartialEscape Bool
_ [] = forall a. Monoid a => a
mempty
-- FIXME replace mconcat + map with foldr
renderQueryBuilderPartialEscape Bool
qmark' (PartialEscapeQueryItem
p : PartialEscapeQuery
ps) =
    forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
        Builder -> PartialEscapeQueryItem -> Builder
go (if Bool
qmark' then Builder
qmark else forall a. Monoid a => a
mempty) PartialEscapeQueryItem
p
            forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Builder -> PartialEscapeQueryItem -> Builder
go Builder
amp) PartialEscapeQuery
ps
  where
    qmark :: Builder
qmark = ByteString -> Builder
B.byteString ByteString
"?"
    amp :: Builder
amp = ByteString -> Builder
B.byteString ByteString
"&"
    equal :: Builder
equal = ByteString -> Builder
B.byteString ByteString
"="
    go :: Builder -> PartialEscapeQueryItem -> Builder
go Builder
sep (ByteString
k, [EscapeItem]
mv) =
        forall a. Monoid a => [a] -> a
mconcat
            [ Builder
sep
            , Bool -> ByteString -> Builder
urlEncodeBuilder Bool
True ByteString
k
            , case [EscapeItem]
mv of
                [] -> forall a. Monoid a => a
mempty
                [EscapeItem]
vs -> Builder
equal forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map EscapeItem -> Builder
encode [EscapeItem]
vs)
            ]
    encode :: EscapeItem -> Builder
encode (QE ByteString
v) = Bool -> ByteString -> Builder
urlEncodeBuilder Bool
True ByteString
v
    encode (QN ByteString
v) = ByteString -> Builder
B.byteString ByteString
v