{-# LANGUAGE OverloadedStrings, CPP #-}
module Network.HTTP.Types.URI
(
QueryItem
, Query
, SimpleQueryItem
, SimpleQuery
, simpleQueryToQuery
, renderQuery
, renderQueryBuilder
, renderSimpleQuery
, parseQuery
, parseQueryReplacePlus
, parseSimpleQuery
, renderQueryPartialEscape
, renderQueryBuilderPartialEscape
, EscapeItem(..)
, PartialEscapeQueryItem
, PartialEscapeQuery
, QueryText
, queryTextToQuery
, queryToQueryText
, renderQueryText
, parseQueryText
, encodePathSegments
, decodePathSegments
, encodePathSegmentsRelative
, extractPath
, encodePath
, decodePath
, urlEncodeBuilder
, urlEncode
, urlDecode
)
where
import Control.Arrow
import Data.Bits
import Data.Char
import Data.List
import Data.Maybe
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Word
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as BL
import Data.ByteString.Char8 ()
type QueryItem = (B.ByteString, Maybe B.ByteString)
type Query = [QueryItem]
type QueryText = [(Text, Maybe Text)]
queryTextToQuery :: QueryText -> Query
queryTextToQuery :: QueryText -> Query
queryTextToQuery = ((Text, Maybe Text) -> QueryItem) -> QueryText -> Query
forall a b. (a -> b) -> [a] -> [b]
map (((Text, Maybe Text) -> QueryItem) -> QueryText -> Query)
-> ((Text, Maybe Text) -> QueryItem) -> QueryText -> Query
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (Maybe Text -> Maybe ByteString)
-> (Text, Maybe Text)
-> QueryItem
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8
renderQueryText :: Bool
-> QueryText
-> B.Builder
renderQueryText :: Bool -> QueryText -> Builder
renderQueryText b :: Bool
b = Bool -> Query -> Builder
renderQueryBuilder Bool
b (Query -> Builder) -> (QueryText -> Query) -> QueryText -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryText -> Query
queryTextToQuery
queryToQueryText :: Query -> QueryText
queryToQueryText :: Query -> QueryText
queryToQueryText =
(QueryItem -> (Text, Maybe Text)) -> Query -> QueryText
forall a b. (a -> b) -> [a] -> [b]
map ((QueryItem -> (Text, Maybe Text)) -> Query -> QueryText)
-> (QueryItem -> (Text, Maybe Text)) -> Query -> QueryText
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
go (ByteString -> Text)
-> (Maybe ByteString -> Maybe Text)
-> QueryItem
-> (Text, Maybe Text)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (ByteString -> Text) -> Maybe ByteString -> Maybe Text
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
parseQueryText :: B.ByteString -> QueryText
parseQueryText :: ByteString -> QueryText
parseQueryText = Query -> QueryText
queryToQueryText (Query -> QueryText)
-> (ByteString -> Query) -> ByteString -> QueryText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Query
parseQuery
type SimpleQueryItem = (B.ByteString, B.ByteString)
type SimpleQuery = [SimpleQueryItem]
simpleQueryToQuery :: SimpleQuery -> Query
simpleQueryToQuery :: SimpleQuery -> Query
simpleQueryToQuery = (SimpleQueryItem -> QueryItem) -> SimpleQuery -> Query
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> Maybe ByteString) -> SimpleQueryItem -> QueryItem
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just)
renderQueryBuilder :: Bool
-> Query
-> B.Builder
renderQueryBuilder :: Bool -> Query -> Builder
renderQueryBuilder _ [] = Builder
forall a. Monoid a => a
mempty
renderQueryBuilder qmark' :: Bool
qmark' (p :: QueryItem
p:ps :: Query
ps) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> QueryItem -> Builder
go (if Bool
qmark' then Builder
qmark else Builder
forall a. Monoid a => a
mempty) QueryItem
p
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: (QueryItem -> Builder) -> Query -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> QueryItem -> Builder
go Builder
amp) Query
ps
where
qmark :: Builder
qmark = ByteString -> Builder
B.byteString "?"
amp :: Builder
amp = ByteString -> Builder
B.byteString "&"
equal :: Builder
equal = ByteString -> Builder
B.byteString "="
go :: Builder -> QueryItem -> Builder
go sep :: Builder
sep (k :: ByteString
k, mv :: Maybe ByteString
mv) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [
Builder
sep
, Bool -> ByteString -> Builder
urlEncodeBuilder Bool
True ByteString
k
, case Maybe ByteString
mv of
Nothing -> Builder
forall a. Monoid a => a
mempty
Just v :: ByteString
v -> Builder
equal Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Bool -> ByteString -> Builder
urlEncodeBuilder Bool
True ByteString
v
]
renderQuery :: Bool
-> Query -> B.ByteString
renderQuery :: Bool -> Query -> ByteString
renderQuery qm :: Bool
qm = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Query -> ByteString) -> Query -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (Query -> Builder) -> Query -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Query -> Builder
renderQueryBuilder Bool
qm
renderSimpleQuery :: Bool
-> SimpleQuery -> B.ByteString
renderSimpleQuery :: Bool -> SimpleQuery -> ByteString
renderSimpleQuery useQuestionMark :: Bool
useQuestionMark = Bool -> Query -> ByteString
renderQuery Bool
useQuestionMark (Query -> ByteString)
-> (SimpleQuery -> Query) -> SimpleQuery -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleQuery -> Query
simpleQueryToQuery
parseQuery :: B.ByteString -> Query
parseQuery :: ByteString -> Query
parseQuery = Bool -> ByteString -> Query
parseQueryReplacePlus Bool
True
parseQueryReplacePlus :: Bool -> B.ByteString -> Query
parseQueryReplacePlus :: Bool -> ByteString -> Query
parseQueryReplacePlus replacePlus :: Bool
replacePlus bs :: ByteString
bs = ByteString -> Query
parseQueryString' (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dropQuestion ByteString
bs
where
dropQuestion :: ByteString -> ByteString
dropQuestion q :: ByteString
q =
case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
q of
Just (63, q' :: ByteString
q') -> ByteString
q'
_ -> ByteString
q
parseQueryString' :: ByteString -> Query
parseQueryString' q :: ByteString
q | ByteString -> Bool
B.null ByteString
q = []
parseQueryString' q :: ByteString
q =
let (x :: ByteString
x, xs :: ByteString
xs) = ByteString -> ByteString -> SimpleQueryItem
breakDiscard ByteString
queryStringSeparators ByteString
q
in ByteString -> QueryItem
parsePair ByteString
x QueryItem -> Query -> Query
forall a. a -> [a] -> [a]
: ByteString -> Query
parseQueryString' ByteString
xs
where
parsePair :: ByteString -> QueryItem
parsePair x :: ByteString
x =
let (k :: ByteString
k, v :: ByteString
v) = (Word8 -> Bool) -> ByteString -> SimpleQueryItem
B.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 61) ByteString
x
v'' :: Maybe ByteString
v'' =
case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
v of
Just (_, v' :: ByteString
v') -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> ByteString -> ByteString
urlDecode Bool
replacePlus ByteString
v'
_ -> Maybe 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 [38,59]
breakDiscard :: B.ByteString -> B.ByteString -> (B.ByteString, B.ByteString)
breakDiscard :: ByteString -> ByteString -> SimpleQueryItem
breakDiscard seps :: ByteString
seps s :: ByteString
s =
let (x :: ByteString
x, y :: ByteString
y) = (Word8 -> Bool) -> ByteString -> SimpleQueryItem
B.break (Word8 -> ByteString -> Bool
`B.elem` ByteString
seps) ByteString
s
in (ByteString
x, Int -> ByteString -> ByteString
B.drop 1 ByteString
y)
parseSimpleQuery :: B.ByteString -> SimpleQuery
parseSimpleQuery :: ByteString -> SimpleQuery
parseSimpleQuery = (QueryItem -> SimpleQueryItem) -> Query -> SimpleQuery
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe ByteString -> ByteString) -> QueryItem -> SimpleQueryItem
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Maybe ByteString -> ByteString) -> QueryItem -> SimpleQueryItem)
-> (Maybe ByteString -> ByteString) -> QueryItem -> SimpleQueryItem
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
B.empty) (Query -> SimpleQuery)
-> (ByteString -> Query) -> ByteString -> SimpleQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Query
parseQuery
ord8 :: Char -> Word8
ord8 :: Char -> Word8
ord8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
unreservedQS, unreservedPI :: [Word8]
unreservedQS :: [Word8]
unreservedQS = (Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ord8 "-_.~"
unreservedPI :: [Word8]
unreservedPI = (Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ord8 "-_.~:@&=+$,"
urlEncodeBuilder' :: [Word8] -> B.ByteString -> B.Builder
urlEncodeBuilder' :: [Word8] -> ByteString -> Builder
urlEncodeBuilder' extraUnreserved :: [Word8]
extraUnreserved = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (ByteString -> [Builder]) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Builder) -> [Word8] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Builder
encodeChar ([Word8] -> [Builder])
-> (ByteString -> [Word8]) -> ByteString -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack
where
encodeChar :: Word8 -> Builder
encodeChar ch :: Word8
ch | Word8 -> Bool
unreserved Word8
ch = Word8 -> Builder
B.word8 Word8
ch
| Bool
otherwise = Word8 -> Builder
h2 Word8
ch
unreserved :: Word8 -> Bool
unreserved ch :: Word8
ch | Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 65 Bool -> Bool -> Bool
&& Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 90 = Bool
True
| Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 97 Bool -> Bool -> Bool
&& Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 122 = Bool
True
| Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 48 Bool -> Bool -> Bool
&& Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 57 = Bool
True
unreserved c :: Word8
c = Word8
c Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8]
extraUnreserved
h2 :: Word8 -> Builder
h2 v :: Word8
v = Word8 -> Builder
B.word8 37 Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Word8 -> Builder
B.word8 (Word8 -> Word8
forall a. (Ord a, Num a) => a -> a
h Word8
a) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Word8 -> Builder
B.word8 (Word8 -> Word8
forall a. (Ord a, Num a) => a -> a
h Word8
b)
where (a :: Word8
a, b :: Word8
b) = Word8
v Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`divMod` 16
h :: a -> a
h i :: a
i | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 10 = 48 a -> a -> a
forall a. Num a => a -> a -> a
+ a
i
| Bool
otherwise = 65 a -> a -> a
forall a. Num a => a -> a -> a
+ a
i a -> a -> a
forall a. Num a => a -> a -> a
- 10
urlEncodeBuilder
:: Bool
-> B.ByteString
-> B.Builder
urlEncodeBuilder :: Bool -> ByteString -> Builder
urlEncodeBuilder True = [Word8] -> ByteString -> Builder
urlEncodeBuilder' [Word8]
unreservedQS
urlEncodeBuilder False = [Word8] -> ByteString -> Builder
urlEncodeBuilder' [Word8]
unreservedPI
urlEncode :: Bool
-> B.ByteString
-> B.ByteString
urlEncode :: Bool -> ByteString -> ByteString
urlEncode q :: Bool
q = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> Builder
urlEncodeBuilder Bool
q
urlDecode :: Bool
-> B.ByteString -> B.ByteString
urlDecode :: Bool -> ByteString -> ByteString
urlDecode replacePlus :: Bool
replacePlus z :: ByteString
z = QueryItem -> ByteString
forall a b. (a, b) -> a
fst (QueryItem -> ByteString) -> QueryItem -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> QueryItem
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 bs :: ByteString
bs =
case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs of
Nothing -> Maybe (Word8, ByteString)
forall a. Maybe a
Nothing
Just (43, ws :: ByteString
ws) | Bool
replacePlus -> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (32, ByteString
ws)
Just (37, ws :: ByteString
ws) -> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just ((Word8, ByteString) -> Maybe (Word8, ByteString))
-> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ (Word8, ByteString)
-> Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a. a -> Maybe a -> a
fromMaybe (37, ByteString
ws) (Maybe (Word8, ByteString) -> (Word8, ByteString))
-> Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ do
(x :: Word8
x, xs :: ByteString
xs) <- ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
ws
Word8
x' <- Word8 -> Maybe Word8
forall a. (Ord a, Num a) => a -> Maybe a
hexVal Word8
x
(y :: Word8
y, ys :: ByteString
ys) <- ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
xs
Word8
y' <- Word8 -> Maybe Word8
forall a. (Ord a, Num a) => a -> Maybe a
hexVal Word8
y
(Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (Word8 -> Word8 -> Word8
combine Word8
x' Word8
y', ByteString
ys)
Just (w :: Word8
w, ws :: ByteString
ws) -> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (Word8
w, ByteString
ws)
hexVal :: a -> Maybe a
hexVal w :: a
w
| 48 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 57 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
w a -> a -> a
forall a. Num a => a -> a -> a
- 48
| 65 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 70 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
w a -> a -> a
forall a. Num a => a -> a -> a
- 55
| 97 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 102 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
w a -> a -> a
forall a. Num a => a -> a -> a
- 87
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
combine :: Word8 -> Word8 -> Word8
combine :: Word8 -> Word8 -> Word8
combine a :: Word8
a b :: Word8
b = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
a 4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
b
encodePathSegments :: [Text] -> B.Builder
encodePathSegments :: [Text] -> Builder
encodePathSegments = (Text -> Builder -> Builder) -> Builder -> [Text] -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\x :: Text
x -> Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend (ByteString -> Builder
B.byteString "/" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Text -> Builder
encodePathSegment Text
x)) Builder
forall a. Monoid a => a
mempty
encodePathSegmentsRelative :: [Text] -> B.Builder
encodePathSegmentsRelative :: [Text] -> Builder
encodePathSegmentsRelative xs :: [Text]
xs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (ByteString -> Builder
B.byteString "/") ((Text -> Builder) -> [Text] -> [Builder]
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 (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
decodePathSegments :: B.ByteString -> [Text]
decodePathSegments :: ByteString -> [Text]
decodePathSegments "" = []
decodePathSegments "/" = []
decodePathSegments a :: ByteString
a =
ByteString -> [Text]
go (ByteString -> [Text]) -> ByteString -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
drop1Slash ByteString
a
where
drop1Slash :: ByteString -> ByteString
drop1Slash bs :: ByteString
bs =
case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs of
Just (47, bs' :: ByteString
bs') -> ByteString
bs'
_ -> ByteString
bs
go :: ByteString -> [Text]
go bs :: ByteString
bs =
let (x :: ByteString
x, y :: ByteString
y) = (Word8 -> Bool) -> ByteString -> SimpleQueryItem
B.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 47) ByteString
bs
in ByteString -> Text
decodePathSegment ByteString
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
if ByteString -> Bool
B.null ByteString
y
then []
else ByteString -> [Text]
go (ByteString -> [Text]) -> ByteString -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop 1 ByteString
y
decodePathSegment :: B.ByteString -> Text
decodePathSegment :: ByteString -> Text
decodePathSegment = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlDecode Bool
False
extractPath :: B.ByteString -> B.ByteString
= ByteString -> ByteString
forall p. (Eq p, IsString p) => p -> p
ensureNonEmpty (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
extract
where
extract :: ByteString -> ByteString
extract path :: ByteString
path
| "http://" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
path = (SimpleQueryItem -> ByteString
forall a b. (a, b) -> b
snd (SimpleQueryItem -> ByteString)
-> (ByteString -> SimpleQueryItem) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SimpleQueryItem
breakOnSlash (ByteString -> SimpleQueryItem)
-> (ByteString -> ByteString) -> ByteString -> SimpleQueryItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop 7) ByteString
path
| "https://" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
path = (SimpleQueryItem -> ByteString
forall a b. (a, b) -> b
snd (SimpleQueryItem -> ByteString)
-> (ByteString -> SimpleQueryItem) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SimpleQueryItem
breakOnSlash (ByteString -> SimpleQueryItem)
-> (ByteString -> ByteString) -> ByteString -> SimpleQueryItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop 8) ByteString
path
| Bool
otherwise = ByteString
path
breakOnSlash :: ByteString -> SimpleQueryItem
breakOnSlash = (Word8 -> Bool) -> ByteString -> SimpleQueryItem
B.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 47)
ensureNonEmpty :: p -> p
ensureNonEmpty "" = "/"
ensureNonEmpty p :: p
p = p
p
encodePath :: [Text] -> Query -> B.Builder
encodePath :: [Text] -> Query -> Builder
encodePath x :: [Text]
x [] = [Text] -> Builder
encodePathSegments [Text]
x
encodePath x :: [Text]
x y :: Query
y = [Text] -> Builder
encodePathSegments [Text]
x Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Bool -> Query -> Builder
renderQueryBuilder Bool
True Query
y
decodePath :: B.ByteString -> ([Text], Query)
decodePath :: ByteString -> ([Text], Query)
decodePath b :: ByteString
b =
let (x :: ByteString
x, y :: ByteString
y) = (Word8 -> Bool) -> ByteString -> SimpleQueryItem
B.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 63) ByteString
b
in (ByteString -> [Text]
decodePathSegments ByteString
x, ByteString -> Query
parseQuery ByteString
y)
data EscapeItem = QE B.ByteString
| QN B.ByteString
deriving (Int -> EscapeItem -> ShowS
[EscapeItem] -> ShowS
EscapeItem -> [Char]
(Int -> EscapeItem -> ShowS)
-> (EscapeItem -> [Char])
-> ([EscapeItem] -> ShowS)
-> Show EscapeItem
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
(EscapeItem -> EscapeItem -> Bool)
-> (EscapeItem -> EscapeItem -> Bool) -> Eq EscapeItem
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
Eq EscapeItem =>
(EscapeItem -> EscapeItem -> Ordering)
-> (EscapeItem -> EscapeItem -> Bool)
-> (EscapeItem -> EscapeItem -> Bool)
-> (EscapeItem -> EscapeItem -> Bool)
-> (EscapeItem -> EscapeItem -> Bool)
-> (EscapeItem -> EscapeItem -> EscapeItem)
-> (EscapeItem -> EscapeItem -> EscapeItem)
-> Ord 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
$cp1Ord :: Eq EscapeItem
Ord)
type PartialEscapeQueryItem = (B.ByteString, [EscapeItem])
type PartialEscapeQuery = [PartialEscapeQueryItem]
renderQueryPartialEscape :: Bool
-> PartialEscapeQuery -> B.ByteString
renderQueryPartialEscape :: Bool -> PartialEscapeQuery -> ByteString
renderQueryPartialEscape qm :: Bool
qm = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (PartialEscapeQuery -> ByteString)
-> PartialEscapeQuery
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (PartialEscapeQuery -> Builder)
-> PartialEscapeQuery
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> PartialEscapeQuery -> Builder
renderQueryBuilderPartialEscape Bool
qm
renderQueryBuilderPartialEscape :: Bool
-> PartialEscapeQuery
-> B.Builder
renderQueryBuilderPartialEscape :: Bool -> PartialEscapeQuery -> Builder
renderQueryBuilderPartialEscape _ [] = Builder
forall a. Monoid a => a
mempty
renderQueryBuilderPartialEscape qmark' :: Bool
qmark' (p :: PartialEscapeQueryItem
p:ps :: PartialEscapeQuery
ps) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> PartialEscapeQueryItem -> Builder
go (if Bool
qmark' then Builder
qmark else Builder
forall a. Monoid a => a
mempty) PartialEscapeQueryItem
p
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: (PartialEscapeQueryItem -> Builder)
-> PartialEscapeQuery -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> PartialEscapeQueryItem -> Builder
go Builder
amp) PartialEscapeQuery
ps
where
qmark :: Builder
qmark = ByteString -> Builder
B.byteString "?"
amp :: Builder
amp = ByteString -> Builder
B.byteString "&"
equal :: Builder
equal = ByteString -> Builder
B.byteString "="
go :: Builder -> PartialEscapeQueryItem -> Builder
go sep :: Builder
sep (k :: ByteString
k, mv :: [EscapeItem]
mv) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [
Builder
sep
, Bool -> ByteString -> Builder
urlEncodeBuilder Bool
True ByteString
k
, case [EscapeItem]
mv of
[] -> Builder
forall a. Monoid a => a
mempty
vs :: [EscapeItem]
vs -> Builder
equal Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((EscapeItem -> Builder) -> [EscapeItem] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map EscapeItem -> Builder
encode [EscapeItem]
vs))
]
encode :: EscapeItem -> Builder
encode (QE v :: ByteString
v) = Bool -> ByteString -> Builder
urlEncodeBuilder Bool
True ByteString
v
encode (QN v :: ByteString
v) = ByteString -> Builder
B.byteString ByteString
v