{-# LANGUAGE FlexibleContexts #-}

{-|
Module      : AWS.Lambda.Runtime.Value
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.

These runtimes expect handlers that accept a parsed JSON AST
('Data.Aeson.Types.Value') as the input, instead some particular type with a FromJSON
instance.  Handlers using these runtimes must take care of the conversion and
handle errors explicitly.  Handlers that should throw an exception or never
expect to be invoked with an invalid payload, should simply use the runtimes in
the "AWS.Lambda.Runtime" module.

Each example shows the conversion from the Value type to the target FromJSON
type.

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.Value (
  pureRuntime,
  pureRuntimeWithContext,
  fallibleRuntime,
  fallibleRuntimeWithContext,
  ioRuntime,
  ioRuntimeWithContext,
  readerTRuntime,
  mRuntime,
  mRuntimeWithContext,
) where

import           AWS.Lambda.RuntimeClient (RuntimeClientConfig, getRuntimeClientConfig,
                                           getNextData, sendEventError, sendEventSuccess)
import           AWS.Lambda.Combinators   (withoutContext)
import           AWS.Lambda.Context       (LambdaContext(..))
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     (ReaderT, runReaderT)
import           Data.Aeson               (ToJSON, Value)
import           Data.Bifunctor           (first)
import           Data.Text                (unpack)
import           System.Environment       (setEnv)

runtimeLoop :: (MonadCatch m, MonadIO m, ToJSON result) => RuntimeClientConfig -> (LambdaContext -> Value -> m result) -> m ()
runtimeLoop :: forall (m :: * -> *) result.
(MonadCatch m, MonadIO m, ToJSON result) =>
RuntimeClientConfig -> (LambdaContext -> Value -> m result) -> m ()
runtimeLoop RuntimeClientConfig
runtimeClientConfig LambdaContext -> Value -> m result
fn = do
  -- Get an event
  (ByteString
reqIdBS, Value
event, Either String LambdaContext
eCtx) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ RuntimeClientConfig
-> IO (ByteString, Value, Either String LambdaContext)
getNextData RuntimeClientConfig
runtimeClientConfig

  -- Propagate the tracing header (Exception safe for this env var name)
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) (String -> String -> IO ()
setEnv String
"_X_AMZN_TRACE_ID" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. LambdaContext -> Text
xRayTraceId) Either String LambdaContext
eCtx

  {- 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 <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (LambdaContext -> Value -> m result
fn (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id Either String LambdaContext
eCtx) Value
event)
  -- Map the Either (via first) so it is an `Either String result`
  let result :: Either String result
result = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall e. Exception e => e -> String
displayException :: SomeException -> String) Either SomeException result
caughtResult

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ case Either String result
result of
    Right result
r -> 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

-- | For any monad that supports 'IO' and 'catch'. Useful if you need
-- caching behaviours or are comfortable manipulating monad
-- transformers, and want full control over your monadic interface.
--
-- A contrived example, that parses the 'Value' argument directly
-- instead of using the higher-level features in
-- @AWS.Lambda.Runtime.Value@:
--
-- @
-- {-\# LANGUAGE DeriveAnyClass, DeriveGeneric, NamedFieldPuns \#-}
--
-- module Main where
--
-- import AWS.Lambda.Context (LambdaContext(..))
-- import AWS.Lambda.Runtime (mRuntimeWithContext)
-- import Control.Monad.Catch (Exception, throwM)
-- import Control.Monad.State.Lazy (StateT, evalStateT, get, put)
-- import Control.Monad.Trans (liftIO)
-- import Data.Aeson (FromJSON, Result(..), Value, fromJSON)
-- import Data.Text (unpack)
-- import System.Environment (getEnv)
-- import GHC.Generics (Generic)
--
-- data AesonParseException = AesonParseException String
--   deriving (Show, Exception)
--
-- data Named = Named {
--   name :: String
-- } deriving Generic
-- instance FromJSON Named
--
-- myHandler :: LambdaContext -> Value -> StateT Int IO String
-- myHandler LambdaContext { functionName } value = do
--   greeting <- liftIO $ getEnv \"GREETING\"
--   Named { name } <- case fromJSON value of
--     Error err -> throwM $ AesonParseException err
--     Success named -> pure named
--   greetingCount <- get
--   put $ greetingCount + 1
--
--   return $ greeting ++ name ++ " (" ++ show greetingCount ++ ") from " ++ unpack functionName ++ "!"
--
-- main :: IO ()
-- main = evalStateT (mRuntimeWithContext myHandler) 0
-- @
mRuntimeWithContext :: (MonadCatch m, MonadIO m, ToJSON result) => (LambdaContext -> Value -> m result) -> m ()
mRuntimeWithContext :: forall (m :: * -> *) result.
(MonadCatch m, MonadIO m, ToJSON result) =>
(LambdaContext -> Value -> m result) -> m ()
mRuntimeWithContext LambdaContext -> Value -> m result
fn = do
  RuntimeClientConfig
runtimeClientConfig <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO RuntimeClientConfig
getRuntimeClientConfig

  forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) result.
(MonadCatch m, MonadIO m, ToJSON result) =>
RuntimeClientConfig -> (LambdaContext -> Value -> m result) -> m ()
runtimeLoop RuntimeClientConfig
runtimeClientConfig LambdaContext -> Value -> m result
fn

-- | For any monad that supports 'IO' and 'catch'. Useful if you need
-- caching behaviours or are comfortable manipulating monad
-- transformers, want full control over your monadic interface, but
-- don't need to inspect the 'LambdaContext'.
--
-- A contrived example, that parses the 'Value' argument directly
-- instead of using the higher-level features in
-- @AWS.Lambda.Runtime.Value@:
--
-- @
-- {-\# LANGUAGE DeriveAnyClass, DeriveGeneric, NamedFieldPuns \#-}
--
-- module Main where
--
-- import AWS.Lambda.Runtime (mRuntime)
-- import Control.Monad.Catch (Exception, throwM)
-- import Control.Monad.State.Lazy (StateT, evalStateT, get, put)
-- import Control.Monad.Trans (liftIO)
-- import Data.Aeson (FromJSON, Result(..), Value, fromJSON)
-- import System.Environment (getEnv)
-- import GHC.Generics (Generic)
--
-- data AesonParseException = AesonParseException String
--   deriving (Show, Exception)
--
-- data Named = Named {
--   name :: String
-- } deriving Generic
-- instance FromJSON Named
--
-- myHandler ::  Value -> StateT Int IO String
-- myHandler value = do
--   greeting <- liftIO $ getEnv \"GREETING\"
--   Named { name } <- case fromJSON value of
--     Error err -> throwM $ AesonParseException err
--     Success named -> pure named
--   greetingCount <- get
--   put $ greetingCount + 1
--
--   return $ greeting ++ name ++ " (" ++ show greetingCount ++ ")!"
--
-- main :: IO ()
-- main = evalStateT (mRuntime myHandler) 0
-- @
mRuntime :: (MonadCatch m, MonadIO m, ToJSON result) => (Value -> m result) -> m ()
mRuntime :: forall (m :: * -> *) result.
(MonadCatch m, MonadIO m, ToJSON result) =>
(Value -> m result) -> m ()
mRuntime = forall (m :: * -> *) result.
(MonadCatch m, MonadIO m, ToJSON result) =>
(LambdaContext -> Value -> m result) -> m ()
mRuntimeWithContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
withoutContext

-- | 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 Control.Monad.Trans (liftIO)
-- import Data.Aeson (Value, FromJSON, parseJSON)
-- import Data.Aeson.Types (parseMaybe)
-- import Data.Text (unpack)
-- import System.Environment (getEnv)
-- import GHC.Generics (Generic)
--
-- data Named = Named {
--   name :: String
-- } deriving Generic
-- instance FromJSON Named
--
-- myHandler :: Value -> ReaderT LambdaContext IO String
-- myHandler jsonAst =
--   case parseMaybe parseJSON jsonAst of
--     Nothing -> return $ "My name is HAL, what's yours?"
--     Just Named { name } -> do
--       LambdaContext { functionName } <- ask
--       greeting <- liftIO $ getEnv \"GREETING\"
--       return $ greeting ++ name ++ " from " ++ unpack functionName ++ "!"
--
-- main :: IO ()
-- main = readerTRuntime myHandler
-- @
readerTRuntime :: ToJSON result =>
  (Value -> ReaderT LambdaContext IO result) -> IO ()
readerTRuntime :: forall result.
ToJSON result =>
(Value -> ReaderT LambdaContext IO result) -> IO ()
readerTRuntime Value -> ReaderT LambdaContext IO result
fn = forall (m :: * -> *) result.
(MonadCatch m, MonadIO m, ToJSON result) =>
(LambdaContext -> Value -> m result) -> m ()
mRuntimeWithContext forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ReaderT LambdaContext IO result
fn)

-- | 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 Control.Monad.Trans (liftIO)
-- import Data.Aeson (Value, FromJSON, parseJSON)
-- import Data.Aeson.Types (parseMaybe)
-- import Data.Text (unpack)
-- import System.Environment (getEnv)
-- import GHC.Generics (Generic)
--
-- data Named = Named {
--   name :: String
-- } deriving Generic
-- instance FromJSON Named
--
-- myHandler :: LambdaContext -> Value -> IO (Either String String)
-- myHandler (LambdaContext { functionName }) jsonAst =
--   case parseMaybe parseJSON jsonAst of
--     Nothing -> return $ pure "My name is HAL, what's yours?"
--     Just Named { name } -> do
--       greeting <- liftIO $ getEnv \"GREETING\"
--       return $ pure $ greeting ++ name ++ " from " ++ unpack functionName ++ "!"
--
-- main :: IO ()
-- main = ioRuntimeWithContext myHandler
-- @
ioRuntimeWithContext :: ToJSON result =>
  (LambdaContext -> Value -> IO (Either String result)) -> IO ()
ioRuntimeWithContext :: forall result.
ToJSON result =>
(LambdaContext -> Value -> IO (Either String result)) -> IO ()
ioRuntimeWithContext LambdaContext -> Value -> IO (Either String result)
fn = forall (m :: * -> *) result.
(MonadCatch m, MonadIO m, ToJSON result) =>
(LambdaContext -> Value -> m result) -> m ()
mRuntimeWithContext (\LambdaContext
lc -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. LambdaContext -> Value -> IO (Either String result)
fn LambdaContext
lc)

-- | 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 Control.Monad.Trans (liftIO)
-- import Data.Aeson (Value, FromJSON, parseJSON)
-- import Data.Aeson.Types (parseMaybe)
-- import System.Environment (getEnv)
-- import GHC.Generics (Generic)
--
-- data Named = Named {
--   name :: String
-- } deriving Generic
-- instance FromJSON Named
--
-- myHandler :: Value -> IO (Either String String)
-- myHandler jsonAst =
--   case parseMaybe parseJSON jsonAst of
--     Nothing -> return $ pure "My name is HAL, what's yours?"
--     Just Named { name } -> do
--       greeting <- liftIO $ getEnv \"GREETING\"
--       return $ pure $ greeting ++ name
--
-- main :: IO ()
-- main = ioRuntime myHandler
-- @
ioRuntime :: ToJSON result =>
  (Value -> IO (Either String result)) -> IO ()
ioRuntime :: forall result.
ToJSON result =>
(Value -> IO (Either String result)) -> IO ()
ioRuntime = forall result.
ToJSON result =>
(LambdaContext -> Value -> IO (Either String result)) -> IO ()
ioRuntimeWithContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (Value, FromJSON, parseJSON)
-- import Data.Aeson.Types (parseMaybe)
-- import Data.Text (unpack)
-- import GHC.Generics (Generic)
--
-- data Named = Named {
--   name :: String
-- } deriving Generic
-- instance FromJSON Named
--
-- myHandler :: LambdaContext -> Value -> Either String String
-- myHandler (LambdaContext { functionName }) jsonAst =
--   case parseMaybe parseJSON jsonAst of
--     Nothing -> Right "My name is HAL, what's yours?"
--     Just 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 :: ToJSON result =>
  (LambdaContext -> Value -> Either String result) -> IO ()
fallibleRuntimeWithContext :: forall result.
ToJSON result =>
(LambdaContext -> Value -> Either String result) -> IO ()
fallibleRuntimeWithContext = forall (m :: * -> *) result.
(MonadCatch m, MonadIO m, ToJSON result) =>
(LambdaContext -> Value -> m result) -> m ()
mRuntimeWithContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure)

