{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}

module Aws.Lambda.Setup
  ( Handler (..),
    HandlerName (..),
    Handlers,
    run,
    addStandaloneLambdaHandler,
    addAPIGatewayHandler,
    addALBHandler,
    runLambdaHaskellRuntime,
  )
where

import Aws.Lambda.Runtime (runLambda)
import Aws.Lambda.Runtime.ALB.Types
  ( ALBRequest,
    ALBResponse,
    ToALBResponseBody (..),
    mkALBResponse,
  )
import Aws.Lambda.Runtime.APIGateway.Types
  ( ApiGatewayDispatcherOptions (propagateImpureExceptions),
    ApiGatewayRequest,
    ApiGatewayResponse,
    ToApiGatewayResponseBody (..),
    mkApiGatewayResponse,
  )
import Aws.Lambda.Runtime.Common
  ( HandlerName (..),
    HandlerType (..),
    LambdaError (..),
    LambdaOptions (LambdaOptions),
    LambdaResult (..),
    RawEventObject,
  )
import Aws.Lambda.Runtime.Configuration
  ( DispatcherOptions (apiGatewayDispatcherOptions),
  )
import Aws.Lambda.Runtime.Context (Context)
import Aws.Lambda.Runtime.StandaloneLambda.Types
  ( ToStandaloneLambdaResponseBody (..),
  )
import Aws.Lambda.Utilities (decodeObj)
import Control.Exception (SomeException)
import Control.Monad.Catch (MonadCatch (catch), throwM)
import Control.Monad.State as State
  ( MonadIO (..),
    MonadState,
    StateT (..),
    modify,
  )
import Data.Aeson (FromJSON)
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as Text
import Data.Typeable (Typeable)
import GHC.IO.Handle.FD (stderr)
import GHC.IO.Handle.Text (hPutStr)

type Handlers handlerType m context request response error =
  HM.HashMap HandlerName (Handler handlerType m context request response error)

type StandaloneCallback m context request response error =
  (request -> Context context -> m (Either error response))

type APIGatewayCallback m context request response error =
  (ApiGatewayRequest request -> Context context -> m (Either (ApiGatewayResponse error) (ApiGatewayResponse response)))

type ALBCallback m context request response error =
  (ALBRequest request -> Context context -> m (Either (ALBResponse error) (ALBResponse response)))

data Handler (handlerType :: HandlerType) m context request response error where
  StandaloneLambdaHandler :: StandaloneCallback m context request response error -> Handler 'StandaloneHandlerType m context request response error
  APIGatewayHandler :: APIGatewayCallback m context request response error -> Handler 'APIGatewayHandlerType m context request response error
  ALBHandler :: ALBCallback m context request response error -> Handler 'ALBHandlerType m context request response error

newtype HandlersM (handlerType :: HandlerType) m context request response error a = HandlersM
  {forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a.
HandlersM handlerType m context request response error a
-> StateT
     (Handlers handlerType m context request response error) IO a
runHandlersM :: StateT (Handlers handlerType m context request response error) IO a}
  deriving newtype
    ( forall a b.
a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error a
forall a b.
(a -> b)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error a
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
(a -> b)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b.
a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error a
$c<$ :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error a
fmap :: forall a b.
(a -> b)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
$cfmap :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
(a -> b)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
Functor,
      forall a.
a -> HandlersM handlerType m context request response error a
forall a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error a
forall a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error b
forall a b.
HandlersM handlerType m context request response error (a -> b)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
forall a b c.
(a -> b -> c)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error c
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error.
Functor (HandlersM handlerType m context request response error)
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a.
a -> HandlersM handlerType m context request response error a
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error a
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error b
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
HandlersM handlerType m context request response error (a -> b)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b c.
(a -> b -> c)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error a
$c<* :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error a
*> :: forall a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error b
$c*> :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error b
liftA2 :: forall a b c.
(a -> b -> c)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error c
$cliftA2 :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b c.
(a -> b -> c)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error c
<*> :: forall a b.
HandlersM handlerType m context request response error (a -> b)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
$c<*> :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
HandlersM handlerType m context request response error (a -> b)
-> HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
pure :: forall a.
a -> HandlersM handlerType m context request response error a
$cpure :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a.
a -> HandlersM handlerType m context request response error a
Applicative,
      forall a.
a -> HandlersM handlerType m context request response error a
forall a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error b
forall a b.
HandlersM handlerType m context request response error a
-> (a -> HandlersM handlerType m context request response error b)
-> HandlersM handlerType m context request response error b
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error.
Applicative
  (HandlersM handlerType m context request response error)
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a.
a -> HandlersM handlerType m context request response error a
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error b
forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
HandlersM handlerType m context request response error a
-> (a -> HandlersM handlerType m context request response error b)
-> HandlersM handlerType m context request response error b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a.
a -> HandlersM handlerType m context request response error a
$creturn :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a.
a -> HandlersM handlerType m context request response error a
>> :: forall a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error b
$c>> :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
HandlersM handlerType m context request response error a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error b
>>= :: forall a b.
HandlersM handlerType m context request response error a
-> (a -> HandlersM handlerType m context request response error b)
-> HandlersM handlerType m context request response error b
$c>>= :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a b.
HandlersM handlerType m context request response error a
-> (a -> HandlersM handlerType m context request response error b)
-> HandlersM handlerType m context request response error b
Monad,
      MonadState (Handlers handlerType m context request response error)
    )

