{-# 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 -> b)
 -> HandlersM handlerType m context request response error a
 -> HandlersM handlerType m context request response error b)
-> (forall a b.
    a
    -> HandlersM handlerType m context request response error b
    -> HandlersM handlerType m context request response error a)
-> Functor (HandlersM handlerType m context request response error)
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
$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
fmap :: forall a b.
(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.
a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error a
<$ :: forall a b.
a
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error a
Functor,
      Functor (HandlersM handlerType m context request response error)
Functor (HandlersM handlerType m context request response error) =>
(forall a.
 a -> HandlersM handlerType m context request response error a)
-> (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 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
    -> HandlersM handlerType m context request response error b
    -> HandlersM handlerType m context request response error a)
-> Applicative
     (HandlersM handlerType m context request response error)
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
$cpure :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a.
a -> HandlersM handlerType m context request response error a
pure :: forall a.
a -> 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 -> b)
-> HandlersM handlerType m context request response error a
-> 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
$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
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
$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
-> 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 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
Applicative,
      Applicative
  (HandlersM handlerType m context request response error)
Applicative
  (HandlersM handlerType m context request response error) =>
(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 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.
    a -> HandlersM handlerType m context request response error a)
-> Monad (HandlersM handlerType m context request response error)
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
$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
>>= :: 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
-> 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
-> HandlersM handlerType m context request response error b
-> HandlersM handlerType m context request response error b
$creturn :: forall (handlerType :: HandlerType) (m :: * -> *) context request
       response error a.
a -> HandlersM handlerType m context request response error a
return :: forall a.
a -> HandlersM handlerType m context request response error a
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 <- (((),
  HashMap
    HandlerName (Handler handlerType m context request response error))
 -> HashMap
      HandlerName (Handler handlerType m context request response error))
-> IO
     ((),
      HashMap
        HandlerName (Handler handlerType m context request response error))
-> IO
     (HashMap
        HandlerName (Handler handlerType m context request response error))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((),
 HashMap
   HandlerName (Handler handlerType m context request response error))
-> HashMap
     HandlerName (Handler handlerType m context request response error)
forall a b. (a, b) -> b
snd (IO
   ((),
    HashMap
      HandlerName (Handler handlerType m context request response error))
 -> IO
      (HashMap
         HandlerName
         (Handler handlerType m context request response error)))
-> (HandlersM handlerType m context request response error ()
    -> IO
         ((),
          HashMap
            HandlerName
            (Handler handlerType m context request response error)))
-> HandlersM handlerType m context request response error ()
-> IO
     (HashMap
        HandlerName (Handler handlerType m context request response error))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
   (HashMap
      HandlerName (Handler handlerType m context request response error))
   IO
   ()
 -> HashMap
      HandlerName (Handler handlerType m context request response error)
 -> IO
      ((),
       HashMap
         HandlerName
         (Handler handlerType m context request response error)))
-> HashMap
     HandlerName (Handler handlerType m context request response error)
-> StateT
     (HashMap
        HandlerName (Handler handlerType m context request response error))
     IO
     ()
-> IO
     ((),
      HashMap
        HandlerName (Handler handlerType m context request response error))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  (HashMap
     HandlerName (Handler handlerType m context request response error))
  IO
  ()
-> HashMap
     HandlerName (Handler handlerType m context request response error)
-> IO
     ((),
      HashMap
        HandlerName (Handler handlerType m context request response error))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT HashMap
  HandlerName (Handler handlerType m context request response error)
forall k v. HashMap k v
HM.empty (StateT
   (HashMap
      HandlerName (Handler handlerType m context request response error))
   IO
   ()
 -> IO
      ((),
       HashMap
         HandlerName
         (Handler handlerType m context request response error)))
-> (HandlersM handlerType m context request response error ()
    -> StateT
         (HashMap
            HandlerName (Handler handlerType m context request response error))
         IO
         ())
-> HandlersM handlerType m context request response error ()
-> IO
     ((),
      HashMap
        HandlerName (Handler handlerType m context request response error))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlersM handlerType m context request response error ()
-> StateT
     (HashMap
        HandlerName (Handler handlerType m context request response error))
     IO
     ()
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 (HandlersM handlerType m context request response error ()
 -> IO
      (HashMap
         HandlerName
         (Handler handlerType m context request response error)))
-> HandlersM handlerType m context request response error ()
-> IO
     (HashMap
        HandlerName (Handler handlerType m context request response error))
forall a b. (a -> b) -> a -> b
$ HandlersM handlerType m context request response error ()
initHandlers
  IO context -> RunCallback handlerType context -> IO ()
