content: {-# 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.Aeson.Key as K
  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
    { albRequestPath :: !Text,
      albRequestHttpMethod :: !Text,
      albRequestHeaders :: !(Maybe (HashMap Text Text)),
      -- TODO: They won't be url decoded in ALB
      albRequestQueryStringParameters :: !(Maybe (HashMap Text Text)),
      albRequestIsBase64Encoded :: !Bool,
      albRequestRequestContext :: !ALBRequestContext,
      albRequestBody :: !(Maybe body)
    }
    deriving (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 = parseALBRequest (.:)
  
  instance {-# OVERLAPPING #-} FromJSON (ALBRequest String) where
    parseJSON = parseALBRequest (.:)
  
  instance FromJSON body => FromJSON (ALBRequest body) where
    parseJSON = parseALBRequest parseObjectFromStringField
  
  -- We need this because API Gateway is going to send us the payload as a JSON string
  parseObjectFromStringField :: FromJSON a => Object -> T.Key -> Parser (Maybe a)
  parseObjectFromStringField obj fieldName = do
    fieldContents <- obj .: fieldName
    case fieldContents of
      String stringContents ->
        case eitherDecodeStrict (T.encodeUtf8 stringContents) of
          Right success -> pure success
          Left err -> fail err
      Null -> pure Nothing
      other -> T.typeMismatch "String or Null" other
  
  parseALBRequest :: (Object -> T.Key -> Parser (Maybe body)) -> Value -> Parser (ALBRequest body)
  parseALBRequest bodyParser (Object v) =
    ALBRequest
      <$> v .: "path"
      <*> v .: "httpMethod"
      <*> v .: "headers"
      <*> v .: "queryStringParameters"
      <*> v .: "isBase64Encoded"
      <*> v .: "requestContext"
      <*> v `bodyParser` "body"
  parseALBRequest _ _ = fail "Expected ALBRequest to be an object."
  
  newtype ALBRequestContext = ALBRequestContext
    {albRequestContextElb :: ALBELB}
    deriving (Show)
  
  instance FromJSON ALBRequestContext where
    parseJSON (Object v) =
      ALBRequestContext
        <$> v .: "elb"
    parseJSON _ = fail "Expected ALBRequestContext to be an object."
  
  newtype ALBELB = ALBELB
    {albElbTargetGroupArn :: Text}
    deriving (Show)
  
  instance FromJSON ALBELB where
    parseJSON (Object v) =
      ALBELB
        <$> v .: "targetGroupArn"
    parseJSON _ = fail "Expected ALBELB to be an object."
  
  newtype ALBResponseBody
    = ALBResponseBody Text
    deriving newtype (ToJSON, 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 = ALBResponseBody
  
  instance {-# OVERLAPPING #-} ToALBResponseBody String where
    toALBResponseBody = ALBResponseBody . T.pack
  
  instance ToJSON a => ToALBResponseBody a where
    toALBResponseBody = ALBResponseBody . toJSONText
  
  data ALBResponse body = ALBResponse
    { albResponseStatusCode :: !Int,
      albResponseStatusDescription :: !Text,
      albResponseHeaders :: !ResponseHeaders,
      albResponseMultiValueHeaders :: !ResponseHeaders,
      albResponseBody :: !body,
      albResponseIsBase64Encoded :: !Bool
    }
    deriving (Generic, Show)
  
  instance Functor ALBResponse where
    fmap f v = v {albResponseBody = f (albResponseBody v)}
  
  instance ToJSON body => ToJSON (ALBResponse body) where
    toJSON = albResponseToJSON toJSON
  
  albResponseToJSON :: (body -> Value) -> ALBResponse body -> Value
  albResponseToJSON bodyTransformer ALBResponse {..} =
    object
      [ "statusCode" .= albResponseStatusCode,
        "body" .= bodyTransformer albResponseBody,
        "headers" .= object (map headerToPair albResponseHeaders),
        "multiValueHeaders" .= object (map headerToPair albResponseHeaders),
        "isBase64Encoded" .= albResponseIsBase64Encoded
      ]
  
  mkALBResponse :: Int -> ResponseHeaders -> payload -> ALBResponse payload
  mkALBResponse code headers payload =
    ALBResponse code (codeDescription code) headers headers payload False
    where
      codeDescription 200 = "200 OK"
      codeDescription 201 = "201 Created"
      codeDescription 202 = "202 Accepted"
      codeDescription 203 = "203 Non-Authoritative Information"
      codeDescription 204 = "204 No Content"
      codeDescription 400 = "400 Bad Request"
      codeDescription 401 = "401 Unauthorized"
      codeDescription 402 = "402 Payment Required"
      codeDescription 403 = "403 Forbidden"
      codeDescription 404 = "404 Not Found"
      codeDescription 405 = "405 Method Not Allowed"
      codeDescription 406 = "406 Not Acceptable"
      codeDescription 500 = "500 Internal Server Error"
      codeDescription other = tshow other
  
  headerToPair :: Header -> T.Pair
  headerToPair (cibyte, bstr) = k .= v
    where
      k = (K.fromText . T.decodeUtf8 . CI.original) cibyte
      v = T.decodeUtf8 bstr
  