{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-}

{-|
Module      : AWS.Lambda.Context
Description : AWS Lambda Context classes and related methods.
Copyright   : (c) Nike, Inc., 2018
License     : BSD3
Maintainer  : nathan.fairhurst@nike.com, fernando.freire@nike.com
Stability   : stable
-}

module AWS.Lambda.Context (
  ClientApplication(..),
  ClientContext(..),
  CognitoIdentity(..),
  LambdaContext(..),
  HasLambdaContext(..),
  defConfig,
  getRemainingTime,
  runReaderTLambdaContext
) where

import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Control.Monad.Reader   (ReaderT, runReaderT)
import           Data.Aeson             (FromJSON, ToJSON)
import           Data.Map               (Map)
import           Data.Text              (Text)
import           Data.Time.Clock        (DiffTime, UTCTime,
                                         diffUTCTime, getCurrentTime)
import           Data.Time.Clock.POSIX  (posixSecondsToUTCTime)
import           GHC.Generics           (Generic)
import           System.Envy            (DefConfig (..))

data ClientApplication = ClientApplication
  { ClientApplication -> Text
appTitle       :: Text,
    ClientApplication -> Text
appVersionName :: Text,
    ClientApplication -> Text
appVersionCode :: Text,
    ClientApplication -> Text
appPackageName :: Text
  } deriving (Int -> ClientApplication -> ShowS
[ClientApplication] -> ShowS
ClientApplication -> String
(Int -> ClientApplication -> ShowS)
-> (ClientApplication -> String)
-> ([ClientApplication] -> ShowS)
-> Show ClientApplication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientApplication] -> ShowS
$cshowList :: [ClientApplication] -> ShowS
show :: ClientApplication -> String
$cshow :: ClientApplication -> String
showsPrec :: Int -> ClientApplication -> ShowS
$cshowsPrec :: Int -> ClientApplication -> ShowS
Show, (forall x. ClientApplication -> Rep ClientApplication x)
-> (forall x. Rep ClientApplication x -> ClientApplication)
-> Generic ClientApplication
forall x. Rep ClientApplication x -> ClientApplication
forall x. ClientApplication -> Rep ClientApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientApplication x -> ClientApplication
$cfrom :: forall x. ClientApplication -> Rep ClientApplication x
Generic)

instance ToJSON ClientApplication
instance FromJSON ClientApplication

data ClientContext = ClientContext
  { ClientContext -> ClientApplication
client      :: ClientApplication,
    ClientContext -> Map Text Text
custom      :: Map Text Text,
    ClientContext -> Map Text Text
environment :: Map Text Text
  } deriving (Int -> ClientContext -> ShowS
[ClientContext] -> ShowS
ClientContext -> String
(Int -> ClientContext -> ShowS)
-> (ClientContext -> String)
-> ([ClientContext] -> ShowS)
-> Show ClientContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientContext] -> ShowS
$cshowList :: [ClientContext] -> ShowS
show :: ClientContext -> String
$cshow :: ClientContext -> String
showsPrec :: Int -> ClientContext -> ShowS
$cshowsPrec :: Int -> ClientContext -> ShowS
Show, (forall x. ClientContext -> Rep ClientContext x)
-> (forall x. Rep ClientContext x -> ClientContext)
-> Generic ClientContext
forall x. Rep ClientContext x -> ClientContext
forall x. ClientContext -> Rep ClientContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientContext x -> ClientContext
$cfrom :: forall x. ClientContext -> Rep ClientContext x
Generic)

instance ToJSON ClientContext
instance FromJSON ClientContext

data CognitoIdentity = CognitoIdentity
  { CognitoIdentity -> Text
identityId     :: Text
  , CognitoIdentity -> Text
identityPoolId :: Text
  } deriving (Int -> CognitoIdentity -> ShowS
[CognitoIdentity] -> ShowS
CognitoIdentity -> String
(Int -> CognitoIdentity -> ShowS)
-> (CognitoIdentity -> String)
-> ([CognitoIdentity] -> ShowS)
-> Show CognitoIdentity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CognitoIdentity] -> ShowS
$cshowList :: [CognitoIdentity] -> ShowS
show :: CognitoIdentity -> String
$cshow :: CognitoIdentity -> String
showsPrec :: Int -> CognitoIdentity -> ShowS
$cshowsPrec :: Int -> CognitoIdentity -> ShowS
Show, (forall x. CognitoIdentity -> Rep CognitoIdentity x)
-> (forall x. Rep CognitoIdentity x -> CognitoIdentity)
-> Generic CognitoIdentity
forall x. Rep CognitoIdentity x -> CognitoIdentity
forall x. CognitoIdentity -> Rep CognitoIdentity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CognitoIdentity x -> CognitoIdentity
$cfrom :: forall x. CognitoIdentity -> Rep CognitoIdentity x
Generic)

