{-# 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
<&> :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
(<&>) f a
x a -> b
f = a -> b
f 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
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. 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
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
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. 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
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 :: forall k a.
(Eq k, FoldCase k, Hashable k) =>
HashMap k a -> HashMap (CI k) a
toCIHashMap = forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FoldCase s => s -> CI s
mk) 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 =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse 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 (forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
H.insertWith forall a. Semigroup a => a -> a -> a
(<>) (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 (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (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 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 :: forall a. ToJSON a => a -> ProxyBody
applicationJson a
x =
    Text -> Text -> Bool -> ProxyBody
ProxyBody
        Text
"application/json; charset=utf-8"
        (Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TLE.decodeUtf8 forall a b. (a -> b) -> a -> b
$ 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 = forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
original) forall a. Monoid a => a
mempty
        in [Pair] -> Value
object
               [ Key
"statusCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Status -> Int
statusCode Status
status
               , Key
"multiValueHeaders" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                     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]
                         (forall {v}. HashMap (CI Text) v -> HashMap Text v
unCI HashMap (CI Text) [Text]
mvh)
               , Key
"body" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
body
               , Key
"isBase64Encoded" 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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProxyResponse" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
        HashMap (CI Text) [Text]
headers <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"multiValueHeaders" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall k a.
(Eq k, FoldCase k, Hashable k) =>
HashMap k a -> HashMap (CI k) a
toCIHashMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map ByteString -> Text
TE.decodeUtf8 HeaderName
hContentType
            contentType :: Text
contentType = case 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 (Text
h:[Text]
_) -> Text
h
                Maybe [Text]
_ -> Text
"application/octet-stream"
            headers' :: HashMap (CI Text) [Text]
headers' = 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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"statusCode" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Enum a => Int -> a
toEnum
        ProxyBody
proxyBody <- Text -> Text -> Bool -> ProxyBody
ProxyBody Text
contentType
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"isBase64Encoded"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse Status
status HashMap (CI Text) [Text]
headers' ProxyBody
proxyBody