-- |
-- Module      : Amazonka.Data.Query
-- Copyright   : (c) 2013-2021 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Data.Query where

import Amazonka.Data.ByteString
import Amazonka.Data.Text
import Amazonka.Prelude
import qualified Data.ByteString.Builder as Build
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List as List
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Types.URI as URI

data QueryString
  = QList [QueryString]
  | QPair ByteString QueryString
  | QValue (Maybe ByteString)
  deriving stock (QueryString -> QueryString -> Bool
(QueryString -> QueryString -> Bool)
-> (QueryString -> QueryString -> Bool) -> Eq QueryString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryString -> QueryString -> Bool
$c/= :: QueryString -> QueryString -> Bool
== :: QueryString -> QueryString -> Bool
$c== :: QueryString -> QueryString -> Bool
Eq, Int -> QueryString -> ShowS
[QueryString] -> ShowS
QueryString -> String
(Int -> QueryString -> ShowS)
-> (QueryString -> String)
-> ([QueryString] -> ShowS)
-> Show QueryString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryString] -> ShowS
$cshowList :: [QueryString] -> ShowS
show :: QueryString -> String
$cshow :: QueryString -> String
showsPrec :: Int -> QueryString -> ShowS
$cshowsPrec :: Int -> QueryString -> ShowS
Show)

instance Semigroup QueryString where
  QueryString
a <> :: QueryString -> QueryString -> QueryString
<> QueryString
b = case (QueryString
a, QueryString
b) of
    (QList [QueryString]
l, QList [QueryString]
r) -> [QueryString] -> QueryString
QList ([QueryString]
l [QueryString] -> [QueryString] -> [QueryString]
forall a. [a] -> [a] -> [a]
++ [QueryString]
r)
    (QList [QueryString]
l, QueryString
r) -> [QueryString] -> QueryString
QList (QueryString
r QueryString -> [QueryString] -> [QueryString]
forall a. a -> [a] -> [a]
: [QueryString]
l)
    (QueryString
l, QList [QueryString]
r) -> [QueryString] -> QueryString
QList (QueryString
l QueryString -> [QueryString] -> [QueryString]
forall a. a -> [a] -> [a]
: [QueryString]
r)
    (QueryString
l, QueryString
r) -> [QueryString] -> QueryString
QList [QueryString
l, QueryString
r]

instance Monoid QueryString where
  mempty :: QueryString
mempty = [QueryString] -> QueryString
QList []
  mappend :: QueryString -> QueryString -> QueryString
mappend = QueryString -> QueryString -> QueryString
forall a. Semigroup a => a -> a -> a
(<>)

instance IsString QueryString where
  fromString :: String -> QueryString
