{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

module Aws.Lambda.Runtime.APIGateway.Types
  ( ApiGatewayRequest (..),
    ApiGatewayRequestContext (..),
    ApiGatewayRequestContextIdentity (..),
    ApiGatewayResponse (..),
    ApiGatewayResponseBody (..),
    ToApiGatewayResponseBody (..),
    ApiGatewayDispatcherOptions (..),
    mkApiGatewayResponse,
  )
where

import Aws.Lambda.Utilities (toJSONText)
import Data.Aeson
  ( FromJSON (parseJSON),
    KeyValue ((.=)),
    Object,
    ToJSON (toJSON),
    Value (Null, Object, String),
    eitherDecodeStrict,
    object,
    (.:),
    (.:?)
  )
import Data.Aeson.Types (Parser)
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.Types as T
import qualified Data.CaseInsensitive as CI
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import GHC.Generics (Generic)
import Network.HTTP.Types (Header, ResponseHeaders)

-- | API Gateway specific dispatcher options
newtype ApiGatewayDispatcherOptions = ApiGatewayDispatcherOptions
  { -- | Should impure exceptions be propagated through the API Gateway interface
    ApiGatewayDispatcherOptions -> Bool
propagateImpureExceptions :: Bool
  }

data ApiGatewayRequest body = ApiGatewayRequest
  { forall body. ApiGatewayRequest body -> Text
apiGatewayRequestResource :: !Text,
    forall body. ApiGatewayRequest body -> Text
apiGatewayRequestPath :: !Text,
    forall body. ApiGatewayRequest body -> Text
apiGatewayRequestHttpMethod :: !Text,
    forall body. ApiGatewayRequest body -> Maybe (HashMap Text Text)
apiGatewayRequestHeaders :: !(Maybe (HashMap Text Text)),
    forall body. ApiGatewayRequest body -> Maybe (HashMap Text Text)
apiGatewayRequestQueryStringParameters :: !(Maybe (HashMap Text Text)),
    forall body. ApiGatewayRequest body -> Maybe (HashMap Text Text)
apiGatewayRequestPathParameters :: !(Maybe (HashMap Text Text)),
    forall body. ApiGatewayRequest body -> Maybe (HashMap Text Text)
apiGatewayRequestStageVariables :: !(Maybe (HashMap Text Text)),
    forall body. ApiGatewayRequest body -> Bool
apiGatewayRequestIsBase64Encoded :: !Bool,
    forall body. ApiGatewayRequest body -> ApiGatewayRequestContext
apiGatewayRequestRequestContext :: !ApiGatewayRequestContext,
    forall body. ApiGatewayRequest body -> Maybe body
apiGatewayRequestBody :: !(Maybe body)
  }
  deriving (Int -> ApiGatewayRequest body -> ShowS
[ApiGatewayRequest body] -> ShowS
ApiGatewayRequest body -> String
(Int -> ApiGatewayRequest body -> ShowS)
-> (ApiGatewayRequest body -> String)
-> ([ApiGatewayRequest body] -> ShowS)
-> Show (ApiGatewayRequest body)
forall body. Show body => Int -> ApiGatewayRequest body -> ShowS
forall body. Show body => [ApiGatewayRequest body] -> ShowS
forall body. Show body => ApiGatewayRequest body -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall body. Show body => Int -> ApiGatewayRequest body -> ShowS
showsPrec :: Int -> ApiGatewayRequest body -> ShowS
$cshow :: forall body. Show body => ApiGatewayRequest body -> String
show :: ApiGatewayRequest body -> String
$cshowList :: forall body. Show body => [ApiGatewayRequest body] -> ShowS
showList :: [ApiGatewayRequest body] -> ShowS
Show)

-- We special case String and Text in order
-- to avoid unneeded encoding which will wrap them in quotes and break parsing
instance {-# OVERLAPPING #-} FromJSON (ApiGatewayRequest Text) where
  parseJSON :: Value -> Parser (ApiGatewayRequest Text)
parseJSON = (Object -> Key -> Parser (Maybe Text))
-> Value -> Parser (ApiGatewayRequest Text)
forall body.
(Object -> Key -> Parser (Maybe body))
-> Value -> Parser (ApiGatewayRequest body)
parseApiGatewayRequest Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
(.:)

instance {-# OVERLAPPING #-} FromJSON (ApiGatewayRequest String) where
  parseJSON :: Value -> Parser (ApiGatewayRequest String)
parseJSON = (Object -> Key -> Parser (Maybe String))
-> Value -> Parser (ApiGatewayRequest String)
forall body.
(Object -> Key -> Parser (Maybe body))
-> Value -> Parser (ApiGatewayRequest body)
parseApiGatewayRequest Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser a
(.:)

instance FromJSON body => FromJSON (ApiGatewayRequest body) where
  parseJSON :: Value -> Parser (ApiGatewayRequest body)
parseJSON = (Object -> Key -> Parser (Maybe body))
-> Value -> Parser (ApiGatewayRequest body)
forall body.
(Object -> Key -> Parser (Maybe body))
-> Value -> Parser (ApiGatewayRequest body)
parseApiGatewayRequest Object -> Key -> Parser (Maybe body)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
parseObjectFromStringField

-- We need this because API Gateway is going to send us the payload as a JSON string
parseObjectFromStringField :: FromJSON a => Object -> T.Key -> Parser (Maybe a)
parseObjectFromStringField :: forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
parseObjectFromStringField Object
obj Key
fieldName = do
  Value
fieldContents <- Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
fieldName
  case Value
fieldContents of
    String Text
stringContents ->
      case ByteString -> Either String (Maybe a)
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (Text -> ByteString
T.encodeUtf8 Text
stringContents) of
        Right Maybe a
success -> Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
success
        Left String
err -> String -> Parser (Maybe a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    Value
Null -> Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Value
other -> String -> Value -> Parser (Maybe a)
forall a. String -> Value -> Parser a
T.typeMismatch String
"String or Null" Value
other

parseApiGatewayRequest :: (Object -> T.Key -> Parser (Maybe body)) -> Value -> Parser (ApiGatewayRequest body)
parseApiGatewayRequest :: forall body.
(Object -> Key -> Parser (Maybe body))
-> Value -> Parser (ApiGatewayRequest body)
parseApiGatewayRequest Object -> Key -> Parser (Maybe body)
bodyParser (Object Object
v) =
  Text
-> Text
-> Text
-> Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text)
-> Bool
-> ApiGatewayRequestContext
-> Maybe body
-> ApiGatewayRequest body
forall body.
Text
-> Text
-> Text
-> Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text)
-> Bool
-> ApiGatewayRequestContext
-> Maybe body
-> ApiGatewayRequest body
ApiGatewayRequest
    (Text
 -> Text
 -> Text
 -> Maybe (HashMap Text Text)
 -> Maybe (HashMap Text Text)
 -> Maybe (HashMap Text Text)
 -> Maybe (HashMap Text Text)
 -> Bool
 -> ApiGatewayRequestContext
 -> Maybe body
 -> ApiGatewayRequest body)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Bool
      -> ApiGatewayRequestContext
      -> Maybe body
      -> ApiGatewayRequest body)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"resource"
    Parser
  (Text
   -> Text
   -> Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Bool
   -> ApiGatewayRequestContext
   -> Maybe body
   -> ApiGatewayRequest body)
-> Parser Text
-> Parser
     (Text
      -> Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Bool
      -> ApiGatewayRequestContext
      -> Maybe body
      -> ApiGatewayRequest body)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
    Parser
  (Text
   -> Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Bool
   -> ApiGatewayRequestContext
   -> Maybe body
   -> ApiGatewayRequest body)
-> Parser Text
-> Parser
     (Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Bool
      -> ApiGatewayRequestContext
      -> Maybe body
      -> ApiGatewayRequest body)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"httpMethod"
    Parser
  (Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Bool
   -> ApiGatewayRequestContext
   -> Maybe body
   -> ApiGatewayRequest body)
-> Parser (Maybe (HashMap Text Text))
-> Parser
     (Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Bool
      -> ApiGatewayRequestContext
      -> Maybe body
      -> ApiGatewayRequest body)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"headers"
    Parser
  (Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Bool
   -> ApiGatewayRequestContext
   -> Maybe body
   -> ApiGatewayRequest body)
-> Parser (Maybe (HashMap Text Text))
-> Parser
     (Maybe (HashMap Text Text)
      -> Maybe (HashMap Text Text)
      -> Bool
      -> ApiGatewayRequestContext
      -> Maybe body
      -> ApiGatewayRequest body)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"queryStringParameters"
    Parser
  (Maybe (HashMap Text Text)
   -> Maybe (HashMap Text Text)
   -> Bool
   -> ApiGatewayRequestContext
   -> Maybe body
   -> ApiGatewayRequest body)
-> Parser (Maybe (HashMap Text Text))
-> Parser
     (Maybe (HashMap Text Text)
      -> Bool
      -> ApiGatewayRequestContext
      -> Maybe body
      -> ApiGatewayRequest body)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pathParameters"
    Parser
  (Maybe (HashMap Text Text)
   -> Bool
   -> ApiGatewayRequestContext
   -> Maybe body
   -> ApiGatewayRequest body)
-> Parser (Maybe (HashMap Text Text))
-> Parser
     (Bool
      -> ApiGatewayRequestContext
      -> Maybe body
      -> ApiGatewayRequest body)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stageVariables"
    Parser
  (Bool
   -> ApiGatewayRequestContext
   -> Maybe body
   -> ApiGatewayRequest body)
-> Parser Bool
-> Parser
     (ApiGatewayRequestContext -> Maybe body -> ApiGatewayRequest body)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"isBase64Encoded"
    Parser
  (ApiGatewayRequestContext -> Maybe body -> ApiGatewayRequest body)
-> Parser ApiGatewayRequestContext
-> Parser (Maybe body -> ApiGatewayRequest body)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ApiGatewayRequestContext
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requestContext"
    Parser (Maybe body -> ApiGatewayRequest body)
-> Parser (Maybe body) -> Parser (ApiGatewayRequest body)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe body)
`bodyParser` Key
"body"
parseApiGatewayRequest Object -> Key -> Parser (Maybe body)
_ Value
_ = String -> Parser (ApiGatewayRequest body)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected ApiGatewayRequest to be an object."

