{-# LANGUAGE FlexibleContexts #-}

{-|
Module      : AWS.Lambda.Runtime
Description : Runtime methods useful when constructing Haskell handlers for the AWS Lambda Custom Runtime.
Copyright   : (c) Nike, Inc., 2018
License     : BSD3
Maintainer  : nathan.fairhurst@nike.com, fernando.freire@nike.com
Stability   : stable

These are runtimes designed for AWS Lambda, which accept a handler and return
an application that will retreive and execute events as long as a container
continues to exist.

Many of these runtimes use "AWS.Lambda.Combinators" under the hood.
For those interested in peeking below the abstractions provided here,
please refer to that module.
-}

module AWS.Lambda.Runtime (
  pureRuntime,
  pureRuntimeWithContext,
  fallibleRuntime,
  fallibleRuntimeWithContext,
  ioRuntime,
  ioRuntimeWithContext,
  readerTRuntime,
  mRuntimeWithContext
) where

import           AWS.Lambda.RuntimeClient (RuntimeClientConfig, getNextEvent,
                                           getRuntimeClientConfig,
                                           sendEventError, sendEventSuccess,
                                           sendInitError)
import           AWS.Lambda.Combinators   (withIOInterface,
                                           withFallibleInterface,
                                           withPureInterface,
                                           withoutContext)
import           AWS.Lambda.Context       (LambdaContext(..), HasLambdaContext(..), runReaderTLambdaContext)
import           AWS.Lambda.Internal      (StaticContext, DynamicContext(DynamicContext),
                                           mkContext)
import           Control.Applicative      ((<*>), liftA2)
import           Control.Exception        (SomeException, displayException)
import           Control.Monad            (forever)
import           Control.Monad.Catch      (MonadCatch, try)
import           Control.Monad.IO.Class   (MonadIO, liftIO)
import           Control.Monad.Reader     (MonadReader, ReaderT, local)
import           Data.Aeson               (FromJSON, ToJSON, decode)
import           Data.Bifunctor           (first)
import qualified Data.ByteString.Char8    as BSC
import qualified Data.ByteString.Lazy     as BSW
import qualified Data.ByteString.Internal as BSI
import           Data.Text                (unpack)
import           Data.Text.Encoding       (decodeUtf8)
import           Data.Time.Clock.POSIX    (posixSecondsToUTCTime)
import           Network.HTTP.Simple      (getResponseBody, getResponseHeader)
import           System.Environment       (setEnv)
import           System.Envy              (decodeEnv)

exactlyOneHeader :: [a] -> Maybe a
exactlyOneHeader :: [a] -> Maybe a
exactlyOneHeader [a
a] = a -> Maybe a
forall a. a -> Maybe a
Just a
a
exactlyOneHeader [a]
_ = Maybe a
forall a. Maybe a
Nothing

maybeToEither :: b -> Maybe a -> Either b a
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither b
b Maybe a
ma = case Maybe a
ma of
  Maybe a
Nothing -> b -> Either b a
forall a b. a -> Either a b
Left b
b
  Just a
a -> a -> Either b a
forall a b. b -> Either a b
Right a
a

-- Note: Does not allow whitespace
readMaybe :: (Read a) => String -> Maybe a
readMaybe :: String -> Maybe a
readMaybe String
s = case ReadS a
forall a. Read a => ReadS a
reads String
s of
  [(a
x,String
"")] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  [(a, String)]
_ -> Maybe a
forall a. Maybe a
Nothing

-- TODO: There must be a better way to do this
decodeHeaderValue :: FromJSON a => BSC.ByteString -> Maybe a
decodeHeaderValue :: ByteString -> Maybe a
decodeHeaderValue = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe a)
-> (ByteString -> ByteString) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BSW.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Word8
BSI.c2w (String -> [Word8])
-> (ByteString -> String) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack

-- An empty array means we successfully decoded, but nothing was there
-- If we have exactly one element, our outer maybe signals successful decode,
--   and our inner maybe signals that there was content sent
-- If we had more than one header value, the event was invalid
decodeOptionalHeader :: FromJSON a => [BSC.ByteString] -> Maybe (Maybe a)
decodeOptionalHeader :: [ByteString] -> Maybe (Maybe a)
decodeOptionalHeader [ByteString]
header =
  case [ByteString]
