{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE UndecidableInstances #-}

module Aws.Lambda.Runtime.Common
  ( RunCallback,
    LambdaResult (..),
    LambdaError (..),
    LambdaOptions (..),
    ApiGatewayDispatcherOptions (..),
    HandlerType (..),
    HandlerName (..),
    RawEventObject,
  )
where

import Aws.Lambda.Runtime.ALB.Types
import Aws.Lambda.Runtime.APIGateway.Types
  ( ApiGatewayDispatcherOptions (..),
    ApiGatewayResponse,
    ApiGatewayResponseBody,
  )
import Aws.Lambda.Runtime.Context (Context)
import Aws.Lambda.Runtime.StandaloneLambda.Types
  ( StandaloneLambdaResponseBody,
  )
import qualified Data.ByteString.Lazy as Lazy
import Data.Hashable (Hashable)
import Data.Text (Text)
import GHC.Generics (Generic)
import Data.String (IsString)

-- | Callback that we pass to the dispatcher function
type RunCallback (handlerType :: HandlerType) context =
  LambdaOptions context -> IO (Either (LambdaError handlerType) (LambdaResult handlerType))

-- | A handler name used to configure the lambda in AWS
newtype HandlerName = HandlerName {HandlerName -> Text
unHandlerName :: Text}
  deriving newtype (HandlerName -> HandlerName -> Bool
(HandlerName -> HandlerName -> Bool)
-> (HandlerName -> HandlerName -> Bool) -> Eq HandlerName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandlerName -> HandlerName -> Bool
$c/= :: HandlerName -> HandlerName -> Bool
== :: HandlerName -> HandlerName -> Bool
$c== :: HandlerName -> HandlerName -> Bool
Eq, Int -> HandlerName -> ShowS
[HandlerName] -> ShowS
HandlerName -> String
(Int -> HandlerName -> ShowS)
-> (HandlerName -> String)
-> ([HandlerName] -> ShowS)
-> Show HandlerName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandlerName] -> ShowS
$cshowList :: [HandlerName] -> ShowS
show :: HandlerName -> String
$cshow :: HandlerName -> String
showsPrec :: Int -> HandlerName -> ShowS
$cshowsPrec :: Int -> HandlerName -> ShowS
Show, ReadPrec [HandlerName]
ReadPrec HandlerName
Int -> ReadS HandlerName
ReadS [HandlerName]
(Int -> ReadS HandlerName)
-> ReadS [HandlerName]
-> ReadPrec HandlerName
-> ReadPrec [HandlerName]
-> Read HandlerName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HandlerName]
$creadListPrec :: ReadPrec [HandlerName]
readPrec :: ReadPrec HandlerName
$creadPrec :: ReadPrec HandlerName
readList :: ReadS [HandlerName]
$creadList :: ReadS [HandlerName]
readsPrec :: Int -> ReadS HandlerName
$creadsPrec :: Int -> ReadS HandlerName
Read, Eq HandlerName
Eq HandlerName
-> (HandlerName -> HandlerName -> Ordering)
-> (HandlerName -> HandlerName -> Bool)
-> (HandlerName -> HandlerName -> Bool)
-> (HandlerName -> HandlerName -> Bool)
-> (HandlerName -> HandlerName -> Bool)
-> (HandlerName -> HandlerName -> HandlerName)
-> (HandlerName -> HandlerName -> HandlerName)
-> Ord HandlerName
HandlerName -> HandlerName -> Bool
HandlerName -> HandlerName -> Ordering
HandlerName -> HandlerName -> HandlerName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HandlerName -> HandlerName -> HandlerName
$cmin :: HandlerName -> HandlerName -> HandlerName
max :: HandlerName -> HandlerName -> HandlerName
$cmax :: HandlerName -> HandlerName -> HandlerName
>= :: HandlerName -> HandlerName -> Bool
$c>= :: HandlerName -> HandlerName -> Bool
> :: HandlerName -> HandlerName -> Bool
$c> :: HandlerName -> HandlerName -> Bool
<= :: HandlerName -> HandlerName -> Bool
$c<= :: HandlerName -> HandlerName -> Bool
< :: HandlerName -> HandlerName -> Bool
$c< :: HandlerName -> HandlerName -> Bool
compare :: HandlerName -> HandlerName -> Ordering
$ccompare :: HandlerName -> HandlerName -> Ordering
$cp1Ord :: Eq HandlerName
Ord, Int -> HandlerName -> Int
HandlerName -> Int
(Int -> HandlerName -> Int)
-> (HandlerName -> Int) -> Hashable HandlerName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HandlerName -> Int
$chash :: HandlerName -> Int
hashWithSalt :: Int -> HandlerName -> Int
$chashWithSalt :: Int -> HandlerName -> Int
Hashable, String -> HandlerName
(String -> HandlerName) -> IsString HandlerName
forall a. (String -> a) -> IsString a
fromString :: String -> HandlerName
$cfromString :: String -> HandlerName
IsString)

-- | The type of the handler depending on how you proxy the Lambda
data HandlerType
  = StandaloneHandlerType
  | APIGatewayHandlerType
  | ALBHandlerType

-- | Wrapper type for lambda execution results
data LambdaError (handlerType :: HandlerType) where
  StandaloneLambdaError :: StandaloneLambdaResponseBody -> LambdaError 'StandaloneHandlerType
  APIGatewayLambdaError :: ApiGatewayResponse ApiGatewayResponseBody -> LambdaError 'APIGatewayHandlerType
  ALBLambdaError :: ALBResponse ALBResponseBody -> LambdaError 'ALBHandlerType

-- | Wrapper type to handle the result of the user
data LambdaResult (handlerType :: HandlerType) where
  StandaloneLambdaResult :: StandaloneLambdaResponseBody -> LambdaResult 'StandaloneHandlerType
  APIGatewayResult :: ApiGatewayResponse ApiGatewayResponseBody -> LambdaResult 'APIGatewayHandlerType
  ALBResult :: ALBResponse ALBResponseBody -> LambdaResult 'ALBHandlerType

-- | The event received by the lambda before any processing
type RawEventObject = Lazy.ByteString

-- | Options that the generated main expects
data LambdaOptions context = LambdaOptions
  { LambdaOptions context -> RawEventObject
eventObject :: !RawEventObject,
    LambdaOptions context -> HandlerName
functionHandler :: !HandlerName,
    LambdaOptions context -> Text
executionUuid :: !Text,
    LambdaOptions context -> Context context
contextObject :: !(Context context)
  }
  deriving ((forall x. LambdaOptions context -> Rep (LambdaOptions context) x)
-> (forall x.
    Rep (LambdaOptions context) x -> LambdaOptions context)
-> Generic (LambdaOptions context)
forall x. Rep (LambdaOptions context) x -> LambdaOptions context
forall x. LambdaOptions context -> Rep (LambdaOptions context) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall context x.
Rep (LambdaOptions context) x -> LambdaOptions context
forall context x.
LambdaOptions context -> Rep (LambdaOptions context) x
$cto :: forall context x.
Rep (LambdaOptions context) x -> LambdaOptions context
$cfrom :: forall context x.
LambdaOptions context -> Rep (LambdaOptions context) x
Generic)