data ApiGatewayRequestContext = ApiGatewayRequestContext
  { ApiGatewayRequestContext -> Text
apiGatewayRequestContextResourceId :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextResourcePath :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextHttpMethod :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextExtendedRequestId :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextRequestTime :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextPath :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextAccountId :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextProtocol :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextStage :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextDomainPrefix :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextRequestId :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextDomainName :: !Text,
    ApiGatewayRequestContext -> Text
apiGatewayRequestContextApiId :: !Text,
    ApiGatewayRequestContext -> ApiGatewayRequestContextIdentity
apiGatewayRequestContextIdentity :: !ApiGatewayRequestContextIdentity,
    ApiGatewayRequestContext -> Maybe Value
apiGatewayRequestContextAuthorizer :: !(Maybe Value)
  }
  deriving (Int -> ApiGatewayRequestContext -> ShowS
[ApiGatewayRequestContext] -> ShowS
ApiGatewayRequestContext -> String
(Int -> ApiGatewayRequestContext -> ShowS)
-> (ApiGatewayRequestContext -> String)
-> ([ApiGatewayRequestContext] -> ShowS)
-> Show ApiGatewayRequestContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApiGatewayRequestContext -> ShowS
showsPrec :: Int -> ApiGatewayRequestContext -> ShowS
$cshow :: ApiGatewayRequestContext -> String
show :: ApiGatewayRequestContext -> String
$cshowList :: [ApiGatewayRequestContext] -> ShowS
showList :: [ApiGatewayRequestContext] -> ShowS
Show)

instance FromJSON ApiGatewayRequestContext where
  parseJSON :: Value -> Parser ApiGatewayRequestContext
parseJSON (Object Object
v) =
    Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> ApiGatewayRequestContextIdentity
-> Maybe Value
-> ApiGatewayRequestContext
ApiGatewayRequestContext
      (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> ApiGatewayRequestContextIdentity
 -> Maybe Value
 -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"resourceId"
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"httpMethod"
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"extendedRequestId"
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requestTime"
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accountId"
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protocol"
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stage"
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"domainPrefix"
      Parser
  (Text
   -> Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requestId"
      Parser
  (Text
   -> Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (Text
      -> ApiGatewayRequestContextIdentity
      -> Maybe Value
      -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"domainName"
      Parser
  (Text
   -> ApiGatewayRequestContextIdentity
   -> Maybe Value
   -> ApiGatewayRequestContext)
-> Parser Text
-> Parser
     (ApiGatewayRequestContextIdentity
      -> Maybe Value -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"apiId"
      Parser
  (ApiGatewayRequestContextIdentity
   -> Maybe Value -> ApiGatewayRequestContext)
-> Parser ApiGatewayRequestContextIdentity
-> Parser (Maybe Value -> ApiGatewayRequestContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ApiGatewayRequestContextIdentity
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identity"
      Parser (Maybe Value -> ApiGatewayRequestContext)
-> Parser (Maybe Value) -> Parser ApiGatewayRequestContext
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorizer"
  parseJSON Value
_ = String -> Parser ApiGatewayRequestContext
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected ApiGatewayRequestContext to be an object."

data ApiGatewayRequestContextIdentity = ApiGatewayRequestContextIdentity
  { ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentityCognitoIdentityPoolId :: !(Maybe Text),
    ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentityAccountId :: !(Maybe Text),
    ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentityCognitoIdentityId :: !(Maybe Text),
    ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentityCaller :: !(Maybe Text),
    ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentitySourceIp :: !(Maybe Text),
    ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentityPrincipalOrgId :: !(Maybe Text),
    ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentityAccesskey :: !(Maybe Text),
    ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentityCognitoAuthenticationType :: !(Maybe Text),
    ApiGatewayRequestContextIdentity -> Maybe Value
apiGatewayRequestContextIdentityCognitoAuthenticationProvider :: !(Maybe Value),
    ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentityUserArn :: !(Maybe Text),
    ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentityUserAgent :: !(Maybe Text),
    ApiGatewayRequestContextIdentity -> Maybe Text
apiGatewayRequestContextIdentityUser :: !(Maybe Text)
  }
  deriving (Int -> ApiGatewayRequestContextIdentity -> ShowS
[ApiGatewayRequestContextIdentity] -> ShowS
ApiGatewayRequestContextIdentity -> String
(Int -> ApiGatewayRequestContextIdentity -> ShowS)
-> (ApiGatewayRequestContextIdentity -> String)
-> ([ApiGatewayRequestContextIdentity] -> ShowS)
-> Show ApiGatewayRequestContextIdentity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApiGatewayRequestContextIdentity -> ShowS
showsPrec :: Int -> ApiGatewayRequestContextIdentity -> ShowS
$cshow :: ApiGatewayRequestContextIdentity -> String
show :: ApiGatewayRequestContextIdentity -> String
$cshowList :: [ApiGatewayRequestContextIdentity] -> ShowS
showList :: [ApiGatewayRequestContextIdentity] -> ShowS
Show)

instance FromJSON ApiGatewayRequestContextIdentity where
  parseJSON :: Value -> Parser ApiGatewayRequestContextIdentity
parseJSON (Object Object
v) =
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> ApiGatewayRequestContextIdentity
ApiGatewayRequestContextIdentity
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Value
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ApiGatewayRequestContextIdentity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cognitoIdentityPoolId"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ApiGatewayRequestContextIdentity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accountId"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ApiGatewayRequestContextIdentity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cognitoIdentityId"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ApiGatewayRequestContextIdentity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"caller"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ApiGatewayRequestContextIdentity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sourceIp"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ApiGatewayRequestContextIdentity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"principalOrgId"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ApiGatewayRequestContextIdentity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accessKey"
      Parser
  (Maybe Text
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ApiGatewayRequestContextIdentity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cognitoAuthenticationType"
      Parser
  (Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Value)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> ApiGatewayRequestContextIdentity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cognitoAuthenticationProvider"
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> ApiGatewayRequestContextIdentity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"userArn"
      Parser
  (Maybe Text -> Maybe Text -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> ApiGatewayRequestContextIdentity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"userAgent"
      Parser (Maybe Text -> ApiGatewayRequestContextIdentity)
-> Parser (Maybe Text) -> Parser ApiGatewayRequestContextIdentity
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
  parseJSON Value
_ = String -> Parser ApiGatewayRequestContextIdentity
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected ApiGatewayRequestContextIdentity to be an object."

newtype ApiGatewayResponseBody
  = ApiGatewayResponseBody Text
  deriving newtype ([ApiGatewayResponseBody] -> Value
[ApiGatewayResponseBody] -> Encoding
ApiGatewayResponseBody -> Bool
ApiGatewayResponseBody -> Value
ApiGatewayResponseBody -> Encoding
(ApiGatewayResponseBody -> Value)
-> (ApiGatewayResponseBody -> Encoding)
-> ([ApiGatewayResponseBody] -> Value)
-> ([ApiGatewayResponseBody] -> Encoding)
-> (ApiGatewayResponseBody -> Bool)
-> ToJSON ApiGatewayResponseBody
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ApiGatewayResponseBody -> Value
toJSON :: ApiGatewayResponseBody -> Value
$ctoEncoding :: ApiGatewayResponseBody -> Encoding
toEncoding :: ApiGatewayResponseBody -> Encoding
$ctoJSONList :: [ApiGatewayResponseBody] -> Value
toJSONList :: [ApiGatewayResponseBody] -> Value
$ctoEncodingList :: [ApiGatewayResponseBody] -> Encoding
toEncodingList :: [ApiGatewayResponseBody] -> Encoding
$comitField :: ApiGatewayResponseBody -> Bool
omitField :: ApiGatewayResponseBody -> Bool
ToJSON, Maybe ApiGatewayResponseBody
Value -> Parser [ApiGatewayResponseBody]
Value -> Parser ApiGatewayResponseBody
(Value -> Parser ApiGatewayResponseBody)
-> (Value -> Parser [ApiGatewayResponseBody])
-> Maybe ApiGatewayResponseBody
-> FromJSON ApiGatewayResponseBody
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ApiGatewayResponseBody
parseJSON :: Value -> Parser ApiGatewayResponseBody
$cparseJSONList :: Value -> Parser [ApiGatewayResponseBody]
parseJSONList :: Value -> Parser [ApiGatewayResponseBody]
$comittedField :: Maybe ApiGatewayResponseBody
omittedField :: Maybe ApiGatewayResponseBody
FromJSON)

class ToApiGatewayResponseBody a where
  toApiGatewayResponseBody :: a -> ApiGatewayResponseBody

-- We special case Text and String to avoid unneeded encoding which will wrap them in quotes
instance {-# OVERLAPPING #-} ToApiGatewayResponseBody Text where
  toApiGatewayResponseBody :: Text -> ApiGatewayResponseBody
toApiGatewayResponseBody = Text -> ApiGatewayResponseBody
ApiGatewayResponseBody

instance {-# OVERLAPPING #-} ToApiGatewayResponseBody String where
  toApiGatewayResponseBody :: String -> ApiGatewayResponseBody
toApiGatewayResponseBody = Text -> ApiGatewayResponseBody
ApiGatewayResponseBody (Text -> ApiGatewayResponseBody)
-> (String -> Text) -> String -> ApiGatewayResponseBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance ToJSON a => ToApiGatewayResponseBody a where
  toApiGatewayResponseBody :: a -> ApiGatewayResponseBody
toApiGatewayResponseBody = Text -> ApiGatewayResponseBody
ApiGatewayResponseBody (Text -> ApiGatewayResponseBody)
-> (a -> Text) -> a -> ApiGatewayResponseBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToJSON a => a -> Text
toJSONText

data ApiGatewayResponse body = ApiGatewayResponse
  { forall body. ApiGatewayResponse body -> Int
apiGatewayResponseStatusCode :: !Int,
    forall body. ApiGatewayResponse body -> ResponseHeaders
apiGatewayResponseHeaders :: !ResponseHeaders,
    forall body. ApiGatewayResponse body -> body
apiGatewayResponseBody :: !body,
    forall body. ApiGatewayResponse body -> Bool
apiGatewayResponseIsBase64Encoded :: !Bool
  }
  deriving ((forall x.
 ApiGatewayResponse body -> Rep (ApiGatewayResponse body) x)
-> (forall x.
    Rep (ApiGatewayResponse body) x -> ApiGatewayResponse body)
-> Generic (ApiGatewayResponse body)
forall x.
Rep (ApiGatewayResponse body) x -> ApiGatewayResponse body
forall x.
ApiGatewayResponse body -> Rep (ApiGatewayResponse body) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall body x.
Rep (ApiGatewayResponse body) x -> ApiGatewayResponse body
forall body x.
ApiGatewayResponse body -> Rep (ApiGatewayResponse body) x
$cfrom :: forall body x.
ApiGatewayResponse body -> Rep (ApiGatewayResponse body) x
from :: forall x.
ApiGatewayResponse body -> Rep (ApiGatewayResponse body) x
$cto :: forall body x.
Rep (ApiGatewayResponse body) x -> ApiGatewayResponse body
to :: forall x.
Rep (ApiGatewayResponse body) x -> ApiGatewayResponse body
Generic, Int -> ApiGatewayResponse body -> ShowS
[ApiGatewayResponse body] -> ShowS
ApiGatewayResponse body -> String
(Int -> ApiGatewayResponse body -> ShowS)
-> (ApiGatewayResponse body -> String)
-> ([ApiGatewayResponse body] -> ShowS)
-> Show (ApiGatewayResponse body)
forall body. Show body => Int -> ApiGatewayResponse body -> ShowS
forall body. Show body => [ApiGatewayResponse body] -> ShowS
forall body. Show body => ApiGatewayResponse body -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall body. Show body => Int -> ApiGatewayResponse body -> ShowS
showsPrec :: Int -> ApiGatewayResponse body -> ShowS
$cshow :: forall body. Show body => ApiGatewayResponse body -> String
show :: ApiGatewayResponse body -> String
$cshowList :: forall body. Show body => [ApiGatewayResponse body] -> ShowS
showList :: [ApiGatewayResponse body] -> ShowS
Show)

instance Functor ApiGatewayResponse where
  fmap :: forall a b.
(a -> b) -> ApiGatewayResponse a -> ApiGatewayResponse b
fmap a -> b
f ApiGatewayResponse a
v = ApiGatewayResponse a
v {apiGatewayResponseBody = f (apiGatewayResponseBody v)}

instance ToJSON body => ToJSON (ApiGatewayResponse body) where
  toJSON :: ApiGatewayResponse body -> Value
toJSON = (body -> Value) -> ApiGatewayResponse body -> Value
forall body. (body -> Value) -> ApiGatewayResponse body -> Value
apiGatewayResponseToJSON body -> Value
forall a. ToJSON a => a -> Value
toJSON

apiGatewayResponseToJSON :: (body -> Value) -> ApiGatewayResponse body -> Value
apiGatewayResponseToJSON :: forall body. (body -> Value) -> ApiGatewayResponse body -> Value
apiGatewayResponseToJSON body -> Value
bodyTransformer ApiGatewayResponse {body
Bool
Int
ResponseHeaders
$sel:apiGatewayResponseStatusCode:ApiGatewayResponse :: forall body. ApiGatewayResponse body -> Int
$sel:apiGatewayResponseHeaders:ApiGatewayResponse :: forall body. ApiGatewayResponse body -> ResponseHeaders
$sel:apiGatewayResponseBody:ApiGatewayResponse :: forall body. ApiGatewayResponse body -> body
$sel:apiGatewayResponseIsBase64Encoded:ApiGatewayResponse :: forall body. ApiGatewayResponse body -> Bool
apiGatewayResponseStatusCode :: Int
apiGatewayResponseHeaders :: ResponseHeaders
apiGatewayResponseBody :: body
apiGatewayResponseIsBase64Encoded :: Bool
..} =
  [Pair] -> Value
object
    [ Key
"statusCode" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
apiGatewayResponseStatusCode,
      Key
"body" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= body -> Value
bodyTransformer body
apiGatewayResponseBody,
      Key
"headers" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object (((HeaderName, ByteString) -> Pair) -> ResponseHeaders -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderName, ByteString) -> Pair
headerToPair ResponseHeaders
apiGatewayResponseHeaders),
      Key
"isBase64Encoded" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
apiGatewayResponseIsBase64Encoded
    ]

mkApiGatewayResponse :: Int -> ResponseHeaders -> payload -> ApiGatewayResponse payload
mkApiGatewayResponse :: forall payload.
Int -> ResponseHeaders -> payload -> ApiGatewayResponse payload
mkApiGatewayResponse Int
code ResponseHeaders
headers payload
payload =
  Int
-> ResponseHeaders -> payload -> Bool -> ApiGatewayResponse payload
forall body.
Int -> ResponseHeaders -> body -> Bool -> ApiGatewayResponse body
ApiGatewayResponse Int
code ResponseHeaders
headers payload
payload Bool
False

headerToPair :: Header -> T.Pair
headerToPair :: (HeaderName, ByteString) -> Pair
headerToPair (HeaderName
cibyte, ByteString
bstr) = Key
k Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
v
  where
    k :: Key
k = (Text -> Key
K.fromText (Text -> Key) -> (HeaderName -> Text) -> HeaderName -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (HeaderName -> ByteString) -> HeaderName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> ByteString
forall s. CI s -> s
CI.original) HeaderName
cibyte
    v :: Text
v = ByteString -> Text
T.decodeUtf8 ByteString
bstr