header of
    [] -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
    [ByteString
x] -> (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a)) -> Maybe a -> Maybe (Maybe a)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decodeHeaderValue ByteString
x
    [ByteString]
_ -> Maybe (Maybe a)
forall a. Maybe a
Nothing


runtimeLoop :: (HasLambdaContext r, MonadReader r m, MonadCatch m, MonadIO m, FromJSON event, ToJSON result) => RuntimeClientConfig -> StaticContext ->
  (event -> m result) -> m ()
runtimeLoop :: RuntimeClientConfig -> StaticContext -> (event -> m result) -> m ()
runtimeLoop RuntimeClientConfig
runtimeClientConfig StaticContext
staticContext event -> m result
fn = do
  -- Get an event
  Response (Either JSONParseException event)
nextRes <- IO (Response (Either JSONParseException event))
-> m (Response (Either JSONParseException event))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response (Either JSONParseException event))
 -> m (Response (Either JSONParseException event)))
-> IO (Response (Either JSONParseException event))
-> m (Response (Either JSONParseException event))
forall a b. (a -> b) -> a -> b
$ RuntimeClientConfig
-> IO (Response (Either JSONParseException event))
forall a.
FromJSON a =>
RuntimeClientConfig -> IO (Response (Either JSONParseException a))
getNextEvent RuntimeClientConfig
runtimeClientConfig

  -- If we got an event but our requestId is invalid/missing, there's no hope of meaningful recovery
  let reqIdBS :: ByteString
