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

import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Data.Aeson             (FromJSON, ToJSON)
import           Data.Map               (Map)
import           Data.Text              (Text)
import           Data.Time.Clock        (DiffTime, UTCTime,
                                         diffUTCTime, getCurrentTime)
import           GHC.Generics           (Generic)

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, ClientApplication -> ClientApplication -> Bool
(ClientApplication -> ClientApplication -> Bool)
-> (ClientApplication -> ClientApplication -> Bool)
-> Eq ClientApplication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientApplication -> ClientApplication -> Bool
$c/= :: ClientApplication -> ClientApplication -> Bool
== :: ClientApplication -> ClientApplication -> Bool
$c== :: ClientApplication -> ClientApplication -> Bool
Eq)

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, ClientContext -> ClientContext -> Bool
(ClientContext -> ClientContext -> Bool)
-> (ClientContext -> ClientContext -> Bool) -> Eq ClientContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientContext -> ClientContext -> Bool
$c/= :: ClientContext -> ClientContext -> Bool
== :: ClientContext -> ClientContext -> Bool
$c== :: ClientContext -> ClientContext -> Bool
Eq)

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, CognitoIdentity -> CognitoIdentity -> Bool
(CognitoIdentity -> CognitoIdentity -> Bool)
-> (CognitoIdentity -> CognitoIdentity -> Bool)
-> Eq CognitoIdentity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CognitoIdentity -> CognitoIdentity -> Bool
$c/= :: CognitoIdentity -> CognitoIdentity -> Bool
== :: CognitoIdentity -> CognitoIdentity -> Bool
$c== :: CognitoIdentity -> CognitoIdentity -> Bool
Eq)

instance ToJSON CognitoIdentity
instance FromJSON CognitoIdentity

getRemainingTime :: MonadIO m => LambdaContext -> m DiffTime
getRemainingTime :: LambdaContext -> m DiffTime
getRemainingTime LambdaContext { UTCTime
$sel:deadline:LambdaContext :: 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, LambdaContext -> LambdaContext -> Bool
(LambdaContext -> LambdaContext -> Bool)
-> (LambdaContext -> LambdaContext -> Bool) -> Eq LambdaContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LambdaContext -> LambdaContext -> Bool
$c/= :: LambdaContext -> LambdaContext -> Bool
== :: LambdaContext -> LambdaContext -> Bool
$c== :: LambdaContext -> LambdaContext -> Bool
Eq)