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

module Aws.Lambda.Runtime.ALB.Types
  ( ALBRequest (..),
    ALBRequestContext (..),
    ALBResponse (..),
    ALBResponseBody (..),
    ToALBResponseBody (..),
    mkALBResponse,
  )
where

import Aws.Lambda.Utilities (toJSONText, tshow)
import Data.Aeson
  ( FromJSON (parseJSON),
    KeyValue ((.=)),
    Object,
    ToJSON (toJSON),
    Value (Null, Object, String),
    eitherDecodeStrict,
    object,
    (.:),
  )
import Data.Aeson.Types (Parser)
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)

data ALBRequest body = ALBRequest
  { ALBRequest body -> Text
albRequestPath :: !Text,
    ALBRequest body -> Text
albRequestHttpMethod :: !Text,
    ALBRequest body -> Maybe (HashMap Text Text)
albRequestHeaders :: !(Maybe (HashMap Text Text)),
    -- TODO: They won't be url decoded in ALB
    ALBRequest body -> Maybe (HashMap Text Text)
albRequestQueryStringParameters :: !(Maybe (HashMap Text Text)),
    ALBRequest body -> Bool
albRequestIsBase64Encoded :: !Bool,
    ALBRequest body -> ALBRequestContext
albRequestRequestContext :: !ALBRequestContext,
    ALBRequest body -> Maybe body
albRequestBody :: !(Maybe body)
  }
  deriving (Int -> ALBRequest body -> ShowS
[ALBRequest body] -> ShowS
ALBRequest body -> String
(Int -> ALBRequest body -> ShowS)
-> (ALBRequest body -> String)
-> ([ALBRequest body] -> ShowS)
-> Show (ALBRequest body)
forall body. Show body => Int -> ALBRequest body -> ShowS
forall body. Show body => [ALBRequest body] -> ShowS
forall body. Show body => ALBRequest body -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ALBRequest body] -> ShowS
$cshowList :: forall body. Show body => [ALBRequest body] -> ShowS
show :: ALBRequest body -> String
$cshow :: forall body. Show body => ALBRequest body -> String
showsPrec :: Int -> ALBRequest body -> ShowS
$cshowsPrec :: forall body. Show body => Int -> ALBRequest 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 (ALBRequest Text) where
  parseJSON :: Value -> Parser (ALBRequest Text)
parseJSON = (Object -> Text -> Parser (Maybe Text))
-> Value -> Parser (ALBRequest Text)
forall body.
(Object -> Text -> Parser (Maybe body))
-> Value -> Parser (ALBRequest body)
parseALBRequest Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
(.:)