type RuntimeContext (handlerType :: HandlerType) m context request response error =
  ( MonadIO m,
    MonadCatch m,
    ToStandaloneLambdaResponseBody error,
    ToStandaloneLambdaResponseBody response,
    ToApiGatewayResponseBody error,
    ToApiGatewayResponseBody response,
    ToALBResponseBody error,
    ToALBResponseBody response,
    FromJSON (ApiGatewayRequest request),
    FromJSON (ALBRequest request),
    FromJSON request,
    Typeable request
  )

runLambdaHaskellRuntime ::
  RuntimeContext handlerType m context request response error =>
  DispatcherOptions ->
  IO context ->
  (forall a. m a -> IO a) ->
  HandlersM handlerType m context request response error () ->
  IO ()
runLambdaHaskellRuntime :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error.
RuntimeContext handlerType m context request response error =>
DispatcherOptions
-> IO context
-> (forall a. m a -> IO a)
-> HandlersM handlerType m context request response error ()
-> IO ()
runLambdaHaskellRuntime DispatcherOptions
options IO context
initializeContext forall a. m a -> IO a
mToIO HandlersM handlerType m context request response error ()
initHandlers = do
  HashMap
  HandlerName (Handler handlerType m context request response error)
handlers <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall k v. HashMap k v
HM.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a.
HandlersM handlerType m context request response error a
-> StateT
     (Handlers handlerType m context request response error) IO a
runHandlersM forall a b. (a -> b) -> a -> b
$ HandlersM handlerType m context request response error ()
initHandlers
  forall context (handlerType :: HandlerType).
IO context -> RunCallback handlerType context -> IO ()
runLambda IO context
initializeContext (forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error.
RuntimeContext handlerType m context request response error =>
DispatcherOptions
-> (forall a. m a -> IO a)
-> Handlers handlerType m context request response error
-> LambdaOptions context
-> IO (Either (LambdaError handlerType) (LambdaResult handlerType))
run DispatcherOptions
options forall a. m a -> IO a
mToIO HashMap
  HandlerName (Handler handlerType m context request response error)
handlers)

run ::
  RuntimeContext handlerType m context request response error =>
  DispatcherOptions ->
  (forall a. m a -> IO a) ->
  Handlers handlerType m context request response error ->
  LambdaOptions context ->
  IO (Either (LambdaError handlerType) (LambdaResult handlerType))
run :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error.
RuntimeContext handlerType m context request response error =>
DispatcherOptions
-> (forall a. m a -> IO a)
-> Handlers handlerType m context request response error
-> LambdaOptions context
-> IO (Either (LambdaError handlerType) (LambdaResult handlerType))
run DispatcherOptions
dispatcherOptions forall a. m a -> IO a
mToIO Handlers handlerType m context request response error
handlers (LambdaOptions RawEventObject
eventObject HandlerName
functionHandler Text
_executionUuid Context context
contextObject) = do
  let asIOCallbacks :: HashMap
  HandlerName
  (IO (Either (LambdaError handlerType) (LambdaResult handlerType)))
asIOCallbacks = forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (forall a. m a -> IO a
mToIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error.
RuntimeContext handlerType m context request response error =>
DispatcherOptions
-> RawEventObject
-> Context context
-> Handler handlerType m context request response error
-> m (Either (LambdaError handlerType) (LambdaResult handlerType))
handlerToCallback DispatcherOptions
dispatcherOptions RawEventObject
eventObject Context context
contextObject) Handlers handlerType m context request response error
handlers
  case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HandlerName
functionHandler HashMap
  HandlerName
  (IO (Either (LambdaError handlerType) (LambdaResult handlerType)))
asIOCallbacks of
    Just IO (Either (LambdaError handlerType) (LambdaResult handlerType))
handlerToCall -> IO (Either (LambdaError handlerType) (LambdaResult handlerType))
handlerToCall
    Maybe
  (IO (Either (LambdaError handlerType) (LambdaResult handlerType)))
Nothing ->
      forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
        String -> IOError
userError forall a b. (a -> b) -> a -> b
$
          String
