{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : AWS.Lambda.Internal
Description : Internal hal helper methods.
Copyright   : (c) Nike, Inc., 2018
License     : BSD3
Maintainer  : nathan.fairhurst@nike.com, fernando.freire@nike.com
Stability   : unstable
-}

module AWS.Lambda.Internal (
  StaticContext(..),
  DynamicContext(..),
  getStaticContext,
  mkContext
) where

import           AWS.Lambda.Context (ClientContext, CognitoIdentity,
                                     LambdaContext (LambdaContext))
import           Data.Maybe         (fromMaybe)
import           Data.Text          (Text, pack)
import           Data.Time.Clock    (UTCTime)
import           GHC.Generics       (Generic)
import           System.Environment (getEnv)
import           Text.Read          (readMaybe)

data StaticContext = StaticContext
  { StaticContext -> Text
functionName       :: Text,
    StaticContext -> Text
functionVersion    :: Text,
    StaticContext -> Int
functionMemorySize :: Int,
    StaticContext -> Text
logGroupName       :: Text,
    StaticContext -> Text
logStreamName      :: Text
  } deriving (Int -> StaticContext -> ShowS
[StaticContext] -> ShowS
StaticContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticContext] -> ShowS
$cshowList :: [StaticContext] -> ShowS
show :: StaticContext -> String
$cshow :: StaticContext -> String
showsPrec :: Int -> StaticContext -> ShowS
$cshowsPrec :: Int -> StaticContext -> ShowS
Show, forall x. Rep StaticContext x -> StaticContext
forall x. StaticContext -> Rep StaticContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaticContext x -> StaticContext
$cfrom :: forall x. StaticContext -> Rep StaticContext x
Generic)

getStaticContext :: IO StaticContext
getStaticContext :: IO StaticContext
getStaticContext =
  Text -> Text -> Int -> Text -> Text -> StaticContext
StaticContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getEnv String
"AWS_LAMBDA_FUNCTION_NAME") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  (String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getEnv String
"AWS_LAMBDA_FUNCTION_VERSION") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  ((forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"AWS_LAMBDA_FUNCTION_MEMORY_SIZE was not an Int") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   String -> IO String
getEnv String
"AWS_LAMBDA_FUNCTION_MEMORY_SIZE") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  (String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getEnv String
"AWS_LAMBDA_LOG_GROUP_NAME") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  (String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getEnv String
"AWS_LAMBDA_LOG_STREAM_NAME")

data DynamicContext = DynamicContext
  { DynamicContext -> Text
awsRequestId       :: Text,
    DynamicContext -> Text
invokedFunctionArn :: Text,
    DynamicContext -> Text
xRayTraceId        :: Text,
    DynamicContext -> UTCTime
deadline           :: UTCTime,
    DynamicContext -> Maybe ClientContext
clientContext      :: Maybe ClientContext,
    DynamicContext -> Maybe CognitoIdentity
identity           :: Maybe CognitoIdentity
  } deriving (Int -> DynamicContext -> ShowS
[DynamicContext] -> ShowS
DynamicContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DynamicContext] -> ShowS
$cshowList :: [DynamicContext] -> ShowS
show :: DynamicContext -> String
$cshow :: DynamicContext -> String
showsPrec :: Int -> DynamicContext -> ShowS
$cshowsPrec :: Int -> DynamicContext -> ShowS
Show)

mkContext :: StaticContext -> DynamicContext -> LambdaContext
mkContext :: StaticContext -> DynamicContext -> LambdaContext
mkContext StaticContext
static DynamicContext
dynamic =
  Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Maybe ClientContext
-> Maybe CognitoIdentity
-> LambdaContext
LambdaContext
    (StaticContext -> Text
functionName StaticContext
static)
    (StaticContext -> Text
functionVersion StaticContext
static)
    (StaticContext -> Int
functionMemorySize StaticContext
static)
    (StaticContext -> Text
logGroupName StaticContext
static)
    (StaticContext -> Text
logStreamName StaticContext
static)
    (DynamicContext -> Text
awsRequestId DynamicContext
dynamic)
    (DynamicContext -> Text
invokedFunctionArn DynamicContext
dynamic)
    (DynamicContext -> Text
xRayTraceId DynamicContext
dynamic)
    (DynamicContext -> UTCTime
deadline DynamicContext
dynamic)
    (DynamicContext -> Maybe ClientContext
clientContext DynamicContext
dynamic)
    (DynamicContext -> Maybe CognitoIdentity
identity DynamicContext
dynamic)