-- | 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 (Value, FromJSON, parseJSON)
-- import Data.Aeson.Types (parseMaybe)
-- import GHC.Generics (Generic)
--
-- data Named = Named {
--   name :: String
-- } deriving Generic
-- instance FromJSON Named
--
-- myHandler :: Value -> Either String String
-- myHandler jsonAst =
--   case parseMaybe parseJSON jsonAst of
--     Nothing -> Right "My name is HAL, what's yours?"
--     Just Named { name } ->
--       if name == \"World\" then
--         Right "Hello, World!"
--       else
--         Left "Can only greet the world."
--
-- main :: IO ()
-- main = fallibleRuntime myHandler
-- @
fallibleRuntime :: ToJSON result =>
  (Value -> Either String result) -> IO ()
fallibleRuntime :: forall result.
ToJSON result =>
(Value -> Either String result) -> IO ()
fallibleRuntime = forall result.
ToJSON result =>
(LambdaContext -> Value -> Either String result) -> IO ()
fallibleRuntimeWithContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (Value, FromJSON, parseJSON)
-- import Data.Aeson.Types (parseMaybe)
-- import Data.Text (unpack)
-- import GHC.Generics (Generic)
--
-- data Named = Named {
--   name :: String
-- } deriving Generic
-- instance FromJSON Named
--
-- myHandler :: LambdaContext -> Value -> Either String String
-- myHandler (LambdaContext { functionName }) jsonAst =
--   case parseMaybe parseJSON jsonAst of
--     Nothing -> Right "My name is HAL, what's yours?"
--     Just Named { name } ->
--       Right $ "Hello, " ++ name ++ " from " ++ unpack functionName ++ "!"
--
-- main :: IO ()
-- main = pureRuntimeWithContext myHandler
-- @
pureRuntimeWithContext :: ToJSON result =>
  (LambdaContext -> Value -> result) -> IO ()
pureRuntimeWithContext :: forall result.
ToJSON result =>
(LambdaContext -> Value -> result) -> IO ()
pureRuntimeWithContext = forall (m :: * -> *) result.
(MonadCatch m, MonadIO m, ToJSON result) =>
(LambdaContext -> Value -> m result) -> m ()
mRuntimeWithContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure)

-- | 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 (Value, FromJSON, parseJSON)
-- import Data.Aeson.Types (parseMaybe)
-- import GHC.Generics (Generic)
--
-- data Named = Named {
--   name :: String
-- } deriving Generic
-- instance FromJSON Named
--
-- myHandler :: Value -> String
-- myHandler jsonAst =
--   case parseMaybe parseJSON jsonAst of
--     Nothing -> "My name is HAL, what's yours?"
--     Just Named { name } ->
--       "Hello, " ++ name ++ "!"
--
-- main :: IO ()
-- main = pureRuntime myHandler
-- @
pureRuntime :: ToJSON result => (Value -> result) -> IO ()
pureRuntime :: forall result. ToJSON result => (Value -> result) -> IO ()
pureRuntime = forall result.
ToJSON result =>
(LambdaContext -> Value -> result) -> IO ()
pureRuntimeWithContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
withoutContext