"Could not find handler '" forall a. Semigroup a => a -> a -> a
<> (Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerName -> Text
unHandlerName forall a b. (a -> b) -> a -> b
$ HandlerName
functionHandler) forall a. Semigroup a => a -> a -> a
<> String
"'."

addStandaloneLambdaHandler ::
  HandlerName ->
  StandaloneCallback m context request response error ->
  HandlersM 'StandaloneHandlerType m context request response error ()
addStandaloneLambdaHandler :: forall (m :: * -> *) context request response error.
HandlerName
-> StandaloneCallback m context request response error
-> HandlersM
     'StandaloneHandlerType m context request response error ()
addStandaloneLambdaHandler HandlerName
handlerName StandaloneCallback m context request response error
handler =
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert HandlerName
handlerName (forall (m :: * -> *) context request response error.
StandaloneCallback m context request response error
-> Handler 'StandaloneHandlerType m context request response error
StandaloneLambdaHandler StandaloneCallback m context request response error
handler))

addAPIGatewayHandler ::
  HandlerName ->
  APIGatewayCallback m context request response error ->
  HandlersM 'APIGatewayHandlerType m context request response error ()
addAPIGatewayHandler :: forall (m :: * -> *) context request response error.
HandlerName
-> APIGatewayCallback m context request response error
-> HandlersM
     'APIGatewayHandlerType m context request response error ()
addAPIGatewayHandler HandlerName
handlerName APIGatewayCallback m context request response error
handler =
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert HandlerName
handlerName (forall (m :: * -> *) context request response error.
APIGatewayCallback m context request response error
-> Handler 'APIGatewayHandlerType m context request response error
APIGatewayHandler APIGatewayCallback m context request response error
handler))

addALBHandler ::
  HandlerName ->
  ALBCallback m context request response error ->
  HandlersM 'ALBHandlerType m context request response error ()
addALBHandler :: forall (m :: * -> *) context request response error.
HandlerName
-> ALBCallback m context request response error
-> HandlersM 'ALBHandlerType m context request response error ()
addALBHandler HandlerName
handlerName ALBCallback m context request response error
handler =
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert HandlerName
handlerName (forall (m :: * -> *) context request response error.
ALBCallback m context request response error
-> Handler 'ALBHandlerType m context request response error
ALBHandler ALBCallback m context request response error
handler))

handlerToCallback ::
  forall handlerType m context request response error.
  RuntimeContext handlerType m context request response error =>
  DispatcherOptions ->
  RawEventObject ->
  Context context ->
  Handler handlerType m context request response error ->
  m (Either (LambdaError handlerType) (LambdaResult handlerType))
handlerToCallback :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error.
RuntimeContext handlerType m context request response error =>
DispatcherOptions
-> RawEventObject
-> Context context
-> Handler handlerType m context request response error
-> m (Either (LambdaError handlerType) (LambdaResult handlerType))
handlerToCallback DispatcherOptions
dispatcherOptions RawEventObject
rawEventObject Context context
context Handler handlerType m context request response error
handlerToCall =
  m (Either (LambdaError handlerType) (LambdaResult handlerType))
call forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException
-> m (Either (LambdaError handlerType) (LambdaResult handlerType))
handleError
  where
    call :: m (Either (LambdaError handlerType) (LambdaResult handlerType))
call =
      case Handler handlerType m context request response error
handlerToCall of
        StandaloneLambdaHandler StandaloneCallback m context request response error
handler ->
          case forall a.
(FromJSON a, Typeable a) =>
RawEventObject -> Either Parsing a
decodeObj @request RawEventObject
rawEventObject of
            Right request
request ->
              forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. StandaloneLambdaResponseBody -> LambdaError 'StandaloneHandlerType
StandaloneLambdaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToStandaloneLambdaResponseBody a =>
a -> StandaloneLambdaResponseBody
toStandaloneLambdaResponse)
                (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. StandaloneLambdaResponseBody -> LambdaResult 'StandaloneHandlerType
StandaloneLambdaResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToStandaloneLambdaResponseBody a =>
a -> StandaloneLambdaResponseBody
toStandaloneLambdaResponse)
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StandaloneCallback m context request response error
handler request
request Context context
context
            Left Parsing
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. StandaloneLambdaResponseBody -> LambdaError 'StandaloneHandlerType
StandaloneLambdaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToStandaloneLambdaResponseBody a =>
a -> StandaloneLambdaResponseBody
toStandaloneLambdaResponse forall a b. (a -> b) -> a -> b
$ Parsing
err
        APIGatewayHandler APIGatewayCallback m context request response error
handler -> do
          case forall a.
(FromJSON a, Typeable a) =>
RawEventObject -> Either Parsing a
decodeObj @(ApiGatewayRequest request) RawEventObject
rawEventObject of
            Right ApiGatewayRequest request