fromString = ByteString -> QueryString
parseQueryString (ByteString -> QueryString)
-> (String -> ByteString) -> String -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
  {-# INLINE fromString #-}

parseQueryString :: ByteString -> QueryString
parseQueryString :: ByteString -> QueryString
parseQueryString ByteString
bs
  | ByteString -> Bool
BS8.null ByteString
bs = QueryString
forall a. Monoid a => a
mempty
  | Bool
otherwise =
    [QueryString] -> QueryString
QList ((ByteString -> QueryString) -> [ByteString] -> [QueryString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> QueryString
breakPair ([ByteString] -> [QueryString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [QueryString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS8.null) ([ByteString] -> [QueryString]) -> [ByteString] -> [QueryString]
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
BS8.split Char
'&' ByteString
bs)
  where
    breakPair :: ByteString -> QueryString
breakPair ByteString
x =
      case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') ByteString
x of
        (ByteString
"", ByteString
"") -> QueryString
forall a. Monoid a => a
mempty
        (ByteString
"", ByteString
v) -> ByteString -> QueryString
stripValue ByteString
v
        (ByteString
k, ByteString
v) -> ByteString -> QueryString -> QueryString
QPair ByteString
k (ByteString -> QueryString
stripValue ByteString
v)

    stripValue :: ByteString -> QueryString
stripValue ByteString
x =
      case ByteString
x of
        ByteString
"" -> Maybe ByteString -> QueryString
QValue Maybe ByteString
forall a. Maybe a
Nothing
        ByteString
"=" -> Maybe ByteString -> QueryString
QValue Maybe ByteString
forall a. Maybe a
Nothing
        ByteString
_ -> Maybe ByteString -> QueryString
QValue (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
x (ByteString -> ByteString -> Maybe ByteString
BS8.stripPrefix ByteString
"=" ByteString
x)))

-- FIXME: use Builder
instance ToByteString QueryString where
  toBS :: QueryString -> ByteString
toBS = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (QueryString -> ByteString) -> QueryString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Build.toLazyByteString (Builder -> ByteString)
-> (QueryString -> Builder) -> QueryString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Builder
cat ([ByteString] -> Builder)
-> (QueryString -> [ByteString]) -> QueryString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. Ord a => [a] -> [a]
List.sort ([ByteString] -> [ByteString])
-> (QueryString -> [ByteString]) -> QueryString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> QueryString -> [ByteString]
enc Maybe ByteString
forall a. Maybe a
Nothing
    where
      enc :: Maybe ByteString -> QueryString -> [ByteString]
      enc :: Maybe ByteString -> QueryString -> [ByteString]
enc Maybe ByteString
p = \case
        QList [QueryString]
xs -> (QueryString -> [ByteString]) -> [QueryString] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe ByteString -> QueryString -> [ByteString]
enc Maybe ByteString
p) [QueryString]
xs
        QPair (Bool -> ByteString -> ByteString
URI.urlEncode Bool
True -> ByteString
k) QueryString
x
          | Just ByteString
n <- Maybe ByteString
p -> Maybe ByteString -> QueryString -> [ByteString]
enc (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
kdelim ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
k)) QueryString
x -- <prev>.key <recur>
          | Bool
otherwise -> Maybe ByteString -> QueryString -> [ByteString]
enc (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
k) QueryString
x -- key <recur>
        QValue (Just (Bool -> ByteString -> ByteString
URI.urlEncode Bool
True -> ByteString
v))
          | Just ByteString
n <- Maybe ByteString
p -> [ByteString
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
vsep ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
v] -- key=value
          | Bool
otherwise -> [ByteString
v ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
vsep] -- value= -- note: required for signing.
        QueryString
_
          | Just ByteString
n <- Maybe ByteString
p -> [ByteString
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
vsep] -- key=
          -- note: this case required for request signing
          | Bool
otherwise -> []

      cat :: [ByteString] -> ByteStringBuilder
      cat :: [ByteString] -> Builder
cat [] = Builder
forall a. Monoid a => a
mempty
      cat [ByteString
x] = ByteString -> Builder
Build.byteString ByteString
x
      cat (ByteString
x : [ByteString]
xs) = ByteString -> Builder
Build.byteString ByteString
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ksep Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> Builder
cat [ByteString]
xs

      kdelim :: ByteString
kdelim = ByteString
"."
      ksep :: Builder
ksep = Builder
"&"
      vsep :: ByteString
vsep = ByteString
"="

pair :: ToQuery a => ByteString -> a -> QueryString -> QueryString
pair :: ByteString -> a -> QueryString -> QueryString
pair ByteString
k a
v = QueryString -> QueryString -> QueryString
forall a. Monoid a => a -> a -> a
mappend (ByteString -> QueryString -> QueryString
QPair ByteString
k (a -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery a
v))

infixr 7 =:

(=:) :: ToQuery a => ByteString -> a -> QueryString
ByteString
k =: :: ByteString -> a -> QueryString
=: a
v = ByteString -> QueryString -> QueryString
QPair ByteString
k (a -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery a
v)

toQueryList ::
  (IsList a, ToQuery (Item a)) =>
  ByteString ->
  a ->
  QueryString
toQueryList :: ByteString -> a -> QueryString
toQueryList ByteString
k = ByteString -> QueryString -> QueryString
QPair ByteString
k (QueryString -> QueryString)
-> (a -> QueryString) -> a -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QueryString] -> QueryString
QList ([QueryString] -> QueryString)
-> (a -> [QueryString]) -> a -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Item a -> QueryString)
-> [Int] -> [Item a] -> [QueryString]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Item a -> QueryString
forall a. ToQuery a => Int -> a -> QueryString
f [Int
1 ..] ([Item a] -> [QueryString])
-> (a -> [Item a]) -> a -> [QueryString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Item a]
forall l. IsList l => l -> [Item l]
toList
  where
    f :: ToQuery a => Int -> a -> QueryString
    f :: Int -> a -> QueryString
