-- | Provides all the values out of
-- the environment variables of the system
module Aws.Lambda.Runtime.Environment
  ( functionMemory,
    apiEndpoint,
    handlerName,
    taskRoot,
    functionName,
    functionVersion,
    logStreamName,
    logGroupName,
    setXRayTrace,
  )
where

import qualified Aws.Lambda.Runtime.Error as Error
import Control.Exception.Safe (throw)
import Data.Text (Text, pack, unpack)
import qualified System.Environment as Environment
import qualified Text.Read as Read

logGroupName :: IO Text
logGroupName :: IO Text
logGroupName =
  Text -> IO Text
readEnvironmentVariable Text
"AWS_LAMBDA_LOG_GROUP_NAME"

logStreamName :: IO Text
logStreamName :: IO Text
logStreamName =
  Text -> IO Text
readEnvironmentVariable Text
"AWS_LAMBDA_LOG_STREAM_NAME"

functionVersion :: IO Text
functionVersion :: IO Text
functionVersion =
  Text -> IO Text
readEnvironmentVariable Text
"AWS_LAMBDA_FUNCTION_VERSION"

functionName :: IO Text
functionName :: IO Text
functionName =
  Text -> IO Text
readEnvironmentVariable Text
"AWS_LAMBDA_FUNCTION_NAME"

setXRayTrace :: Text -> IO ()
setXRayTrace :: Text -> IO ()
setXRayTrace = String -> String -> IO ()
Environment.setEnv String
"_X_AMZN_TRACE_ID" (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

taskRoot :: IO Text
taskRoot :: IO Text
taskRoot =
  Text -> IO Text
readEnvironmentVariable Text
"LAMBDA_TASK_ROOT"

handlerName :: IO Text
handlerName :: IO Text
handlerName =
  Text -> IO Text
readEnvironmentVariable Text
"_HANDLER"

apiEndpoint :: IO Text
apiEndpoint :: IO Text
apiEndpoint =
  Text -> IO Text
readEnvironmentVariable Text
"AWS_LAMBDA_RUNTIME_API"

functionMemory :: IO Int
functionMemory :: IO Int
functionMemory = do
  let envVar :: Text
envVar = Text
"AWS_LAMBDA_FUNCTION_MEMORY_SIZE"
  Text
memoryValue <- Text -> IO Text
readEnvironmentVariable Text
envVar
  case String -> Maybe Int
forall a. Read a => String -> Maybe a
Read.readMaybe (Text -> String
unpack Text
memoryValue) of
    Just Int
value -> Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
value
    Maybe Int
Nothing -> Parsing -> IO Int
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw (Text -> Text -> Text -> Parsing
Error.Parsing Text
envVar Text
memoryValue Text
envVar)

readEnvironmentVariable :: Text -> IO Text
readEnvironmentVariable :: Text -> IO Text
readEnvironmentVariable Text
envVar = do
  Maybe String
v <- String -> IO (Maybe String)
Environment.lookupEnv (Text -> String
unpack Text
envVar)
  case Maybe String
v of
    Just String
value -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> (String -> Text) -> String -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> IO Text) -> String -> IO Text
forall a b. (a -> b) -> a -> b
$ String
value
    Maybe String
Nothing -> EnvironmentVariableNotSet -> IO Text
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw (Text -> EnvironmentVariableNotSet
Error.EnvironmentVariableNotSet Text
envVar)