request ->
              forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiGatewayResponse ApiGatewayResponseBody
-> LambdaError 'APIGatewayHandlerType
APIGatewayLambdaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToApiGatewayResponseBody a => a -> ApiGatewayResponseBody
toApiGatewayResponseBody)
                (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiGatewayResponse ApiGatewayResponseBody
-> LambdaResult 'APIGatewayHandlerType
APIGatewayResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToApiGatewayResponseBody a => a -> ApiGatewayResponseBody
toApiGatewayResponseBody)
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> APIGatewayCallback m context request response error
handler ApiGatewayRequest request
request Context context
context
            Left Parsing
err -> forall {f :: * -> *} {b}.
Applicative f =>
Int
-> ApiGatewayResponseBody
-> f (Either (LambdaError 'APIGatewayHandlerType) b)
apiGatewayErr Int
400 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToApiGatewayResponseBody a => a -> ApiGatewayResponseBody
toApiGatewayResponseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Parsing
err
        ALBHandler ALBCallback m context request response error
handler ->
          case forall a.
(FromJSON a, Typeable a) =>
RawEventObject -> Either Parsing a
decodeObj @(ALBRequest request) RawEventObject
rawEventObject of
            Right ALBRequest request
request ->
              forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ALBResponse ALBResponseBody -> LambdaError 'ALBHandlerType
ALBLambdaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToALBResponseBody a => a -> ALBResponseBody
toALBResponseBody)
                (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ALBResponse ALBResponseBody -> LambdaResult 'ALBHandlerType
ALBResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToALBResponseBody a => a -> ALBResponseBody
toALBResponseBody)
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ALBCallback m context request response error
handler ALBRequest request
request Context context
context
            Left Parsing
err -> forall {f :: * -> *} {b}.
Applicative f =>
Int
-> ALBResponseBody -> f (Either (LambdaError 'ALBHandlerType) b)
albErr Int
400 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToALBResponseBody a => a -> ALBResponseBody
toALBResponseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Parsing
err

    handleError :: SomeException
-> m (Either (LambdaError handlerType) (LambdaResult handlerType))
handleError (SomeException
exception :: SomeException) = do
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ SomeException
exception
      case Handler handlerType m context request response error
handlerToCall of
        StandaloneLambdaHandler StandaloneCallback m context request response error
_ ->
          forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. StandaloneLambdaResponseBody -> LambdaError 'StandaloneHandlerType
StandaloneLambdaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToStandaloneLambdaResponseBody a =>
a -> StandaloneLambdaResponseBody
toStandaloneLambdaResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ SomeException
exception
        ALBHandler ALBCallback m context request response error
_ ->
          forall {f :: * -> *} {b}.
Applicative f =>
Int
-> ALBResponseBody -> f (Either (LambdaError 'ALBHandlerType) b)
albErr Int
500 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToALBResponseBody a => a -> ALBResponseBody
toALBResponseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ SomeException
exception
        APIGatewayHandler APIGatewayCallback m context request response error
_ ->
          if ApiGatewayDispatcherOptions -> Bool
propagateImpureExceptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. DispatcherOptions -> ApiGatewayDispatcherOptions
apiGatewayDispatcherOptions forall a b. (a -> b) -> a -> b
$ DispatcherOptions
dispatcherOptions
            then forall {f :: * -> *} {b}.
Applicative f =>
Int
-> ApiGatewayResponseBody
-> f (Either (LambdaError 'APIGatewayHandlerType) b)
apiGatewayErr Int
500 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToApiGatewayResponseBody a => a -> ApiGatewayResponseBody
toApiGatewayResponseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ SomeException
exception
            else forall {f :: * -> *} {b}.
Applicative f =>
Int
-> ApiGatewayResponseBody
-> f (Either (LambdaError 'APIGatewayHandlerType) b)
apiGatewayErr Int
500 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToApiGatewayResponseBody a => a -> ApiGatewayResponseBody
toApiGatewayResponseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"Something went wrong."

    apiGatewayErr :: Int
-> ApiGatewayResponseBody
-> f (Either (LambdaError 'APIGatewayHandlerType) b)
apiGatewayErr Int
statusCode =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiGatewayResponse ApiGatewayResponseBody
-> LambdaError 'APIGatewayHandlerType
APIGatewayLambdaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall payload.
Int -> ResponseHeaders -> payload -> ApiGatewayResponse payload
mkApiGatewayResponse Int
statusCode []

    albErr :: Int
-> ALBResponseBody -> f (Either (LambdaError 'ALBHandlerType) b)
albErr Int
statusCode =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ALBResponse ALBResponseBody -> LambdaError 'ALBHandlerType
ALBLambdaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall payload.
Int -> ResponseHeaders -> payload -> ALBResponse payload
mkALBResponse Int
statusCode []