reqIdBS = [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName
-> Response (Either JSONParseException event) -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Lambda-Runtime-Aws-Request-Id" Response (Either JSONParseException event)
nextRes

  let mTraceId :: Maybe Text
mTraceId = (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (Maybe ByteString -> Maybe Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
exactlyOneHeader ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName
-> Response (Either JSONParseException event) -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Lambda-Runtime-Trace-Id" Response (Either JSONParseException event)
nextRes
  let mFunctionArn :: Maybe Text
mFunctionArn = (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (Maybe ByteString -> Maybe Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
exactlyOneHeader ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName
-> Response (Either JSONParseException event) -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Lambda-Runtime-Invoked-Function-Arn" Response (Either JSONParseException event)
nextRes
  let mDeadline :: Maybe UTCTime
mDeadline = do
        ByteString
header <- [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
exactlyOneHeader (HeaderName
-> Response (Either JSONParseException event) -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Lambda-Runtime-Deadline-Ms" Response (Either JSONParseException event)
nextRes)
        Double
milliseconds :: Double <- String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Double) -> String -> Maybe Double
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
header
        UTCTime -> Maybe UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Double -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> POSIXTime) -> Double -> POSIXTime
forall a b. (a -> b) -> a -> b
$ Double
milliseconds Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000

  let mClientContext :: Maybe (Maybe ClientContext)
mClientContext = [ByteString] -> Maybe (Maybe ClientContext)
forall a. FromJSON a => [ByteString] -> Maybe (Maybe a)
decodeOptionalHeader ([ByteString] -> Maybe (Maybe ClientContext))
-> [ByteString] -> Maybe (Maybe ClientContext)
forall a b. (a -> b) -> a -> b
$ HeaderName
-> Response (Either JSONParseException event) -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Lambda-Runtime-Client-Context" Response (Either JSONParseException event)
nextRes
  let mIdentity :: Maybe (Maybe CognitoIdentity)
mIdentity = [ByteString] -> Maybe (Maybe CognitoIdentity)
forall a. FromJSON a => [ByteString] -> Maybe (Maybe a)
decodeOptionalHeader ([ByteString] -> Maybe (Maybe CognitoIdentity))
-> [ByteString] -> Maybe (Maybe CognitoIdentity)
forall a b. (a -> b) -> a -> b
$ HeaderName
-> Response (Either JSONParseException event) -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Lambda-Runtime-Cognito-Identity" Response (Either JSONParseException event)
nextRes

  -- Populate the context with values from headers
  let eCtx :: Either String LambdaContext
eCtx =
        -- combine our StaticContext and possible DynamicContext into a LambdaContext
        (DynamicContext -> LambdaContext)
-> Either String DynamicContext -> Either String LambdaContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StaticContext -> DynamicContext -> LambdaContext
mkContext StaticContext
staticContext)
        -- convert the Maybe DynamicContext into an Either String DynamicContext
        (Either String DynamicContext -> Either String LambdaContext)
-> Either String DynamicContext -> Either String LambdaContext
forall a b. (a -> b) -> a -> b
$ String -> Maybe DynamicContext -> Either String DynamicContext
forall b a. b -> Maybe a -> Either b a
maybeToEither String
"Runtime Error: Unable to decode Context from event response."
        -- Build the Dynamic Context, collapsing individual Maybes into a single Maybe
        (Maybe DynamicContext -> Either String DynamicContext)
-> Maybe DynamicContext -> Either String DynamicContext
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Text
-> UTCTime
-> Maybe ClientContext
-> Maybe CognitoIdentity
-> DynamicContext
DynamicContext (ByteString -> Text
decodeUtf8 ByteString
reqIdBS)
        (Text
 -> Text
 -> UTCTime
 -> Maybe ClientContext
 -> Maybe CognitoIdentity
 -> DynamicContext)
-> Maybe Text
-> Maybe
     (Text
      -> UTCTime
      -> Maybe ClientContext
      -> Maybe CognitoIdentity
      -> DynamicContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mFunctionArn
        Maybe
  (Text
   -> UTCTime
   -> Maybe ClientContext
   -> Maybe CognitoIdentity
   -> DynamicContext)
-> Maybe Text
-> Maybe
     (UTCTime
      -> Maybe ClientContext -> Maybe CognitoIdentity -> DynamicContext)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
mTraceId
        Maybe
  (UTCTime
   -> Maybe ClientContext -> Maybe CognitoIdentity -> DynamicContext)
-> Maybe UTCTime
-> Maybe
     (Maybe ClientContext -> Maybe CognitoIdentity -> DynamicContext)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe UTCTime
mDeadline
        Maybe
  (Maybe ClientContext -> Maybe CognitoIdentity -> DynamicContext)
-> Maybe (Maybe ClientContext)
-> Maybe (Maybe CognitoIdentity -> DynamicContext)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Maybe ClientContext)
mClientContext
        Maybe (Maybe CognitoIdentity -> DynamicContext)
-> Maybe (Maybe CognitoIdentity) -> Maybe DynamicContext
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Maybe CognitoIdentity)
mIdentity

  let eEvent :: Either String event
eEvent = (JSONParseException -> String)
-> Either JSONParseException event -> Either String event
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first JSONParseException -> String
forall e. Exception e => e -> String
displayException (Either JSONParseException event -> Either String event)
-> Either JSONParseException event -> Either String event
forall a b. (a -> b) -> a -> b
$ Response (Either JSONParseException event)
-> Either JSONParseException event
forall a. Response a -> a
getResponseBody Response (Either JSONParseException event)
nextRes

  Either String result
result <- case (LambdaContext -> event -> (LambdaContext, event))
-> Either String LambdaContext
-> Either String event
-> Either String (LambdaContext, event)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Either String LambdaContext
eCtx Either String event
eEvent of
    Left String
e -> Either String result -> m (Either String result)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String result -> m (Either String result))
-> Either String result -> m (Either String result)
forall a b. (a -> b) -> a -> b
$ String -> Either String result
forall a b. a -> Either a b
Left String
e
    Right (LambdaContext
ctx, event
event) ->
      (r -> r) -> m (Either String result) -> m (Either String result)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (LambdaContext -> r -> r
forall r. HasLambdaContext r => LambdaContext -> r -> r
withContext LambdaContext
ctx) (m (Either String result) -> m (Either String result))
-> m (Either String result) -> m (Either String result)
forall a b. (a -> b) -> a -> b
$ do
        -- Propagate the tracing header (Exception safe for this env var name)
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
setEnv String
"_X_AMZN_TRACE_ID" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ LambdaContext -> Text
xRayTraceId LambdaContext
ctx

        {- Catching like this is _usually_ considered bad practice, but this is a true
             case where we want to both catch all errors and propogate information about them.
             See: http://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Exception.html#g:4
        -}
        -- Put any exceptions in an Either
        Either SomeException result
caughtResult <- m result -> m (Either SomeException result)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (event -> m result
fn event
event)
        -- Map the Either (via first) so it is an `Either String a`
        Either String result -> m (Either String result)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String result -> m (Either String result))
