hal-1.0.0.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.ProxyRequest

Description

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.

Synopsis

Documentation

data ProxyRequest a Source #

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

Instances

Instances details
FromJSON a => FromJSON (ProxyRequest a) Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

ToJSON a => ToJSON (ProxyRequest a) Source #

Since: 0.4.8

Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

Generic (ProxyRequest a) Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

Associated Types

type Rep (ProxyRequest a) :: Type -> Type #

Methods

from :: ProxyRequest a -> Rep (ProxyRequest a) x #

to :: Rep (ProxyRequest a) x -> ProxyRequest a #

Show a => Show (ProxyRequest a) Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

Eq a => Eq (ProxyRequest a) Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

type Rep (ProxyRequest a) Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

type Rep (ProxyRequest a) = D1 ('MetaData "ProxyRequest" "AWS.Lambda.Events.ApiGateway.ProxyRequest" "hal-1.0.0.1-BeoXkqcCy2H4yZDIVGzIdn" 'False) (C1 ('MetaCons "ProxyRequest" 'PrefixI 'True) (((S1 ('MetaSel ('Just "path") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "headers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HashMap (CI Text) Text))) :*: (S1 ('MetaSel ('Just "multiValueHeaders") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HashMap (CI Text) [Text])) :*: (S1 ('MetaSel ('Just "pathParameters") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HashMap Text Text)) :*: S1 ('MetaSel ('Just "stageVariables") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HashMap Text Text))))) :*: ((S1 ('MetaSel ('Just "requestContext") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RequestContext a)) :*: (S1 ('MetaSel ('Just "resource") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "httpMethod") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))) :*: (S1 ('MetaSel ('Just "queryStringParameters") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HashMap Text Text)) :*: (S1 ('MetaSel ('Just "multiValueQueryStringParameters") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HashMap Text [Text])) :*: S1 ('MetaSel ('Just "body") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString))))))

data RequestContext a Source #

Instances

Instances details
FromJSON a => FromJSON (RequestContext a) Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

ToJSON a => ToJSON (RequestContext a) Source #

Since: 0.4.8

Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

Generic (RequestContext a) Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

Associated Types

type Rep (RequestContext a) :: Type -> Type #

Show a => Show (RequestContext a) Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

Eq a => Eq (RequestContext a) Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

type Rep (RequestContext a) Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

type Rep (RequestContext a) = D1 ('MetaData "RequestContext" "AWS.Lambda.Events.ApiGateway.ProxyRequest" "hal-1.0.0.1-BeoXkqcCy2H4yZDIVGzIdn" 'False) (C1 ('MetaCons "RequestContext" 'PrefixI 'True) (((S1 ('MetaSel ('Just "path") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: (S1 ('MetaSel ('Just "accountId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "authorizer") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe a)))) :*: (S1 ('MetaSel ('Just "resourceId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: (S1 ('MetaSel ('Just "stage") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "domainPrefix") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text))))) :*: ((S1 ('MetaSel ('Just "requestId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: (S1 ('MetaSel ('Just "identity") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Identity) :*: S1 ('MetaSel ('Just "domainName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)))) :*: ((S1 ('MetaSel ('Just "resourcePath") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "httpMethod") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)) :*: (S1 ('MetaSel ('Just "extendedRequestId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "apiId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))))))

data Identity Source #

Instances

Instances details
FromJSON Identity Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

ToJSON Identity Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

Generic Identity Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

Associated Types

type Rep Identity :: Type -> Type #

Methods

from :: Identity -> Rep Identity x #

to :: Rep Identity x -> Identity #

Show Identity Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

Eq Identity Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

type Rep Identity Source # 
Instance details

Defined in AWS.Lambda.Events.ApiGateway.ProxyRequest

type Rep Identity = D1 ('MetaData "Identity" "AWS.Lambda.Events.ApiGateway.ProxyRequest" "hal-1.0.0.1-BeoXkqcCy2H4yZDIVGzIdn" 'False) (C1 ('MetaCons "Identity" 'PrefixI 'True) (((S1 ('MetaSel ('Just "cognitoIdentityPoolId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: (S1 ('MetaSel ('Just "accountId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "cognitoIdentityId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)))) :*: (S1 ('MetaSel ('Just "caller") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: (S1 ('MetaSel ('Just "apiKey") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "sourceIp") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))) :*: ((S1 ('MetaSel ('Just "accessKey") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: (S1 ('MetaSel ('Just "cognitoAuthenticationType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "cognitoAuthenticationProvider") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)))) :*: ((S1 ('MetaSel ('Just "userArn") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "apiKeyId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text))) :*: (S1 ('MetaSel ('Just "userAgent") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "user") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)))))))

type NoAuthorizer = Value Source #

For ignoring API Gateway custom authorizer values

type StrictlyNoAuthorizer = Void Source #

For ensuring that there were no API Gateway custom authorizer values (this is not likely to be useful, you probably want NoAuthorizer)