module Aws.Lambda.Runtime.Context
  ( Context (..),
    initialize,
    setEventData,
  )
where

import qualified Aws.Lambda.Runtime.ApiInfo as ApiInfo
import qualified Aws.Lambda.Runtime.Environment as Environment
import qualified Aws.Lambda.Runtime.Error as Error
import Control.Exception.Safe.Checked (Throws)
import Data.IORef (IORef)
import Data.Text (Text)

-- | Context that is passed to all the handlers
data Context context = Context
  { forall context. Context context -> Int
memoryLimitInMb :: !Int,
    forall context. Context context -> Text
functionName :: !Text,
    forall context. Context context -> Text
functionVersion :: !Text,
    forall context. Context context -> Text
invokedFunctionArn :: !Text,
    forall context. Context context -> Text
awsRequestId :: !Text,
    forall context. Context context -> Text
xrayTraceId :: !Text,
    forall context. Context context -> Text
logStreamName :: !Text,
    forall context. Context context -> Text
logGroupName :: !Text,
    forall context. Context context -> Int
deadline :: !Int,
    forall context. Context context -> IORef context
customContext :: !(IORef context)
  }

-- | Initializes the context out of the environment
initialize ::
  Throws Error.Parsing =>
  Throws Error.EnvironmentVariableNotSet =>
  IORef context ->
  IO (Context context)
initialize :: forall context.
(Throws Parsing, Throws EnvironmentVariableNotSet) =>
IORef context -> IO (Context context)
initialize IORef context
customContextRef = do
  Text
functionName <- Throws EnvironmentVariableNotSet => IO Text
Environment.functionName
  Text
version <- Throws EnvironmentVariableNotSet => IO Text
Environment.functionVersion
  Text
logStream <- Throws EnvironmentVariableNotSet => IO Text
Environment.logStreamName
  Text
logGroup <- Throws EnvironmentVariableNotSet => IO Text
Environment.logGroupName
  Int
memoryLimitInMb <- (Throws Parsing, Throws EnvironmentVariableNotSet) => IO Int
Environment.functionMemory

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Context
      { functionName :: Text
functionName = Text
functionName,
        functionVersion :: Text
functionVersion = Text
version,
        logStreamName :: Text
logStreamName = Text
logStream,
        logGroupName :: Text
logGroupName = Text
logGroup,
        memoryLimitInMb :: Int
memoryLimitInMb = Int
memoryLimitInMb,
        customContext :: IORef context
customContext = IORef context
customContextRef,
        -- We set those to "empty" values because they will be assigned
        -- from the incoming event once one has been received. (see setEventData)
        invokedFunctionArn :: Text
invokedFunctionArn = forall a. Monoid a => a
mempty,
        xrayTraceId :: Text
xrayTraceId = forall a. Monoid a => a
mempty,
        awsRequestId :: Text
awsRequestId = forall a. Monoid a => a
mempty,
        deadline :: Int
deadline = Int
0
      }

-- | Sets the context's event data
setEventData ::
  Context context ->
  ApiInfo.Event ->
  IO (Context context)
setEventData :: forall context. Context context -> Event -> IO (Context context)
setEventData Context context
context ApiInfo.Event {Int
ByteString
Text
event :: Event -> ByteString
invokedFunctionArn :: Event -> Text
awsRequestId :: Event -> Text
traceId :: Event -> Text
deadlineMs :: Event -> Int
event :: ByteString
invokedFunctionArn :: Text
awsRequestId :: Text
traceId :: Text
deadlineMs :: Int
..} = do
  Text -> IO ()
Environment.setXRayTrace Text
traceId

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    Context context
context
      { invokedFunctionArn :: Text
invokedFunctionArn = Text
invokedFunctionArn,
        xrayTraceId :: Text
xrayTraceId = Text
traceId,
        awsRequestId :: Text
awsRequestId = Text
awsRequestId,
        deadline :: Int
deadline = Int
deadlineMs
      }