-> Either String result -> m (Either String result)
forall a b. (a -> b) -> a -> b
$ (SomeException -> String)
-> Either SomeException result -> Either String result
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (SomeException -> String
forall e. Exception e => e -> String
displayException :: SomeException -> String) Either SomeException result
caughtResult

  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ case Either String result
result of
    Right result
r -> RuntimeClientConfig -> ByteString -> result -> IO ()
forall a.
ToJSON a =>
RuntimeClientConfig -> ByteString -> a -> IO ()
sendEventSuccess RuntimeClientConfig
runtimeClientConfig ByteString
reqIdBS result
r
    Left String
e  -> RuntimeClientConfig -> ByteString -> String -> IO ()
sendEventError RuntimeClientConfig
runtimeClientConfig ByteString
reqIdBS String
e

--TODO: Revisit all names before we put them under contract
-- | For any monad that supports IO/catch/Reader LambdaContext.
--
-- Use this if you need caching behavours or are comfortable
-- manipulating monad transformers and want full control over
-- your monadic interface.
--
-- @
--     {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}
--
--     module Main where
--
--     import AWS.Lambda.Context (LambdaContext(..))
--     import AWS.Lambda.Runtime (mRuntimeWithContext)
--     import Control.Monad.Reader (ReaderT, ask)
--     import Control.Monad.State.Lazy (StateT, runStateT, get, put)
--     import Data.Aeson (FromJSON)
--     import Data.Text (unpack)
--     import System.Environment (getEnv)
--
--     data Named = {
--       name :: String
--     } deriving Generic
--     instance FromJSON Named
--
--     myHandler :: Named -> StateT Int (ReaderT LambdaContext IO String)
--     myHandler Named { name } = do
--       LambdaContext { functionName } <- ask
--       greeting <- getEnv \"GREETING\"
--
--       greetingCount <- get
--       put $ greetingCount + 1
--
--       return $ greeting ++ name ++ " (" ++ show greetingCount ++ ") from " ++ unpack functionName ++ "!"
--
--     main :: IO ()
--     main = runStateT (mRuntimeWithContext myHandler) 0
-- @
mRuntimeWithContext :: (HasLambdaContext r, MonadCatch m, MonadReader r m, MonadIO m, FromJSON event, ToJSON result) =>
  (event -> m result) -> m ()
mRuntimeWithContext :: (event -> m result) -> m ()
mRuntimeWithContext event -> m result
fn = do
  -- TODO: Hide the implementation details of StaticContext within
  -- RuntimeClientConfig that encapsulates more details
  RuntimeClientConfig
runtimeClientConfig <- IO RuntimeClientConfig -> m RuntimeClientConfig
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO RuntimeClientConfig
getRuntimeClientConfig

  Either String StaticContext
possibleStaticCtx <- IO (Either String StaticContext) -> m (Either String StaticContext)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String StaticContext)
 -> m (Either String StaticContext))
-> IO (Either String StaticContext)
-> m (Either String StaticContext)
forall a b. (a -> b) -> a -> b
$ (IO (Either String StaticContext)
forall a. FromEnv a => IO (Either String a)
decodeEnv :: IO (Either String StaticContext))

  case Either String StaticContext
possibleStaticCtx of
    Left String
err -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ RuntimeClientConfig -> String -> IO ()
sendInitError RuntimeClientConfig
runtimeClientConfig String
err
    Right StaticContext
staticContext -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ RuntimeClientConfig -> StaticContext -> (event -> m result) -> m ()
forall r (m :: * -> *) event result.
(HasLambdaContext r, MonadReader r m, MonadCatch m, MonadIO m,
 FromJSON event, ToJSON result) =>
RuntimeClientConfig -> StaticContext -> (event -> m result) -> m ()
runtimeLoop RuntimeClientConfig
runtimeClientConfig StaticContext
staticContext event -> m result
fn

