module AWS.Lambda.RuntimeAPI
	( runLambda
	) where

import AWS.Lambda.RuntimeAPI.Types
import Data.Aeson ( encode, eitherDecode' )
import Data.List ( find )
import System.Environment ( lookupEnv )
import Text.Read ( readMaybe )
import UnliftIO
import qualified Data.ByteString.Char8 as C8
import qualified Data.CaseInsensitive as CI
import qualified Data.Map.Strict as Map
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.Internal as HTTP
import qualified Network.HTTP.Types.Header as HTTP
import qualified Network.HTTP.Types.Status as HTTP
import qualified Data.Text as Text

cts :: Text -> String
cts :: Text -> String
cts = Text -> String
Text.unpack

cst :: String -> Text
cst :: String -> Text
cst = String -> Text
Text.pack

mkLambdaHeaderName :: (CI.FoldCase s, Semigroup s, IsString s) => s -> CI.CI s
mkLambdaHeaderName :: s -> CI s
mkLambdaHeaderName s
str = s -> CI s
forall s. FoldCase s => s -> CI s
CI.mk (s -> CI s) -> s -> CI s
forall a b. (a -> b) -> a -> b
$ s
"Lambda-Runtime-" s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
str

requestIdHeader :: HTTP.HeaderName
requestIdHeader :: HeaderName
requestIdHeader = ByteString -> HeaderName
forall s. (FoldCase s, Semigroup s, IsString s) => s -> CI s
mkLambdaHeaderName ByteString
"Aws-Request-Id"

invokedFunctionArnHeader :: HTTP.HeaderName
invokedFunctionArnHeader :: HeaderName
invokedFunctionArnHeader = ByteString -> HeaderName
forall s. (FoldCase s, Semigroup s, IsString s) => s -> CI s
mkLambdaHeaderName ByteString
"Invoked-Function-Arn"

traceIdHeader :: HTTP.HeaderName
traceIdHeader :: HeaderName
traceIdHeader = ByteString -> HeaderName
forall s. (FoldCase s, Semigroup s, IsString s) => s -> CI s
mkLambdaHeaderName ByteString
"Trace-Id"

clientContextHeader :: HTTP.HeaderName
clientContextHeader :: HeaderName
clientContextHeader = ByteString -> HeaderName
forall s. (FoldCase s, Semigroup s, IsString s) => s -> CI s
mkLambdaHeaderName ByteString
"Client-Context"

cognitoIdentityHeader :: HTTP.HeaderName
cognitoIdentityHeader :: HeaderName
cognitoIdentityHeader = ByteString -> HeaderName
forall s. (FoldCase s, Semigroup s, IsString s) => s -> CI s
mkLambdaHeaderName ByteString
"Cognito-Identity"

unhandledErrorHeader :: HTTP.Header
unhandledErrorHeader :: Header
unhandledErrorHeader = ( ByteString -> HeaderName
forall s. (FoldCase s, Semigroup s, IsString s) => s -> CI s
mkLambdaHeaderName ByteString
"Function-Error-Type", ByteString
"Unhandled" )

apiVersion :: String
apiVersion :: String
apiVersion = String
"2018-06-01"

apiHostEnvVarName :: String
apiHostEnvVarName :: String
apiHostEnvVarName = String
"AWS_LAMBDA_RUNTIME_API"

-- | This function is intended to be your `main` implementation.  Given a handler for 'LambdaInvocation' instances,
--   it loops indefinitely (until AWS terminates the process) on the retrieval of invocations. It feeds each of those
--   invocations into the handler that was passed in as an argument. It then posts the result back to AWS and begins
--   the loop again.
runLambda :: (MonadUnliftIO m, MonadFail m, MonadThrow m, FromJSON a, ToJSON b, NFData a, NFData b) => (LambdaInvocation a -> m (LambdaResult b)) -> m ()
runLambda :: (LambdaInvocation a -> m (LambdaResult b)) -> m ()
runLambda LambdaInvocation a -> m (LambdaResult b)
handler = do
		LambdaExecutionContext a m b
ctx <- (LambdaInvocation a -> m (LambdaResult b))
-> m (LambdaExecutionContext a m b)
forall (m :: * -> *) a b.
(MonadUnliftIO m, MonadFail m) =>
(LambdaInvocation a -> m (LambdaResult b))
-> m (LambdaExecutionContext a m b)
lookupLEC LambdaInvocation a -> m (LambdaResult b)
handler
		m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LambdaExecutionContext a m b -> m ()
forall (m :: * -> *) a b.
(MonadUnliftIO m, MonadThrow m, MonadFail m, FromJSON a, ToJSON b,
 NFData a, NFData b) =>
LambdaExecutionContext a m b -> m ()
doRound LambdaExecutionContext a m b
ctx

lookupLEC :: (MonadUnliftIO m, MonadFail m) => (LambdaInvocation a -> m (LambdaResult b)) -> m (LambdaExecutionContext a m b)
lookupLEC :: (LambdaInvocation a -> m (LambdaResult b))
-> m (LambdaExecutionContext a m b)
lookupLEC LambdaInvocation a -> m (LambdaResult b)
lecHandler = do
		String
apiHost <- m String
lookupApiHost
		let lecApiPrefix :: String
lecApiPrefix = String
"http://" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
apiHost String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
apiVersion
		Manager
lecHttpManager <- IO Manager -> m Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> m Manager) -> IO Manager -> m Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
HTTP.newManager ManagerSettings
managerSettings
		LambdaExecutionContext a m b -> m (LambdaExecutionContext a m b)
