{-|
Module      : AWS.Lambda.Events.ApiGateway.ProxyRequest
Description : Data types that represent typical lambda responses
Copyright   : (c) Nike, Inc., 2019
License     : BSD3
Maintainer  : nathan.fairhurst@nike.com, fernando.freire@nike.com
Stability   : stable

This module exposes types used to model incoming __proxy__ requests from AWS
API Gateway.  These types are a light pass over the incoming JSON
representation.
-}
module AWS.Lambda.Events.ApiGateway.ProxyRequest
    ( ProxyRequest(..)
    , RequestContext(..)
    , Identity(..)
    , NoAuthorizer
    , StrictlyNoAuthorizer
    ) where

import           Data.Aeson                  (FromJSON, Value, parseJSON,
                                              withObject, (.:), (.:?))
import           Data.ByteString.Base64.Lazy (decodeLenient)
import           Data.ByteString.Lazy        (ByteString)
import           Data.CaseInsensitive        (CI, mk)
import           Data.Foldable               (fold)
import           Data.HashMap.Strict         (HashMap, foldrWithKey, insert)
import           Data.Text                   (Text)
import qualified Data.Text.Lazy              as TL
import qualified Data.Text.Lazy.Encoding     as TLE
import           Data.Void                   (Void)
import           GHC.Generics                (Generic (..))

-- This function is available in Data.Functor as of base 4.11, but we define it
-- here for compatibility.
(<&>) :: Functor f => f a -> (a -> b) -> f b
<&> :: f a -> (a -> b) -> f b
(<&>) f a
x a -> b
f = a -> b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x

infixl 1 <&>

data Identity = Identity
    { Identity -> Maybe Text
cognitoIdentityPoolId         :: Maybe Text
    , Identity -> Maybe Text
accountId                     :: Maybe Text
    , Identity -> Maybe Text
cognitoIdentityId             :: Maybe Text
    , Identity -> Maybe Text
caller                        :: Maybe Text
    , Identity -> Maybe Text
apiKey                        :: Maybe Text
    , Identity -> Text
sourceIp                      :: Text
    , Identity -> Maybe Text
accessKey                     :: Maybe Text
    , Identity -> Maybe Text
cognitoAuthenticationType     :: Maybe Text
    , Identity -> Maybe Text
cognitoAuthenticationProvider :: Maybe Text
    , Identity -> Maybe Text
userArn                       :: Maybe Text
    , Identity -> Maybe Text
apiKeyId                      :: Maybe Text
    , Identity -> Maybe Text
userAgent                     :: Maybe Text
    , Identity -> Maybe Text
user                          :: Maybe Text
    } deriving ((forall x. Identity -> Rep Identity x)
-> (forall x. Rep Identity x -> Identity) -> Generic Identity
forall x. Rep Identity x -> Identity
forall x. Identity -> Rep Identity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Identity x -> Identity
$cfrom :: forall x. Identity -> Rep Identity x
Generic)

instance FromJSON Identity

data RequestContext a = RequestContext
    { RequestContext a -> Text
path              :: Text
    , RequestContext a -> Text
accountId         :: Text
    , RequestContext a -> Maybe a
authorizer        :: Maybe a
    , RequestContext a -> Text
resourceId        :: Text
    , RequestContext a -> Text
stage             :: Text
    , RequestContext a -> Maybe Text
domainPrefix      :: Maybe Text
    , RequestContext a -> Text
requestId         :: Text
    , RequestContext a -> Identity
identity          :: Identity
    , RequestContext a -> Maybe Text
domainName        :: Maybe Text
    , RequestContext a -> Text
resourcePath      :: Text
    , RequestContext a -> Text
httpMethod        :: Text
    , RequestContext a -> Maybe Text
extendedRequestId :: Maybe Text
    , RequestContext a -> Text
apiId             :: Text
    }

instance FromJSON a => FromJSON (RequestContext a) where
    parseJSON :: Value -> Parser (RequestContext a)
parseJSON = String
-> (Object -> Parser (RequestContext a))
-> Value
-> Parser (RequestContext a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProxyRequest" ((Object -> Parser (RequestContext a))
 -> Value -> Parser (RequestContext a))