-- | For functions that can read the lambda context and use IO within the same monad.
--
-- Use this for handlers that need any form of side-effect such as reading
-- environment variables or making network requests, and prefer to access the
-- AWS Lambda Context in the same monad.
-- However, do not use this runtime if you need stateful (caching) behaviors.
--
-- @
--     {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}
--
--     module Main where
--
--     import AWS.Lambda.Context (LambdaContext(..))
--     import AWS.Lambda.Runtime (readerTRuntime)
--     import Control.Monad.Reader (ReaderT, ask)
--     import Data.Aeson (FromJSON)
--     import Data.Text (unpack)
--     import System.Environment (getEnv)
--
--     data Named = {
--       name :: String
--     } deriving Generic
--     instance FromJSON Named
--
--     myHandler :: Named -> ReaderT LambdaContext IO String
--     myHandler Named { name } = do
--       LambdaContext { functionName } <- ask
--       greeting <- getEnv \"GREETING\"
--       return $ greeting ++ name ++ " from " ++ unpack functionName ++ "!"
--
--     main :: IO ()
--     main = readerTRuntime myHandler
-- @
readerTRuntime :: (FromJSON event, ToJSON result) =>
  (event -> ReaderT LambdaContext IO result) -> IO ()
readerTRuntime :: (event -> ReaderT LambdaContext IO result) -> IO ()
readerTRuntime = ReaderT LambdaContext IO () -> IO ()
forall (m :: * -> *) a. ReaderT LambdaContext m a -> m a
runReaderTLambdaContext (ReaderT LambdaContext IO () -> IO ())
-> ((event -> ReaderT LambdaContext IO result)
    -> ReaderT LambdaContext IO ())
-> (event -> ReaderT LambdaContext IO result)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (event -> ReaderT LambdaContext IO result)
-> ReaderT LambdaContext IO ()
forall r (m :: * -> *) event result.
(HasLambdaContext r, MonadCatch m, MonadReader r m, MonadIO m,
 FromJSON event, ToJSON result) =>
(event -> m result) -> m ()
mRuntimeWithContext

-- | For functions with IO that can fail in a pure way (or via throw).
--
-- Use this for handlers that need any form of side-effect such as reading
-- environment variables or making network requests, and also need the
-- AWS Lambda Context as input.
-- However, do not use this runtime if you need stateful (caching) behaviors.
--
-- @
--     {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}
--
--     module Main where
--
--     import AWS.Lambda.Context (LambdaContext(..))
--     import AWS.Lambda.Runtime (ioRuntimeWithContext)
--     import Data.Aeson (FromJSON)
--     import Data.Text (unpack)
--     import System.Environment (getEnv)
--
--     data Named = {
--       name :: String
--     } deriving Generic
--     instance FromJSON Named
--
--     myHandler :: LambdaContext -> Named -> IO String
--     myHandler (LambdaContext { functionName }) (Named { name }) = do
--       greeting <- getEnv \"GREETING\"
--       return $ greeting ++ name ++ " from " ++ unpack functionName ++ "!"
--
--     main :: IO ()
--     main = ioRuntimeWithContext myHandler
-- @
ioRuntimeWithContext :: (FromJSON event, ToJSON result) =>
  (LambdaContext -> event -> IO (Either String result)) -> IO ()
ioRuntimeWithContext :: (LambdaContext -> event -> IO (Either String result)) -> IO ()
ioRuntimeWithContext = (event -> ReaderT LambdaContext IO result) -> IO ()
forall event result.
(FromJSON event, ToJSON result) =>
(event -> ReaderT LambdaContext IO result) -> IO ()
readerTRuntime ((event -> ReaderT LambdaContext IO result) -> IO ())
-> ((LambdaContext -> event -> IO (Either String result))
    -> event -> ReaderT LambdaContext IO result)
-> (LambdaContext -> event -> IO (Either String result))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LambdaContext -> event -> IO (Either String result))
-> event -> ReaderT LambdaContext IO result
forall c (m :: * -> *) b a.
(MonadReader c m, MonadIO m) =>
(c -> b -> IO (Either String a)) -> b -> m a
withIOInterface

-- | For functions with IO that can fail in a pure way (or via throw).
--
-- Use this for handlers that need any form of side-effect such as reading
-- environment variables or making network requests.
-- However, do not use this runtime if you need stateful (caching) behaviors.
--
-- @
--     {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}
--
--     module Main where
--
--     import AWS.Lambda.Runtime (ioRuntime)
--     import Data.Aeson (FromJSON)
--     import System.Environment (getEnv)
--
--     data Named = {
--       name :: String
--     } deriving Generic
--     instance FromJSON Named
--
--     myHandler :: Named -> IO String
--     myHandler (Named { name }) = do
--       greeting <- getEnv \"GREETING\"
--       return $ greeting ++ name
--
--     main :: IO ()
--     main = ioRuntime myHandler
-- @
ioRuntime :: (FromJSON event, ToJSON result) =>
  (event -> IO (Either String result)) -> IO ()