instance {-# OVERLAPPING #-} FromJSON (ALBRequest String) where
  parseJSON :: Value -> Parser (ALBRequest String)
parseJSON = (Object -> Text -> Parser (Maybe String))
-> Value -> Parser (ALBRequest String)
forall body.
(Object -> Text -> Parser (Maybe body))
-> Value -> Parser (ALBRequest body)
parseALBRequest Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser a
(.:)

instance FromJSON body => FromJSON (ALBRequest body) where
  parseJSON :: Value -> Parser (ALBRequest body)
parseJSON = (Object -> Text -> Parser (Maybe body))
-> Value -> Parser (ALBRequest body)
forall body.
(Object -> Text -> Parser (Maybe body))
-> Value -> Parser (ALBRequest body)
parseALBRequest Object -> Text -> Parser (Maybe body)
forall a. FromJSON a => Object -> Text -> 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 -> Text -> Parser (Maybe a)
parseObjectFromStringField :: Object -> Text -> Parser (Maybe a)
parseObjectFromStringField Object
obj Text
fieldName = do
  Value
fieldContents <- Object
obj Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
success
        Left String
err -> String -> Parser (Maybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    Value
Null -> Maybe a -> Parser (Maybe 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

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

newtype ALBRequestContext = ALBRequestContext
  {ALBRequestContext -> ALBELB
albRequestContextElb :: ALBELB}
  deriving (Int -> ALBRequestContext -> ShowS
[ALBRequestContext] -> ShowS
ALBRequestContext -> String
(Int -> ALBRequestContext -> ShowS)
-> (ALBRequestContext -> String)
-> ([ALBRequestContext] -> ShowS)
-> Show ALBRequestContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ALBRequestContext] -> ShowS
$cshowList :: [ALBRequestContext] -> ShowS
show :: ALBRequestContext -> String
$cshow :: ALBRequestContext -> String
showsPrec :: Int -> ALBRequestContext -> ShowS
$cshowsPrec :: Int -> ALBRequestContext -> ShowS
Show)

instance FromJSON ALBRequestContext where
  parseJSON :: Value -> Parser ALBRequestContext
parseJSON (Object Object
v) =
    ALBELB -> ALBRequestContext
ALBRequestContext
      (ALBELB -> ALBRequestContext)
-> Parser ALBELB -> Parser ALBRequestContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser ALBELB
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"elb"
  parseJSON Value
_ = String -> Parser ALBRequestContext
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected ALBRequestContext to be an object."

newtype ALBELB = ALBELB
  {ALBELB -> Text
albElbTargetGroupArn :: Text}
  deriving (Int -> ALBELB -> ShowS
[ALBELB] -> ShowS
ALBELB -> String
(Int -> ALBELB -> ShowS)
-> (ALBELB -> String) -> ([ALBELB] -> ShowS) -> Show ALBELB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ALBELB] -> ShowS
$cshowList :: [ALBELB] -> ShowS
show :: ALBELB -> String
$cshow :: ALBELB -> String
showsPrec :: Int -> ALBELB -> ShowS
$cshowsPrec :: Int -> ALBELB -> ShowS
Show)

instance FromJSON ALBELB where
  parseJSON :: Value -> Parser ALBELB
parseJSON (Object Object
v) =
    Text -> ALBELB
ALBELB
      (Text -> ALBELB) -> Parser Text -> Parser ALBELB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"targetGroupArn"
  parseJSON Value
_ = String -> Parser ALBELB
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected ALBELB to be an object."

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

class ToALBResponseBody a where
  toALBResponseBody :: a -> ALBResponseBody

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

instance {-# OVERLAPPING #-} ToALBResponseBody String where
  toALBResponseBody :: String -> ALBResponseBody
toALBResponseBody = Text -> ALBResponseBody
ALBResponseBody (Text -> ALBResponseBody)
-> (String -> Text) -> String -> ALBResponseBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance ToJSON a => ToALBResponseBody a where
  toALBResponseBody :: a -> ALBResponseBody
toALBResponseBody = Text -> ALBResponseBody
ALBResponseBody (Text -> ALBResponseBody) -> (a -> Text) -> a -> ALBResponseBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToJSON a => a -> Text
toJSONText

data ALBResponse body = ALBResponse
  { ALBResponse body -> Int
albResponseStatusCode :: !Int,
    ALBResponse body -> Text
albResponseStatusDescription :: !Text,
    ALBResponse body -> ResponseHeaders
albResponseHeaders :: !ResponseHeaders,
    ALBResponse body -> ResponseHeaders
albResponseMultiValueHeaders :: !ResponseHeaders,
    ALBResponse body -> body
albResponseBody :: !body,
    ALBResponse body -> Bool
albResponseIsBase64Encoded :: !Bool
  }
  deriving ((forall x. ALBResponse body -> Rep (ALBResponse body) x)
-> (forall x. Rep (ALBResponse body) x -> ALBResponse body)
-> Generic (ALBResponse body)
forall x. Rep (ALBResponse body) x -> ALBResponse body
forall x. ALBResponse body -> Rep (ALBResponse body) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall body x. Rep (ALBResponse body) x -> ALBResponse body
forall body x. ALBResponse body -> Rep (ALBResponse body) x
$cto :: forall body x. Rep (ALBResponse body) x -> ALBResponse body
$cfrom :: forall body x. ALBResponse body -> Rep (ALBResponse body) x
Generic, Int -> ALBResponse body -> ShowS
[ALBResponse body] -> ShowS
ALBResponse body -> String
(Int -> ALBResponse body -> ShowS)
-> (ALBResponse body -> String)
-> ([ALBResponse body] -> ShowS)
-> Show (ALBResponse body)
forall body. Show body => Int -> ALBResponse body -> ShowS
forall body. Show body => [ALBResponse body] -> ShowS
forall body. Show body => ALBResponse body -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ALBResponse body] -> ShowS
$cshowList :: forall body. Show body => [ALBResponse body] -> ShowS
show :: ALBResponse body -> String
$cshow :: forall body. Show body => ALBResponse body -> String
showsPrec :: Int -> ALBResponse body -> ShowS
$cshowsPrec :: forall body. Show body => Int -> ALBResponse body -> ShowS
Show)

instance Functor ALBResponse where
  fmap :: (a -> b) -> ALBResponse a -> ALBResponse b
fmap a -> b
f ALBResponse a
v = ALBResponse a
v {$sel:albResponseBody:ALBResponse :: b
albResponseBody = a -> b
f (ALBResponse a -> a
forall body. ALBResponse body -> body
albResponseBody ALBResponse a
v)}

instance ToJSON body => ToJSON (ALBResponse body) where
  toJSON :: ALBResponse body -> Value
toJSON = (body -> Value) -> ALBResponse body -> Value
forall body. (body -> Value) -> ALBResponse body -> Value
albResponseToJSON body -> Value
forall a. ToJSON a => a -> Value
toJSON

albResponseToJSON :: (body -> Value) -> ALBResponse body -> Value
albResponseToJSON :: (body -> Value) -> ALBResponse body -> Value
albResponseToJSON body -> Value
bodyTransformer ALBResponse {body
Bool
Int
ResponseHeaders
Text
albResponseIsBase64Encoded :: Bool
albResponseBody :: body
albResponseMultiValueHeaders :: ResponseHeaders
albResponseHeaders :: ResponseHeaders
albResponseStatusDescription :: Text
albResponseStatusCode :: Int
$sel:albResponseIsBase64Encoded:ALBResponse :: forall body. ALBResponse body -> Bool
$sel:albResponseBody:ALBResponse :: forall body. ALBResponse body -> body
$sel:albResponseMultiValueHeaders:ALBResponse :: forall body. ALBResponse body -> ResponseHeaders
$sel:albResponseHeaders:ALBResponse :: forall body. ALBResponse body -> ResponseHeaders
$sel:albResponseStatusDescription:ALBResponse :: forall body. ALBResponse body -> Text
$sel:albResponseStatusCode:ALBResponse :: forall body. ALBResponse body -> Int
..} =
  [Pair] -> Value
object
    [ Text
"statusCode" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
albResponseStatusCode,
      Text
"body" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= body -> Value
bodyTransformer body
albResponseBody,
      Text
"headers" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object ((Header -> Pair) -> ResponseHeaders -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map Header -> Pair
headerToPair ResponseHeaders
albResponseHeaders),
      Text
"multiValueHeaders" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object ((Header -> Pair) -> ResponseHeaders -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map Header -> Pair
headerToPair ResponseHeaders
albResponseHeaders),
      Text
"isBase64Encoded" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
albResponseIsBase64Encoded
    ]

mkALBResponse :: Int -> ResponseHeaders -> payload -> ALBResponse payload
mkALBResponse :: Int -> ResponseHeaders -> payload -> ALBResponse payload
mkALBResponse Int
code ResponseHeaders
headers payload
payload =
  Int
-> Text
-> ResponseHeaders
-> ResponseHeaders
-> payload
-> Bool
-> ALBResponse payload
forall body.
Int
-> Text
-> ResponseHeaders
-> ResponseHeaders
-> body
-> Bool
-> ALBResponse body
ALBResponse Int
code (Int -> Text
forall a. (Eq a, Num a, Show a) => a -> Text
codeDescription Int
code) ResponseHeaders
headers ResponseHeaders
headers payload
payload Bool
False
  where
    codeDescription :: a -> Text
codeDescription a
200 = Text
"200 OK"
    codeDescription a
201 = Text
"201 Created"
    codeDescription a
202 = Text
"202 Accepted"
    codeDescription a
203 = Text
"203 Non-Authoritative Information"
    codeDescription a
204 = Text
"204 No Content"
    codeDescription a
400 = Text
"400 Bad Request"
    codeDescription a
401 = Text
"401 Unauthorized"
    codeDescription a
402 = Text
"402 Payment Required"
    codeDescription a
403 = Text
"403 Forbidden"
    codeDescription a
404 = Text
"404 Not Found"
    codeDescription a
405 = Text
"405 Method Not Allowed"
    codeDescription a
406 = Text
"406 Not Acceptable"
    codeDescription a
500 = Text
"500 Internal Server Error"
    codeDescription a
other = a -> Text
forall a. Show a => a -> Text
tshow a
other

headerToPair :: Header -> T.Pair
headerToPair :: Header -> Pair
headerToPair (HeaderName
cibyte, ByteString
bstr) = Text
k Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
v
  where
    k :: Text
k = (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