f Int
n a
v = Int -> ByteString
forall a. ToByteString a => a -> ByteString
toBS Int
n ByteString -> QueryString -> QueryString
forall a. ToQuery a => ByteString -> a -> QueryString
=: a -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery a
v

toQueryMap ::
  (ToQuery k, ToQuery v) =>
  ByteString ->
  ByteString ->
  ByteString ->
  HashMap k v ->
  QueryString
toQueryMap :: ByteString
-> ByteString -> ByteString -> HashMap k v -> QueryString
toQueryMap ByteString
e ByteString
k ByteString
v = ByteString -> [QueryString] -> QueryString
forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
toQueryList ByteString
e ([QueryString] -> QueryString)
-> (HashMap k v -> [QueryString]) -> HashMap k v -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> QueryString) -> [(k, v)] -> [QueryString]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> QueryString
f ([(k, v)] -> [QueryString])
-> (HashMap k v -> [(k, v)]) -> HashMap k v -> [QueryString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
  where
    f :: (k, v) -> QueryString
f (k
x, v
y) = [QueryString] -> QueryString
QList [ByteString
k ByteString -> QueryString -> QueryString
forall a. ToQuery a => ByteString -> a -> QueryString
=: k -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery k
x, ByteString
v ByteString -> QueryString -> QueryString
forall a. ToQuery a => ByteString -> a -> QueryString
=: v -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery v
y]

class ToQuery a where
  toQuery :: a -> QueryString
  default toQuery :: ToText a => a -> QueryString
  toQuery = Text -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (Text -> QueryString) -> (a -> Text) -> a -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToText a => a -> Text
toText

instance ToQuery QueryString where
  toQuery :: QueryString -> QueryString
toQuery = QueryString -> QueryString
forall a. a -> a
id

instance (ToByteString k, ToQuery v) => ToQuery (k, v) where
  toQuery :: (k, v) -> QueryString
toQuery (k
k, v
v) = ByteString -> QueryString -> QueryString
QPair (k -> ByteString
forall a. ToByteString a => a -> ByteString
toBS k
k) (v -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery v
v)

instance ToQuery Char where
  toQuery :: Char -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (Char -> ByteString) -> Char -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString
BS8.singleton

instance ToQuery ByteString where
  toQuery :: ByteString -> QueryString
toQuery ByteString
"" = Maybe ByteString -> QueryString
QValue Maybe ByteString
forall a. Maybe a
Nothing
  toQuery ByteString
bs = Maybe ByteString -> QueryString
QValue (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)

instance ToQuery Text where toQuery :: Text -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (Text -> ByteString) -> Text -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

instance ToQuery Int where toQuery :: Int -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (Int -> ByteString) -> Int -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery Integer where toQuery :: Integer -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (Integer -> ByteString) -> Integer -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery Double where toQuery :: Double -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (Double -> ByteString) -> Double -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery Natural where toQuery :: Natural -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (Natural -> ByteString) -> Natural -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery a => ToQuery (Maybe a) where
  toQuery :: Maybe a -> QueryString
toQuery (Just a
x) = a -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery a
x
  toQuery Maybe a
Nothing = QueryString
forall a. Monoid a => a
mempty

instance ToQuery Bool where
  toQuery :: Bool -> QueryString
toQuery Bool
True = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString
"true" :: ByteString)
  toQuery Bool
False = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString
"false" :: ByteString)