ioRuntime :: (event -> IO (Either String result)) -> IO ()
ioRuntime = (event -> ReaderT LambdaContext IO result) -> IO ()
forall event result.
(FromJSON event, ToJSON result) =>
(event -> ReaderT LambdaContext IO result) -> IO ()
readerTRuntime ((event -> ReaderT LambdaContext IO result) -> IO ())
-> ((event -> IO (Either String result))
    -> event -> ReaderT LambdaContext IO result)
-> (event -> IO (Either String result))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LambdaContext -> event -> IO (Either String result))
-> event -> ReaderT LambdaContext IO result
forall c (m :: * -> *) b a.
(MonadReader c m, MonadIO m) =>
(c -> b -> IO (Either String a)) -> b -> m a
withIOInterface ((LambdaContext -> event -> IO (Either String result))
 -> event -> ReaderT LambdaContext IO result)
-> ((event -> IO (Either String result))
    -> LambdaContext -> event -> IO (Either String result))
-> (event -> IO (Either String result))
-> event
-> ReaderT LambdaContext IO result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (event -> IO (Either String result))
-> LambdaContext -> event -> IO (Either String result)
forall a b. a -> b -> a
withoutContext

-- | For pure functions that can still fail.
--
-- Use this for simple handlers that just translate input to output without side-effects,
-- but can fail and need the AWS Lambda Context as input.
--
-- @
--     {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}
--
--     module Main where
--
--     import AWS.Lambda.Context (LambdaContext(..))
--     import AWS.Lambda.Runtime (fallibleRuntimeWithContext)
--     import Data.Aeson (FromJSON)
--     import Data.Text (unpack)
--
--     data Named = {
--       name :: String
--     } deriving Generic
--     instance FromJSON Named
--
--     myHandler :: LambdaContext -> Named -> Either String String
--     myHandler (LambdaContext { functionName }) (Named { name }) =
--       if name == \"World\" then
--         Right "Hello, World from " ++ unpack functionName ++ "!"
--       else
--         Left "Can only greet the world."
--
--     main :: IO ()
--     main = fallibleRuntimeWithContext myHandler
-- @
fallibleRuntimeWithContext :: (FromJSON event, ToJSON result) =>
  (LambdaContext -> event -> Either String result) -> IO ()
fallibleRuntimeWithContext :: (LambdaContext -> event -> Either String result) -> IO ()
fallibleRuntimeWithContext = (event -> ReaderT LambdaContext IO result) -> IO ()
forall event result.
(FromJSON event, ToJSON result) =>
(event -> ReaderT LambdaContext IO result) -> IO ()
readerTRuntime ((event -> ReaderT LambdaContext IO result) -> IO ())
-> ((LambdaContext -> event -> Either String result)
    -> event -> ReaderT LambdaContext IO result)
-> (LambdaContext -> event -> Either String result)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LambdaContext -> event -> Either String result)
-> event -> ReaderT LambdaContext IO result
forall c (m :: * -> *) b a.
MonadReader c m =>
(c -> b -> Either String a) -> b -> m a
withFallibleInterface

-- | For pure functions that can still fail.
--
-- Use this for simple handlers that just translate input to output without side-effects,
-- but can fail.
--
-- @
--     {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}
--
--     module Main where
--
--     import AWS.Lambda.Runtime (fallibleRuntime)
--     import Data.Aeson (FromJSON)
--
--     data Named = {
--       name :: String
--     } deriving Generic
--     instance FromJSON Named
--
--     myHandler :: Named -> Either String String
--     myHandler (Named { name }) =
--       if name == \"World\" then
--         Right "Hello, World!"
--       else
--         Left "Can only greet the world."
--
--     main :: IO ()
--     main = fallibleRuntime myHandler
-- @
fallibleRuntime :: (FromJSON event, ToJSON result) =>
  (event -> Either String result) -> IO ()