forall (m :: * -> *) a. Monad m => a -> m a
return LambdaExecutionContext :: forall a (m :: * -> *) b.
String
-> Manager
-> (LambdaInvocation a -> m (LambdaResult b))
-> LambdaExecutionContext a m b
LambdaExecutionContext{String
Manager
LambdaInvocation a -> m (LambdaResult b)
lecHandler :: LambdaInvocation a -> m (LambdaResult b)
lecHttpManager :: Manager
lecApiPrefix :: String
lecHttpManager :: Manager
lecApiPrefix :: String
lecHandler :: LambdaInvocation a -> m (LambdaResult b)
..}
	where
		lookupApiHost :: m String
lookupApiHost = IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ( String -> IO (Maybe String)
lookupEnv String
apiHostEnvVarName ) m (Maybe String) -> (Maybe String -> m String) -> m String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
			Maybe String
Nothing -> String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"No API host environment variable name found: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
apiHostEnvVarName
			Just String
val -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
val
		managerSettings :: ManagerSettings
managerSettings = ManagerSettings
HTTP.defaultManagerSettings
			{ managerResponseTimeout :: ResponseTimeout
HTTP.managerResponseTimeout = ResponseTimeout
HTTP.responseTimeoutNone
			, managerIdleConnectionCount :: Int
HTTP.managerIdleConnectionCount = Int
1
			}

