{-# LANGUAGE CPP #-}
{-|
Module      : AWS.Lambda.Events.ApiGateway.ProxyResponse
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 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.
-}
module AWS.Lambda.Events.ApiGateway.ProxyResponse
    ( ProxyResponse(..)
    , response
    , addHeader
    , setHeader
    , ProxyBody(..)
    , textPlain
    , applicationJson
    , genericBinary
    , module Network.HTTP.Types.Status
    ) where

import           Data.Aeson                (FromJSON(..), ToJSON, encode,
                                            object, toJSON, withObject, (.:),
                                            (.:?), (.=))
import           Data.ByteString           (ByteString)
import qualified Data.ByteString.Base64    as B64
import           Data.CaseInsensitive      (CI, FoldCase, mk, original)
import qualified Data.CaseInsensitive      as CI
import           Data.Foldable             (fold)
import           Data.Hashable             (Hashable)
import           Data.HashMap.Strict       (HashMap)
import qualified Data.HashMap.Strict       as H
#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup            ((<>))
#endif
import qualified Data.Text                 as T
import qualified Data.Text.Encoding        as TE
import qualified Data.Text.Lazy            as TL
import qualified Data.Text.Lazy.Encoding   as TLE
import           Network.HTTP.Types.Header (hContentType)
import           Network.HTTP.Types.Status (Status (..), accepted202,
                                            badGateway502, badRequest400,
                                            conflict409, continue100,
                                            created201, expectationFailed417,
                                            forbidden403, found302,
                                            gatewayTimeout504, gone410,
                                            httpVersionNotSupported505,
                                            imATeapot418,
                                            internalServerError500,
                                            lengthRequired411,
                                            methodNotAllowed405,
                                            movedPermanently301,
                                            multipleChoices300,
                                            networkAuthenticationRequired511,
                                            noContent204, nonAuthoritative203,
                                            notAcceptable406, notFound404,
                                            notImplemented501, notModified304,
                                            ok200, partialContent206,
                                            paymentRequired402,
                                            permanentRedirect308,
                                            preconditionFailed412,
                                            preconditionRequired428,
                                            proxyAuthenticationRequired407,
                                            requestEntityTooLarge413,
                                            requestHeaderFieldsTooLarge431,
                                            requestTimeout408,
                                            requestURITooLong414,
                                            requestedRangeNotSatisfiable416,
                                            resetContent205, seeOther303,
                                            serviceUnavailable503, status100,
                                            status101, status200, status201,
                                            status202, status203, status204,
                                            status205, status206, status300,
                                            status301, status302, status303,
                                            status304, status305, status307,
                                            status308, status400, status401,
                                            status402, status403, status404,
                                            status405, status406, status407,
                                            status408, status409, status410,
                                            status411, status412, status413,
                                            status414, status415, status416,
                                            status417, status418, status422,
                                            status426, status428, status429,
                                            status431, status500, status501,
                                            status502, status503, status504,
                                            status505, status511,
                                            switchingProtocols101,
                                            temporaryRedirect307,
                                            tooManyRequests429, unauthorized401,
                                            unprocessableEntity422,
                                            unsupportedMediaType415,
                                            upgradeRequired426, useProxy305)
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 <&>

-- | 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.
data ProxyBody = ProxyBody
    { ProxyBody -> Text
contentType     :: T.Text
    , ProxyBody -> Text
serialized      :: T.Text
    , ProxyBody -> Bool
isBase64Encoded :: Bool
    } deriving (ProxyBody -> ProxyBody -> Bool
(ProxyBody -> ProxyBody -> Bool)
-> (ProxyBody -> ProxyBody -> Bool) -> Eq ProxyBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProxyBody -> ProxyBody -> Bool
$c/= :: ProxyBody -> ProxyBody -> Bool
== :: ProxyBody -> ProxyBody -> Bool
$c== :: ProxyBody -> ProxyBody -> Bool
Eq, (forall x. ProxyBody -> Rep ProxyBody x)
-> (forall x. Rep ProxyBody x -> ProxyBody) -> Generic ProxyBody
forall x. Rep ProxyBody x -> ProxyBody
forall x. ProxyBody -> Rep ProxyBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProxyBody x -> ProxyBody
$cfrom :: forall x. ProxyBody -> Rep ProxyBody x
Generic, Int -> ProxyBody -> ShowS
[ProxyBody] -> ShowS
ProxyBody -> String
(Int -> ProxyBody -> ShowS)
-> (ProxyBody -> String)
-> ([ProxyBody] -> ShowS)
-> Show ProxyBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyBody] -> ShowS
$cshowList :: [ProxyBody] -> ShowS
show :: ProxyBody -> String
$cshow :: ProxyBody -> String
showsPrec :: Int -> ProxyBody -> ShowS
$cshowsPrec :: Int -> ProxyBody -> ShowS
Show)

