{-# 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(..),
  mkContext
) where

import           AWS.Lambda.Context (ClientContext, CognitoIdentity,
                                     LambdaContext (LambdaContext))
import           Data.Text          (Text)
import           Data.Time.Clock    (UTCTime)
import           GHC.Generics       (Generic)
import           System.Envy        (DefConfig (..), FromEnv, Option (..),
                                     fromEnv, gFromEnvCustom)

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
(Int -> StaticContext -> ShowS)
-> (StaticContext -> String)
-> ([StaticContext] -> ShowS)
-> Show StaticContext
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. StaticContext -> Rep StaticContext x)
-> (forall x. Rep StaticContext x -> StaticContext)
-> Generic StaticContext
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)

instance DefConfig StaticContext where
  defConfig :: StaticContext
defConfig = Text -> Text -> Int -> Text -> Text -> StaticContext
StaticContext Text
"" Text
"" Int
0 Text
"" Text
""

instance FromEnv StaticContext where
  fromEnv :: Parser StaticContext
fromEnv = Option -> Parser StaticContext
forall a.
(DefConfig a, Generic a, GFromEnv (Rep a)) =>
Option -> Parser a
gFromEnvCustom Option :: Int -> String -> Option
Option {
                    dropPrefixCount :: Int
dropPrefixCount = Int
0,
                    customPrefix :: String
customPrefix = String
"AWS_LAMBDA"
          }

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
(Int -> DynamicContext -> ShowS)
-> (DynamicContext -> String)
-> ([DynamicContext] -> ShowS)
-> Show DynamicContext
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)