fallibleRuntime :: (event -> Either String result) -> IO ()
fallibleRuntime = (event -> ReaderT LambdaContext IO result) -> IO ()
forall event result.
(FromJSON event, ToJSON result) =>
(event -> ReaderT LambdaContext IO result) -> IO ()
readerTRuntime ((event -> ReaderT LambdaContext IO result) -> IO ())
-> ((event -> Either String result)
    -> event -> ReaderT LambdaContext IO result)
-> (event -> Either String result)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LambdaContext -> event -> Either String result)
-> event -> ReaderT LambdaContext IO result
forall c (m :: * -> *) b a.
MonadReader c m =>
(c -> b -> Either String a) -> b -> m a
withFallibleInterface ((LambdaContext -> event -> Either String result)
 -> event -> ReaderT LambdaContext IO result)
-> ((event -> Either String result)
    -> LambdaContext -> event -> Either String result)
-> (event -> Either String result)
-> event
-> ReaderT LambdaContext IO result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (event -> Either String result)
-> LambdaContext -> event -> Either String result
forall a b. a -> b -> a
withoutContext

-- | For pure functions that can never fail that also need access to the context.
--
-- Use this for simple handlers that just translate input to output without side-effects,
-- but that need the AWS Lambda Context as input.
--
-- @
--     {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}
--
--     module Main where
--
--     import AWS.Lambda.Context (LambdaContext(..))
--     import AWS.Lambda.Runtime (pureRuntimeWithContext)
--     import Data.Aeson (FromJSON)
--     import Data.Text (unpack)
--
--     data Named = {
--       name :: String
--     } deriving Generic
--     instance FromJSON Named
--
--     myHandler :: LambdaContext -> Named -> String
--     myHandler (LambdaContext { functionName }) (Named { name }) =
--       "Hello, " ++ name ++ " from " ++ unpack functionName ++ "!"
--
--     main :: IO ()
--     main = pureRuntimeWithContext myHandler
-- @
pureRuntimeWithContext :: (FromJSON event, ToJSON result) =>
  (LambdaContext -> event -> result) -> IO ()
pureRuntimeWithContext :: (LambdaContext -> event -> result) -> IO ()
pureRuntimeWithContext = (event -> ReaderT LambdaContext IO result) -> IO ()
forall event result.
(FromJSON event, ToJSON result) =>
(event -> ReaderT LambdaContext IO result) -> IO ()
readerTRuntime ((event -> ReaderT LambdaContext IO result) -> IO ())
-> ((LambdaContext -> event -> result)
    -> event -> ReaderT LambdaContext IO result)
-> (LambdaContext -> event -> result)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LambdaContext -> event -> result)
-> event -> ReaderT LambdaContext IO result
forall c (m :: * -> *) b a.
MonadReader c m =>
(c -> b -> a) -> b -> m a
withPureInterface

-- | For pure functions that can never fail.
--
-- Use this for simple handlers that just translate input to output without side-effects.
--
-- @
--     {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}
--
--     module Main where
--
--     import AWS.Lambda.Runtime (pureRuntime)
--     import Data.Aeson (FromJSON)
--
--     data Named = {
--       name :: String
--     } deriving Generic
--     instance FromJSON Named
--
--     myHandler :: Named -> String
--     myHandler Named { name } = "Hello, " ++ name ++ "!"
--
--     main :: IO ()
--     main = pureRuntime myHandler
-- @
pureRuntime :: (FromJSON event, ToJSON result) => (event -> result) -> IO ()
pureRuntime :: (event -> result) -> IO ()
pureRuntime = (event -> ReaderT LambdaContext IO result) -> IO ()
forall event result.
(FromJSON event, ToJSON result) =>
(event -> ReaderT LambdaContext IO result) -> IO ()
readerTRuntime ((event -> ReaderT LambdaContext IO result) -> IO ())
-> ((event -> result) -> event -> ReaderT LambdaContext IO result)
-> (event -> result)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LambdaContext -> event -> result)
-> event -> ReaderT LambdaContext IO result
forall c (m :: * -> *) b a.
MonadReader c m =>
(c -> b -> a) -> b -> m a
withPureInterface ((LambdaContext -> event -> result)
 -> event -> ReaderT LambdaContext IO result)
-> ((event -> result) -> LambdaContext -> event -> result)
-> (event -> result)
-> event
-> ReaderT LambdaContext IO result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (event -> result) -> LambdaContext -> event -> result
forall a b. a -> b -> a
withoutContext