-- | 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
-- @
data ProxyResponse = ProxyResponse
    { ProxyResponse -> Status
status            :: Status
    , ProxyResponse -> HashMap (CI Text) [Text]
multiValueHeaders :: HashMap (CI T.Text) [T.Text]
    , ProxyResponse -> ProxyBody
body              :: ProxyBody
    } deriving (ProxyResponse -> ProxyResponse -> Bool
(ProxyResponse -> ProxyResponse -> Bool)
-> (ProxyResponse -> ProxyResponse -> Bool) -> Eq ProxyResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProxyResponse -> ProxyResponse -> Bool
$c/= :: ProxyResponse -> ProxyResponse -> Bool
== :: ProxyResponse -> ProxyResponse -> Bool
$c== :: ProxyResponse -> ProxyResponse -> Bool
Eq, (forall x. ProxyResponse -> Rep ProxyResponse x)
-> (forall x. Rep ProxyResponse x -> ProxyResponse)
-> Generic ProxyResponse
forall x. Rep ProxyResponse x -> ProxyResponse
forall x. ProxyResponse -> Rep ProxyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProxyResponse x -> ProxyResponse
$cfrom :: forall x. ProxyResponse -> Rep ProxyResponse x
Generic, Int -> ProxyResponse -> ShowS
[ProxyResponse] -> ShowS
ProxyResponse -> String
(Int -> ProxyResponse -> ShowS)
-> (ProxyResponse -> String)
-> ([ProxyResponse] -> ShowS)
-> Show ProxyResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyResponse] -> ShowS
$cshowList :: [ProxyResponse] -> ShowS
show :: ProxyResponse -> String
$cshow :: ProxyResponse -> String
showsPrec :: Int -> ProxyResponse -> ShowS
$cshowsPrec :: Int -> ProxyResponse -> ShowS
Show)

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

-- | Smart constructor for creating a ProxyResponse from a status and a body
response :: Status -> ProxyBody -> ProxyResponse
response :: Status -> ProxyBody -> ProxyResponse
response =
  (Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse)
-> HashMap (CI Text) [Text] -> Status -> ProxyBody -> ProxyResponse
forall a b c. (a -> b -> c) -> b -> a -> c
flip Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse HashMap (CI Text) [Text]
forall a. Monoid a => a
mempty

-- | 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.
addHeader :: T.Text -> T.Text -> ProxyResponse -> ProxyResponse
addHeader :: Text -> Text -> ProxyResponse -> ProxyResponse
addHeader Text
header Text
value (ProxyResponse Status
s HashMap (CI Text) [Text]
mvh ProxyBody
b) =
  Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse Status