forall context (handlerType :: HandlerType).
IO context -> RunCallback handlerType context -> IO ()
runLambda IO context
initializeContext (DispatcherOptions
-> (forall a. m a -> IO a)
-> HashMap
     HandlerName (Handler handlerType m context request response error)
-> RunCallback handlerType context
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 m a -> IO a
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 = (Handler handlerType m context request response error
 -> IO
      (Either (LambdaError handlerType) (LambdaResult handlerType)))
-> Handlers handlerType m context request response error
-> HashMap
     HandlerName
     (IO (Either (LambdaError handlerType) (LambdaResult handlerType)))
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (m (Either (LambdaError handlerType) (LambdaResult handlerType))
-> IO (Either (LambdaError handlerType) (LambdaResult handlerType))
forall a. m a -> IO a
mToIO (m (Either (LambdaError handlerType) (LambdaResult handlerType))
 -> IO
      (Either (LambdaError handlerType) (LambdaResult handlerType)))
-> (Handler handlerType m context request response error
    -> m (Either (LambdaError handlerType) (LambdaResult handlerType)))
-> Handler handlerType m context request response error
-> IO (Either (LambdaError handlerType) (LambdaResult handlerType))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DispatcherOptions
-> RawEventObject
-> Context context
-> Handler handlerType m context request response error
-> m (Either (LambdaError handlerType) (LambdaResult handlerType))
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 HandlerName
-> HashMap
     HandlerName
     (IO (Either (LambdaError handlerType) (LambdaResult handlerType)))
-> Maybe
     (IO (Either (LambdaError handlerType) (LambdaResult handlerType)))
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 ->
      IOError
-> IO (Either (LambdaError handlerType) (LambdaResult handlerType))
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (IOError
 -> IO
      (Either (LambdaError handlerType) (LambdaResult handlerType)))
-> IOError
-> IO (Either (LambdaError handlerType) (LambdaResult handlerType))
forall a b. (a -> b) -> a -> b
$
        String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
          String
"Could not find handler '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Text -> String
Text.unpack (Text -> String) -> (HandlerName -> Text) -> HandlerName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerName -> Text
unHandlerName (HandlerName -> String) -> HandlerName -> String
forall a b. (a -> b) -> a -> b
$ HandlerName
functionHandler) String -> String -> String
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 =
  (HashMap
   HandlerName
   (Handler 'StandaloneHandlerType m context request response error)
 -> HashMap
      HandlerName
      (Handler 'StandaloneHandlerType m context request response error))
-> HandlersM
     'StandaloneHandlerType m context request response error ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (HandlerName
-> Handler 'StandaloneHandlerType m context request response error
-> HashMap
     HandlerName
     (Handler 'StandaloneHandlerType m context request response error)
-> HashMap
     HandlerName
     (Handler 'StandaloneHandlerType m context request response error)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert HandlerName
handlerName (StandaloneCallback m context request response error
-> Handler 'StandaloneHandlerType m context request response error
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 =
  (HashMap
   HandlerName
   (Handler 'APIGatewayHandlerType m context request response error)
 -> HashMap
      HandlerName
      (Handler 'APIGatewayHandlerType m context request response error))
-> HandlersM
     'APIGatewayHandlerType m context request response error ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (HandlerName
-> Handler 'APIGatewayHandlerType m context request response error
-> HashMap
     HandlerName
     (Handler 'APIGatewayHandlerType m context request response error)
-> HashMap
     HandlerName
     (Handler 'APIGatewayHandlerType m context request response error)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert HandlerName
handlerName (APIGatewayCallback m context request response error
-> Handler 'APIGatewayHandlerType m context request response error
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 =
  (HashMap
   HandlerName
   (Handler 'ALBHandlerType m context request response error)
 -> HashMap
      HandlerName
      (Handler 'ALBHandlerType m context request response error))
-> HandlersM 'ALBHandlerType m context request response error ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (HandlerName
-> Handler 'ALBHandlerType m context request response error
-> HashMap
     HandlerName
     (Handler 'ALBHandlerType m context request response error)
-> HashMap
     HandlerName
     (Handler 'ALBHandlerType m context request response error)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert HandlerName
handlerName (ALBCallback m context request response error
-> Handler 'ALBHandlerType m context request response error
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 m (Either (LambdaError handlerType) (LambdaResult handlerType))
-> (SomeException
    -> m (Either (LambdaError handlerType) (LambdaResult handlerType)))
-> m (Either (LambdaError handlerType) (LambdaResult handlerType))
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, 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 ->
              (error
 -> Either
      (LambdaError 'StandaloneHandlerType)
      (LambdaResult 'StandaloneHandlerType))
-> (response
    -> Either
         (LambdaError 'StandaloneHandlerType)
         (LambdaResult 'StandaloneHandlerType))
-> Either error response
-> Either
     (LambdaError 'StandaloneHandlerType)
     (LambdaResult 'StandaloneHandlerType)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (LambdaError 'StandaloneHandlerType
-> Either
     (LambdaError 'StandaloneHandlerType)
     (LambdaResult 'StandaloneHandlerType)
forall a b. a -> Either a b
Left (LambdaError 'StandaloneHandlerType
 -> Either
      (LambdaError 'StandaloneHandlerType)
      (LambdaResult 'StandaloneHandlerType))
-> (error -> LambdaError 'StandaloneHandlerType)
-> error
-> Either
     (LambdaError 'StandaloneHandlerType)
     (LambdaResult 'StandaloneHandlerType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StandaloneLambdaResponseBody -> LambdaError 'StandaloneHandlerType
StandaloneLambdaError (StandaloneLambdaResponseBody
 -> LambdaError 'StandaloneHandlerType)
-> (error -> StandaloneLambdaResponseBody)
-> error
-> LambdaError 'StandaloneHandlerType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. error -> StandaloneLambdaResponseBody
forall a.
ToStandaloneLambdaResponseBody a =>
a -> StandaloneLambdaResponseBody
toStandaloneLambdaResponse)
                (LambdaResult 'StandaloneHandlerType
-> Either
     (LambdaError 'StandaloneHandlerType)
     (LambdaResult 'StandaloneHandlerType)
forall a b. b -> Either a b
Right (LambdaResult 'StandaloneHandlerType
 -> Either
      (LambdaError 'StandaloneHandlerType)
      (LambdaResult 'StandaloneHandlerType))
-> (response -> LambdaResult 'StandaloneHandlerType)
-> response
-> Either
     (LambdaError 'StandaloneHandlerType)
     (LambdaResult 'StandaloneHandlerType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StandaloneLambdaResponseBody -> LambdaResult 'StandaloneHandlerType
StandaloneLambdaResult (StandaloneLambdaResponseBody
 -> LambdaResult 'StandaloneHandlerType)
-> (response -> StandaloneLambdaResponseBody)
-> response
-> LambdaResult 'StandaloneHandlerType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> StandaloneLambdaResponseBody
forall a.
ToStandaloneLambdaResponseBody a =>
a -> StandaloneLambdaResponseBody
toStandaloneLambdaResponse)
                (Either error response
 -> Either
      (LambdaError 'StandaloneHandlerType)
      (LambdaResult 'StandaloneHandlerType))
-> m (Either error response)
-> m (Either
        (LambdaError 'StandaloneHandlerType)
        (LambdaResult 'StandaloneHandlerType))
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 -> Either
  (LambdaError 'StandaloneHandlerType)
  (LambdaResult 'StandaloneHandlerType)
-> m (Either
        (LambdaError 'StandaloneHandlerType)
        (LambdaResult 'StandaloneHandlerType))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (LambdaError 'StandaloneHandlerType)
   (LambdaResult 'StandaloneHandlerType)
 -> m (Either
         (LambdaError 'StandaloneHandlerType)
         (LambdaResult 'StandaloneHandlerType)))
-> (Parsing
    -> Either
         (LambdaError 'StandaloneHandlerType)
         (LambdaResult 'StandaloneHandlerType))
-> Parsing
-> m (Either
        (LambdaError 'StandaloneHandlerType)
        (LambdaResult 'StandaloneHandlerType))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LambdaError 'StandaloneHandlerType
-> Either
     (LambdaError 'StandaloneHandlerType)
     (LambdaResult 'StandaloneHandlerType)
forall a b. a -> Either a b
Left (LambdaError 'StandaloneHandlerType
 -> Either
      (LambdaError 'StandaloneHandlerType)
      (LambdaResult 'StandaloneHandlerType))
-> (Parsing -> LambdaError 'StandaloneHandlerType)
-> Parsing
-> Either
     (LambdaError 'StandaloneHandlerType)
     (LambdaResult 'StandaloneHandlerType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StandaloneLambdaResponseBody -> LambdaError 'StandaloneHandlerType
StandaloneLambdaError (StandaloneLambdaResponseBody
 -> LambdaError 'StandaloneHandlerType)
-> (Parsing -> StandaloneLambdaResponseBody)
-> Parsing
-> LambdaError 'StandaloneHandlerType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsing -> StandaloneLambdaResponseBody
forall a.
ToStandaloneLambdaResponseBody a =>
a -> StandaloneLambdaResponseBody
toStandaloneLambdaResponse (Parsing
 -> m (Either
         (LambdaError 'StandaloneHandlerType)
         (LambdaResult 'StandaloneHandlerType)))
-> Parsing
-> m (Either
        (LambdaError 'StandaloneHandlerType)
        (LambdaResult 'StandaloneHandlerType))
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 ->
              (ApiGatewayResponse error
 -> Either
      (LambdaError 'APIGatewayHandlerType)
      (LambdaResult 'APIGatewayHandlerType))
-> (ApiGatewayResponse response
    -> Either
         (LambdaError 'APIGatewayHandlerType)
         (LambdaResult 'APIGatewayHandlerType))
-> Either (ApiGatewayResponse error) (ApiGatewayResponse response)
-> Either
     (LambdaError 'APIGatewayHandlerType)
     (LambdaResult 'APIGatewayHandlerType)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (LambdaError 'APIGatewayHandlerType
-> Either
     (LambdaError 'APIGatewayHandlerType)
     (LambdaResult 'APIGatewayHandlerType)
forall a b. a -> Either a b
Left (LambdaError 'APIGatewayHandlerType
 -> Either
      (LambdaError 'APIGatewayHandlerType)
      (LambdaResult 'APIGatewayHandlerType))
-> (ApiGatewayResponse error -> LambdaError 'APIGatewayHandlerType)
-> ApiGatewayResponse error
-> Either
     (LambdaError 'APIGatewayHandlerType)
     (LambdaResult 'APIGatewayHandlerType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiGatewayResponse ApiGatewayResponseBody
-> LambdaError 'APIGatewayHandlerType
APIGatewayLambdaError (ApiGatewayResponse ApiGatewayResponseBody
 -> LambdaError 'APIGatewayHandlerType)
-> (ApiGatewayResponse error
    -> ApiGatewayResponse ApiGatewayResponseBody)
-> ApiGatewayResponse error
-> LambdaError 'APIGatewayHandlerType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (error -> ApiGatewayResponseBody)
-> ApiGatewayResponse error
-> ApiGatewayResponse ApiGatewayResponseBody
forall a b.
(a -> b) -> ApiGatewayResponse a -> ApiGatewayResponse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap error -> ApiGatewayResponseBody
forall a. ToApiGatewayResponseBody a => a -> ApiGatewayResponseBody
toApiGatewayResponseBody)
                (LambdaResult 'APIGatewayHandlerType
-> Either
     (LambdaError 'APIGatewayHandlerType)
     (LambdaResult 'APIGatewayHandlerType)
forall a b. b -> Either a b
Right (LambdaResult 'APIGatewayHandlerType
 -> Either
      (LambdaError 'APIGatewayHandlerType)
      (LambdaResult 'APIGatewayHandlerType))
-> (ApiGatewayResponse response
    -> LambdaResult 'APIGatewayHandlerType)
-> ApiGatewayResponse response
-> Either
     (LambdaError 'APIGatewayHandlerType)
     (LambdaResult 'APIGatewayHandlerType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiGatewayResponse ApiGatewayResponseBody
-> LambdaResult 'APIGatewayHandlerType
APIGatewayResult (ApiGatewayResponse ApiGatewayResponseBody
 -> LambdaResult 'APIGatewayHandlerType)
-> (ApiGatewayResponse response
    -> ApiGatewayResponse ApiGatewayResponseBody)
-> ApiGatewayResponse response
-> LambdaResult 'APIGatewayHandlerType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (response -> ApiGatewayResponseBody)
-> ApiGatewayResponse response
-> ApiGatewayResponse ApiGatewayResponseBody
forall a b.
(a -> b) -> ApiGatewayResponse a -> ApiGatewayResponse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap response -> ApiGatewayResponseBody
forall a. ToApiGatewayResponseBody a => a -> ApiGatewayResponseBody
toApiGatewayResponseBody)
                (Either (ApiGatewayResponse error) (ApiGatewayResponse response)
 -> Either
      (LambdaError 'APIGatewayHandlerType)
      (LambdaResult 'APIGatewayHandlerType))
-> m (Either
        (ApiGatewayResponse error) (ApiGatewayResponse response))
-> m (Either
        (LambdaError 'APIGatewayHandlerType)
        (LambdaResult 'APIGatewayHandlerType))
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 -> Int
-> ApiGatewayResponseBody
-> m (Either
        (LambdaError 'APIGatewayHandlerType)
        (LambdaResult 'APIGatewayHandlerType))
forall {f :: * -> *} {b}.
Applicative f =>
Int
-> ApiGatewayResponseBody
-> f (Either (LambdaError 'APIGatewayHandlerType) b)
apiGatewayErr Int
400 (ApiGatewayResponseBody
 -> m (Either
         (LambdaError 'APIGatewayHandlerType)
         (LambdaResult 'APIGatewayHandlerType)))
-> (Parsing -> ApiGatewayResponseBody)
-> Parsing
-> m (Either
        (LambdaError 'APIGatewayHandlerType)
        (LambdaResult 'APIGatewayHandlerType))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ApiGatewayResponseBody
forall a. ToApiGatewayResponseBody a => a -> ApiGatewayResponseBody
toApiGatewayResponseBody (Text -> ApiGatewayResponseBody)
-> (Parsing -> Text) -> Parsing -> ApiGatewayResponseBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Parsing -> String) -> Parsing -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsing -> String
forall a. Show a => a -> String
show (Parsing
 -> m (Either
         (LambdaError 'APIGatewayHandlerType)
         (LambdaResult 'APIGatewayHandlerType)))
-> Parsing
-> m (Either
        (LambdaError 'APIGatewayHandlerType)
        (LambdaResult 'APIGatewayHandlerType))
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 ->
              (ALBResponse error
 -> Either
      (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType))
-> (ALBResponse response
    -> Either
         (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType))
-> Either (ALBResponse error) (ALBResponse response)
-> Either
     (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (LambdaError 'ALBHandlerType
-> Either
     (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType)
forall a b. a -> Either a b
Left (LambdaError 'ALBHandlerType
 -> Either
      (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType))
-> (ALBResponse error -> LambdaError 'ALBHandlerType)
-> ALBResponse error
-> Either
     (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ALBResponse ALBResponseBody -> LambdaError 'ALBHandlerType
ALBLambdaError (ALBResponse ALBResponseBody -> LambdaError 'ALBHandlerType)
-> (ALBResponse error -> ALBResponse ALBResponseBody)
-> ALBResponse error
-> LambdaError 'ALBHandlerType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (error -> ALBResponseBody)
-> ALBResponse error -> ALBResponse ALBResponseBody
forall a b. (a -> b) -> ALBResponse a -> ALBResponse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap error -> ALBResponseBody
forall a. ToALBResponseBody a => a -> ALBResponseBody
toALBResponseBody)
                (LambdaResult 'ALBHandlerType
-> Either
     (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType)
forall a b. b -> Either a b
Right (LambdaResult 'ALBHandlerType
 -> Either
      (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType))
-> (ALBResponse response -> LambdaResult 'ALBHandlerType)
-> ALBResponse response
-> Either
     (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ALBResponse ALBResponseBody -> LambdaResult 'ALBHandlerType
ALBResult (ALBResponse ALBResponseBody -> LambdaResult 'ALBHandlerType)
-> (ALBResponse response -> ALBResponse ALBResponseBody)
-> ALBResponse response
-> LambdaResult 'ALBHandlerType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (response -> ALBResponseBody)
-> ALBResponse response -> ALBResponse ALBResponseBody
forall a b. (a -> b) -> ALBResponse a -> ALBResponse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap response -> ALBResponseBody
forall a. ToALBResponseBody a => a -> ALBResponseBody
toALBResponseBody)
                (Either (ALBResponse error) (ALBResponse response)
 -> Either
      (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType))
-> m (Either (ALBResponse error) (ALBResponse response))
-> m (Either
        (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType))
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 -> Int
-> ALBResponseBody
-> m (Either
        (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType))
forall {f :: * -> *} {b}.
Applicative f =>
Int
-> ALBResponseBody -> f (Either (LambdaError 'ALBHandlerType) b)
albErr Int
400 (ALBResponseBody
 -> m (Either
         (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType)))
-> (Parsing -> ALBResponseBody)
-> Parsing
-> m (Either
        (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ALBResponseBody
forall a. ToALBResponseBody a => a -> ALBResponseBody
toALBResponseBody (Text -> ALBResponseBody)
-> (Parsing -> Text) -> Parsing -> ALBResponseBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Parsing -> String) -> Parsing -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsing -> String
forall a. Show a => a -> String
show (Parsing
 -> m (Either
         (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType)))
-> Parsing
-> m (Either
        (LambdaError 'ALBHandlerType) (LambdaResult 'ALBHandlerType))
forall a b. (a -> b) -> a -> b
$ Parsing
err

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

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

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