instance ToJSON CognitoIdentity
instance FromJSON CognitoIdentity

getRemainingTime :: MonadIO m => LambdaContext -> m DiffTime
getRemainingTime :: LambdaContext -> m DiffTime
getRemainingTime LambdaContext { UTCTime
deadline :: LambdaContext -> UTCTime
deadline :: UTCTime
deadline } =
  IO DiffTime -> m DiffTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DiffTime -> m DiffTime) -> IO DiffTime -> m DiffTime
forall a b. (a -> b) -> a -> b
$ (UTCTime -> DiffTime) -> IO UTCTime -> IO DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> DiffTime)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline) IO UTCTime
getCurrentTime

data LambdaContext = LambdaContext
  { LambdaContext -> Text
functionName       :: Text,
    LambdaContext -> Text
functionVersion    :: Text,
    LambdaContext -> Int
functionMemorySize :: Int,
    LambdaContext -> Text
logGroupName       :: Text,
    LambdaContext -> Text
logStreamName      :: Text,
    -- The following context values come from headers rather than env vars.
    LambdaContext -> Text
awsRequestId       :: Text,
    LambdaContext -> Text
invokedFunctionArn :: Text,
    LambdaContext -> Text
xRayTraceId        :: Text,
    LambdaContext -> UTCTime
deadline           :: UTCTime,
    LambdaContext -> Maybe ClientContext
clientContext      :: Maybe ClientContext,
    LambdaContext -> Maybe CognitoIdentity
identity           :: Maybe CognitoIdentity
  } deriving (Int -> LambdaContext -> ShowS
[LambdaContext] -> ShowS
LambdaContext -> String
(Int -> LambdaContext -> ShowS)
-> (LambdaContext -> String)
-> ([LambdaContext] -> ShowS)
-> Show LambdaContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LambdaContext] -> ShowS
$cshowList :: [LambdaContext] -> ShowS
show :: LambdaContext -> String
$cshow :: LambdaContext -> String
showsPrec :: Int -> LambdaContext -> ShowS
$cshowsPrec :: Int -> LambdaContext -> ShowS
Show, (forall x. LambdaContext -> Rep LambdaContext x)
-> (forall x. Rep LambdaContext x -> LambdaContext)
-> Generic LambdaContext
forall x. Rep LambdaContext x -> LambdaContext
forall x. LambdaContext -> Rep LambdaContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LambdaContext x -> LambdaContext
$cfrom :: forall x. LambdaContext -> Rep LambdaContext x
Generic)

class HasLambdaContext r where
  withContext :: (LambdaContext -> r -> r)

instance HasLambdaContext LambdaContext where
  withContext :: LambdaContext -> LambdaContext -> LambdaContext
withContext = LambdaContext -> LambdaContext -> LambdaContext
forall a b. a -> b -> a
const

instance DefConfig LambdaContext where
  defConfig :: LambdaContext
defConfig = Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Maybe ClientContext
-> Maybe CognitoIdentity
-> LambdaContext
LambdaContext Text
"" Text
"" Int
0 Text
"" Text
"" Text
"" Text
"" Text
"" (NominalDiffTime -> UTCTime
posixSecondsToUTCTime NominalDiffTime
0) Maybe ClientContext
forall a. Maybe a
Nothing Maybe CognitoIdentity
forall a. Maybe a
Nothing

-- | Helper for using arbitrary monads with only the LambdaContext in its Reader
runReaderTLambdaContext :: ReaderT LambdaContext m a -> m a
runReaderTLambdaContext :: ReaderT LambdaContext m a -> m a
runReaderTLambdaContext = (ReaderT LambdaContext m a -> LambdaContext -> m a)
-> LambdaContext -> ReaderT LambdaContext m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT LambdaContext m a -> LambdaContext -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT LambdaContext
forall a. DefConfig a => a
defConfig