s (([Text] -> [Text] -> [Text])
-> CI Text
-> [Text]
-> HashMap (CI Text) [Text]
-> HashMap (CI Text) [Text]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
H.insertWith [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
(<>) (Text -> CI Text
forall s. FoldCase s => s -> CI s
mk Text
header) [Text
value] HashMap (CI Text) [Text]
mvh) ProxyBody
b

-- | Set a header to the ProxyResponse.  If there were any previous values for
-- this header they are __all replaced__ by this new value.
setHeader :: T.Text -> T.Text -> ProxyResponse -> ProxyResponse
setHeader :: Text -> Text -> ProxyResponse -> ProxyResponse
setHeader Text
header Text
value (ProxyResponse Status
s HashMap (CI Text) [Text]
mvh ProxyBody
b) =
  Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse Status
s (CI Text
-> [Text] -> HashMap (CI Text) [Text] -> HashMap (CI Text) [Text]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (Text -> CI Text
forall s. FoldCase s => s -> CI s
mk Text
header) [Text
value] HashMap (CI Text) [Text]
mvh) ProxyBody
b

-- | 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"
-- @
genericBinary :: T.Text -> ByteString -> ProxyBody
genericBinary :: Text -> ByteString -> ProxyBody
genericBinary Text
contentType ByteString
x =
    Text -> Text -> Bool -> ProxyBody
ProxyBody Text
contentType (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
x) Bool
True

-- | Smart constructor for creating a simple body of text.
textPlain :: T.Text -> ProxyBody
textPlain :: Text -> ProxyBody
textPlain Text
x = Text -> Text -> Bool -> ProxyBody
ProxyBody Text
"text/plain; charset=utf-8" Text
x Bool
False

-- | Smart constructor for creating a simple body of JSON.
applicationJson :: ToJSON a => a -> ProxyBody
applicationJson :: a -> ProxyBody
applicationJson a
x =
    Text -> Text -> Bool -> ProxyBody
ProxyBody
        Text
"application/json; charset=utf-8"
        (Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TLE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
x)
        Bool
False

instance ToJSON ProxyResponse where
    toJSON :: ProxyResponse -> Value
toJSON (ProxyResponse Status
status HashMap (CI Text) [Text]
mvh (ProxyBody Text
contentType Text
body Bool
isBase64Encoded)) =
        let unCI :: HashMap (CI Text) v -> HashMap Text v
unCI = (CI Text -> v -> HashMap Text v -> HashMap Text v)
-> HashMap Text v -> HashMap (CI Text) v -> HashMap Text v
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (Text -> v -> HashMap Text v -> HashMap Text v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (Text -> v -> HashMap Text v -> HashMap Text v)
-> (CI Text -> Text)
-> CI Text
-> v
-> HashMap Text v
-> HashMap Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> Text
forall s. CI s -> s
original) HashMap Text v
forall a. Monoid a => a
mempty
        in [Pair] -> Value
object
               [ Key
"statusCode" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Status -> Int
statusCode Status
status
               , Key
"multiValueHeaders" Key -> HashMap Text [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                     ([Text] -> [Text] -> [Text])
-> Text -> [Text] -> HashMap Text [Text] -> HashMap Text [Text]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
H.insertWith
                         (\[Text]
_ [Text]
old -> [Text]
old)
                         (Text
"Content-Type" :: T.Text)
                         [Text
contentType]
                         (HashMap (CI Text) [Text] -> HashMap Text [Text]
forall v. HashMap (CI Text) v -> HashMap Text v
unCI HashMap (CI Text) [Text]
mvh)
               , Key
"body" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
body
               , Key
"isBase64Encoded" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
isBase64Encoded
               ]

-- | @since 0.4.8
instance FromJSON ProxyResponse where
    parseJSON :: Value -> Parser ProxyResponse
parseJSON = String
-> (Object -> Parser ProxyResponse)
-> Value
-> Parser ProxyResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProxyResponse" ((Object -> Parser ProxyResponse) -> Value -> Parser ProxyResponse)
-> (Object -> Parser ProxyResponse)
-> Value
-> Parser ProxyResponse
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
        HashMap (CI Text) [Text]
headers <- Object
v Object -> Key -> Parser (Maybe (HashMap Text [Text]))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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 k a.
(Eq k, FoldCase k, Hashable k) =>
HashMap k a -> HashMap (CI k) 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
        -- Move the "Content-Type" header into the ProxyBody. This is
        -- necessary to ensure round-tripping.
        let contentTypeHeader :: CI Text
contentTypeHeader = (ByteString -> Text) -> CI ByteString -> CI Text
forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map ByteString -> Text
TE.decodeUtf8 CI ByteString
hContentType
            contentType :: Text
contentType = case CI Text -> HashMap (CI Text) [Text] -> Maybe [Text]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup CI Text
contentTypeHeader HashMap (CI Text) [Text]
headers of
                Just (h:_) -> Text
h
                Maybe [Text]
_ -> Text
"application/octet-stream"
            headers' :: HashMap (CI Text) [Text]
headers' = CI Text -> HashMap (CI Text) [Text] -> HashMap (CI Text) [Text]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete CI Text
contentTypeHeader HashMap (CI Text) [Text]
headers
        Status
status <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"statusCode" Parser Int -> (Int -> Status) -> Parser Status
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int -> Status
forall a. Enum a => Int -> a
toEnum
        ProxyBody
proxyBody <- Text -> Text -> Bool -> ProxyBody
ProxyBody Text
contentType
            (Text -> Bool -> ProxyBody)
-> Parser Text -> Parser (Bool -> ProxyBody)
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
"body"
            Parser (Bool -> ProxyBody) -> Parser Bool -> Parser ProxyBody
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"
        ProxyResponse -> Parser ProxyResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProxyResponse -> Parser ProxyResponse)
-> ProxyResponse -> Parser ProxyResponse
forall a b. (a -> b) -> a -> b
$ Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse Status
status HashMap (CI Text) [Text]
headers' ProxyBody
proxyBody