-> (Object -> Parser (RequestContext a))
-> Value
-> Parser (RequestContext a)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Text
-> Text
-> Maybe a
-> Text
-> Text
-> Maybe Text
-> Text
-> Identity
-> Maybe Text
-> Text
-> Text
-> Maybe Text
-> Text
-> RequestContext a
forall a.
Text
-> Text
-> Maybe a
-> Text
-> Text
-> Maybe Text
-> Text
-> Identity
-> Maybe Text
-> Text
-> Text
-> Maybe Text
-> Text
-> RequestContext a
RequestContext (Text
 -> Text
 -> Maybe a
 -> Text
 -> Text
 -> Maybe Text
 -> Text
 -> Identity
 -> Maybe Text
 -> Text
 -> Text
 -> Maybe Text
 -> Text
 -> RequestContext a)
-> Parser Text
-> Parser
     (Text
      -> Maybe a
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Identity
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> RequestContext a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path" Parser
  (Text
   -> Maybe a
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Identity
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> RequestContext a)
-> Parser Text
-> Parser
     (Maybe a
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Identity
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"accountId" Parser
  (Maybe a
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Identity
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> RequestContext a)
-> Parser (Maybe a)
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> Text
      -> Identity
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"authorizer" Parser
  (Text
   -> Text
   -> Maybe Text
   -> Text
   -> Identity
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> RequestContext a)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> Text
      -> Identity
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"resourceId" Parser
  (Text
   -> Maybe Text
   -> Text
   -> Identity
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> RequestContext a)
-> Parser Text
-> Parser
     (Maybe Text
      -> Text
      -> Identity
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"stage" Parser
  (Maybe Text
   -> Text
   -> Identity
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> RequestContext a)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Identity
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"domainPrefix" Parser
  (Text
   -> Identity
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> RequestContext a)
-> Parser Text
-> Parser
     (Identity
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"requestId" Parser
  (Identity
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> RequestContext a)
-> Parser Identity
-> Parser
     (Maybe Text
      -> Text -> Text -> Maybe Text -> Text -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser Identity
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"identity" Parser
  (Maybe Text
   -> Text -> Text -> Maybe Text -> Text -> RequestContext a)
-> Parser (Maybe Text)
-> Parser (Text -> Text -> Maybe Text -> Text -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"domainName" Parser (Text -> Text -> Maybe Text -> Text -> RequestContext a)
-> Parser Text
-> Parser (Text -> Maybe Text -> Text -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"resourcePath" Parser (Text -> Maybe Text -> Text -> RequestContext a)
-> Parser Text -> Parser (Maybe Text -> Text -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"httpMethod" Parser (Maybe Text -> Text -> RequestContext a)
-> Parser (Maybe Text) -> Parser (Text -> RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"extendedRequestId" Parser (Text -> RequestContext a)
-> Parser Text -> Parser (RequestContext a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"apiId"

-- TODO: Should also include websocket fields
-- | This type is for representing events that come from API Gateway via the
-- Lambda Proxy integration (forwarding HTTP data directly, rather than a
-- custom integration).  It will automatically decode the event that comes in.
--
-- The 'ProxyRequest' notably has one parameter for the type of information
-- returned by the API Gateway's custom authorizer (if applicable).  This type
-- must also implement FromJSON so that it can be decoded.  If you do not
-- expect this data to be populated we recommended using the 'NoAuthorizer'
-- type exported from this module (which is just an alias for 'Value').  If
-- there _must not_ be authorizer populated (this is unlikely) then use the
-- 'StrictlyNoAuthorizer' type.
--
-- @
--     {-\# LANGUAGE NamedFieldPuns \#-}
--     {-\# LANGUAGE DuplicateRecordFields \#-}
--
--     module Main where
--
--     import AWS.Lambda.Runtime (pureRuntime)
--     import AWS.Lambda.Events.ApiGateway.ProxyRequest (ProxyRequest(..), NoAuthorizer)
--     import AWS.Lambda.Events.ApiGateway.ProxyResponse (ProxyResponse(..), textPlain, forbidden403, ok200)
--
--     myHandler :: ProxyRequest NoAuthorizer -> ProxyResponse
--     myHandler ProxyRequest { httpMethod = \"GET\", path = "/say_hello" } =
--         ProxyResponse
--         {   status = ok200
--         ,   body = textPlain \"Hello\"
--         ,   headers = mempty
--         ,   multiValueHeaders = mempty
--         }
--     myHandler _ =
--         ProxyResponse
--         {   status = forbidden403
--         ,   body = textPlain \"Forbidden\"
--         ,   headers = mempty
--         ,   multiValueHeaders = mempty
--         }
--
--     main :: IO ()
--     main = pureRuntime myHandler
-- @
data ProxyRequest a = ProxyRequest
    { ProxyRequest a -> Text
path                            :: Text
    , ProxyRequest a -> HashMap (CI Text) Text
headers                         :: HashMap (CI Text) Text
    , ProxyRequest a -> HashMap (CI Text) [Text]
multiValueHeaders               :: HashMap (CI Text) [Text]
    , ProxyRequest a -> HashMap Text Text
pathParameters                  :: HashMap Text Text
    , ProxyRequest a -> HashMap Text Text
stageVariables                  :: HashMap Text Text
    , ProxyRequest a -> RequestContext a
requestContext                  :: RequestContext a
    , ProxyRequest a -> Text
resource                        :: Text
    , ProxyRequest a -> Text
httpMethod                      :: Text
    , ProxyRequest a -> HashMap Text Text
queryStringParameters           :: HashMap Text Text
    , ProxyRequest a -> HashMap Text [Text]
multiValueQueryStringParameters :: HashMap Text [Text]
    , ProxyRequest a -> ByteString
body                            :: ByteString
    } deriving ((forall x. ProxyRequest a -> Rep (ProxyRequest a) x)
-> (forall x. Rep (ProxyRequest a) x -> ProxyRequest a)
-> Generic (ProxyRequest a)
forall x. Rep (ProxyRequest a) x -> ProxyRequest a
forall x. ProxyRequest a -> Rep (ProxyRequest a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ProxyRequest a) x -> ProxyRequest a
forall a x. ProxyRequest a -> Rep (ProxyRequest a) x
$cto :: forall a x. Rep (ProxyRequest a) x -> ProxyRequest a
$cfrom :: forall a x. ProxyRequest a -> Rep (ProxyRequest a) x
Generic)

toCIHashMap :: HashMap Text a -> HashMap (CI Text) a
toCIHashMap :: HashMap Text a -> HashMap (CI Text) a
toCIHashMap = (Text -> a -> HashMap (CI Text) a -> HashMap (CI Text) a)
-> HashMap (CI Text) a -> HashMap Text a -> HashMap (CI Text) a
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey (CI Text -> a -> HashMap (CI Text) a -> HashMap (CI Text) a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert (CI Text -> a -> HashMap (CI Text) a -> HashMap (CI Text) a)
-> (Text -> CI Text)
-> Text
-> a
-> HashMap (CI Text) a
-> HashMap (CI Text) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
mk) HashMap (CI Text) a
forall a. Monoid a => a
mempty

toByteString :: Bool -> TL.Text -> ByteString
toByteString :: Bool -> Text -> ByteString
toByteString Bool
isBase64Encoded =
    if Bool
isBase64Encoded
        then ByteString -> ByteString
decodeLenient (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8
        else Text -> ByteString
TLE.encodeUtf8

-- | For ignoring API Gateway custom authorizer values
type NoAuthorizer = Value

-- | For ensuring that there were no API Gateway custom authorizer values (this
-- is not likely to be useful, you probably want 'NoAuthorizer')
type StrictlyNoAuthorizer = Void

instance FromJSON a => FromJSON (ProxyRequest a) where
    parseJSON :: Value -> Parser (ProxyRequest a)
parseJSON = String
-> (Object -> Parser (ProxyRequest a))
-> Value
-> Parser (ProxyRequest a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProxyRequest" ((Object -> Parser (ProxyRequest a))
 -> Value -> Parser (ProxyRequest a))
-> (Object -> Parser (ProxyRequest a))
-> Value
-> Parser (ProxyRequest a)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Text
-> HashMap (CI Text) Text
-> HashMap (CI Text) [Text]
-> HashMap Text Text
-> HashMap Text Text
-> RequestContext a
-> Text
-> Text
-> HashMap Text Text
-> HashMap Text [Text]
-> ByteString
-> ProxyRequest a
forall a.
Text
-> HashMap (CI Text) Text
-> HashMap (CI Text) [Text]
-> HashMap Text Text
-> HashMap Text Text
-> RequestContext a
-> Text
-> Text
-> HashMap Text Text
-> HashMap Text [Text]
-> ByteString
-> ProxyRequest a
ProxyRequest (Text
 -> HashMap (CI Text) Text
 -> HashMap (CI Text) [Text]
 -> HashMap Text Text
 -> HashMap Text Text
 -> RequestContext a
 -> Text
 -> Text
 -> HashMap Text Text
 -> HashMap Text [Text]
 -> ByteString
 -> ProxyRequest a)
-> Parser Text
-> Parser
     (HashMap (CI Text) Text
      -> HashMap (CI Text) [Text]
      -> HashMap Text Text
      -> HashMap Text Text
      -> RequestContext a
      -> Text
      -> Text
      -> HashMap Text Text
      -> HashMap Text [Text]
      -> ByteString
      -> ProxyRequest a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"path" Parser
  (HashMap (CI Text) Text
   -> HashMap (CI Text) [Text]
   -> HashMap Text Text
   -> HashMap Text Text
   -> RequestContext a
   -> Text
   -> Text
   -> HashMap Text Text
   -> HashMap Text [Text]
   -> ByteString
   -> ProxyRequest a)
-> Parser (HashMap (CI Text) Text)
-> Parser
     (HashMap (CI Text) [Text]
      -> HashMap Text Text
      -> HashMap Text Text
      -> RequestContext a
      -> Text
      -> Text
      -> HashMap Text Text
      -> HashMap Text [Text]
      -> ByteString
      -> ProxyRequest a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        (Object
v Object -> Text -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"headers" Parser (Maybe (HashMap Text Text))
-> (Maybe (HashMap Text Text) -> HashMap (CI Text) Text)
-> Parser (HashMap (CI Text) Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> HashMap Text Text -> HashMap (CI Text) Text
forall a. HashMap Text a -> HashMap (CI Text) a
toCIHashMap (HashMap Text Text -> HashMap (CI Text) Text)
-> (Maybe (HashMap Text Text) -> HashMap Text Text)
-> Maybe (HashMap Text Text)
-> HashMap (CI Text) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (HashMap Text Text) -> HashMap Text Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold) Parser
  (HashMap (CI Text) [Text]
   -> HashMap Text Text
   -> HashMap Text Text
   -> RequestContext a
   -> Text
   -> Text
   -> HashMap Text Text
   -> HashMap Text [Text]
   -> ByteString
   -> ProxyRequest a)
-> Parser (HashMap (CI Text) [Text])
-> Parser
     (HashMap Text Text
      -> HashMap Text Text
      -> RequestContext a
      -> Text
      -> Text
      -> HashMap Text Text
      -> HashMap Text [Text]
      -> ByteString
      -> ProxyRequest a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        (Object
v Object -> Text -> Parser (Maybe (HashMap Text [Text]))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"multiValueHeaders" Parser (Maybe (HashMap Text [Text]))
-> (Maybe (HashMap Text [Text]) -> HashMap (CI Text) [Text])
-> Parser (HashMap (CI Text) [Text])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> HashMap Text [Text] -> HashMap (CI Text) [Text]
forall a. HashMap Text a -> HashMap (CI Text) a
toCIHashMap (HashMap Text [Text] -> HashMap (CI Text) [Text])
-> (Maybe (HashMap Text [Text]) -> HashMap Text [Text])
-> Maybe (HashMap Text [Text])
-> HashMap (CI Text) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (HashMap Text [Text]) -> HashMap Text [Text]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold) Parser
  (HashMap Text Text
   -> HashMap Text Text
   -> RequestContext a
   -> Text
   -> Text
   -> HashMap Text Text
   -> HashMap Text [Text]
   -> ByteString
   -> ProxyRequest a)
-> Parser (HashMap Text Text)
-> Parser
     (HashMap Text Text
      -> RequestContext a
      -> Text
      -> Text
      -> HashMap Text Text
      -> HashMap Text [Text]
      -> ByteString
      -> ProxyRequest a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        (Object
v Object -> Text -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"pathParameters" Parser (Maybe (HashMap Text Text))
-> (Maybe (HashMap Text Text) -> HashMap Text Text)
-> Parser (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe (HashMap Text Text) -> HashMap Text Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold) Parser
  (HashMap Text Text
   -> RequestContext a
   -> Text
   -> Text
   -> HashMap Text Text
   -> HashMap Text [Text]
   -> ByteString
   -> ProxyRequest a)
-> Parser (HashMap Text Text)
-> Parser
     (RequestContext a
      -> Text
      -> Text
      -> HashMap Text Text
      -> HashMap Text [Text]
      -> ByteString
      -> ProxyRequest a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        (Object
v Object -> Text -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"stageVariables" Parser (Maybe (HashMap Text Text))
-> (Maybe (HashMap Text Text) -> HashMap Text Text)
-> Parser (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe (HashMap Text Text) -> HashMap Text Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold) Parser
  (RequestContext a
   -> Text
   -> Text
   -> HashMap Text Text
   -> HashMap Text [Text]
   -> ByteString
   -> ProxyRequest a)
-> Parser (RequestContext a)
-> Parser
     (Text
      -> Text
      -> HashMap Text Text
      -> HashMap Text [Text]
      -> ByteString
      -> ProxyRequest a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser (RequestContext a)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"requestContext" Parser
  (Text
   -> Text
   -> HashMap Text Text
   -> HashMap Text [Text]
   -> ByteString
   -> ProxyRequest a)
-> Parser Text
-> Parser
     (Text
      -> HashMap Text Text
      -> HashMap Text [Text]
      -> ByteString
      -> ProxyRequest a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"resource" Parser
  (Text
   -> HashMap Text Text
   -> HashMap Text [Text]
   -> ByteString
   -> ProxyRequest a)
-> Parser Text
-> Parser
     (HashMap Text Text
      -> HashMap Text [Text] -> ByteString -> ProxyRequest a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"httpMethod" Parser
  (HashMap Text Text
   -> HashMap Text [Text] -> ByteString -> ProxyRequest a)
-> Parser (HashMap Text Text)
-> Parser (HashMap Text [Text] -> ByteString -> ProxyRequest a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        (Object
v Object -> Text -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"queryStringParameters" Parser (Maybe (HashMap Text Text))
-> (Maybe (HashMap Text Text) -> HashMap Text Text)
-> Parser (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe (HashMap Text Text) -> HashMap Text Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold) Parser (HashMap Text [Text] -> ByteString -> ProxyRequest a)
-> Parser (HashMap Text [Text])
-> Parser (ByteString -> ProxyRequest a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        (Object
v Object -> Text -> Parser (Maybe (HashMap Text [Text]))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"multiValueQueryStringParameters" Parser (Maybe (HashMap Text [Text]))
-> (Maybe (HashMap Text [Text]) -> HashMap Text [Text])
-> Parser (HashMap Text [Text])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe (HashMap Text [Text]) -> HashMap Text [Text]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold) Parser (ByteString -> ProxyRequest a)
-> Parser ByteString -> Parser (ProxyRequest a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        (Bool -> Text -> ByteString
toByteString (Bool -> Text -> ByteString)
-> Parser Bool -> Parser (Text -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"isBase64Encoded" Parser (Text -> ByteString) -> Parser Text -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"body" Parser (Maybe Text) -> (Maybe Text -> Text) -> Parser Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe Text -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold))