hal-1.1: A runtime environment for Haskell applications running on AWS Lambda.
Copyright(c) Nike Inc. 2019
LicenseBSD3
Maintainernathan.fairhurst@nike.com, fernando.freire@nike.com
Stabilitystable
Safe HaskellSafe-Inferred
LanguageHaskell2010

AWS.Lambda.Events.ApiGateway.ProxyResponse

Description

This module enable exposes the required types for responding to API Gateway Proxy Events. Responses must return a status, body, and optionaly headers. Multiple smart contructors and helpers are provided to help encapsulated details like header case-insensitivity, multiple header copies, correct base64 encoding, and default content type.

Synopsis

Documentation

data ProxyResponse Source #

A response returned to an API Gateway when using the HTTP Lambda Proxy integration. ContentType will be set based on the ProxyBody (recommended) if a value is not present in the headers field.

This type can be constructed explicity or via the smart constructor response. Headers can then be added incrementally with addHeader or setHeader. The smart constructor pattern is recommended because it avoids some of the awkwardness of dealing with the multiValueHeaders field's type.

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

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, response)

myHandler :: ProxyRequest NoAuthorizer -> ProxyResponse
myHandler ProxyRequest { httpMethod = "GET", path = "/say_hello" } =
    -- Smart Constructor and added header (recommended)
    addHeader "My-Custom-Header" Value $
      response ok200 $ textPlain "Hello"
myHandler _ =
    -- Explicit Construction (not recommended)
    ProxyResponse
    {   status = forbidden403
    ,   body = textPlain "Forbidden"
    ,   multiValueHeaders =
          fromList [(mk "My-Custom-Header", ["Other Value])]
    }

main :: IO ()
main = pureRuntime myHandler

Instances

Instances details
FromJSON ProxyResponse Source #

Since: 0.4.8

Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyResponse

ToJSON ProxyResponse Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyResponse

Generic ProxyResponse Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyResponse

Associated Types

type Rep ProxyResponse :: Type -> Type #

Show ProxyResponse Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyResponse

Eq ProxyResponse Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyResponse

type Rep ProxyResponse Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyResponse

type Rep ProxyResponse = D1 ('MetaData "ProxyResponse" "AWS.Lambda.Events.ApiGateway.ProxyResponse" "hal-1.1-IwuGgwGQvpsJOoRlidLUAk" 'False) (C1 ('MetaCons "ProxyResponse" 'PrefixI 'True) (S1 ('MetaSel ('Just "status") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Status) :*: (S1 ('MetaSel ('Just "multiValueHeaders") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HashMap (CI Text) [Text])) :*: S1 ('MetaSel ('Just "body") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ProxyBody))))

response :: Status -> ProxyBody -> ProxyResponse Source #

Smart constructor for creating a ProxyResponse from a status and a body

addHeader :: Text -> Text -> ProxyResponse -> ProxyResponse Source #

Add a header to the ProxyResponse. If there was already a value for this header, this one is added, meaning the response will include multiple copies of this header (valid by the HTTP spec). This does NOT replace any previous headers or their values.

setHeader :: Text -> Text -> ProxyResponse -> ProxyResponse Source #

Set a header to the ProxyResponse. If there were any previous values for this header they are all replaced by this new value.

data ProxyBody Source #

Type that represents the body returned to an API Gateway when using HTTP Lambda Proxy integration. It is highly recommended that you do not use this type directly, and instead use the smart constructors exposed such as textPlain, applicationJson, and genericBinary. These make sure that the base64 encodings work transparently.

Constructors

ProxyBody 

Instances

Instances details
Generic ProxyBody Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyResponse

Associated Types

type Rep ProxyBody :: Type -> Type #

Show ProxyBody Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyResponse

Eq ProxyBody Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyResponse

type Rep ProxyBody Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyResponse

type Rep ProxyBody = D1 ('MetaData "ProxyBody" "AWS.Lambda.Events.ApiGateway.ProxyResponse" "hal-1.1-IwuGgwGQvpsJOoRlidLUAk" 'False) (C1 ('MetaCons "ProxyBody" 'PrefixI 'True) (S1 ('MetaSel ('Just "contentType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: (S1 ('MetaSel ('Just "serialized") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "isBase64Encoded") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool))))

textPlain :: Text -> ProxyBody Source #

Smart constructor for creating a simple body of text.

applicationJson :: ToJSON a => a -> ProxyBody Source #

Smart constructor for creating a simple body of JSON.

genericBinary :: Text -> ByteString -> ProxyBody Source #

Smart constructor for creating a ProxyBody with an arbitrary ByteString of the chosen content type. Use this smart constructor to avoid invalid JSON representations of binary data.

From here it is easy to make more specific body constructors:

imageGif :: ByteString -> ProxyBody
imageGif = genericBinary "image/gif"

imageJpeg :: ByteString -> ProxyBody
imageJpeg = genericBinary "image/jpeg"

networkAuthenticationRequired511 :: Status #

Network Authentication Required 511 (RFC 6585)

Since: http-types-0.8.5

status511 :: Status #

Network Authentication Required 511 (RFC 6585)

Since: http-types-0.8.5

httpVersionNotSupported505 :: Status #

HTTP Version Not Supported 505

Since: http-types-0.6.6

status505 :: Status #

HTTP Version Not Supported 505

Since: http-types-0.6.6

gatewayTimeout504 :: Status #

Gateway Timeout 504

Since: http-types-0.6.6

status504 :: Status #

Gateway Timeout 504

Since: http-types-0.6.6

serviceUnavailable503 :: Status #

Service Unavailable 503

Since: http-types-0.6.6

status503 :: Status #

Service Unavailable 503

Since: http-types-0.6.6

badGateway502 :: Status #

Bad Gateway 502

Since: http-types-0.6.6

status502 :: Status #

Bad Gateway 502

Since: http-types-0.6.6

notImplemented501 :: Status #

Not Implemented 501

Since: http-types-0.6.1

status501 :: Status #

Not Implemented 501

Since: http-types-0.6.1

internalServerError500 :: Status #

Internal Server Error 500

status500 :: Status #

Internal Server Error 500

requestHeaderFieldsTooLarge431 :: Status #

Request Header Fields Too Large 431 (RFC 6585)

Since: http-types-0.8.5

status431 :: Status #

Request Header Fields Too Large 431 (RFC 6585)

Since: http-types-0.8.5

tooManyRequests429 :: Status #

Too Many Requests 429 (RFC 6585)

Since: http-types-0.8.5

status429 :: Status #

Too Many Requests 429 (RFC 6585)

Since: http-types-0.8.5

preconditionRequired428 :: Status #

Precondition Required 428 (RFC 6585)

Since: http-types-0.8.5

status428 :: Status #

Precondition Required 428 (RFC 6585)

Since: http-types-0.8.5

upgradeRequired426 :: Status #

Upgrade Required 426 (https://tools.ietf.org/html/rfc7231#section-6.5.15)

Since: http-types-0.10

status426 :: Status #

Upgrade Required 426 (https://tools.ietf.org/html/rfc7231#section-6.5.15)

Since: http-types-0.10

unprocessableEntity422 :: Status #

Unprocessable Entity 422 (RFC 4918)

Since: http-types-0.9.1

status422 :: Status #

Unprocessable Entity 422 (RFC 4918)

Since: http-types-0.9.1

imATeapot418 :: Status #

I'm a teapot 418

Since: http-types-0.6.6

status418 :: Status #

I'm a teapot 418

Since: http-types-0.6.6

expectationFailed417 :: Status #

Expectation Failed 417

Since: http-types-0.6.6

status417 :: Status #

Expectation Failed 417

Since: http-types-0.6.6

requestedRangeNotSatisfiable416 :: Status #

Requested Range Not Satisfiable 416

Since: http-types-0.6.1

status416 :: Status #

Requested Range Not Satisfiable 416

Since: http-types-0.6.1

unsupportedMediaType415 :: Status #

Unsupported Media Type 415

Since: http-types-0.6.6

status415 :: Status #

Unsupported Media Type 415

Since: http-types-0.6.6

requestURITooLong414 :: Status #

Request-URI Too Long 414

Since: http-types-0.6.6

status414 :: Status #

Request-URI Too Long 414

Since: http-types-0.6.6

requestEntityTooLarge413 :: Status #

Request Entity Too Large 413

Since: http-types-0.6.6

status413 :: Status #

Request Entity Too Large 413

Since: http-types-0.6.6

preconditionFailed412 :: Status #

Precondition Failed 412

Since: http-types-0.6.1

status412 :: Status #

Precondition Failed 412

Since: http-types-0.6.1

lengthRequired411 :: Status #

Length Required 411

Since: http-types-0.6.6

status411 :: Status #

Length Required 411

Since: http-types-0.6.6

gone410 :: Status #

Gone 410

Since: http-types-0.6.6

status410 :: Status #

Gone 410

Since: http-types-0.6.6

conflict409 :: Status #

Conflict 409

Since: http-types-0.6.6

status409 :: Status #

Conflict 409

Since: http-types-0.6.6

requestTimeout408 :: Status #

Request Timeout 408

Since: http-types-0.6.6

status408 :: Status #

Request Timeout 408

Since: http-types-0.6.6

proxyAuthenticationRequired407 :: Status #

Proxy Authentication Required 407

Since: http-types-0.6.6

status407 :: Status #

Proxy Authentication Required 407

Since: http-types-0.6.6

notAcceptable406 :: Status #

Not Acceptable 406

Since: http-types-0.6.6

status406 :: Status #

Not Acceptable 406

Since: http-types-0.6.6

methodNotAllowed405 :: Status #

Method Not Allowed 405

status405 :: Status #

Method Not Allowed 405

notFound404 :: Status #

Not Found 404

status404 :: Status #

Not Found 404

forbidden403 :: Status #

Forbidden 403

status403 :: Status #

Forbidden 403

paymentRequired402 :: Status #

Payment Required 402

Since: http-types-0.6.6

status402 :: Status #

Payment Required 402

Since: http-types-0.6.6

unauthorized401 :: Status #

Unauthorized 401

status401 :: Status #

Unauthorized 401

badRequest400 :: Status #

Bad Request 400

status400 :: Status #

Bad Request 400

permanentRedirect308 :: Status #

Permanent Redirect 308

Since: http-types-0.9

status308 :: Status #

Permanent Redirect 308

Since: http-types-0.9

temporaryRedirect307 :: Status #

Temporary Redirect 307

Since: http-types-0.6.6

status307 :: Status #

Temporary Redirect 307

Since: http-types-0.6.6

useProxy305 :: Status #

Use Proxy 305

Since: http-types-0.6.6

status305 :: Status #

Use Proxy 305

Since: http-types-0.6.6

notModified304 :: Status #

Not Modified 304

Since: http-types-0.6.1

status304 :: Status #

Not Modified 304

Since: http-types-0.6.1

seeOther303 :: Status #

See Other 303

status303 :: Status #

See Other 303

found302 :: Status #

Found 302

status302 :: Status #

Found 302

movedPermanently301 :: Status #

Moved Permanently 301

status301 :: Status #

Moved Permanently 301

multipleChoices300 :: Status #

Multiple Choices 300

status300 :: Status #

Multiple Choices 300

partialContent206 :: Status #

Partial Content 206

Since: http-types-0.5.1

status206 :: Status #

Partial Content 206

Since: http-types-0.5.1

resetContent205 :: Status #

Reset Content 205

Since: http-types-0.6.6

status205 :: Status #

Reset Content 205

Since: http-types-0.6.6

noContent204 :: Status #

No Content 204

Since: http-types-0.6.6

status204 :: Status #

No Content 204

Since: http-types-0.6.6

nonAuthoritative203 :: Status #

Non-Authoritative Information 203

Since: http-types-0.6.6

status203 :: Status #

Non-Authoritative Information 203

Since: http-types-0.6.6

accepted202 :: Status #

Accepted 202

Since: http-types-0.6.6

status202 :: Status #

Accepted 202

Since: http-types-0.6.6

created201 :: Status #

Created 201

status201 :: Status #

Created 201

ok200 :: Status #

OK 200

status200 :: Status #

OK 200

switchingProtocols101 :: Status #

Switching Protocols 101

Since: http-types-0.6.6

status101 :: Status #

Switching Protocols 101

Since: http-types-0.6.6

continue100 :: Status #

Continue 100

Since: http-types-0.6.6

status100 :: Status #

Continue 100

Since: http-types-0.6.6

data Status #

HTTP Status.

Only the statusCode is used for comparisons.

Please use mkStatus to create status codes from code and message, or the Enum instance or the status code constants (like ok200). There might be additional record members in the future.

Note that the Show instance is only for debugging.

Constructors

Status 

Instances

Instances details
Data Status

Since: http-types-0.12.4

Instance details

Defined in Network.HTTP.Types.Status

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Status -> c Status #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Status #

toConstr :: Status -> Constr #

dataTypeOf :: Status -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Status) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Status) #

gmapT :: (forall b. Data b => b -> b) -> Status -> Status #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Status -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Status -> r #

gmapQ :: (forall d. Data d => d -> u) -> Status -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Status -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Status -> m Status #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Status -> m Status #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Status -> m Status #

Bounded Status

Since: http-types-0.11

Instance details

Defined in Network.HTTP.Types.Status

Enum Status

Be advised, that when using the "enumFrom*" family of methods or ranges in lists, it will generate all possible status codes.

E.g. [status100 .. status200] generates Statuses of 100, 101, 102 .. 198, 199, 200

The statuses not included in this library will have an empty message.

Since: http-types-0.7.3

Instance details

Defined in Network.HTTP.Types.Status

Generic Status 
Instance details

Defined in Network.HTTP.Types.Status

Associated Types

type Rep Status :: Type -> Type #

Methods

from :: Status -> Rep Status x #

to :: Rep Status x -> Status #

Show Status 
Instance details

Defined in Network.HTTP.Types.Status

Eq Status

A Status is equal to another Status if the status codes are equal.

Instance details

Defined in Network.HTTP.Types.Status

Methods

(==) :: Status -> Status -> Bool #

(/=) :: Status -> Status -> Bool #

Ord Status

Statuses are ordered according to their status codes only.

Instance details

Defined in Network.HTTP.Types.Status

type Rep Status

Since: http-types-0.12.4

Instance details

Defined in Network.HTTP.Types.Status

type Rep Status = D1 ('MetaData "Status" "Network.HTTP.Types.Status" "http-types-0.12.4-8sVzaiF2LjrERDtipkARMD" 'False) (C1 ('MetaCons "Status" 'PrefixI 'True) (S1 ('MetaSel ('Just "statusCode") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Just "statusMessage") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))