doRound :: (MonadUnliftIO m, MonadThrow m, MonadFail m, FromJSON a, ToJSON b, NFData a, NFData b) => LambdaExecutionContext a m b -> m ()
doRound :: LambdaExecutionContext a m b -> m ()
doRound LambdaExecutionContext a m b
ctx = m (Maybe (LambdaInvocation a))
getNextInvocation m (Maybe (LambdaInvocation a))
-> (Maybe (LambdaInvocation a) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
			Maybe (LambdaInvocation a)
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
			Just LambdaInvocation a
request -> LambdaInvocation a -> m (LambdaResult b)
processRequest LambdaInvocation a
request m (LambdaResult b) -> (LambdaResult b -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LambdaExecutionContext a m b
-> LambdaInvocation a -> LambdaResult b -> m ()
forall (m :: * -> *) b a.
(MonadUnliftIO m, MonadThrow m, ToJSON b) =>
LambdaExecutionContext a m b
-> LambdaInvocation a -> LambdaResult b -> m ()
postResult LambdaExecutionContext a m b
ctx LambdaInvocation a
request
	where
		getNextInvocation :: m (Maybe (LambdaInvocation a))
getNextInvocation = (SomeException -> m (Maybe (LambdaInvocation a)))
-> m (Maybe (LambdaInvocation a)) -> m (Maybe (LambdaInvocation a))
forall (m :: * -> *) a.
(MonadUnliftIO m, NFData a) =>
(SomeException -> m a) -> m a -> m a
handleAnyDeep SomeException -> m (Maybe (LambdaInvocation a))
handleTopException ( LambdaInvocation a -> Maybe (LambdaInvocation a)
forall a. a -> Maybe a
Just (LambdaInvocation a -> Maybe (LambdaInvocation a))
-> m (LambdaInvocation a) -> m (Maybe (LambdaInvocation a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LambdaExecutionContext a m b -> m (LambdaInvocation a)
forall (m :: * -> *) a b.
(MonadUnliftIO m, MonadThrow m, MonadFail m, FromJSON a) =>
LambdaExecutionContext a m b -> m (LambdaInvocation a)
fetchNext LambdaExecutionContext a m b
ctx )
		handler :: LambdaInvocation a -> m (LambdaResult b)
handler = LambdaExecutionContext a m b
-> LambdaInvocation a -> m (LambdaResult b)
forall a (m :: * -> *) b.
LambdaExecutionContext a m b
-> LambdaInvocation a -> m (LambdaResult b)
lecHandler LambdaExecutionContext a m b
ctx
		processRequest :: LambdaInvocation a -> m (LambdaResult b)
processRequest LambdaInvocation a
invoc = (SomeException -> m (LambdaResult b))
-> m (LambdaResult b) -> m (LambdaResult b)
forall (m :: * -> *) a.
(MonadUnliftIO m, NFData a) =>
(SomeException -> m a) -> m a -> m a
handleAnyDeep SomeException -> m (LambdaResult b)
forall (m :: * -> *) e payload.
(Monad m, Exception e) =>
e -> m (LambdaResult payload)
handleException (m (LambdaResult b) -> m (LambdaResult b))
-> m (LambdaResult b) -> m (LambdaResult b)
forall a b. (a -> b) -> a -> b
$ LambdaInvocation a -> m (LambdaResult b)
handler LambdaInvocation a
invoc
		handleException :: e -> m (LambdaResult payload)
handleException e
e = LambdaResult payload -> m (LambdaResult payload)
forall (m :: * -> *) a. Monad m => a -> m a
return (LambdaResult payload -> m (LambdaResult payload))
-> LambdaResult payload -> m (LambdaResult payload)
forall a b. (a -> b) -> a -> b
$ ErrorInfo -> LambdaResult payload
forall payload. ErrorInfo -> LambdaResult payload
LambdaError (String -> Text
cst (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
exToTypeStr e
e, String -> Text
cst (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
exToHumanStr e
e)
		handleTopException :: SomeException -> m (Maybe (LambdaInvocation a))
handleTopException SomeException
err = LambdaExecutionContext a m b -> SomeException -> m ()
forall (m :: * -> *) e a b.
(MonadIO m, Exception e) =>
LambdaExecutionContext a m b -> e -> m ()
handleInvocationException LambdaExecutionContext a m b
ctx SomeException
err m ()
-> m (Maybe (LambdaInvocation a)) -> m (Maybe (LambdaInvocation a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (LambdaInvocation a) -> m (Maybe (LambdaInvocation a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LambdaInvocation a)
forall a. Maybe a
Nothing

exToTypeStr :: (Exception e) => e -> String
exToTypeStr :: e -> String
exToTypeStr = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> (e -> TypeRep) -> e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf

exToHumanStr :: (Exception e) => e -> String
exToHumanStr :: e -> String
exToHumanStr = e -> String
forall e. Exception e => e -> String
displayException

handleInvocationException :: (MonadIO m, Exception e) => LambdaExecutionContext a m b -> e -> m ()
handleInvocationException :: LambdaExecutionContext a m b -> e -> m ()
handleInvocationException
	LambdaExecutionContext{String
lecApiPrefix :: String
lecApiPrefix :: forall a (m :: * -> *) b. LambdaExecutionContext a m b -> String
lecApiPrefix, Manager
lecHttpManager :: Manager
lecHttpManager :: forall a (m :: * -> *) b. LambdaExecutionContext a m b -> Manager
lecHttpManager}
	e
err
	= IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
		String -> IO ()
putStrLn String
"!!!Invocation Exception!!!"
		String -> IO ()
putStrLn String
"\tThis is a problem with the Lambda Runtime API or AWS."
		String -> IO ()
putStrLn String
"\tThe problem is not in your code. Scroll down for details."
		String -> IO ()
putStrLn String
"\tThe Runtime API will now attempt to get another invocation."
		String -> IO ()
putStrLn String
""
		IO ()
printTypeStr
		IO ()
printHumanStr
		String -> IO ()
putStrLn String
"^^^Invocation Exception^^^"
		Request
initReq <- String -> String -> Maybe (Map String String) -> IO Request
forall (m :: * -> *) b.
(MonadThrow m, ToJSON b) =>
String -> String -> Maybe b -> m Request
makeHttpRequest String
"POST" String
url Maybe (Map String String)
body
		let req :: Request
req = Request
initReq
			{ requestHeaders :: RequestHeaders
HTTP.requestHeaders = Header
unhandledErrorHeader Header -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
HTTP.requestHeaders Request
initReq
			}
		Response ()
response <- Request -> Manager -> IO (Response ())
HTTP.httpNoBody Request
req Manager
lecHttpManager
		Response () -> IO ()
forall (m :: * -> *) body. MonadFail m => Response body -> m ()
checkResponseStatus Response ()
response
	where
		url :: String
url = String
lecApiPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/runtime/init/error"
		body :: Maybe (Map String String)
body = Map String String -> Maybe (Map String String)
forall a. a -> Maybe a
Just (Map String String -> Maybe (Map String String))
-> Map String String -> Maybe (Map String String)
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
			[ ( String
"errorMessage", String
humanStr )
			, ( String
"errorType", String
typeStr )
			]
		typeStr :: String
typeStr = e -> String
forall e. Exception e => e -> String
exToTypeStr e
err
		humanStr :: String
humanStr = e -> String
forall e. Exception e => e -> String
exToHumanStr e
err
		printTypeStr :: IO ()
printTypeStr = String -> IO ()
putStrLn String
typeStr
		printHumanStr :: IO ()
printHumanStr =
			if String
typeStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
humanStr then
				() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
			else
				String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
exToHumanStr e
err

checkResponseStatus :: MonadFail m => HTTP.Response body -> m ()
checkResponseStatus :: Response body -> m ()
checkResponseStatus Response body
response =
	let status :: Status
status = Response body -> Status
forall body. Response body -> Status
HTTP.responseStatus Response body
response in
	if Status -> Bool
HTTP.statusIsSuccessful (Status -> Bool) -> Status -> Bool
forall a b. (a -> b) -> a -> b
$ Response body -> Status
forall body. Response body -> Status
HTTP.responseStatus Response body
response then
		() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
	else
		String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Received non-successful status when trying to fetch: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Status -> String
forall a. Show a => a -> String
show Status
status

fetchNext :: (MonadUnliftIO m, MonadThrow m, MonadFail m, FromJSON a) => LambdaExecutionContext a m b ->  m (LambdaInvocation a)
fetchNext :: LambdaExecutionContext a m b -> m (LambdaInvocation a)
fetchNext LambdaExecutionContext{String
lecApiPrefix :: String
lecApiPrefix :: forall a (m :: * -> *) b. LambdaExecutionContext a m b -> String
lecApiPrefix, Manager
lecHttpManager :: Manager
lecHttpManager :: forall a (m :: * -> *) b. LambdaExecutionContext a m b -> Manager
lecHttpManager} = do
		Request
req <- String -> String -> Maybe () -> m Request
forall (m :: * -> *) b.
(MonadThrow m, ToJSON b) =>
String -> String -> Maybe b -> m Request
makeHttpRequest String
"GET" String
url (Maybe ()
forall a. Maybe a
Nothing::Maybe ())
		Response ByteString
response <- IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
req Manager
lecHttpManager
		Response ByteString -> m ()
forall (m :: * -> *) body. MonadFail m => Response body -> m ()
checkResponseStatus Response ByteString
response
		a
liPayload <- Response ByteString -> m a
forall a (m :: * -> *).
(FromJSON a, MonadFail m) =>
Response ByteString -> m a
readPayload Response ByteString
response
		Text
liAwsRequestId <- String -> Text
cst (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response ByteString -> HeaderName -> m String
forall (m :: * -> *) body.
MonadFail m =>
Response body -> HeaderName -> m String
readHeader Response ByteString
response HeaderName
requestIdHeader
		Word64
liDeadlineMs <- Response ByteString -> m Word64
forall (m :: * -> *) b body.
(MonadFail m, Read b) =>
Response body -> m b
readDeadline Response ByteString
response
		Text
liInvokedFunctionArn <- String -> Text
cst (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response ByteString -> HeaderName -> m String
forall (m :: * -> *) body.
MonadFail m =>
Response body -> HeaderName -> m String
readHeader Response ByteString
response HeaderName
invokedFunctionArnHeader
		Text
liTraceId <- String -> Text
cst (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response ByteString -> HeaderName -> m String
forall (m :: * -> *) body.
MonadFail m =>
Response body -> HeaderName -> m String
readHeader Response ByteString
response HeaderName
traceIdHeader
		let liMobileMetadata :: Maybe MobileInvocationMetadata
liMobileMetadata = Response ByteString -> Maybe MobileInvocationMetadata
forall (m :: * -> *) body.
MonadFail m =>
Response body -> m MobileInvocationMetadata
readMobileMetadata Response ByteString
response
		LambdaInvocation a -> m (LambdaInvocation a)
forall (m :: * -> *) a. Monad m => a -> m a
return (LambdaInvocation a -> m (LambdaInvocation a))
-> LambdaInvocation a -> m (LambdaInvocation a)
forall a b. (a -> b) -> a -> b
$ LambdaInvocation :: forall payload.
Text
-> Word64
-> Text
-> Text
-> Maybe MobileInvocationMetadata
-> payload
-> LambdaInvocation payload
LambdaInvocation{a
Maybe MobileInvocationMetadata
Word64
Text
liPayload :: a
liMobileMetadata :: Maybe MobileInvocationMetadata
liTraceId :: Text
liInvokedFunctionArn :: Text
liDeadlineMs :: Word64
liAwsRequestId :: Text
liMobileMetadata :: Maybe MobileInvocationMetadata
liTraceId :: Text
liInvokedFunctionArn :: Text
liDeadlineMs :: Word64
liAwsRequestId :: Text
liPayload :: a
..}
	where
		url :: String
url = String
lecApiPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/runtime/invocation/next"
		readMobileMetadata :: Response body -> m MobileInvocationMetadata
readMobileMetadata Response body
response = do
			Text
mimClientContext <- String -> Text
cst (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response body -> HeaderName -> m String
forall (m :: * -> *) body.
MonadFail m =>
Response body -> HeaderName -> m String
readHeader Response body
response HeaderName
clientContextHeader
			Text
mimCognitoIdentity <- String -> Text
cst (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response body -> HeaderName -> m String
forall (m :: * -> *) body.
MonadFail m =>
Response body -> HeaderName -> m String
readHeader Response body
response HeaderName
cognitoIdentityHeader
			MobileInvocationMetadata -> m MobileInvocationMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return (MobileInvocationMetadata -> m MobileInvocationMetadata)
-> MobileInvocationMetadata -> m MobileInvocationMetadata
forall a b. (a -> b) -> a -> b
$ MobileInvocationMetadata :: Text -> Text -> MobileInvocationMetadata
MobileInvocationMetadata{Text
mimCognitoIdentity :: Text
mimClientContext :: Text
mimCognitoIdentity :: Text
mimClientContext :: Text
..}
		readHeader :: Response body -> HeaderName -> m String
readHeader Response body
response HeaderName
headerName =
			let headers :: RequestHeaders
headers = Response body -> RequestHeaders
forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response body
response in
			let finder :: Header -> Bool
finder (HeaderName
otherHeaderName, ByteString
_) = HeaderName
headerName HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
otherHeaderName in
			case (Header -> Bool) -> RequestHeaders -> Maybe Header
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Header -> Bool
finder RequestHeaders
headers of
				Just (HeaderName
_,ByteString
value) -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
C8.unpack ByteString
value
				Maybe Header
Nothing -> String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"Could not find header: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HeaderName -> String
forall a. Show a => a -> String
show HeaderName
headerName
		readDeadline :: Response body -> m b
readDeadline Response body
response = do
			String
headerValue <- Response body -> HeaderName -> m String
forall (m :: * -> *) body.
MonadFail m =>
Response body -> HeaderName -> m String
readHeader Response body
response HeaderName
"Lambda-Runtime-Deadline-Ms"
			case String -> Maybe b
forall a. Read a => String -> Maybe a
readMaybe String
headerValue of
				Maybe b
Nothing -> String -> m b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m b) -> String -> m b
forall a b. (a -> b) -> a -> b
$ String
"Could not parse deadline header value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
headerValue
				Just b
parsed -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
parsed
		readPayload :: Response ByteString -> m a
readPayload Response ByteString
response =
			let body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
HTTP.responseBody Response ByteString
response in
			case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode' ByteString
body of
				Left String
err -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Could not parse the body of the next invocation: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
				Right a
value -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
value

makeHttpRequest :: (MonadThrow m, ToJSON b) => String -> String -> Maybe b -> m HTTP.Request
makeHttpRequest :: String -> String -> Maybe b -> m Request
makeHttpRequest String
method String
url Maybe b
maybeBody =
		Request -> Request
customizeRequest (Request -> Request) -> m Request -> m Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HTTP.parseUrlThrow (String
method String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
url)
	where
		customizeRequest :: Request -> Request
customizeRequest Request
initReq = Request
initReq
			{ decompress :: ByteString -> Bool
HTTP.decompress = ByteString -> Bool
HTTP.alwaysDecompress
			, requestHeaders :: RequestHeaders
HTTP.requestHeaders =
				[ ( HeaderName
HTTP.hAccept, ByteString
"application/json" )
				, ( HeaderName
HTTP.hContentType, ByteString
"application/json" )
				]
			, requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ case Maybe b
maybeBody of
					Maybe b
Nothing -> ByteString
""
					Just b
body -> b -> ByteString
forall a. ToJSON a => a -> ByteString
encode b
body
			}

postResult :: (MonadUnliftIO m, MonadThrow m, ToJSON b) => LambdaExecutionContext a m b -> LambdaInvocation a -> LambdaResult b -> m ()
postResult :: LambdaExecutionContext a m b
-> LambdaInvocation a -> LambdaResult b -> m ()
postResult
	LambdaExecutionContext{String
lecApiPrefix :: String
lecApiPrefix :: forall a (m :: * -> *) b. LambdaExecutionContext a m b -> String
lecApiPrefix, Manager
lecHttpManager :: Manager
lecHttpManager :: forall a (m :: * -> *) b. LambdaExecutionContext a m b -> Manager
lecHttpManager}
	LambdaInvocation{Text
liAwsRequestId :: Text
liAwsRequestId :: forall payload. LambdaInvocation payload -> Text
liAwsRequestId, Text
liTraceId :: Text
liTraceId :: forall payload. LambdaInvocation payload -> Text
liTraceId}
	LambdaResult b
result =
		case LambdaResult b
result of
			LambdaResult b
LambdaNop -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
			(LambdaSuccess b
payload) -> do
				let url :: String
url = String
lecApiPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/runtime/invocation/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
cts Text
liAwsRequestId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/response"
				let body :: Maybe b
body = b -> Maybe b
forall a. a -> Maybe a
Just b
payload
				Request
req <- Request -> Request
addTraceId (Request -> Request) -> m Request -> m Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Maybe b -> m Request
forall (m :: * -> *) b.
(MonadThrow m, ToJSON b) =>
String -> String -> Maybe b -> m Request
makeHttpRequest String
"POST" String
url Maybe b
body
				m (Response ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Response ()) -> m ())
-> (IO (Response ()) -> m (Response ()))
-> IO (Response ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Response ()) -> m (Response ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ()) -> m ()) -> IO (Response ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ())
HTTP.httpNoBody Request
req Manager
lecHttpManager
			LambdaError (Text
errType, Text
errMsg) -> do
				let url :: String
url = String
lecApiPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/runtime/invocation/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
cts Text
liAwsRequestId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/error"
				let body :: Maybe (Map String Text)
body = Map String Text -> Maybe (Map String Text)
forall a. a -> Maybe a
Just (Map String Text -> Maybe (Map String Text))
-> Map String Text -> Maybe (Map String Text)
forall a b. (a -> b) -> a -> b
$ [(String, Text)] -> Map String Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
					[ ( String
"errorMessage", Text
errMsg )
					, ( String
"errorType", Text
errType )
					]
				Request
req <- String -> String -> Maybe (Map String Text) -> m Request
forall (m :: * -> *) b.
(MonadThrow m, ToJSON b) =>
String -> String -> Maybe b -> m Request
makeHttpRequest String
"POST" String
url Maybe (Map String Text)
body
				m (Response ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Response ()) -> m ())
-> (IO (Response ()) -> m (Response ()))
-> IO (Response ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Response ()) -> m (Response ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ()) -> m ()) -> IO (Response ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ())
HTTP.httpNoBody Request
req Manager
lecHttpManager
	where
		addTraceId :: Request -> Request
addTraceId Request
req = Request
req
			{ requestHeaders :: RequestHeaders
HTTP.requestHeaders
				= (HeaderName
traceIdHeader, String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
cts Text
liTraceId) Header -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
:  Request -> RequestHeaders
HTTP.requestHeaders Request
req
			}